Don't set C_OPTIMIZE_SWITCH.
[emacs.git] / src / xfns.c
blobd5e966ed6bcf98ddcfa82fcbc91735bc497a11af
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 /* On some systems, the character-composition stuff is broken in X11R5. */
55 #if defined (HAVE_X11R5) && ! defined (HAVE_X11R6)
56 #ifdef X11R5_INHIBIT_I18N
57 #define X_I18N_INHIBITED
58 #endif
59 #endif
61 #ifndef VMS
62 #if 1 /* Used to be #ifdef EMACS_BITMAP_FILES, but this should always work. */
63 #include "bitmaps/gray.xbm"
64 #else
65 #include <X11/bitmaps/gray>
66 #endif
67 #else
68 #include "[.bitmaps]gray.xbm"
69 #endif
71 #ifdef USE_X_TOOLKIT
72 #include <X11/Shell.h>
74 #ifndef USE_MOTIF
75 #include <X11/Xaw/Paned.h>
76 #include <X11/Xaw/Label.h>
77 #endif /* USE_MOTIF */
79 #ifdef USG
80 #undef USG /* ####KLUDGE for Solaris 2.2 and up */
81 #include <X11/Xos.h>
82 #define USG
83 #else
84 #include <X11/Xos.h>
85 #endif
87 #include "widget.h"
89 #include "../lwlib/lwlib.h"
91 #ifdef USE_MOTIF
92 #include <Xm/Xm.h>
93 #include <Xm/DialogS.h>
94 #include <Xm/FileSB.h>
95 #endif
97 /* Do the EDITRES protocol if running X11R5
98 Exception: HP-UX (at least version A.09.05) has X11R5 without EditRes */
100 #if (XtSpecificationRelease >= 5) && !defined(NO_EDITRES)
101 #define HACK_EDITRES
102 extern void _XEditResCheckMessages ();
103 #endif /* R5 + Athena */
105 /* Unique id counter for widgets created by the Lucid Widget Library. */
107 extern LWLIB_ID widget_id_tick;
109 #ifdef USE_LUCID
110 /* This is part of a kludge--see lwlib/xlwmenu.c. */
111 extern XFontStruct *xlwmenu_default_font;
112 #endif
114 extern void free_frame_menubar ();
115 extern double atof ();
117 #endif /* USE_X_TOOLKIT */
119 #define min(a,b) ((a) < (b) ? (a) : (b))
120 #define max(a,b) ((a) > (b) ? (a) : (b))
122 #ifdef HAVE_X11R4
123 #define MAXREQUEST(dpy) (XMaxRequestSize (dpy))
124 #else
125 #define MAXREQUEST(dpy) ((dpy)->max_request_size)
126 #endif
128 /* The gray bitmap `bitmaps/gray'. This is done because xterm.c uses
129 it, and including `bitmaps/gray' more than once is a problem when
130 config.h defines `static' as an empty replacement string. */
132 int gray_bitmap_width = gray_width;
133 int gray_bitmap_height = gray_height;
134 unsigned char *gray_bitmap_bits = gray_bits;
136 /* The name we're using in resource queries. Most often "emacs". */
138 Lisp_Object Vx_resource_name;
140 /* The application class we're using in resource queries.
141 Normally "Emacs". */
143 Lisp_Object Vx_resource_class;
145 /* Non-zero means we're allowed to display a busy cursor. */
147 int display_busy_cursor_p;
149 /* The background and shape of the mouse pointer, and shape when not
150 over text or in the modeline. */
152 Lisp_Object Vx_pointer_shape, Vx_nontext_pointer_shape, Vx_mode_pointer_shape;
153 Lisp_Object Vx_busy_pointer_shape;
155 /* The shape when over mouse-sensitive text. */
157 Lisp_Object Vx_sensitive_text_pointer_shape;
159 /* Color of chars displayed in cursor box. */
161 Lisp_Object Vx_cursor_fore_pixel;
163 /* Nonzero if using X. */
165 static int x_in_use;
167 /* Non nil if no window manager is in use. */
169 Lisp_Object Vx_no_window_manager;
171 /* Search path for bitmap files. */
173 Lisp_Object Vx_bitmap_file_path;
175 /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. */
177 Lisp_Object Vx_pixel_size_width_font_regexp;
179 /* Evaluate this expression to rebuild the section of syms_of_xfns
180 that initializes and staticpros the symbols declared below. Note
181 that Emacs 18 has a bug that keeps C-x C-e from being able to
182 evaluate this expression.
184 (progn
185 ;; Accumulate a list of the symbols we want to initialize from the
186 ;; declarations at the top of the file.
187 (goto-char (point-min))
188 (search-forward "/\*&&& symbols declared here &&&*\/\n")
189 (let (symbol-list)
190 (while (looking-at "Lisp_Object \\(Q[a-z_]+\\)")
191 (setq symbol-list
192 (cons (buffer-substring (match-beginning 1) (match-end 1))
193 symbol-list))
194 (forward-line 1))
195 (setq symbol-list (nreverse symbol-list))
196 ;; Delete the section of syms_of_... where we initialize the symbols.
197 (search-forward "\n /\*&&& init symbols here &&&*\/\n")
198 (let ((start (point)))
199 (while (looking-at "^ Q")
200 (forward-line 2))
201 (kill-region start (point)))
202 ;; Write a new symbol initialization section.
203 (while symbol-list
204 (insert (format " %s = intern (\"" (car symbol-list)))
205 (let ((start (point)))
206 (insert (substring (car symbol-list) 1))
207 (subst-char-in-region start (point) ?_ ?-))
208 (insert (format "\");\n staticpro (&%s);\n" (car symbol-list)))
209 (setq symbol-list (cdr symbol-list)))))
213 /*&&& symbols declared here &&&*/
214 Lisp_Object Qauto_raise;
215 Lisp_Object Qauto_lower;
216 Lisp_Object Qbar;
217 Lisp_Object Qborder_color;
218 Lisp_Object Qborder_width;
219 Lisp_Object Qbox;
220 Lisp_Object Qcursor_color;
221 Lisp_Object Qcursor_type;
222 Lisp_Object Qgeometry;
223 Lisp_Object Qicon_left;
224 Lisp_Object Qicon_top;
225 Lisp_Object Qicon_type;
226 Lisp_Object Qicon_name;
227 Lisp_Object Qinternal_border_width;
228 Lisp_Object Qleft;
229 Lisp_Object Qright;
230 Lisp_Object Qmouse_color;
231 Lisp_Object Qnone;
232 Lisp_Object Qouter_window_id;
233 Lisp_Object Qparent_id;
234 Lisp_Object Qscroll_bar_width;
235 Lisp_Object Qsuppress_icon;
236 extern Lisp_Object Qtop;
237 Lisp_Object Qundefined_color;
238 Lisp_Object Qvertical_scroll_bars;
239 Lisp_Object Qvisibility;
240 Lisp_Object Qwindow_id;
241 Lisp_Object Qx_frame_parameter;
242 Lisp_Object Qx_resource_name;
243 Lisp_Object Quser_position;
244 Lisp_Object Quser_size;
245 extern Lisp_Object Qdisplay;
246 Lisp_Object Qscroll_bar_foreground, Qscroll_bar_background;
247 Lisp_Object Qscreen_gamma;
249 /* The below are defined in frame.c. */
251 extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth;
252 extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle;
253 extern Lisp_Object Qtool_bar_lines;
255 extern Lisp_Object Vwindow_system_version;
257 Lisp_Object Qface_set_after_frame_default;
260 /* Error if we are not connected to X. */
262 void
263 check_x ()
265 if (! x_in_use)
266 error ("X windows are not in use or not initialized");
269 /* Nonzero if we can use mouse menus.
270 You should not call this unless HAVE_MENUS is defined. */
273 have_menus_p ()
275 return x_in_use;
278 /* Extract a frame as a FRAME_PTR, defaulting to the selected frame
279 and checking validity for X. */
281 FRAME_PTR
282 check_x_frame (frame)
283 Lisp_Object frame;
285 FRAME_PTR f;
287 if (NILP (frame))
288 frame = selected_frame;
289 CHECK_LIVE_FRAME (frame, 0);
290 f = XFRAME (frame);
291 if (! FRAME_X_P (f))
292 error ("Non-X frame used");
293 return f;
296 /* Let the user specify an X display with a frame.
297 nil stands for the selected frame--or, if that is not an X frame,
298 the first X display on the list. */
300 static struct x_display_info *
301 check_x_display_info (frame)
302 Lisp_Object frame;
304 if (NILP (frame))
306 struct frame *sf = XFRAME (selected_frame);
308 if (FRAME_X_P (sf) && FRAME_LIVE_P (sf))
309 return FRAME_X_DISPLAY_INFO (sf);
310 else if (x_display_list != 0)
311 return x_display_list;
312 else
313 error ("X windows are not in use or not initialized");
315 else if (STRINGP (frame))
316 return x_display_info_for_name (frame);
317 else
319 FRAME_PTR f;
321 CHECK_LIVE_FRAME (frame, 0);
322 f = XFRAME (frame);
323 if (! FRAME_X_P (f))
324 error ("Non-X frame used");
325 return FRAME_X_DISPLAY_INFO (f);
330 /* Return the Emacs frame-object corresponding to an X window.
331 It could be the frame's main window or an icon window. */
333 /* This function can be called during GC, so use GC_xxx type test macros. */
335 struct frame *
336 x_window_to_frame (dpyinfo, wdesc)
337 struct x_display_info *dpyinfo;
338 int wdesc;
340 Lisp_Object tail, frame;
341 struct frame *f;
343 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
345 frame = XCAR (tail);
346 if (!GC_FRAMEP (frame))
347 continue;
348 f = XFRAME (frame);
349 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
350 continue;
351 if (f->output_data.x->busy_window == wdesc)
352 return f;
353 #ifdef USE_X_TOOLKIT
354 if ((f->output_data.x->edit_widget
355 && XtWindow (f->output_data.x->edit_widget) == wdesc)
356 /* A tooltip frame? */
357 || (!f->output_data.x->edit_widget
358 && FRAME_X_WINDOW (f) == wdesc)
359 || f->output_data.x->icon_desc == wdesc)
360 return f;
361 #else /* not USE_X_TOOLKIT */
362 if (FRAME_X_WINDOW (f) == wdesc
363 || f->output_data.x->icon_desc == wdesc)
364 return f;
365 #endif /* not USE_X_TOOLKIT */
367 return 0;
370 #ifdef USE_X_TOOLKIT
371 /* Like x_window_to_frame but also compares the window with the widget's
372 windows. */
374 struct frame *
375 x_any_window_to_frame (dpyinfo, wdesc)
376 struct x_display_info *dpyinfo;
377 int wdesc;
379 Lisp_Object tail, frame;
380 struct frame *f, *found;
381 struct x_output *x;
383 found = NULL;
384 for (tail = Vframe_list; GC_CONSP (tail) && !found; tail = XCDR (tail))
386 frame = XCAR (tail);
387 if (!GC_FRAMEP (frame))
388 continue;
390 f = XFRAME (frame);
391 if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo)
393 /* This frame matches if the window is any of its widgets. */
394 x = f->output_data.x;
395 if (x->busy_window == wdesc)
396 found = f;
397 else if (x->widget)
399 if (wdesc == XtWindow (x->widget)
400 || wdesc == XtWindow (x->column_widget)
401 || wdesc == XtWindow (x->edit_widget))
402 found = f;
403 /* Match if the window is this frame's menubar. */
404 else if (lw_window_is_in_menubar (wdesc, x->menubar_widget))
405 found = f;
407 else if (FRAME_X_WINDOW (f) == wdesc)
408 /* A tooltip frame. */
409 found = f;
413 return found;
416 /* Likewise, but exclude the menu bar widget. */
418 struct frame *
419 x_non_menubar_window_to_frame (dpyinfo, wdesc)
420 struct x_display_info *dpyinfo;
421 int wdesc;
423 Lisp_Object tail, frame;
424 struct frame *f;
425 struct x_output *x;
427 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
429 frame = XCAR (tail);
430 if (!GC_FRAMEP (frame))
431 continue;
432 f = XFRAME (frame);
433 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
434 continue;
435 x = f->output_data.x;
436 /* This frame matches if the window is any of its widgets. */
437 if (x->busy_window == wdesc)
438 return f;
439 else if (x->widget)
441 if (wdesc == XtWindow (x->widget)
442 || wdesc == XtWindow (x->column_widget)
443 || wdesc == XtWindow (x->edit_widget))
444 return f;
446 else if (FRAME_X_WINDOW (f) == wdesc)
447 /* A tooltip frame. */
448 return f;
450 return 0;
453 /* Likewise, but consider only the menu bar widget. */
455 struct frame *
456 x_menubar_window_to_frame (dpyinfo, wdesc)
457 struct x_display_info *dpyinfo;
458 int wdesc;
460 Lisp_Object tail, frame;
461 struct frame *f;
462 struct x_output *x;
464 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
466 frame = XCAR (tail);
467 if (!GC_FRAMEP (frame))
468 continue;
469 f = XFRAME (frame);
470 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
471 continue;
472 x = f->output_data.x;
473 /* Match if the window is this frame's menubar. */
474 if (x->menubar_widget
475 && lw_window_is_in_menubar (wdesc, x->menubar_widget))
476 return f;
478 return 0;
481 /* Return the frame whose principal (outermost) window is WDESC.
482 If WDESC is some other (smaller) window, we return 0. */
484 struct frame *
485 x_top_window_to_frame (dpyinfo, wdesc)
486 struct x_display_info *dpyinfo;
487 int wdesc;
489 Lisp_Object tail, frame;
490 struct frame *f;
491 struct x_output *x;
493 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
495 frame = XCAR (tail);
496 if (!GC_FRAMEP (frame))
497 continue;
498 f = XFRAME (frame);
499 if (!FRAME_X_P (f) || FRAME_X_DISPLAY_INFO (f) != dpyinfo)
500 continue;
501 x = f->output_data.x;
503 if (x->widget)
505 /* This frame matches if the window is its topmost widget. */
506 if (wdesc == XtWindow (x->widget))
507 return f;
508 #if 0 /* I don't know why it did this,
509 but it seems logically wrong,
510 and it causes trouble for MapNotify events. */
511 /* Match if the window is this frame's menubar. */
512 if (x->menubar_widget
513 && wdesc == XtWindow (x->menubar_widget))
514 return f;
515 #endif
517 else if (FRAME_X_WINDOW (f) == wdesc)
518 /* Tooltip frame. */
519 return f;
521 return 0;
523 #endif /* USE_X_TOOLKIT */
527 /* Code to deal with bitmaps. Bitmaps are referenced by their bitmap
528 id, which is just an int that this section returns. Bitmaps are
529 reference counted so they can be shared among frames.
531 Bitmap indices are guaranteed to be > 0, so a negative number can
532 be used to indicate no bitmap.
534 If you use x_create_bitmap_from_data, then you must keep track of
535 the bitmaps yourself. That is, creating a bitmap from the same
536 data more than once will not be caught. */
539 /* Functions to access the contents of a bitmap, given an id. */
542 x_bitmap_height (f, id)
543 FRAME_PTR f;
544 int id;
546 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].height;
550 x_bitmap_width (f, id)
551 FRAME_PTR f;
552 int id;
554 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].width;
558 x_bitmap_pixmap (f, id)
559 FRAME_PTR f;
560 int id;
562 return FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].pixmap;
566 /* Allocate a new bitmap record. Returns index of new record. */
568 static int
569 x_allocate_bitmap_record (f)
570 FRAME_PTR f;
572 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
573 int i;
575 if (dpyinfo->bitmaps == NULL)
577 dpyinfo->bitmaps_size = 10;
578 dpyinfo->bitmaps
579 = (struct x_bitmap_record *) xmalloc (dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
580 dpyinfo->bitmaps_last = 1;
581 return 1;
584 if (dpyinfo->bitmaps_last < dpyinfo->bitmaps_size)
585 return ++dpyinfo->bitmaps_last;
587 for (i = 0; i < dpyinfo->bitmaps_size; ++i)
588 if (dpyinfo->bitmaps[i].refcount == 0)
589 return i + 1;
591 dpyinfo->bitmaps_size *= 2;
592 dpyinfo->bitmaps
593 = (struct x_bitmap_record *) xrealloc (dpyinfo->bitmaps,
594 dpyinfo->bitmaps_size * sizeof (struct x_bitmap_record));
595 return ++dpyinfo->bitmaps_last;
598 /* Add one reference to the reference count of the bitmap with id ID. */
600 void
601 x_reference_bitmap (f, id)
602 FRAME_PTR f;
603 int id;
605 ++FRAME_X_DISPLAY_INFO (f)->bitmaps[id - 1].refcount;
608 /* Create a bitmap for frame F from a HEIGHT x WIDTH array of bits at BITS. */
611 x_create_bitmap_from_data (f, bits, width, height)
612 struct frame *f;
613 char *bits;
614 unsigned int width, height;
616 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
617 Pixmap bitmap;
618 int id;
620 bitmap = XCreateBitmapFromData (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
621 bits, width, height);
623 if (! bitmap)
624 return -1;
626 id = x_allocate_bitmap_record (f);
627 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
628 dpyinfo->bitmaps[id - 1].file = NULL;
629 dpyinfo->bitmaps[id - 1].refcount = 1;
630 dpyinfo->bitmaps[id - 1].depth = 1;
631 dpyinfo->bitmaps[id - 1].height = height;
632 dpyinfo->bitmaps[id - 1].width = width;
634 return id;
637 /* Create bitmap from file FILE for frame F. */
640 x_create_bitmap_from_file (f, file)
641 struct frame *f;
642 Lisp_Object file;
644 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
645 unsigned int width, height;
646 Pixmap bitmap;
647 int xhot, yhot, result, id;
648 Lisp_Object found;
649 int fd;
650 char *filename;
652 /* Look for an existing bitmap with the same name. */
653 for (id = 0; id < dpyinfo->bitmaps_last; ++id)
655 if (dpyinfo->bitmaps[id].refcount
656 && dpyinfo->bitmaps[id].file
657 && !strcmp (dpyinfo->bitmaps[id].file, (char *) XSTRING (file)->data))
659 ++dpyinfo->bitmaps[id].refcount;
660 return id + 1;
664 /* Search bitmap-file-path for the file, if appropriate. */
665 fd = openp (Vx_bitmap_file_path, file, "", &found, 0);
666 if (fd < 0)
667 return -1;
668 /* XReadBitmapFile won't handle magic file names. */
669 if (fd == 0)
670 return -1;
671 emacs_close (fd);
673 filename = (char *) XSTRING (found)->data;
675 result = XReadBitmapFile (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
676 filename, &width, &height, &bitmap, &xhot, &yhot);
677 if (result != BitmapSuccess)
678 return -1;
680 id = x_allocate_bitmap_record (f);
681 dpyinfo->bitmaps[id - 1].pixmap = bitmap;
682 dpyinfo->bitmaps[id - 1].refcount = 1;
683 dpyinfo->bitmaps[id - 1].file
684 = (char *) xmalloc (STRING_BYTES (XSTRING (file)) + 1);
685 dpyinfo->bitmaps[id - 1].depth = 1;
686 dpyinfo->bitmaps[id - 1].height = height;
687 dpyinfo->bitmaps[id - 1].width = width;
688 strcpy (dpyinfo->bitmaps[id - 1].file, XSTRING (file)->data);
690 return id;
693 /* Remove reference to bitmap with id number ID. */
695 void
696 x_destroy_bitmap (f, id)
697 FRAME_PTR f;
698 int id;
700 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
702 if (id > 0)
704 --dpyinfo->bitmaps[id - 1].refcount;
705 if (dpyinfo->bitmaps[id - 1].refcount == 0)
707 BLOCK_INPUT;
708 XFreePixmap (FRAME_X_DISPLAY (f), dpyinfo->bitmaps[id - 1].pixmap);
709 if (dpyinfo->bitmaps[id - 1].file)
711 xfree (dpyinfo->bitmaps[id - 1].file);
712 dpyinfo->bitmaps[id - 1].file = NULL;
714 UNBLOCK_INPUT;
719 /* Free all the bitmaps for the display specified by DPYINFO. */
721 static void
722 x_destroy_all_bitmaps (dpyinfo)
723 struct x_display_info *dpyinfo;
725 int i;
726 for (i = 0; i < dpyinfo->bitmaps_last; i++)
727 if (dpyinfo->bitmaps[i].refcount > 0)
729 XFreePixmap (dpyinfo->display, dpyinfo->bitmaps[i].pixmap);
730 if (dpyinfo->bitmaps[i].file)
731 xfree (dpyinfo->bitmaps[i].file);
733 dpyinfo->bitmaps_last = 0;
736 /* Connect the frame-parameter names for X frames
737 to the ways of passing the parameter values to the window system.
739 The name of a parameter, as a Lisp symbol,
740 has an `x-frame-parameter' property which is an integer in Lisp
741 that is an index in this table. */
743 struct x_frame_parm_table
745 char *name;
746 void (*setter) P_ ((struct frame *, Lisp_Object, Lisp_Object));
749 static void x_create_im P_ ((struct frame *));
750 void x_set_foreground_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
751 void x_set_background_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
752 void x_set_mouse_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
753 void x_set_cursor_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
754 void x_set_border_color P_ ((struct frame *, Lisp_Object, Lisp_Object));
755 void x_set_cursor_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
756 void x_set_icon_type P_ ((struct frame *, Lisp_Object, Lisp_Object));
757 void x_set_icon_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
758 void x_set_font P_ ((struct frame *, Lisp_Object, Lisp_Object));
759 void x_set_border_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
760 void x_set_internal_border_width P_ ((struct frame *, Lisp_Object,
761 Lisp_Object));
762 void x_explicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object));
763 void x_set_autoraise P_ ((struct frame *, Lisp_Object, Lisp_Object));
764 void x_set_autolower P_ ((struct frame *, Lisp_Object, Lisp_Object));
765 void x_set_vertical_scroll_bars P_ ((struct frame *, Lisp_Object,
766 Lisp_Object));
767 void x_set_visibility P_ ((struct frame *, Lisp_Object, Lisp_Object));
768 void x_set_menu_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
769 void x_set_scroll_bar_width P_ ((struct frame *, Lisp_Object, Lisp_Object));
770 void x_set_title P_ ((struct frame *, Lisp_Object, Lisp_Object));
771 void x_set_unsplittable P_ ((struct frame *, Lisp_Object, Lisp_Object));
772 void x_set_tool_bar_lines P_ ((struct frame *, Lisp_Object, Lisp_Object));
773 void x_set_scroll_bar_foreground P_ ((struct frame *, Lisp_Object,
774 Lisp_Object));
775 void x_set_scroll_bar_background P_ ((struct frame *, Lisp_Object,
776 Lisp_Object));
777 static Lisp_Object x_default_scroll_bar_color_parameter P_ ((struct frame *,
778 Lisp_Object,
779 Lisp_Object,
780 char *, char *,
781 int));
782 static void x_set_screen_gamma P_ ((struct frame *, Lisp_Object, Lisp_Object));
784 static struct x_frame_parm_table x_frame_parms[] =
786 "auto-raise", x_set_autoraise,
787 "auto-lower", x_set_autolower,
788 "background-color", x_set_background_color,
789 "border-color", x_set_border_color,
790 "border-width", x_set_border_width,
791 "cursor-color", x_set_cursor_color,
792 "cursor-type", x_set_cursor_type,
793 "font", x_set_font,
794 "foreground-color", x_set_foreground_color,
795 "icon-name", x_set_icon_name,
796 "icon-type", x_set_icon_type,
797 "internal-border-width", x_set_internal_border_width,
798 "menu-bar-lines", x_set_menu_bar_lines,
799 "mouse-color", x_set_mouse_color,
800 "name", x_explicitly_set_name,
801 "scroll-bar-width", x_set_scroll_bar_width,
802 "title", x_set_title,
803 "unsplittable", x_set_unsplittable,
804 "vertical-scroll-bars", x_set_vertical_scroll_bars,
805 "visibility", x_set_visibility,
806 "tool-bar-lines", x_set_tool_bar_lines,
807 "scroll-bar-foreground", x_set_scroll_bar_foreground,
808 "scroll-bar-background", x_set_scroll_bar_background,
809 "screen-gamma", x_set_screen_gamma
812 /* Attach the `x-frame-parameter' properties to
813 the Lisp symbol names of parameters relevant to X. */
815 void
816 init_x_parm_symbols ()
818 int i;
820 for (i = 0; i < sizeof (x_frame_parms) / sizeof (x_frame_parms[0]); i++)
821 Fput (intern (x_frame_parms[i].name), Qx_frame_parameter,
822 make_number (i));
825 /* Change the parameters of frame F as specified by ALIST.
826 If a parameter is not specially recognized, do nothing;
827 otherwise call the `x_set_...' function for that parameter. */
829 void
830 x_set_frame_parameters (f, alist)
831 FRAME_PTR f;
832 Lisp_Object alist;
834 Lisp_Object tail;
836 /* If both of these parameters are present, it's more efficient to
837 set them both at once. So we wait until we've looked at the
838 entire list before we set them. */
839 int width, height;
841 /* Same here. */
842 Lisp_Object left, top;
844 /* Same with these. */
845 Lisp_Object icon_left, icon_top;
847 /* Record in these vectors all the parms specified. */
848 Lisp_Object *parms;
849 Lisp_Object *values;
850 int i, p;
851 int left_no_change = 0, top_no_change = 0;
852 int icon_left_no_change = 0, icon_top_no_change = 0;
854 struct gcpro gcpro1, gcpro2;
856 i = 0;
857 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
858 i++;
860 parms = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
861 values = (Lisp_Object *) alloca (i * sizeof (Lisp_Object));
863 /* Extract parm names and values into those vectors. */
865 i = 0;
866 for (tail = alist; CONSP (tail); tail = Fcdr (tail))
868 Lisp_Object elt;
870 elt = Fcar (tail);
871 parms[i] = Fcar (elt);
872 values[i] = Fcdr (elt);
873 i++;
875 /* TAIL and ALIST are not used again below here. */
876 alist = tail = Qnil;
878 GCPRO2 (*parms, *values);
879 gcpro1.nvars = i;
880 gcpro2.nvars = i;
882 /* There is no need to gcpro LEFT, TOP, ICON_LEFT, or ICON_TOP,
883 because their values appear in VALUES and strings are not valid. */
884 top = left = Qunbound;
885 icon_left = icon_top = Qunbound;
887 /* Provide default values for HEIGHT and WIDTH. */
888 if (FRAME_NEW_WIDTH (f))
889 width = FRAME_NEW_WIDTH (f);
890 else
891 width = FRAME_WIDTH (f);
893 if (FRAME_NEW_HEIGHT (f))
894 height = FRAME_NEW_HEIGHT (f);
895 else
896 height = FRAME_HEIGHT (f);
898 /* Process foreground_color and background_color before anything else.
899 They are independent of other properties, but other properties (e.g.,
900 cursor_color) are dependent upon them. */
901 for (p = 0; p < i; p++)
903 Lisp_Object prop, val;
905 prop = parms[p];
906 val = values[p];
907 if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
909 register Lisp_Object param_index, old_value;
911 param_index = Fget (prop, Qx_frame_parameter);
912 old_value = get_frame_param (f, prop);
913 store_frame_param (f, prop, val);
914 if (NATNUMP (param_index)
915 && (XFASTINT (param_index)
916 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
917 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
921 /* Now process them in reverse of specified order. */
922 for (i--; i >= 0; i--)
924 Lisp_Object prop, val;
926 prop = parms[i];
927 val = values[i];
929 if (EQ (prop, Qwidth) && NUMBERP (val))
930 width = XFASTINT (val);
931 else if (EQ (prop, Qheight) && NUMBERP (val))
932 height = XFASTINT (val);
933 else if (EQ (prop, Qtop))
934 top = val;
935 else if (EQ (prop, Qleft))
936 left = val;
937 else if (EQ (prop, Qicon_top))
938 icon_top = val;
939 else if (EQ (prop, Qicon_left))
940 icon_left = val;
941 else if (EQ (prop, Qforeground_color) || EQ (prop, Qbackground_color))
942 /* Processed above. */
943 continue;
944 else
946 register Lisp_Object param_index, old_value;
948 param_index = Fget (prop, Qx_frame_parameter);
949 old_value = get_frame_param (f, prop);
950 store_frame_param (f, prop, val);
951 if (NATNUMP (param_index)
952 && (XFASTINT (param_index)
953 < sizeof (x_frame_parms)/sizeof (x_frame_parms[0])))
954 (*x_frame_parms[XINT (param_index)].setter)(f, val, old_value);
958 /* Don't die if just one of these was set. */
959 if (EQ (left, Qunbound))
961 left_no_change = 1;
962 if (f->output_data.x->left_pos < 0)
963 left = Fcons (Qplus, Fcons (make_number (f->output_data.x->left_pos), Qnil));
964 else
965 XSETINT (left, f->output_data.x->left_pos);
967 if (EQ (top, Qunbound))
969 top_no_change = 1;
970 if (f->output_data.x->top_pos < 0)
971 top = Fcons (Qplus, Fcons (make_number (f->output_data.x->top_pos), Qnil));
972 else
973 XSETINT (top, f->output_data.x->top_pos);
976 /* If one of the icon positions was not set, preserve or default it. */
977 if (EQ (icon_left, Qunbound) || ! INTEGERP (icon_left))
979 icon_left_no_change = 1;
980 icon_left = Fcdr (Fassq (Qicon_left, f->param_alist));
981 if (NILP (icon_left))
982 XSETINT (icon_left, 0);
984 if (EQ (icon_top, Qunbound) || ! INTEGERP (icon_top))
986 icon_top_no_change = 1;
987 icon_top = Fcdr (Fassq (Qicon_top, f->param_alist));
988 if (NILP (icon_top))
989 XSETINT (icon_top, 0);
992 /* Don't set these parameters unless they've been explicitly
993 specified. The window might be mapped or resized while we're in
994 this function, and we don't want to override that unless the lisp
995 code has asked for it.
997 Don't set these parameters unless they actually differ from the
998 window's current parameters; the window may not actually exist
999 yet. */
1001 Lisp_Object frame;
1003 check_frame_size (f, &height, &width);
1005 XSETFRAME (frame, f);
1007 if (width != FRAME_WIDTH (f)
1008 || height != FRAME_HEIGHT (f)
1009 || FRAME_NEW_HEIGHT (f) || FRAME_NEW_WIDTH (f))
1010 Fset_frame_size (frame, make_number (width), make_number (height));
1012 if ((!NILP (left) || !NILP (top))
1013 && ! (left_no_change && top_no_change)
1014 && ! (NUMBERP (left) && XINT (left) == f->output_data.x->left_pos
1015 && NUMBERP (top) && XINT (top) == f->output_data.x->top_pos))
1017 int leftpos = 0;
1018 int toppos = 0;
1020 /* Record the signs. */
1021 f->output_data.x->size_hint_flags &= ~ (XNegative | YNegative);
1022 if (EQ (left, Qminus))
1023 f->output_data.x->size_hint_flags |= XNegative;
1024 else if (INTEGERP (left))
1026 leftpos = XINT (left);
1027 if (leftpos < 0)
1028 f->output_data.x->size_hint_flags |= XNegative;
1030 else if (CONSP (left) && EQ (XCAR (left), Qminus)
1031 && CONSP (XCDR (left))
1032 && INTEGERP (XCAR (XCDR (left))))
1034 leftpos = - XINT (XCAR (XCDR (left)));
1035 f->output_data.x->size_hint_flags |= XNegative;
1037 else if (CONSP (left) && EQ (XCAR (left), Qplus)
1038 && CONSP (XCDR (left))
1039 && INTEGERP (XCAR (XCDR (left))))
1041 leftpos = XINT (XCAR (XCDR (left)));
1044 if (EQ (top, Qminus))
1045 f->output_data.x->size_hint_flags |= YNegative;
1046 else if (INTEGERP (top))
1048 toppos = XINT (top);
1049 if (toppos < 0)
1050 f->output_data.x->size_hint_flags |= YNegative;
1052 else if (CONSP (top) && EQ (XCAR (top), Qminus)
1053 && CONSP (XCDR (top))
1054 && INTEGERP (XCAR (XCDR (top))))
1056 toppos = - XINT (XCAR (XCDR (top)));
1057 f->output_data.x->size_hint_flags |= YNegative;
1059 else if (CONSP (top) && EQ (XCAR (top), Qplus)
1060 && CONSP (XCDR (top))
1061 && INTEGERP (XCAR (XCDR (top))))
1063 toppos = XINT (XCAR (XCDR (top)));
1067 /* Store the numeric value of the position. */
1068 f->output_data.x->top_pos = toppos;
1069 f->output_data.x->left_pos = leftpos;
1071 f->output_data.x->win_gravity = NorthWestGravity;
1073 /* Actually set that position, and convert to absolute. */
1074 x_set_offset (f, leftpos, toppos, -1);
1077 if ((!NILP (icon_left) || !NILP (icon_top))
1078 && ! (icon_left_no_change && icon_top_no_change))
1079 x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
1082 UNGCPRO;
1085 /* Store the screen positions of frame F into XPTR and YPTR.
1086 These are the positions of the containing window manager window,
1087 not Emacs's own window. */
1089 void
1090 x_real_positions (f, xptr, yptr)
1091 FRAME_PTR f;
1092 int *xptr, *yptr;
1094 int win_x, win_y;
1095 Window child;
1097 /* This is pretty gross, but seems to be the easiest way out of
1098 the problem that arises when restarting window-managers. */
1100 #ifdef USE_X_TOOLKIT
1101 Window outer = (f->output_data.x->widget
1102 ? XtWindow (f->output_data.x->widget)
1103 : FRAME_X_WINDOW (f));
1104 #else
1105 Window outer = f->output_data.x->window_desc;
1106 #endif
1107 Window tmp_root_window;
1108 Window *tmp_children;
1109 int tmp_nchildren;
1111 while (1)
1113 int count = x_catch_errors (FRAME_X_DISPLAY (f));
1114 Window outer_window;
1116 XQueryTree (FRAME_X_DISPLAY (f), outer, &tmp_root_window,
1117 &f->output_data.x->parent_desc,
1118 &tmp_children, &tmp_nchildren);
1119 XFree ((char *) tmp_children);
1121 win_x = win_y = 0;
1123 /* Find the position of the outside upper-left corner of
1124 the inner window, with respect to the outer window. */
1125 if (f->output_data.x->parent_desc != FRAME_X_DISPLAY_INFO (f)->root_window)
1126 outer_window = f->output_data.x->parent_desc;
1127 else
1128 outer_window = outer;
1130 XTranslateCoordinates (FRAME_X_DISPLAY (f),
1132 /* From-window, to-window. */
1133 outer_window,
1134 FRAME_X_DISPLAY_INFO (f)->root_window,
1136 /* From-position, to-position. */
1137 0, 0, &win_x, &win_y,
1139 /* Child of win. */
1140 &child);
1142 /* It is possible for the window returned by the XQueryNotify
1143 to become invalid by the time we call XTranslateCoordinates.
1144 That can happen when you restart some window managers.
1145 If so, we get an error in XTranslateCoordinates.
1146 Detect that and try the whole thing over. */
1147 if (! x_had_errors_p (FRAME_X_DISPLAY (f)))
1149 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1150 break;
1153 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1156 *xptr = win_x;
1157 *yptr = win_y;
1160 /* Insert a description of internally-recorded parameters of frame X
1161 into the parameter alist *ALISTPTR that is to be given to the user.
1162 Only parameters that are specific to the X window system
1163 and whose values are not correctly recorded in the frame's
1164 param_alist need to be considered here. */
1166 void
1167 x_report_frame_params (f, alistptr)
1168 struct frame *f;
1169 Lisp_Object *alistptr;
1171 char buf[16];
1172 Lisp_Object tem;
1174 /* Represent negative positions (off the top or left screen edge)
1175 in a way that Fmodify_frame_parameters will understand correctly. */
1176 XSETINT (tem, f->output_data.x->left_pos);
1177 if (f->output_data.x->left_pos >= 0)
1178 store_in_alist (alistptr, Qleft, tem);
1179 else
1180 store_in_alist (alistptr, Qleft, Fcons (Qplus, Fcons (tem, Qnil)));
1182 XSETINT (tem, f->output_data.x->top_pos);
1183 if (f->output_data.x->top_pos >= 0)
1184 store_in_alist (alistptr, Qtop, tem);
1185 else
1186 store_in_alist (alistptr, Qtop, Fcons (Qplus, Fcons (tem, Qnil)));
1188 store_in_alist (alistptr, Qborder_width,
1189 make_number (f->output_data.x->border_width));
1190 store_in_alist (alistptr, Qinternal_border_width,
1191 make_number (f->output_data.x->internal_border_width));
1192 sprintf (buf, "%ld", (long) FRAME_X_WINDOW (f));
1193 store_in_alist (alistptr, Qwindow_id,
1194 build_string (buf));
1195 #ifdef USE_X_TOOLKIT
1196 /* Tooltip frame may not have this widget. */
1197 if (f->output_data.x->widget)
1198 #endif
1199 sprintf (buf, "%ld", (long) FRAME_OUTER_WINDOW (f));
1200 store_in_alist (alistptr, Qouter_window_id,
1201 build_string (buf));
1202 store_in_alist (alistptr, Qicon_name, f->icon_name);
1203 FRAME_SAMPLE_VISIBILITY (f);
1204 store_in_alist (alistptr, Qvisibility,
1205 (FRAME_VISIBLE_P (f) ? Qt
1206 : FRAME_ICONIFIED_P (f) ? Qicon : Qnil));
1207 store_in_alist (alistptr, Qdisplay,
1208 XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element));
1210 if (f->output_data.x->parent_desc == FRAME_X_DISPLAY_INFO (f)->root_window)
1211 tem = Qnil;
1212 else
1213 XSETFASTINT (tem, f->output_data.x->parent_desc);
1214 store_in_alist (alistptr, Qparent_id, tem);
1219 /* Gamma-correct COLOR on frame F. */
1221 void
1222 gamma_correct (f, color)
1223 struct frame *f;
1224 XColor *color;
1226 if (f->gamma)
1228 color->red = pow (color->red / 65535.0, f->gamma) * 65535.0 + 0.5;
1229 color->green = pow (color->green / 65535.0, f->gamma) * 65535.0 + 0.5;
1230 color->blue = pow (color->blue / 65535.0, f->gamma) * 65535.0 + 0.5;
1235 /* Decide if color named COLOR is valid for the display associated with
1236 the selected frame; if so, return the rgb values in COLOR_DEF.
1237 If ALLOC is nonzero, allocate a new colormap cell. */
1240 x_defined_color (f, color, color_def, alloc)
1241 FRAME_PTR f;
1242 char *color;
1243 XColor *color_def;
1244 int alloc;
1246 register int status;
1247 Colormap screen_colormap;
1248 Display *display = FRAME_X_DISPLAY (f);
1250 BLOCK_INPUT;
1251 screen_colormap = DefaultColormap (display, XDefaultScreen (display));
1253 status = XParseColor (display, screen_colormap, color, color_def);
1254 if (status && alloc)
1256 /* Apply gamma correction. */
1257 gamma_correct (f, color_def);
1259 status = XAllocColor (display, screen_colormap, color_def);
1260 if (!status)
1262 /* If we got to this point, the colormap is full, so we're
1263 going to try and get the next closest color.
1264 The algorithm used is a least-squares matching, which is
1265 what X uses for closest color matching with StaticColor visuals. */
1267 XColor *cells;
1268 int no_cells;
1269 int nearest;
1270 long nearest_delta, trial_delta;
1271 int x;
1273 no_cells = XDisplayCells (display, XDefaultScreen (display));
1274 cells = (XColor *) alloca (sizeof (XColor) * no_cells);
1276 for (x = 0; x < no_cells; x++)
1277 cells[x].pixel = x;
1279 XQueryColors (display, screen_colormap, cells, no_cells);
1280 nearest = 0;
1281 /* I'm assuming CSE so I'm not going to condense this. */
1282 nearest_delta = ((((color_def->red >> 8) - (cells[0].red >> 8))
1283 * ((color_def->red >> 8) - (cells[0].red >> 8)))
1285 (((color_def->green >> 8) - (cells[0].green >> 8))
1286 * ((color_def->green >> 8) - (cells[0].green >> 8)))
1288 (((color_def->blue >> 8) - (cells[0].blue >> 8))
1289 * ((color_def->blue >> 8) - (cells[0].blue >> 8))));
1290 for (x = 1; x < no_cells; x++)
1292 trial_delta = ((((color_def->red >> 8) - (cells[x].red >> 8))
1293 * ((color_def->red >> 8) - (cells[x].red >> 8)))
1295 (((color_def->green >> 8) - (cells[x].green >> 8))
1296 * ((color_def->green >> 8) - (cells[x].green >> 8)))
1298 (((color_def->blue >> 8) - (cells[x].blue >> 8))
1299 * ((color_def->blue >> 8) - (cells[x].blue >> 8))));
1300 if (trial_delta < nearest_delta)
1302 XColor temp;
1303 temp.red = cells[x].red;
1304 temp.green = cells[x].green;
1305 temp.blue = cells[x].blue;
1306 status = XAllocColor (display, screen_colormap, &temp);
1307 if (status)
1309 nearest = x;
1310 nearest_delta = trial_delta;
1314 color_def->red = cells[nearest].red;
1315 color_def->green = cells[nearest].green;
1316 color_def->blue = cells[nearest].blue;
1317 status = XAllocColor (display, screen_colormap, color_def);
1320 UNBLOCK_INPUT;
1322 if (status)
1323 return 1;
1324 else
1325 return 0;
1328 /* Given a string ARG naming a color, compute a pixel value from it
1329 suitable for screen F.
1330 If F is not a color screen, return DEF (default) regardless of what
1331 ARG says. */
1334 x_decode_color (f, arg, def)
1335 FRAME_PTR f;
1336 Lisp_Object arg;
1337 int def;
1339 XColor cdef;
1341 CHECK_STRING (arg, 0);
1343 if (strcmp (XSTRING (arg)->data, "black") == 0)
1344 return BLACK_PIX_DEFAULT (f);
1345 else if (strcmp (XSTRING (arg)->data, "white") == 0)
1346 return WHITE_PIX_DEFAULT (f);
1348 if (FRAME_X_DISPLAY_INFO (f)->n_planes == 1)
1349 return def;
1351 /* x_defined_color is responsible for coping with failures
1352 by looking for a near-miss. */
1353 if (x_defined_color (f, XSTRING (arg)->data, &cdef, 1))
1354 return cdef.pixel;
1356 Fsignal (Qerror, Fcons (build_string ("undefined color"),
1357 Fcons (arg, Qnil)));
1360 /* Change the `screen-gamma' frame parameter of frame F. OLD_VALUE is
1361 the previous value of that parameter, NEW_VALUE is the new value. */
1363 static void
1364 x_set_screen_gamma (f, new_value, old_value)
1365 struct frame *f;
1366 Lisp_Object new_value, old_value;
1368 if (NILP (new_value))
1369 f->gamma = 0;
1370 else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
1371 /* The value 0.4545 is the normal viewing gamma. */
1372 f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
1373 else
1374 Fsignal (Qerror, Fcons (build_string ("Illegal screen-gamma"),
1375 Fcons (new_value, Qnil)));
1377 clear_face_cache (0);
1381 /* Functions called only from `x_set_frame_param'
1382 to set individual parameters.
1384 If FRAME_X_WINDOW (f) is 0,
1385 the frame is being created and its X-window does not exist yet.
1386 In that case, just record the parameter's new value
1387 in the standard place; do not attempt to change the window. */
1389 void
1390 x_set_foreground_color (f, arg, oldval)
1391 struct frame *f;
1392 Lisp_Object arg, oldval;
1394 unsigned long pixel
1395 = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1397 unload_color (f, f->output_data.x->foreground_pixel);
1398 f->output_data.x->foreground_pixel = pixel;
1400 if (FRAME_X_WINDOW (f) != 0)
1402 BLOCK_INPUT;
1403 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1404 f->output_data.x->foreground_pixel);
1405 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1406 f->output_data.x->foreground_pixel);
1407 UNBLOCK_INPUT;
1408 update_face_from_frame_parameter (f, Qforeground_color, arg);
1409 if (FRAME_VISIBLE_P (f))
1410 redraw_frame (f);
1414 void
1415 x_set_background_color (f, arg, oldval)
1416 struct frame *f;
1417 Lisp_Object arg, oldval;
1419 unsigned long pixel
1420 = x_decode_color (f, arg, WHITE_PIX_DEFAULT (f));
1422 unload_color (f, f->output_data.x->background_pixel);
1423 f->output_data.x->background_pixel = pixel;
1425 if (FRAME_X_WINDOW (f) != 0)
1427 BLOCK_INPUT;
1428 /* The main frame area. */
1429 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc,
1430 f->output_data.x->background_pixel);
1431 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->reverse_gc,
1432 f->output_data.x->background_pixel);
1433 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1434 f->output_data.x->background_pixel);
1435 XSetWindowBackground (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1436 f->output_data.x->background_pixel);
1438 Lisp_Object bar;
1439 for (bar = FRAME_SCROLL_BARS (f); !NILP (bar);
1440 bar = XSCROLL_BAR (bar)->next)
1441 XSetWindowBackground (FRAME_X_DISPLAY (f),
1442 SCROLL_BAR_X_WINDOW (XSCROLL_BAR (bar)),
1443 f->output_data.x->background_pixel);
1445 UNBLOCK_INPUT;
1447 update_face_from_frame_parameter (f, Qbackground_color, arg);
1449 if (FRAME_VISIBLE_P (f))
1450 redraw_frame (f);
1454 void
1455 x_set_mouse_color (f, arg, oldval)
1456 struct frame *f;
1457 Lisp_Object arg, oldval;
1459 Cursor cursor, nontext_cursor, mode_cursor, cross_cursor;
1460 Cursor busy_cursor;
1461 int count;
1462 unsigned long pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1463 unsigned long mask_color = f->output_data.x->background_pixel;
1465 /* Don't let pointers be invisible. */
1466 if (mask_color == pixel
1467 && mask_color == f->output_data.x->background_pixel)
1468 pixel = f->output_data.x->foreground_pixel;
1470 unload_color (f, f->output_data.x->mouse_pixel);
1471 f->output_data.x->mouse_pixel = pixel;
1473 BLOCK_INPUT;
1475 /* It's not okay to crash if the user selects a screwy cursor. */
1476 count = x_catch_errors (FRAME_X_DISPLAY (f));
1478 if (!EQ (Qnil, Vx_pointer_shape))
1480 CHECK_NUMBER (Vx_pointer_shape, 0);
1481 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XINT (Vx_pointer_shape));
1483 else
1484 cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1485 x_check_errors (FRAME_X_DISPLAY (f), "bad text pointer cursor: %s");
1487 if (!EQ (Qnil, Vx_nontext_pointer_shape))
1489 CHECK_NUMBER (Vx_nontext_pointer_shape, 0);
1490 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1491 XINT (Vx_nontext_pointer_shape));
1493 else
1494 nontext_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_left_ptr);
1495 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1497 if (!EQ (Qnil, Vx_busy_pointer_shape))
1499 CHECK_NUMBER (Vx_busy_pointer_shape, 0);
1500 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1501 XINT (Vx_busy_pointer_shape));
1503 else
1504 busy_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_watch);
1505 x_check_errors (FRAME_X_DISPLAY (f), "bad busy pointer cursor: %s");
1507 x_check_errors (FRAME_X_DISPLAY (f), "bad nontext pointer cursor: %s");
1508 if (!EQ (Qnil, Vx_mode_pointer_shape))
1510 CHECK_NUMBER (Vx_mode_pointer_shape, 0);
1511 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f),
1512 XINT (Vx_mode_pointer_shape));
1514 else
1515 mode_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_xterm);
1516 x_check_errors (FRAME_X_DISPLAY (f), "bad modeline pointer cursor: %s");
1518 if (!EQ (Qnil, Vx_sensitive_text_pointer_shape))
1520 CHECK_NUMBER (Vx_sensitive_text_pointer_shape, 0);
1521 cross_cursor
1522 = XCreateFontCursor (FRAME_X_DISPLAY (f),
1523 XINT (Vx_sensitive_text_pointer_shape));
1525 else
1526 cross_cursor = XCreateFontCursor (FRAME_X_DISPLAY (f), XC_crosshair);
1528 /* Check and report errors with the above calls. */
1529 x_check_errors (FRAME_X_DISPLAY (f), "can't set cursor shape: %s");
1530 x_uncatch_errors (FRAME_X_DISPLAY (f), count);
1533 XColor fore_color, back_color;
1535 fore_color.pixel = f->output_data.x->mouse_pixel;
1536 back_color.pixel = mask_color;
1537 XQueryColor (FRAME_X_DISPLAY (f),
1538 DefaultColormap (FRAME_X_DISPLAY (f),
1539 DefaultScreen (FRAME_X_DISPLAY (f))),
1540 &fore_color);
1541 XQueryColor (FRAME_X_DISPLAY (f),
1542 DefaultColormap (FRAME_X_DISPLAY (f),
1543 DefaultScreen (FRAME_X_DISPLAY (f))),
1544 &back_color);
1545 XRecolorCursor (FRAME_X_DISPLAY (f), cursor,
1546 &fore_color, &back_color);
1547 XRecolorCursor (FRAME_X_DISPLAY (f), nontext_cursor,
1548 &fore_color, &back_color);
1549 XRecolorCursor (FRAME_X_DISPLAY (f), mode_cursor,
1550 &fore_color, &back_color);
1551 XRecolorCursor (FRAME_X_DISPLAY (f), cross_cursor,
1552 &fore_color, &back_color);
1553 XRecolorCursor (FRAME_X_DISPLAY (f), busy_cursor,
1554 &fore_color, &back_color);
1557 if (FRAME_X_WINDOW (f) != 0)
1558 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), cursor);
1560 if (cursor != f->output_data.x->text_cursor && f->output_data.x->text_cursor != 0)
1561 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->text_cursor);
1562 f->output_data.x->text_cursor = cursor;
1564 if (nontext_cursor != f->output_data.x->nontext_cursor
1565 && f->output_data.x->nontext_cursor != 0)
1566 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->nontext_cursor);
1567 f->output_data.x->nontext_cursor = nontext_cursor;
1569 if (busy_cursor != f->output_data.x->busy_cursor
1570 && f->output_data.x->busy_cursor != 0)
1571 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->busy_cursor);
1572 f->output_data.x->busy_cursor = busy_cursor;
1574 if (mode_cursor != f->output_data.x->modeline_cursor
1575 && f->output_data.x->modeline_cursor != 0)
1576 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->modeline_cursor);
1577 f->output_data.x->modeline_cursor = mode_cursor;
1579 if (cross_cursor != f->output_data.x->cross_cursor
1580 && f->output_data.x->cross_cursor != 0)
1581 XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->cross_cursor);
1582 f->output_data.x->cross_cursor = cross_cursor;
1584 XFlush (FRAME_X_DISPLAY (f));
1585 UNBLOCK_INPUT;
1587 update_face_from_frame_parameter (f, Qmouse_color, arg);
1590 void
1591 x_set_cursor_color (f, arg, oldval)
1592 struct frame *f;
1593 Lisp_Object arg, oldval;
1595 unsigned long fore_pixel, pixel;
1597 if (!EQ (Vx_cursor_fore_pixel, Qnil))
1598 fore_pixel = x_decode_color (f, Vx_cursor_fore_pixel,
1599 WHITE_PIX_DEFAULT (f));
1600 else
1601 fore_pixel = f->output_data.x->background_pixel;
1602 pixel = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1604 /* Make sure that the cursor color differs from the background color. */
1605 if (pixel == f->output_data.x->background_pixel)
1607 pixel = f->output_data.x->mouse_pixel;
1608 if (pixel == fore_pixel)
1609 fore_pixel = f->output_data.x->background_pixel;
1612 unload_color (f, f->output_data.x->cursor_foreground_pixel);
1613 f->output_data.x->cursor_foreground_pixel = fore_pixel;
1615 unload_color (f, f->output_data.x->cursor_pixel);
1616 f->output_data.x->cursor_pixel = pixel;
1618 if (FRAME_X_WINDOW (f) != 0)
1620 BLOCK_INPUT;
1621 XSetBackground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1622 f->output_data.x->cursor_pixel);
1623 XSetForeground (FRAME_X_DISPLAY (f), f->output_data.x->cursor_gc,
1624 fore_pixel);
1625 UNBLOCK_INPUT;
1627 if (FRAME_VISIBLE_P (f))
1629 x_update_cursor (f, 0);
1630 x_update_cursor (f, 1);
1634 update_face_from_frame_parameter (f, Qcursor_color, arg);
1637 /* Set the border-color of frame F to value described by ARG.
1638 ARG can be a string naming a color.
1639 The border-color is used for the border that is drawn by the X server.
1640 Note that this does not fully take effect if done before
1641 F has an x-window; it must be redone when the window is created.
1643 Note: this is done in two routines because of the way X10 works.
1645 Note: under X11, this is normally the province of the window manager,
1646 and so emacs' border colors may be overridden. */
1648 void
1649 x_set_border_color (f, arg, oldval)
1650 struct frame *f;
1651 Lisp_Object arg, oldval;
1653 int pix;
1655 CHECK_STRING (arg, 0);
1656 pix = x_decode_color (f, arg, BLACK_PIX_DEFAULT (f));
1657 x_set_border_pixel (f, pix);
1658 update_face_from_frame_parameter (f, Qborder_color, arg);
1661 /* Set the border-color of frame F to pixel value PIX.
1662 Note that this does not fully take effect if done before
1663 F has an x-window. */
1665 void
1666 x_set_border_pixel (f, pix)
1667 struct frame *f;
1668 int pix;
1670 unload_color (f, f->output_data.x->border_pixel);
1671 f->output_data.x->border_pixel = pix;
1673 if (FRAME_X_WINDOW (f) != 0 && f->output_data.x->border_width > 0)
1675 BLOCK_INPUT;
1676 XSetWindowBorder (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
1677 (unsigned long)pix);
1678 UNBLOCK_INPUT;
1680 if (FRAME_VISIBLE_P (f))
1681 redraw_frame (f);
1685 void
1686 x_set_cursor_type (f, arg, oldval)
1687 FRAME_PTR f;
1688 Lisp_Object arg, oldval;
1690 if (EQ (arg, Qbar))
1692 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
1693 f->output_data.x->cursor_width = 2;
1695 else if (CONSP (arg) && EQ (XCAR (arg), Qbar)
1696 && INTEGERP (XCDR (arg)))
1698 FRAME_DESIRED_CURSOR (f) = BAR_CURSOR;
1699 f->output_data.x->cursor_width = XINT (XCDR (arg));
1701 else
1702 /* Treat anything unknown as "box cursor".
1703 It was bad to signal an error; people have trouble fixing
1704 .Xdefaults with Emacs, when it has something bad in it. */
1705 FRAME_DESIRED_CURSOR (f) = FILLED_BOX_CURSOR;
1707 /* Make sure the cursor gets redrawn. This is overkill, but how
1708 often do people change cursor types? */
1709 update_mode_lines++;
1712 void
1713 x_set_icon_type (f, arg, oldval)
1714 struct frame *f;
1715 Lisp_Object arg, oldval;
1717 int result;
1719 if (STRINGP (arg))
1721 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1722 return;
1724 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1725 return;
1727 BLOCK_INPUT;
1728 if (NILP (arg))
1729 result = x_text_icon (f,
1730 (char *) XSTRING ((!NILP (f->icon_name)
1731 ? f->icon_name
1732 : f->name))->data);
1733 else
1734 result = x_bitmap_icon (f, arg);
1736 if (result)
1738 UNBLOCK_INPUT;
1739 error ("No icon window available");
1742 XFlush (FRAME_X_DISPLAY (f));
1743 UNBLOCK_INPUT;
1746 /* Return non-nil if frame F wants a bitmap icon. */
1748 Lisp_Object
1749 x_icon_type (f)
1750 FRAME_PTR f;
1752 Lisp_Object tem;
1754 tem = assq_no_quit (Qicon_type, f->param_alist);
1755 if (CONSP (tem))
1756 return XCDR (tem);
1757 else
1758 return Qnil;
1761 void
1762 x_set_icon_name (f, arg, oldval)
1763 struct frame *f;
1764 Lisp_Object arg, oldval;
1766 int result;
1768 if (STRINGP (arg))
1770 if (STRINGP (oldval) && EQ (Fstring_equal (oldval, arg), Qt))
1771 return;
1773 else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil))
1774 return;
1776 f->icon_name = arg;
1778 if (f->output_data.x->icon_bitmap != 0)
1779 return;
1781 BLOCK_INPUT;
1783 result = x_text_icon (f,
1784 (char *) XSTRING ((!NILP (f->icon_name)
1785 ? f->icon_name
1786 : !NILP (f->title)
1787 ? f->title
1788 : f->name))->data);
1790 if (result)
1792 UNBLOCK_INPUT;
1793 error ("No icon window available");
1796 XFlush (FRAME_X_DISPLAY (f));
1797 UNBLOCK_INPUT;
1800 void
1801 x_set_font (f, arg, oldval)
1802 struct frame *f;
1803 Lisp_Object arg, oldval;
1805 Lisp_Object result;
1806 Lisp_Object fontset_name;
1807 Lisp_Object frame;
1809 CHECK_STRING (arg, 1);
1811 fontset_name = Fquery_fontset (arg, Qnil);
1813 BLOCK_INPUT;
1814 result = (STRINGP (fontset_name)
1815 ? x_new_fontset (f, XSTRING (fontset_name)->data)
1816 : x_new_font (f, XSTRING (arg)->data));
1817 UNBLOCK_INPUT;
1819 if (EQ (result, Qnil))
1820 error ("Font `%s' is not defined", XSTRING (arg)->data);
1821 else if (EQ (result, Qt))
1822 error ("The characters of the given font have varying widths");
1823 else if (STRINGP (result))
1825 store_frame_param (f, Qfont, result);
1826 recompute_basic_faces (f);
1828 else
1829 abort ();
1831 do_pending_window_change (0);
1833 /* Don't call `face-set-after-frame-default' when faces haven't been
1834 initialized yet. This is the case when called from
1835 Fx_create_frame. In that case, the X widget or window doesn't
1836 exist either, and we can end up in x_report_frame_params with a
1837 null widget which gives a segfault. */
1838 if (FRAME_FACE_CACHE (f))
1840 XSETFRAME (frame, f);
1841 call1 (Qface_set_after_frame_default, frame);
1845 void
1846 x_set_border_width (f, arg, oldval)
1847 struct frame *f;
1848 Lisp_Object arg, oldval;
1850 CHECK_NUMBER (arg, 0);
1852 if (XINT (arg) == f->output_data.x->border_width)
1853 return;
1855 if (FRAME_X_WINDOW (f) != 0)
1856 error ("Cannot change the border width of a window");
1858 f->output_data.x->border_width = XINT (arg);
1861 void
1862 x_set_internal_border_width (f, arg, oldval)
1863 struct frame *f;
1864 Lisp_Object arg, oldval;
1866 int old = f->output_data.x->internal_border_width;
1868 CHECK_NUMBER (arg, 0);
1869 f->output_data.x->internal_border_width = XINT (arg);
1870 if (f->output_data.x->internal_border_width < 0)
1871 f->output_data.x->internal_border_width = 0;
1873 #ifdef USE_X_TOOLKIT
1874 if (f->output_data.x->edit_widget)
1875 widget_store_internal_border (f->output_data.x->edit_widget);
1876 #endif
1878 if (f->output_data.x->internal_border_width == old)
1879 return;
1881 if (FRAME_X_WINDOW (f) != 0)
1883 x_set_window_size (f, 0, f->width, f->height);
1884 SET_FRAME_GARBAGED (f);
1885 do_pending_window_change (0);
1889 void
1890 x_set_visibility (f, value, oldval)
1891 struct frame *f;
1892 Lisp_Object value, oldval;
1894 Lisp_Object frame;
1895 XSETFRAME (frame, f);
1897 if (NILP (value))
1898 Fmake_frame_invisible (frame, Qt);
1899 else if (EQ (value, Qicon))
1900 Ficonify_frame (frame);
1901 else
1902 Fmake_frame_visible (frame);
1905 static void
1906 x_set_menu_bar_lines_1 (window, n)
1907 Lisp_Object window;
1908 int n;
1910 struct window *w = XWINDOW (window);
1912 XSETFASTINT (w->top, XFASTINT (w->top) + n);
1913 XSETFASTINT (w->height, XFASTINT (w->height) - n);
1915 /* Handle just the top child in a vertical split. */
1916 if (!NILP (w->vchild))
1917 x_set_menu_bar_lines_1 (w->vchild, n);
1919 /* Adjust all children in a horizontal split. */
1920 for (window = w->hchild; !NILP (window); window = w->next)
1922 w = XWINDOW (window);
1923 x_set_menu_bar_lines_1 (window, n);
1927 void
1928 x_set_menu_bar_lines (f, value, oldval)
1929 struct frame *f;
1930 Lisp_Object value, oldval;
1932 int nlines;
1933 #ifndef USE_X_TOOLKIT
1934 int olines = FRAME_MENU_BAR_LINES (f);
1935 #endif
1937 /* Right now, menu bars don't work properly in minibuf-only frames;
1938 most of the commands try to apply themselves to the minibuffer
1939 frame itself, and get an error because you can't switch buffers
1940 in or split the minibuffer window. */
1941 if (FRAME_MINIBUF_ONLY_P (f))
1942 return;
1944 if (INTEGERP (value))
1945 nlines = XINT (value);
1946 else
1947 nlines = 0;
1949 /* Make sure we redisplay all windows in this frame. */
1950 windows_or_buffers_changed++;
1952 #ifdef USE_X_TOOLKIT
1953 FRAME_MENU_BAR_LINES (f) = 0;
1954 if (nlines)
1956 FRAME_EXTERNAL_MENU_BAR (f) = 1;
1957 if (FRAME_X_P (f) && f->output_data.x->menubar_widget == 0)
1958 /* Make sure next redisplay shows the menu bar. */
1959 XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
1961 else
1963 if (FRAME_EXTERNAL_MENU_BAR (f) == 1)
1964 free_frame_menubar (f);
1965 FRAME_EXTERNAL_MENU_BAR (f) = 0;
1966 if (FRAME_X_P (f))
1967 f->output_data.x->menubar_widget = 0;
1969 #else /* not USE_X_TOOLKIT */
1970 FRAME_MENU_BAR_LINES (f) = nlines;
1971 x_set_menu_bar_lines_1 (f->root_window, nlines - olines);
1972 #endif /* not USE_X_TOOLKIT */
1973 adjust_glyphs (f);
1977 /* Set the number of lines used for the tool bar of frame F to VALUE.
1978 VALUE not an integer, or < 0 means set the lines to zero. OLDVAL
1979 is the old number of tool bar lines. This function changes the
1980 height of all windows on frame F to match the new tool bar height.
1981 The frame's height doesn't change. */
1983 void
1984 x_set_tool_bar_lines (f, value, oldval)
1985 struct frame *f;
1986 Lisp_Object value, oldval;
1988 int delta, nlines;
1990 /* Use VALUE only if an integer >= 0. */
1991 if (INTEGERP (value) && XINT (value) >= 0)
1992 nlines = XFASTINT (value);
1993 else
1994 nlines = 0;
1996 /* Make sure we redisplay all windows in this frame. */
1997 ++windows_or_buffers_changed;
1999 delta = nlines - FRAME_TOOL_BAR_LINES (f);
2000 FRAME_TOOL_BAR_LINES (f) = nlines;
2001 x_set_menu_bar_lines_1 (FRAME_ROOT_WINDOW (f), delta);
2002 adjust_glyphs (f);
2006 /* Set the foreground color for scroll bars on frame F to VALUE.
2007 VALUE should be a string, a color name. If it isn't a string or
2008 isn't a valid color name, do nothing. OLDVAL is the old value of
2009 the frame parameter. */
2011 void
2012 x_set_scroll_bar_foreground (f, value, oldval)
2013 struct frame *f;
2014 Lisp_Object value, oldval;
2016 unsigned long pixel;
2018 if (STRINGP (value))
2019 pixel = x_decode_color (f, value, BLACK_PIX_DEFAULT (f));
2020 else
2021 pixel = -1;
2023 if (f->output_data.x->scroll_bar_foreground_pixel != -1)
2024 unload_color (f, f->output_data.x->scroll_bar_foreground_pixel);
2026 f->output_data.x->scroll_bar_foreground_pixel = pixel;
2027 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2029 /* Remove all scroll bars because they have wrong colors. */
2030 if (condemn_scroll_bars_hook)
2031 (*condemn_scroll_bars_hook) (f);
2032 if (judge_scroll_bars_hook)
2033 (*judge_scroll_bars_hook) (f);
2035 update_face_from_frame_parameter (f, Qscroll_bar_foreground, value);
2036 redraw_frame (f);
2041 /* Set the background color for scroll bars on frame F to VALUE VALUE
2042 should be a string, a color name. If it isn't a string or isn't a
2043 valid color name, do nothing. OLDVAL is the old value of the frame
2044 parameter. */
2046 void
2047 x_set_scroll_bar_background (f, value, oldval)
2048 struct frame *f;
2049 Lisp_Object value, oldval;
2051 unsigned long pixel;
2053 if (STRINGP (value))
2054 pixel = x_decode_color (f, value, WHITE_PIX_DEFAULT (f));
2055 else
2056 pixel = -1;
2058 if (f->output_data.x->scroll_bar_background_pixel != -1)
2059 unload_color (f, f->output_data.x->scroll_bar_background_pixel);
2061 f->output_data.x->scroll_bar_background_pixel = pixel;
2062 if (FRAME_X_WINDOW (f) && FRAME_VISIBLE_P (f))
2064 /* Remove all scroll bars because they have wrong colors. */
2065 if (condemn_scroll_bars_hook)
2066 (*condemn_scroll_bars_hook) (f);
2067 if (judge_scroll_bars_hook)
2068 (*judge_scroll_bars_hook) (f);
2070 update_face_from_frame_parameter (f, Qscroll_bar_background, value);
2071 redraw_frame (f);
2076 /* Change the name of frame F to NAME. If NAME is nil, set F's name to
2077 x_id_name.
2079 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2080 name; if NAME is a string, set F's name to NAME and set
2081 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2083 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2084 suggesting a new name, which lisp code should override; if
2085 F->explicit_name is set, ignore the new name; otherwise, set it. */
2087 void
2088 x_set_name (f, name, explicit)
2089 struct frame *f;
2090 Lisp_Object name;
2091 int explicit;
2093 /* Make sure that requests from lisp code override requests from
2094 Emacs redisplay code. */
2095 if (explicit)
2097 /* If we're switching from explicit to implicit, we had better
2098 update the mode lines and thereby update the title. */
2099 if (f->explicit_name && NILP (name))
2100 update_mode_lines = 1;
2102 f->explicit_name = ! NILP (name);
2104 else if (f->explicit_name)
2105 return;
2107 /* If NAME is nil, set the name to the x_id_name. */
2108 if (NILP (name))
2110 /* Check for no change needed in this very common case
2111 before we do any consing. */
2112 if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name,
2113 XSTRING (f->name)->data))
2114 return;
2115 name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name);
2117 else
2118 CHECK_STRING (name, 0);
2120 /* Don't change the name if it's already NAME. */
2121 if (! NILP (Fstring_equal (name, f->name)))
2122 return;
2124 f->name = name;
2126 /* For setting the frame title, the title parameter should override
2127 the name parameter. */
2128 if (! NILP (f->title))
2129 name = f->title;
2131 if (FRAME_X_WINDOW (f))
2133 BLOCK_INPUT;
2134 #ifdef HAVE_X11R4
2136 XTextProperty text, icon;
2137 Lisp_Object icon_name;
2139 text.value = XSTRING (name)->data;
2140 text.encoding = XA_STRING;
2141 text.format = 8;
2142 text.nitems = STRING_BYTES (XSTRING (name));
2144 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
2146 icon.value = XSTRING (icon_name)->data;
2147 icon.encoding = XA_STRING;
2148 icon.format = 8;
2149 icon.nitems = STRING_BYTES (XSTRING (icon_name));
2150 #ifdef USE_X_TOOLKIT
2151 XSetWMName (FRAME_X_DISPLAY (f),
2152 XtWindow (f->output_data.x->widget), &text);
2153 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2154 &icon);
2155 #else /* not USE_X_TOOLKIT */
2156 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2157 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2158 #endif /* not USE_X_TOOLKIT */
2160 #else /* not HAVE_X11R4 */
2161 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2162 XSTRING (name)->data);
2163 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2164 XSTRING (name)->data);
2165 #endif /* not HAVE_X11R4 */
2166 UNBLOCK_INPUT;
2170 /* This function should be called when the user's lisp code has
2171 specified a name for the frame; the name will override any set by the
2172 redisplay code. */
2173 void
2174 x_explicitly_set_name (f, arg, oldval)
2175 FRAME_PTR f;
2176 Lisp_Object arg, oldval;
2178 x_set_name (f, arg, 1);
2181 /* This function should be called by Emacs redisplay code to set the
2182 name; names set this way will never override names set by the user's
2183 lisp code. */
2184 void
2185 x_implicitly_set_name (f, arg, oldval)
2186 FRAME_PTR f;
2187 Lisp_Object arg, oldval;
2189 x_set_name (f, arg, 0);
2192 /* Change the title of frame F to NAME.
2193 If NAME is nil, use the frame name as the title.
2195 If EXPLICIT is non-zero, that indicates that lisp code is setting the
2196 name; if NAME is a string, set F's name to NAME and set
2197 F->explicit_name; if NAME is Qnil, then clear F->explicit_name.
2199 If EXPLICIT is zero, that indicates that Emacs redisplay code is
2200 suggesting a new name, which lisp code should override; if
2201 F->explicit_name is set, ignore the new name; otherwise, set it. */
2203 void
2204 x_set_title (f, name, old_name)
2205 struct frame *f;
2206 Lisp_Object name, old_name;
2208 /* Don't change the title if it's already NAME. */
2209 if (EQ (name, f->title))
2210 return;
2212 update_mode_lines = 1;
2214 f->title = name;
2216 if (NILP (name))
2217 name = f->name;
2218 else
2219 CHECK_STRING (name, 0);
2221 if (FRAME_X_WINDOW (f))
2223 BLOCK_INPUT;
2224 #ifdef HAVE_X11R4
2226 XTextProperty text, icon;
2227 Lisp_Object icon_name;
2229 text.value = XSTRING (name)->data;
2230 text.encoding = XA_STRING;
2231 text.format = 8;
2232 text.nitems = STRING_BYTES (XSTRING (name));
2234 icon_name = (!NILP (f->icon_name) ? f->icon_name : name);
2236 icon.value = XSTRING (icon_name)->data;
2237 icon.encoding = XA_STRING;
2238 icon.format = 8;
2239 icon.nitems = STRING_BYTES (XSTRING (icon_name));
2240 #ifdef USE_X_TOOLKIT
2241 XSetWMName (FRAME_X_DISPLAY (f),
2242 XtWindow (f->output_data.x->widget), &text);
2243 XSetWMIconName (FRAME_X_DISPLAY (f), XtWindow (f->output_data.x->widget),
2244 &icon);
2245 #else /* not USE_X_TOOLKIT */
2246 XSetWMName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &text);
2247 XSetWMIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &icon);
2248 #endif /* not USE_X_TOOLKIT */
2250 #else /* not HAVE_X11R4 */
2251 XSetIconName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2252 XSTRING (name)->data);
2253 XStoreName (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2254 XSTRING (name)->data);
2255 #endif /* not HAVE_X11R4 */
2256 UNBLOCK_INPUT;
2260 void
2261 x_set_autoraise (f, arg, oldval)
2262 struct frame *f;
2263 Lisp_Object arg, oldval;
2265 f->auto_raise = !EQ (Qnil, arg);
2268 void
2269 x_set_autolower (f, arg, oldval)
2270 struct frame *f;
2271 Lisp_Object arg, oldval;
2273 f->auto_lower = !EQ (Qnil, arg);
2276 void
2277 x_set_unsplittable (f, arg, oldval)
2278 struct frame *f;
2279 Lisp_Object arg, oldval;
2281 f->no_split = !NILP (arg);
2284 void
2285 x_set_vertical_scroll_bars (f, arg, oldval)
2286 struct frame *f;
2287 Lisp_Object arg, oldval;
2289 if ((EQ (arg, Qleft) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (f))
2290 || (EQ (arg, Qright) && FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (f))
2291 || (NILP (arg) && FRAME_HAS_VERTICAL_SCROLL_BARS (f))
2292 || (!NILP (arg) && ! FRAME_HAS_VERTICAL_SCROLL_BARS (f)))
2294 FRAME_VERTICAL_SCROLL_BAR_TYPE (f)
2295 = (NILP (arg)
2296 ? vertical_scroll_bar_none
2297 : EQ (Qright, arg)
2298 ? vertical_scroll_bar_right
2299 : vertical_scroll_bar_left);
2301 /* We set this parameter before creating the X window for the
2302 frame, so we can get the geometry right from the start.
2303 However, if the window hasn't been created yet, we shouldn't
2304 call x_set_window_size. */
2305 if (FRAME_X_WINDOW (f))
2306 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2307 do_pending_window_change (0);
2311 void
2312 x_set_scroll_bar_width (f, arg, oldval)
2313 struct frame *f;
2314 Lisp_Object arg, oldval;
2316 int wid = FONT_WIDTH (f->output_data.x->font);
2318 if (NILP (arg))
2320 #ifdef USE_TOOLKIT_SCROLL_BARS
2321 /* A minimum width of 14 doesn't look good for toolkit scroll bars. */
2322 int width = 16 + 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM;
2323 FRAME_SCROLL_BAR_COLS (f) = (width + wid - 1) / wid;
2324 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = width;
2325 #else
2326 /* Make the actual width at least 14 pixels and a multiple of a
2327 character width. */
2328 FRAME_SCROLL_BAR_COLS (f) = (14 + wid - 1) / wid;
2330 /* Use all of that space (aside from required margins) for the
2331 scroll bar. */
2332 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = 0;
2333 #endif
2335 if (FRAME_X_WINDOW (f))
2336 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2337 do_pending_window_change (0);
2339 else if (INTEGERP (arg) && XINT (arg) > 0
2340 && XFASTINT (arg) != FRAME_SCROLL_BAR_PIXEL_WIDTH (f))
2342 if (XFASTINT (arg) <= 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM)
2343 XSETINT (arg, 2 * VERTICAL_SCROLL_BAR_WIDTH_TRIM + 1);
2345 FRAME_SCROLL_BAR_PIXEL_WIDTH (f) = XFASTINT (arg);
2346 FRAME_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + wid-1) / wid;
2347 if (FRAME_X_WINDOW (f))
2348 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
2351 change_frame_size (f, 0, FRAME_WIDTH (f), 0, 0, 0);
2352 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.hpos = 0;
2353 XWINDOW (FRAME_SELECTED_WINDOW (f))->cursor.x = 0;
2358 /* Subroutines of creating an X frame. */
2360 /* Make sure that Vx_resource_name is set to a reasonable value.
2361 Fix it up, or set it to `emacs' if it is too hopeless. */
2363 static void
2364 validate_x_resource_name ()
2366 int len = 0;
2367 /* Number of valid characters in the resource name. */
2368 int good_count = 0;
2369 /* Number of invalid characters in the resource name. */
2370 int bad_count = 0;
2371 Lisp_Object new;
2372 int i;
2374 if (!STRINGP (Vx_resource_class))
2375 Vx_resource_class = build_string (EMACS_CLASS);
2377 if (STRINGP (Vx_resource_name))
2379 unsigned char *p = XSTRING (Vx_resource_name)->data;
2380 int i;
2382 len = STRING_BYTES (XSTRING (Vx_resource_name));
2384 /* Only letters, digits, - and _ are valid in resource names.
2385 Count the valid characters and count the invalid ones. */
2386 for (i = 0; i < len; i++)
2388 int c = p[i];
2389 if (! ((c >= 'a' && c <= 'z')
2390 || (c >= 'A' && c <= 'Z')
2391 || (c >= '0' && c <= '9')
2392 || c == '-' || c == '_'))
2393 bad_count++;
2394 else
2395 good_count++;
2398 else
2399 /* Not a string => completely invalid. */
2400 bad_count = 5, good_count = 0;
2402 /* If name is valid already, return. */
2403 if (bad_count == 0)
2404 return;
2406 /* If name is entirely invalid, or nearly so, use `emacs'. */
2407 if (good_count == 0
2408 || (good_count == 1 && bad_count > 0))
2410 Vx_resource_name = build_string ("emacs");
2411 return;
2414 /* Name is partly valid. Copy it and replace the invalid characters
2415 with underscores. */
2417 Vx_resource_name = new = Fcopy_sequence (Vx_resource_name);
2419 for (i = 0; i < len; i++)
2421 int c = XSTRING (new)->data[i];
2422 if (! ((c >= 'a' && c <= 'z')
2423 || (c >= 'A' && c <= 'Z')
2424 || (c >= '0' && c <= '9')
2425 || c == '-' || c == '_'))
2426 XSTRING (new)->data[i] = '_';
2431 extern char *x_get_string_resource ();
2433 DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0,
2434 "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\
2435 This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\
2436 class, where INSTANCE is the name under which Emacs was invoked, or\n\
2437 the name specified by the `-name' or `-rn' command-line arguments.\n\
2439 The optional arguments COMPONENT and SUBCLASS add to the key and the\n\
2440 class, respectively. You must specify both of them or neither.\n\
2441 If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\
2442 and the class is `Emacs.CLASS.SUBCLASS'.")
2443 (attribute, class, component, subclass)
2444 Lisp_Object attribute, class, component, subclass;
2446 register char *value;
2447 char *name_key;
2448 char *class_key;
2450 check_x ();
2452 CHECK_STRING (attribute, 0);
2453 CHECK_STRING (class, 0);
2455 if (!NILP (component))
2456 CHECK_STRING (component, 1);
2457 if (!NILP (subclass))
2458 CHECK_STRING (subclass, 2);
2459 if (NILP (component) != NILP (subclass))
2460 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2462 validate_x_resource_name ();
2464 /* Allocate space for the components, the dots which separate them,
2465 and the final '\0'. Make them big enough for the worst case. */
2466 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2467 + (STRINGP (component)
2468 ? STRING_BYTES (XSTRING (component)) : 0)
2469 + STRING_BYTES (XSTRING (attribute))
2470 + 3);
2472 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2473 + STRING_BYTES (XSTRING (class))
2474 + (STRINGP (subclass)
2475 ? STRING_BYTES (XSTRING (subclass)) : 0)
2476 + 3);
2478 /* Start with emacs.FRAMENAME for the name (the specific one)
2479 and with `Emacs' for the class key (the general one). */
2480 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2481 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2483 strcat (class_key, ".");
2484 strcat (class_key, XSTRING (class)->data);
2486 if (!NILP (component))
2488 strcat (class_key, ".");
2489 strcat (class_key, XSTRING (subclass)->data);
2491 strcat (name_key, ".");
2492 strcat (name_key, XSTRING (component)->data);
2495 strcat (name_key, ".");
2496 strcat (name_key, XSTRING (attribute)->data);
2498 value = x_get_string_resource (check_x_display_info (Qnil)->xrdb,
2499 name_key, class_key);
2501 if (value != (char *) 0)
2502 return build_string (value);
2503 else
2504 return Qnil;
2507 /* Get an X resource, like Fx_get_resource, but for display DPYINFO. */
2509 Lisp_Object
2510 display_x_get_resource (dpyinfo, attribute, class, component, subclass)
2511 struct x_display_info *dpyinfo;
2512 Lisp_Object attribute, class, component, subclass;
2514 register char *value;
2515 char *name_key;
2516 char *class_key;
2518 check_x ();
2520 CHECK_STRING (attribute, 0);
2521 CHECK_STRING (class, 0);
2523 if (!NILP (component))
2524 CHECK_STRING (component, 1);
2525 if (!NILP (subclass))
2526 CHECK_STRING (subclass, 2);
2527 if (NILP (component) != NILP (subclass))
2528 error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither");
2530 validate_x_resource_name ();
2532 /* Allocate space for the components, the dots which separate them,
2533 and the final '\0'. Make them big enough for the worst case. */
2534 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_name))
2535 + (STRINGP (component)
2536 ? STRING_BYTES (XSTRING (component)) : 0)
2537 + STRING_BYTES (XSTRING (attribute))
2538 + 3);
2540 class_key = (char *) alloca (STRING_BYTES (XSTRING (Vx_resource_class))
2541 + STRING_BYTES (XSTRING (class))
2542 + (STRINGP (subclass)
2543 ? STRING_BYTES (XSTRING (subclass)) : 0)
2544 + 3);
2546 /* Start with emacs.FRAMENAME for the name (the specific one)
2547 and with `Emacs' for the class key (the general one). */
2548 strcpy (name_key, XSTRING (Vx_resource_name)->data);
2549 strcpy (class_key, XSTRING (Vx_resource_class)->data);
2551 strcat (class_key, ".");
2552 strcat (class_key, XSTRING (class)->data);
2554 if (!NILP (component))
2556 strcat (class_key, ".");
2557 strcat (class_key, XSTRING (subclass)->data);
2559 strcat (name_key, ".");
2560 strcat (name_key, XSTRING (component)->data);
2563 strcat (name_key, ".");
2564 strcat (name_key, XSTRING (attribute)->data);
2566 value = x_get_string_resource (dpyinfo->xrdb, name_key, class_key);
2568 if (value != (char *) 0)
2569 return build_string (value);
2570 else
2571 return Qnil;
2574 /* Used when C code wants a resource value. */
2576 char *
2577 x_get_resource_string (attribute, class)
2578 char *attribute, *class;
2580 char *name_key;
2581 char *class_key;
2582 struct frame *sf = SELECTED_FRAME ();
2584 /* Allocate space for the components, the dots which separate them,
2585 and the final '\0'. */
2586 name_key = (char *) alloca (STRING_BYTES (XSTRING (Vinvocation_name))
2587 + strlen (attribute) + 2);
2588 class_key = (char *) alloca ((sizeof (EMACS_CLASS) - 1)
2589 + strlen (class) + 2);
2591 sprintf (name_key, "%s.%s",
2592 XSTRING (Vinvocation_name)->data,
2593 attribute);
2594 sprintf (class_key, "%s.%s", EMACS_CLASS, class);
2596 return x_get_string_resource (FRAME_X_DISPLAY_INFO (sf)->xrdb,
2597 name_key, class_key);
2600 /* Types we might convert a resource string into. */
2601 enum resource_types
2603 RES_TYPE_NUMBER,
2604 RES_TYPE_FLOAT,
2605 RES_TYPE_BOOLEAN,
2606 RES_TYPE_STRING,
2607 RES_TYPE_SYMBOL
2610 /* Return the value of parameter PARAM.
2612 First search ALIST, then Vdefault_frame_alist, then the X defaults
2613 database, using ATTRIBUTE as the attribute name and CLASS as its class.
2615 Convert the resource to the type specified by desired_type.
2617 If no default is specified, return Qunbound. If you call
2618 x_get_arg, make sure you deal with Qunbound in a reasonable way,
2619 and don't let it get stored in any Lisp-visible variables! */
2621 static Lisp_Object
2622 x_get_arg (dpyinfo, alist, param, attribute, class, type)
2623 struct x_display_info *dpyinfo;
2624 Lisp_Object alist, param;
2625 char *attribute;
2626 char *class;
2627 enum resource_types type;
2629 register Lisp_Object tem;
2631 tem = Fassq (param, alist);
2632 if (EQ (tem, Qnil))
2633 tem = Fassq (param, Vdefault_frame_alist);
2634 if (EQ (tem, Qnil))
2637 if (attribute)
2639 tem = display_x_get_resource (dpyinfo,
2640 build_string (attribute),
2641 build_string (class),
2642 Qnil, Qnil);
2644 if (NILP (tem))
2645 return Qunbound;
2647 switch (type)
2649 case RES_TYPE_NUMBER:
2650 return make_number (atoi (XSTRING (tem)->data));
2652 case RES_TYPE_FLOAT:
2653 return make_float (atof (XSTRING (tem)->data));
2655 case RES_TYPE_BOOLEAN:
2656 tem = Fdowncase (tem);
2657 if (!strcmp (XSTRING (tem)->data, "on")
2658 || !strcmp (XSTRING (tem)->data, "true"))
2659 return Qt;
2660 else
2661 return Qnil;
2663 case RES_TYPE_STRING:
2664 return tem;
2666 case RES_TYPE_SYMBOL:
2667 /* As a special case, we map the values `true' and `on'
2668 to Qt, and `false' and `off' to Qnil. */
2670 Lisp_Object lower;
2671 lower = Fdowncase (tem);
2672 if (!strcmp (XSTRING (lower)->data, "on")
2673 || !strcmp (XSTRING (lower)->data, "true"))
2674 return Qt;
2675 else if (!strcmp (XSTRING (lower)->data, "off")
2676 || !strcmp (XSTRING (lower)->data, "false"))
2677 return Qnil;
2678 else
2679 return Fintern (tem, Qnil);
2682 default:
2683 abort ();
2686 else
2687 return Qunbound;
2689 return Fcdr (tem);
2692 /* Like x_get_arg, but also record the value in f->param_alist. */
2694 static Lisp_Object
2695 x_get_and_record_arg (f, alist, param, attribute, class, type)
2696 struct frame *f;
2697 Lisp_Object alist, param;
2698 char *attribute;
2699 char *class;
2700 enum resource_types type;
2702 Lisp_Object value;
2704 value = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, param,
2705 attribute, class, type);
2706 if (! NILP (value))
2707 store_frame_param (f, param, value);
2709 return value;
2712 /* Record in frame F the specified or default value according to ALIST
2713 of the parameter named PROP (a Lisp symbol).
2714 If no value is specified for PROP, look for an X default for XPROP
2715 on the frame named NAME.
2716 If that is not found either, use the value DEFLT. */
2718 static Lisp_Object
2719 x_default_parameter (f, alist, prop, deflt, xprop, xclass, type)
2720 struct frame *f;
2721 Lisp_Object alist;
2722 Lisp_Object prop;
2723 Lisp_Object deflt;
2724 char *xprop;
2725 char *xclass;
2726 enum resource_types type;
2728 Lisp_Object tem;
2730 tem = x_get_arg (FRAME_X_DISPLAY_INFO (f), alist, prop, xprop, xclass, type);
2731 if (EQ (tem, Qunbound))
2732 tem = deflt;
2733 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2734 return tem;
2738 /* Record in frame F the specified or default value according to ALIST
2739 of the parameter named PROP (a Lisp symbol). If no value is
2740 specified for PROP, look for an X default for XPROP on the frame
2741 named NAME. If that is not found either, use the value DEFLT. */
2743 static Lisp_Object
2744 x_default_scroll_bar_color_parameter (f, alist, prop, xprop, xclass,
2745 foreground_p)
2746 struct frame *f;
2747 Lisp_Object alist;
2748 Lisp_Object prop;
2749 char *xprop;
2750 char *xclass;
2751 int foreground_p;
2753 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2754 Lisp_Object tem;
2756 tem = x_get_arg (dpyinfo, alist, prop, xprop, xclass, RES_TYPE_STRING);
2757 if (EQ (tem, Qunbound))
2759 #ifdef USE_TOOLKIT_SCROLL_BARS
2761 /* See if an X resource for the scroll bar color has been
2762 specified. */
2763 tem = display_x_get_resource (dpyinfo,
2764 build_string (foreground_p
2765 ? "foreground"
2766 : "background"),
2767 build_string (""),
2768 build_string ("verticalScrollBar"),
2769 build_string (""));
2770 if (!STRINGP (tem))
2772 /* If nothing has been specified, scroll bars will use a
2773 toolkit-dependent default. Because these defaults are
2774 difficult to get at without actually creating a scroll
2775 bar, use nil to indicate that no color has been
2776 specified. */
2777 tem = Qnil;
2780 #else /* not USE_TOOLKIT_SCROLL_BARS */
2782 tem = Qnil;
2784 #endif /* not USE_TOOLKIT_SCROLL_BARS */
2787 x_set_frame_parameters (f, Fcons (Fcons (prop, tem), Qnil));
2788 return tem;
2793 DEFUN ("x-parse-geometry", Fx_parse_geometry, Sx_parse_geometry, 1, 1, 0,
2794 "Parse an X-style geometry string STRING.\n\
2795 Returns an alist of the form ((top . TOP), (left . LEFT) ... ).\n\
2796 The properties returned may include `top', `left', `height', and `width'.\n\
2797 The value of `left' or `top' may be an integer,\n\
2798 or a list (+ N) meaning N pixels relative to top/left corner,\n\
2799 or a list (- N) meaning -N pixels relative to bottom/right corner.")
2800 (string)
2801 Lisp_Object string;
2803 int geometry, x, y;
2804 unsigned int width, height;
2805 Lisp_Object result;
2807 CHECK_STRING (string, 0);
2809 geometry = XParseGeometry ((char *) XSTRING (string)->data,
2810 &x, &y, &width, &height);
2812 #if 0
2813 if (!!(geometry & XValue) != !!(geometry & YValue))
2814 error ("Must specify both x and y position, or neither");
2815 #endif
2817 result = Qnil;
2818 if (geometry & XValue)
2820 Lisp_Object element;
2822 if (x >= 0 && (geometry & XNegative))
2823 element = Fcons (Qleft, Fcons (Qminus, Fcons (make_number (-x), Qnil)));
2824 else if (x < 0 && ! (geometry & XNegative))
2825 element = Fcons (Qleft, Fcons (Qplus, Fcons (make_number (x), Qnil)));
2826 else
2827 element = Fcons (Qleft, make_number (x));
2828 result = Fcons (element, result);
2831 if (geometry & YValue)
2833 Lisp_Object element;
2835 if (y >= 0 && (geometry & YNegative))
2836 element = Fcons (Qtop, Fcons (Qminus, Fcons (make_number (-y), Qnil)));
2837 else if (y < 0 && ! (geometry & YNegative))
2838 element = Fcons (Qtop, Fcons (Qplus, Fcons (make_number (y), Qnil)));
2839 else
2840 element = Fcons (Qtop, make_number (y));
2841 result = Fcons (element, result);
2844 if (geometry & WidthValue)
2845 result = Fcons (Fcons (Qwidth, make_number (width)), result);
2846 if (geometry & HeightValue)
2847 result = Fcons (Fcons (Qheight, make_number (height)), result);
2849 return result;
2852 /* Calculate the desired size and position of this window,
2853 and return the flags saying which aspects were specified.
2855 This function does not make the coordinates positive. */
2857 #define DEFAULT_ROWS 40
2858 #define DEFAULT_COLS 80
2860 static int
2861 x_figure_window_size (f, parms)
2862 struct frame *f;
2863 Lisp_Object parms;
2865 register Lisp_Object tem0, tem1, tem2;
2866 long window_prompting = 0;
2867 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2869 /* Default values if we fall through.
2870 Actually, if that happens we should get
2871 window manager prompting. */
2872 SET_FRAME_WIDTH (f, DEFAULT_COLS);
2873 f->height = DEFAULT_ROWS;
2874 /* Window managers expect that if program-specified
2875 positions are not (0,0), they're intentional, not defaults. */
2876 f->output_data.x->top_pos = 0;
2877 f->output_data.x->left_pos = 0;
2879 tem0 = x_get_arg (dpyinfo, parms, Qheight, 0, 0, RES_TYPE_NUMBER);
2880 tem1 = x_get_arg (dpyinfo, parms, Qwidth, 0, 0, RES_TYPE_NUMBER);
2881 tem2 = x_get_arg (dpyinfo, parms, Quser_size, 0, 0, RES_TYPE_NUMBER);
2882 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2884 if (!EQ (tem0, Qunbound))
2886 CHECK_NUMBER (tem0, 0);
2887 f->height = XINT (tem0);
2889 if (!EQ (tem1, Qunbound))
2891 CHECK_NUMBER (tem1, 0);
2892 SET_FRAME_WIDTH (f, XINT (tem1));
2894 if (!NILP (tem2) && !EQ (tem2, Qunbound))
2895 window_prompting |= USSize;
2896 else
2897 window_prompting |= PSize;
2900 f->output_data.x->vertical_scroll_bar_extra
2901 = (!FRAME_HAS_VERTICAL_SCROLL_BARS (f)
2903 : (FRAME_SCROLL_BAR_COLS (f) * FONT_WIDTH (f->output_data.x->font)));
2904 f->output_data.x->flags_areas_extra
2905 = FRAME_FLAGS_AREA_WIDTH (f);
2906 f->output_data.x->pixel_width = CHAR_TO_PIXEL_WIDTH (f, f->width);
2907 f->output_data.x->pixel_height = CHAR_TO_PIXEL_HEIGHT (f, f->height);
2909 tem0 = x_get_arg (dpyinfo, parms, Qtop, 0, 0, RES_TYPE_NUMBER);
2910 tem1 = x_get_arg (dpyinfo, parms, Qleft, 0, 0, RES_TYPE_NUMBER);
2911 tem2 = x_get_arg (dpyinfo, parms, Quser_position, 0, 0, RES_TYPE_NUMBER);
2912 if (! EQ (tem0, Qunbound) || ! EQ (tem1, Qunbound))
2914 if (EQ (tem0, Qminus))
2916 f->output_data.x->top_pos = 0;
2917 window_prompting |= YNegative;
2919 else if (CONSP (tem0) && EQ (XCAR (tem0), Qminus)
2920 && CONSP (XCDR (tem0))
2921 && INTEGERP (XCAR (XCDR (tem0))))
2923 f->output_data.x->top_pos = - XINT (XCAR (XCDR (tem0)));
2924 window_prompting |= YNegative;
2926 else if (CONSP (tem0) && EQ (XCAR (tem0), Qplus)
2927 && CONSP (XCDR (tem0))
2928 && INTEGERP (XCAR (XCDR (tem0))))
2930 f->output_data.x->top_pos = XINT (XCAR (XCDR (tem0)));
2932 else if (EQ (tem0, Qunbound))
2933 f->output_data.x->top_pos = 0;
2934 else
2936 CHECK_NUMBER (tem0, 0);
2937 f->output_data.x->top_pos = XINT (tem0);
2938 if (f->output_data.x->top_pos < 0)
2939 window_prompting |= YNegative;
2942 if (EQ (tem1, Qminus))
2944 f->output_data.x->left_pos = 0;
2945 window_prompting |= XNegative;
2947 else if (CONSP (tem1) && EQ (XCAR (tem1), Qminus)
2948 && CONSP (XCDR (tem1))
2949 && INTEGERP (XCAR (XCDR (tem1))))
2951 f->output_data.x->left_pos = - XINT (XCAR (XCDR (tem1)));
2952 window_prompting |= XNegative;
2954 else if (CONSP (tem1) && EQ (XCAR (tem1), Qplus)
2955 && CONSP (XCDR (tem1))
2956 && INTEGERP (XCAR (XCDR (tem1))))
2958 f->output_data.x->left_pos = XINT (XCAR (XCDR (tem1)));
2960 else if (EQ (tem1, Qunbound))
2961 f->output_data.x->left_pos = 0;
2962 else
2964 CHECK_NUMBER (tem1, 0);
2965 f->output_data.x->left_pos = XINT (tem1);
2966 if (f->output_data.x->left_pos < 0)
2967 window_prompting |= XNegative;
2970 if (!NILP (tem2) && ! EQ (tem2, Qunbound))
2971 window_prompting |= USPosition;
2972 else
2973 window_prompting |= PPosition;
2976 return window_prompting;
2979 #if !defined (HAVE_X11R4) && !defined (HAVE_XSETWMPROTOCOLS)
2981 Status
2982 XSetWMProtocols (dpy, w, protocols, count)
2983 Display *dpy;
2984 Window w;
2985 Atom *protocols;
2986 int count;
2988 Atom prop;
2989 prop = XInternAtom (dpy, "WM_PROTOCOLS", False);
2990 if (prop == None) return False;
2991 XChangeProperty (dpy, w, prop, XA_ATOM, 32, PropModeReplace,
2992 (unsigned char *) protocols, count);
2993 return True;
2995 #endif /* not HAVE_X11R4 && not HAVE_XSETWMPROTOCOLS */
2997 #ifdef USE_X_TOOLKIT
2999 /* If the WM_PROTOCOLS property does not already contain WM_TAKE_FOCUS,
3000 WM_DELETE_WINDOW, and WM_SAVE_YOURSELF, then add them. (They may
3001 already be present because of the toolkit (Motif adds some of them,
3002 for example, but Xt doesn't). */
3004 static void
3005 hack_wm_protocols (f, widget)
3006 FRAME_PTR f;
3007 Widget widget;
3009 Display *dpy = XtDisplay (widget);
3010 Window w = XtWindow (widget);
3011 int need_delete = 1;
3012 int need_focus = 1;
3013 int need_save = 1;
3015 BLOCK_INPUT;
3017 Atom type, *atoms = 0;
3018 int format = 0;
3019 unsigned long nitems = 0;
3020 unsigned long bytes_after;
3022 if ((XGetWindowProperty (dpy, w,
3023 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3024 (long)0, (long)100, False, XA_ATOM,
3025 &type, &format, &nitems, &bytes_after,
3026 (unsigned char **) &atoms)
3027 == Success)
3028 && format == 32 && type == XA_ATOM)
3029 while (nitems > 0)
3031 nitems--;
3032 if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window)
3033 need_delete = 0;
3034 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus)
3035 need_focus = 0;
3036 else if (atoms[nitems] == FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself)
3037 need_save = 0;
3039 if (atoms) XFree ((char *) atoms);
3042 Atom props [10];
3043 int count = 0;
3044 if (need_delete)
3045 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3046 if (need_focus)
3047 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_take_focus;
3048 if (need_save)
3049 props[count++] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3050 if (count)
3051 XChangeProperty (dpy, w, FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3052 XA_ATOM, 32, PropModeAppend,
3053 (unsigned char *) props, count);
3055 UNBLOCK_INPUT;
3057 #endif
3061 /* Support routines for XIC (X Input Context). */
3063 #ifdef HAVE_X_I18N
3065 static XFontSet xic_create_xfontset P_ ((struct frame *, char *));
3066 static XIMStyle best_xim_style P_ ((XIMStyles *, XIMStyles *));
3069 /* Supported XIM styles, ordered by preferenc. */
3071 static XIMStyle supported_xim_styles[] =
3073 XIMPreeditPosition | XIMStatusArea,
3074 XIMPreeditPosition | XIMStatusNothing,
3075 XIMPreeditPosition | XIMStatusNone,
3076 XIMPreeditNothing | XIMStatusArea,
3077 XIMPreeditNothing | XIMStatusNothing,
3078 XIMPreeditNothing | XIMStatusNone,
3079 XIMPreeditNone | XIMStatusArea,
3080 XIMPreeditNone | XIMStatusNothing,
3081 XIMPreeditNone | XIMStatusNone,
3086 /* Create an X fontset on frame F with base font name
3087 BASE_FONTNAME.. */
3089 static XFontSet
3090 xic_create_xfontset (f, base_fontname)
3091 struct frame *f;
3092 char *base_fontname;
3094 XFontSet xfs;
3095 char **missing_list;
3096 int missing_count;
3097 char *def_string;
3099 xfs = XCreateFontSet (FRAME_X_DISPLAY (f),
3100 base_fontname, &missing_list,
3101 &missing_count, &def_string);
3102 if (missing_list)
3103 XFreeStringList (missing_list);
3105 /* No need to free def_string. */
3106 return xfs;
3110 /* Value is the best input style, given user preferences USER (already
3111 checked to be supported by Emacs), and styles supported by the
3112 input method XIM. */
3114 static XIMStyle
3115 best_xim_style (user, xim)
3116 XIMStyles *user;
3117 XIMStyles *xim;
3119 int i, j;
3121 for (i = 0; i < user->count_styles; ++i)
3122 for (j = 0; j < xim->count_styles; ++j)
3123 if (user->supported_styles[i] == xim->supported_styles[j])
3124 return user->supported_styles[i];
3126 /* Return the default style. */
3127 return XIMPreeditNothing | XIMStatusNothing;
3130 /* Create XIC for frame F. */
3132 void
3133 create_frame_xic (f)
3134 struct frame *f;
3136 #ifndef X_I18N_INHIBITED
3137 XIM xim;
3138 XIC xic = NULL;
3139 XFontSet xfs = NULL;
3140 static XIMStyle xic_style;
3142 if (FRAME_XIC (f))
3143 return;
3145 xim = FRAME_X_XIM (f);
3146 if (xim)
3148 XRectangle s_area;
3149 XPoint spot;
3150 XVaNestedList preedit_attr;
3151 XVaNestedList status_attr;
3152 char *base_fontname;
3153 int fontset;
3155 s_area.x = 0; s_area.y = 0; s_area.width = 1; s_area.height = 1;
3156 spot.x = 0; spot.y = 1;
3157 /* Create X fontset. */
3158 fontset = FRAME_FONTSET (f);
3159 if (fontset < 0)
3160 base_fontname = "-*-*-*-r-normal--14-*-*-*-*-*-*-*";
3161 else
3163 struct fontset_info *fontsetp;
3164 int len = 0;
3165 int i;
3167 fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
3168 for (i = 0; i <= MAX_CHARSET; i++)
3169 if (fontsetp->fontname[i])
3170 len += strlen (fontsetp->fontname[i]) + 1;
3171 base_fontname = alloca (len);
3172 strcpy (base_fontname, fontsetp->fontname[CHARSET_ASCII]);
3173 for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i <= MAX_CHARSET; i++)
3174 if (fontsetp->fontname[i])
3176 strcat (base_fontname, ",");
3177 strcat (base_fontname, fontsetp->fontname[i]);
3180 xfs = xic_create_xfontset (f, base_fontname);
3182 /* Determine XIC style. */
3183 if (xic_style == 0)
3185 XIMStyles supported_list;
3186 supported_list.count_styles = (sizeof supported_xim_styles
3187 / sizeof supported_xim_styles[0]);
3188 supported_list.supported_styles = supported_xim_styles;
3189 xic_style = best_xim_style (&supported_list,
3190 FRAME_X_XIM_STYLES (f));
3193 preedit_attr = XVaCreateNestedList (0,
3194 XNFontSet, xfs,
3195 XNForeground,
3196 FRAME_FOREGROUND_PIXEL (f),
3197 XNBackground,
3198 FRAME_BACKGROUND_PIXEL (f),
3199 (xic_style & XIMPreeditPosition
3200 ? XNSpotLocation
3201 : NULL),
3202 &spot,
3203 NULL);
3204 status_attr = XVaCreateNestedList (0,
3205 XNArea,
3206 &s_area,
3207 XNFontSet,
3208 xfs,
3209 XNForeground,
3210 FRAME_FOREGROUND_PIXEL (f),
3211 XNBackground,
3212 FRAME_BACKGROUND_PIXEL (f),
3213 NULL);
3215 xic = XCreateIC (xim,
3216 XNInputStyle, xic_style,
3217 XNClientWindow, FRAME_X_WINDOW(f),
3218 XNFocusWindow, FRAME_X_WINDOW(f),
3219 XNStatusAttributes, status_attr,
3220 XNPreeditAttributes, preedit_attr,
3221 NULL);
3222 XFree (preedit_attr);
3223 XFree (status_attr);
3226 FRAME_XIC (f) = xic;
3227 FRAME_XIC_STYLE (f) = xic_style;
3228 FRAME_XIC_FONTSET (f) = xfs;
3229 #else /* X_I18N_INHIBITED */
3230 FRAME_XIC (f) = NULL;
3231 FRAME_XIC_STYLE (f) = 0;
3232 FRAME_XIC_FONTSET (f) = NULL;
3233 #endif /* X_I18N_INHIBITED */
3237 /* Destroy XIC and free XIC fontset of frame F, if any. */
3239 void
3240 free_frame_xic (f)
3241 struct frame *f;
3243 if (FRAME_XIC (f) == NULL)
3244 return;
3246 XDestroyIC (FRAME_XIC (f));
3247 if (FRAME_XIC_FONTSET (f))
3248 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3250 FRAME_XIC (f) = NULL;
3251 FRAME_XIC_FONTSET (f) = NULL;
3255 /* Place preedit area for XIC of window W's frame to specified
3256 pixel position X/Y. X and Y are relative to window W. */
3258 void
3259 xic_set_preeditarea (w, x, y)
3260 struct window *w;
3261 int x, y;
3263 struct frame *f = XFRAME (w->frame);
3264 XVaNestedList attr;
3265 XPoint spot;
3267 spot.x = WINDOW_TO_FRAME_PIXEL_X (w, x);
3268 spot.y = WINDOW_TO_FRAME_PIXEL_Y (w, y) + FONT_BASE (FRAME_FONT (f));
3269 attr = XVaCreateNestedList (0, XNSpotLocation, &spot, NULL);
3270 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3271 XFree (attr);
3275 /* Place status area for XIC in bottom right corner of frame F.. */
3277 void
3278 xic_set_statusarea (f)
3279 struct frame *f;
3281 XIC xic = FRAME_XIC (f);
3282 XVaNestedList attr;
3283 XRectangle area;
3284 XRectangle *needed;
3286 /* Negotiate geometry of status area. If input method has existing
3287 status area, use its current size. */
3288 area.x = area.y = area.width = area.height = 0;
3289 attr = XVaCreateNestedList (0, XNAreaNeeded, &area, NULL);
3290 XSetICValues (xic, XNStatusAttributes, attr, NULL);
3291 XFree (attr);
3293 attr = XVaCreateNestedList (0, XNAreaNeeded, &needed, NULL);
3294 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3295 XFree (attr);
3297 if (needed->width == 0) /* Use XNArea instead of XNAreaNeeded */
3299 attr = XVaCreateNestedList (0, XNArea, &needed, NULL);
3300 XGetICValues (xic, XNStatusAttributes, attr, NULL);
3301 XFree (attr);
3304 area.width = needed->width;
3305 area.height = needed->height;
3306 area.x = PIXEL_WIDTH (f) - area.width - FRAME_INTERNAL_BORDER_WIDTH (f);
3307 area.y = (PIXEL_HEIGHT (f) - area.height
3308 - FRAME_MENUBAR_HEIGHT (f) - FRAME_INTERNAL_BORDER_WIDTH (f));
3309 XFree (needed);
3311 attr = XVaCreateNestedList (0, XNArea, &area, NULL);
3312 XSetICValues(xic, XNStatusAttributes, attr, NULL);
3313 XFree (attr);
3317 /* Set X fontset for XIC of frame F, using base font name
3318 BASE_FONTNAME. Called when a new Emacs fontset is chosen. */
3320 void
3321 xic_set_xfontset (f, base_fontname)
3322 struct frame *f;
3323 char *base_fontname;
3325 XVaNestedList attr;
3326 XFontSet xfs;
3328 xfs = xic_create_xfontset (f, base_fontname);
3330 attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL);
3331 if (FRAME_XIC_STYLE (f) & XIMPreeditPosition)
3332 XSetICValues (FRAME_XIC (f), XNPreeditAttributes, attr, NULL);
3333 if (FRAME_XIC_STYLE (f) & XIMStatusArea)
3334 XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL);
3335 XFree (attr);
3337 if (FRAME_XIC_FONTSET (f))
3338 XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f));
3339 FRAME_XIC_FONTSET (f) = xfs;
3342 #endif /* HAVE_X_I18N */
3346 #ifdef USE_X_TOOLKIT
3348 /* Create and set up the X widget for frame F. */
3350 static void
3351 x_window (f, window_prompting, minibuffer_only)
3352 struct frame *f;
3353 long window_prompting;
3354 int minibuffer_only;
3356 XClassHint class_hints;
3357 XSetWindowAttributes attributes;
3358 unsigned long attribute_mask;
3360 Widget shell_widget;
3361 Widget pane_widget;
3362 Widget frame_widget;
3363 Arg al [25];
3364 int ac;
3366 BLOCK_INPUT;
3368 /* Use the resource name as the top-level widget name
3369 for looking up resources. Make a non-Lisp copy
3370 for the window manager, so GC relocation won't bother it.
3372 Elsewhere we specify the window name for the window manager. */
3375 char *str = (char *) XSTRING (Vx_resource_name)->data;
3376 f->namebuf = (char *) xmalloc (strlen (str) + 1);
3377 strcpy (f->namebuf, str);
3380 ac = 0;
3381 XtSetArg (al[ac], XtNallowShellResize, 1); ac++;
3382 XtSetArg (al[ac], XtNinput, 1); ac++;
3383 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3384 XtSetArg (al[ac], XtNborderWidth, f->output_data.x->border_width); ac++;
3385 shell_widget = XtAppCreateShell (f->namebuf, EMACS_CLASS,
3386 applicationShellWidgetClass,
3387 FRAME_X_DISPLAY (f), al, ac);
3389 f->output_data.x->widget = shell_widget;
3390 /* maybe_set_screen_title_format (shell_widget); */
3392 pane_widget = lw_create_widget ("main", "pane", widget_id_tick++,
3393 (widget_value *) NULL,
3394 shell_widget, False,
3395 (lw_callback) NULL,
3396 (lw_callback) NULL,
3397 (lw_callback) NULL,
3398 (lw_callback) NULL);
3400 f->output_data.x->column_widget = pane_widget;
3402 /* mappedWhenManaged to false tells to the paned window to not map/unmap
3403 the emacs screen when changing menubar. This reduces flickering. */
3405 ac = 0;
3406 XtSetArg (al[ac], XtNmappedWhenManaged, 0); ac++;
3407 XtSetArg (al[ac], XtNshowGrip, 0); ac++;
3408 XtSetArg (al[ac], XtNallowResize, 1); ac++;
3409 XtSetArg (al[ac], XtNresizeToPreferred, 1); ac++;
3410 XtSetArg (al[ac], XtNemacsFrame, f); ac++;
3411 frame_widget = XtCreateWidget (f->namebuf,
3412 emacsFrameClass,
3413 pane_widget, al, ac);
3415 f->output_data.x->edit_widget = frame_widget;
3417 XtManageChild (frame_widget);
3419 /* Do some needed geometry management. */
3421 int len;
3422 char *tem, shell_position[32];
3423 Arg al[2];
3424 int ac = 0;
3425 int extra_borders = 0;
3426 int menubar_size
3427 = (f->output_data.x->menubar_widget
3428 ? (f->output_data.x->menubar_widget->core.height
3429 + f->output_data.x->menubar_widget->core.border_width)
3430 : 0);
3432 #if 0 /* Experimentally, we now get the right results
3433 for -geometry -0-0 without this. 24 Aug 96, rms. */
3434 if (FRAME_EXTERNAL_MENU_BAR (f))
3436 Dimension ibw = 0;
3437 XtVaGetValues (pane_widget, XtNinternalBorderWidth, &ibw, NULL);
3438 menubar_size += ibw;
3440 #endif
3442 f->output_data.x->menubar_height = menubar_size;
3444 #ifndef USE_LUCID
3445 /* Motif seems to need this amount added to the sizes
3446 specified for the shell widget. The Athena/Lucid widgets don't.
3447 Both conclusions reached experimentally. -- rms. */
3448 XtVaGetValues (f->output_data.x->edit_widget, XtNinternalBorderWidth,
3449 &extra_borders, NULL);
3450 extra_borders *= 2;
3451 #endif
3453 /* Convert our geometry parameters into a geometry string
3454 and specify it.
3455 Note that we do not specify here whether the position
3456 is a user-specified or program-specified one.
3457 We pass that information later, in x_wm_set_size_hints. */
3459 int left = f->output_data.x->left_pos;
3460 int xneg = window_prompting & XNegative;
3461 int top = f->output_data.x->top_pos;
3462 int yneg = window_prompting & YNegative;
3463 if (xneg)
3464 left = -left;
3465 if (yneg)
3466 top = -top;
3468 if (window_prompting & USPosition)
3469 sprintf (shell_position, "=%dx%d%c%d%c%d",
3470 PIXEL_WIDTH (f) + extra_borders,
3471 PIXEL_HEIGHT (f) + menubar_size + extra_borders,
3472 (xneg ? '-' : '+'), left,
3473 (yneg ? '-' : '+'), top);
3474 else
3475 sprintf (shell_position, "=%dx%d",
3476 PIXEL_WIDTH (f) + extra_borders,
3477 PIXEL_HEIGHT (f) + menubar_size + extra_borders);
3480 len = strlen (shell_position) + 1;
3481 /* We don't free this because we don't know whether
3482 it is safe to free it while the frame exists.
3483 It isn't worth the trouble of arranging to free it
3484 when the frame is deleted. */
3485 tem = (char *) xmalloc (len);
3486 strncpy (tem, shell_position, len);
3487 XtSetArg (al[ac], XtNgeometry, tem); ac++;
3488 XtSetValues (shell_widget, al, ac);
3491 XtManageChild (pane_widget);
3492 XtRealizeWidget (shell_widget);
3494 FRAME_X_WINDOW (f) = XtWindow (frame_widget);
3496 validate_x_resource_name ();
3498 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
3499 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
3500 XSetClassHint (FRAME_X_DISPLAY (f), XtWindow (shell_widget), &class_hints);
3502 #ifdef HAVE_X_I18N
3503 FRAME_XIC (f) = NULL;
3504 create_frame_xic (f);
3505 #endif
3507 f->output_data.x->wm_hints.input = True;
3508 f->output_data.x->wm_hints.flags |= InputHint;
3509 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3510 &f->output_data.x->wm_hints);
3512 hack_wm_protocols (f, shell_widget);
3514 #ifdef HACK_EDITRES
3515 XtAddEventHandler (shell_widget, 0, True, _XEditResCheckMessages, 0);
3516 #endif
3518 /* Do a stupid property change to force the server to generate a
3519 PropertyNotify event so that the event_stream server timestamp will
3520 be initialized to something relevant to the time we created the window.
3522 XChangeProperty (XtDisplay (frame_widget), XtWindow (frame_widget),
3523 FRAME_X_DISPLAY_INFO (f)->Xatom_wm_protocols,
3524 XA_ATOM, 32, PropModeAppend,
3525 (unsigned char*) NULL, 0);
3527 /* Make all the standard events reach the Emacs frame. */
3528 attributes.event_mask = STANDARD_EVENT_SET;
3530 #ifdef HAVE_X_I18N
3531 if (FRAME_XIC (f))
3533 /* XIM server might require some X events. */
3534 unsigned long fevent = NoEventMask;
3535 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3536 attributes.event_mask |= fevent;
3538 #endif /* HAVE_X_I18N */
3540 attribute_mask = CWEventMask;
3541 XChangeWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget),
3542 attribute_mask, &attributes);
3544 XtMapWidget (frame_widget);
3546 /* x_set_name normally ignores requests to set the name if the
3547 requested name is the same as the current name. This is the one
3548 place where that assumption isn't correct; f->name is set, but
3549 the X server hasn't been told. */
3551 Lisp_Object name;
3552 int explicit = f->explicit_name;
3554 f->explicit_name = 0;
3555 name = f->name;
3556 f->name = Qnil;
3557 x_set_name (f, name, explicit);
3560 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3561 f->output_data.x->text_cursor);
3563 UNBLOCK_INPUT;
3565 /* This is a no-op, except under Motif. Make sure main areas are
3566 set to something reasonable, in case we get an error later. */
3567 lw_set_main_areas (pane_widget, 0, frame_widget);
3570 #else /* not USE_X_TOOLKIT */
3572 /* Create and set up the X window for frame F. */
3574 void
3575 x_window (f)
3576 struct frame *f;
3579 XClassHint class_hints;
3580 XSetWindowAttributes attributes;
3581 unsigned long attribute_mask;
3583 attributes.background_pixel = f->output_data.x->background_pixel;
3584 attributes.border_pixel = f->output_data.x->border_pixel;
3585 attributes.bit_gravity = StaticGravity;
3586 attributes.backing_store = NotUseful;
3587 attributes.save_under = True;
3588 attributes.event_mask = STANDARD_EVENT_SET;
3589 attribute_mask = (CWBackPixel | CWBorderPixel | CWBitGravity
3590 #if 0
3591 | CWBackingStore | CWSaveUnder
3592 #endif
3593 | CWEventMask);
3595 BLOCK_INPUT;
3596 FRAME_X_WINDOW (f)
3597 = XCreateWindow (FRAME_X_DISPLAY (f),
3598 f->output_data.x->parent_desc,
3599 f->output_data.x->left_pos,
3600 f->output_data.x->top_pos,
3601 PIXEL_WIDTH (f), PIXEL_HEIGHT (f),
3602 f->output_data.x->border_width,
3603 CopyFromParent, /* depth */
3604 InputOutput, /* class */
3605 FRAME_X_DISPLAY_INFO (f)->visual,
3606 attribute_mask, &attributes);
3608 #ifdef HAVE_X_I18N
3609 create_frame_xic (f);
3610 if (FRAME_XIC (f))
3612 /* XIM server might require some X events. */
3613 unsigned long fevent = NoEventMask;
3614 XGetICValues(FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
3615 attributes.event_mask |= fevent;
3616 attribute_mask = CWEventMask;
3617 XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3618 attribute_mask, &attributes);
3620 #endif /* HAVE_X_I18N */
3622 validate_x_resource_name ();
3624 class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data;
3625 class_hints.res_class = (char *) XSTRING (Vx_resource_class)->data;
3626 XSetClassHint (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &class_hints);
3628 /* The menubar is part of the ordinary display;
3629 it does not count in addition to the height of the window. */
3630 f->output_data.x->menubar_height = 0;
3632 /* This indicates that we use the "Passive Input" input model.
3633 Unless we do this, we don't get the Focus{In,Out} events that we
3634 need to draw the cursor correctly. Accursed bureaucrats.
3635 XWhipsAndChains (FRAME_X_DISPLAY (f), IronMaiden, &TheRack); */
3637 f->output_data.x->wm_hints.input = True;
3638 f->output_data.x->wm_hints.flags |= InputHint;
3639 XSetWMHints (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3640 &f->output_data.x->wm_hints);
3641 f->output_data.x->wm_hints.icon_pixmap = None;
3643 /* Request "save yourself" and "delete window" commands from wm. */
3645 Atom protocols[2];
3646 protocols[0] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_delete_window;
3647 protocols[1] = FRAME_X_DISPLAY_INFO (f)->Xatom_wm_save_yourself;
3648 XSetWMProtocols (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), protocols, 2);
3651 /* x_set_name normally ignores requests to set the name if the
3652 requested name is the same as the current name. This is the one
3653 place where that assumption isn't correct; f->name is set, but
3654 the X server hasn't been told. */
3656 Lisp_Object name;
3657 int explicit = f->explicit_name;
3659 f->explicit_name = 0;
3660 name = f->name;
3661 f->name = Qnil;
3662 x_set_name (f, name, explicit);
3665 XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3666 f->output_data.x->text_cursor);
3668 UNBLOCK_INPUT;
3670 if (FRAME_X_WINDOW (f) == 0)
3671 error ("Unable to create window");
3674 #endif /* not USE_X_TOOLKIT */
3676 /* Handle the icon stuff for this window. Perhaps later we might
3677 want an x_set_icon_position which can be called interactively as
3678 well. */
3680 static void
3681 x_icon (f, parms)
3682 struct frame *f;
3683 Lisp_Object parms;
3685 Lisp_Object icon_x, icon_y;
3686 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
3688 /* Set the position of the icon. Note that twm groups all
3689 icons in an icon window. */
3690 icon_x = x_get_and_record_arg (f, parms, Qicon_left, 0, 0, RES_TYPE_NUMBER);
3691 icon_y = x_get_and_record_arg (f, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER);
3692 if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound))
3694 CHECK_NUMBER (icon_x, 0);
3695 CHECK_NUMBER (icon_y, 0);
3697 else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound))
3698 error ("Both left and top icon corners of icon must be specified");
3700 BLOCK_INPUT;
3702 if (! EQ (icon_x, Qunbound))
3703 x_wm_set_icon_position (f, XINT (icon_x), XINT (icon_y));
3705 /* Start up iconic or window? */
3706 x_wm_set_window_state
3707 (f, (EQ (x_get_arg (dpyinfo, parms, Qvisibility, 0, 0, RES_TYPE_SYMBOL),
3708 Qicon)
3709 ? IconicState
3710 : NormalState));
3712 x_text_icon (f, (char *) XSTRING ((!NILP (f->icon_name)
3713 ? f->icon_name
3714 : f->name))->data);
3716 UNBLOCK_INPUT;
3719 /* Make the GC's needed for this window, setting the
3720 background, border and mouse colors; also create the
3721 mouse cursor and the gray border tile. */
3723 static char cursor_bits[] =
3725 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3726 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3727 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
3728 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
3731 static void
3732 x_make_gc (f)
3733 struct frame *f;
3735 XGCValues gc_values;
3737 BLOCK_INPUT;
3739 /* Create the GC's of this frame.
3740 Note that many default values are used. */
3742 /* Normal video */
3743 gc_values.font = f->output_data.x->font->fid;
3744 gc_values.foreground = f->output_data.x->foreground_pixel;
3745 gc_values.background = f->output_data.x->background_pixel;
3746 gc_values.line_width = 0; /* Means 1 using fast algorithm. */
3747 f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f),
3748 FRAME_X_WINDOW (f),
3749 GCLineWidth | GCFont
3750 | GCForeground | GCBackground,
3751 &gc_values);
3753 /* Reverse video style. */
3754 gc_values.foreground = f->output_data.x->background_pixel;
3755 gc_values.background = f->output_data.x->foreground_pixel;
3756 f->output_data.x->reverse_gc = XCreateGC (FRAME_X_DISPLAY (f),
3757 FRAME_X_WINDOW (f),
3758 GCFont | GCForeground | GCBackground
3759 | GCLineWidth,
3760 &gc_values);
3762 /* Cursor has cursor-color background, background-color foreground. */
3763 gc_values.foreground = f->output_data.x->background_pixel;
3764 gc_values.background = f->output_data.x->cursor_pixel;
3765 gc_values.fill_style = FillOpaqueStippled;
3766 gc_values.stipple
3767 = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
3768 FRAME_X_DISPLAY_INFO (f)->root_window,
3769 cursor_bits, 16, 16);
3770 f->output_data.x->cursor_gc
3771 = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
3772 (GCFont | GCForeground | GCBackground
3773 | GCFillStyle /* | GCStipple */ | GCLineWidth),
3774 &gc_values);
3776 /* Reliefs. */
3777 f->output_data.x->white_relief.gc = 0;
3778 f->output_data.x->black_relief.gc = 0;
3780 /* Create the gray border tile used when the pointer is not in
3781 the frame. Since this depends on the frame's pixel values,
3782 this must be done on a per-frame basis. */
3783 f->output_data.x->border_tile
3784 = (XCreatePixmapFromBitmapData
3785 (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
3786 gray_bits, gray_width, gray_height,
3787 f->output_data.x->foreground_pixel,
3788 f->output_data.x->background_pixel,
3789 DefaultDepth (FRAME_X_DISPLAY (f),
3790 XScreenNumberOfScreen (FRAME_X_SCREEN (f)))));
3792 UNBLOCK_INPUT;
3795 DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame,
3796 1, 1, 0,
3797 "Make a new X window, which is called a \"frame\" in Emacs terms.\n\
3798 Returns an Emacs frame object.\n\
3799 ALIST is an alist of frame parameters.\n\
3800 If the parameters specify that the frame should not have a minibuffer,\n\
3801 and do not specify a specific minibuffer window to use,\n\
3802 then `default-minibuffer-frame' must be a frame whose minibuffer can\n\
3803 be shared by the new frame.\n\
3805 This function is an internal primitive--use `make-frame' instead.")
3806 (parms)
3807 Lisp_Object parms;
3809 struct frame *f;
3810 Lisp_Object frame, tem;
3811 Lisp_Object name;
3812 int minibuffer_only = 0;
3813 long window_prompting = 0;
3814 int width, height;
3815 int count = specpdl_ptr - specpdl;
3816 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3817 Lisp_Object display;
3818 struct x_display_info *dpyinfo = NULL;
3819 Lisp_Object parent;
3820 struct kboard *kb;
3822 check_x ();
3824 /* Use this general default value to start with
3825 until we know if this frame has a specified name. */
3826 Vx_resource_name = Vinvocation_name;
3828 display = x_get_arg (dpyinfo, parms, Qdisplay, 0, 0, RES_TYPE_STRING);
3829 if (EQ (display, Qunbound))
3830 display = Qnil;
3831 dpyinfo = check_x_display_info (display);
3832 #ifdef MULTI_KBOARD
3833 kb = dpyinfo->kboard;
3834 #else
3835 kb = &the_only_kboard;
3836 #endif
3838 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
3839 if (!STRINGP (name)
3840 && ! EQ (name, Qunbound)
3841 && ! NILP (name))
3842 error ("Invalid frame name--not a string or nil");
3844 if (STRINGP (name))
3845 Vx_resource_name = name;
3847 /* See if parent window is specified. */
3848 parent = x_get_arg (dpyinfo, parms, Qparent_id, NULL, NULL, RES_TYPE_NUMBER);
3849 if (EQ (parent, Qunbound))
3850 parent = Qnil;
3851 if (! NILP (parent))
3852 CHECK_NUMBER (parent, 0);
3854 /* make_frame_without_minibuffer can run Lisp code and garbage collect. */
3855 /* No need to protect DISPLAY because that's not used after passing
3856 it to make_frame_without_minibuffer. */
3857 frame = Qnil;
3858 GCPRO4 (parms, parent, name, frame);
3859 tem = x_get_arg (dpyinfo, parms, Qminibuffer, "minibuffer", "Minibuffer",
3860 RES_TYPE_SYMBOL);
3861 if (EQ (tem, Qnone) || NILP (tem))
3862 f = make_frame_without_minibuffer (Qnil, kb, display);
3863 else if (EQ (tem, Qonly))
3865 f = make_minibuffer_frame ();
3866 minibuffer_only = 1;
3868 else if (WINDOWP (tem))
3869 f = make_frame_without_minibuffer (tem, kb, display);
3870 else
3871 f = make_frame (1);
3873 XSETFRAME (frame, f);
3875 /* Note that X Windows does support scroll bars. */
3876 FRAME_CAN_HAVE_SCROLL_BARS (f) = 1;
3878 f->output_method = output_x_window;
3879 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
3880 bzero (f->output_data.x, sizeof (struct x_output));
3881 f->output_data.x->icon_bitmap = -1;
3882 f->output_data.x->fontset = -1;
3883 f->output_data.x->scroll_bar_foreground_pixel = -1;
3884 f->output_data.x->scroll_bar_background_pixel = -1;
3886 f->icon_name
3887 = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title",
3888 RES_TYPE_STRING);
3889 if (! STRINGP (f->icon_name))
3890 f->icon_name = Qnil;
3892 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
3893 #ifdef MULTI_KBOARD
3894 FRAME_KBOARD (f) = kb;
3895 #endif
3897 /* Specify the parent under which to make this X window. */
3899 if (!NILP (parent))
3901 f->output_data.x->parent_desc = (Window) XFASTINT (parent);
3902 f->output_data.x->explicit_parent = 1;
3904 else
3906 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
3907 f->output_data.x->explicit_parent = 0;
3910 /* Set the name; the functions to which we pass f expect the name to
3911 be set. */
3912 if (EQ (name, Qunbound) || NILP (name))
3914 f->name = build_string (dpyinfo->x_id_name);
3915 f->explicit_name = 0;
3917 else
3919 f->name = name;
3920 f->explicit_name = 1;
3921 /* use the frame's title when getting resources for this frame. */
3922 specbind (Qx_resource_name, name);
3925 /* Create fontsets from `global_fontset_alist' before handling fonts. */
3926 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
3927 fs_register_fontset (f, XCAR (tem));
3929 /* Extract the window parameters from the supplied values
3930 that are needed to determine window geometry. */
3932 Lisp_Object font;
3934 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
3936 BLOCK_INPUT;
3937 /* First, try whatever font the caller has specified. */
3938 if (STRINGP (font))
3940 tem = Fquery_fontset (font, Qnil);
3941 if (STRINGP (tem))
3942 font = x_new_fontset (f, XSTRING (tem)->data);
3943 else
3944 font = x_new_font (f, XSTRING (font)->data);
3947 /* Try out a font which we hope has bold and italic variations. */
3948 if (!STRINGP (font))
3949 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
3950 if (!STRINGP (font))
3951 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3952 if (! STRINGP (font))
3953 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
3954 if (! STRINGP (font))
3955 /* This was formerly the first thing tried, but it finds too many fonts
3956 and takes too long. */
3957 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
3958 /* If those didn't work, look for something which will at least work. */
3959 if (! STRINGP (font))
3960 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
3961 UNBLOCK_INPUT;
3962 if (! STRINGP (font))
3963 font = build_string ("fixed");
3965 x_default_parameter (f, parms, Qfont, font,
3966 "font", "Font", RES_TYPE_STRING);
3969 #ifdef USE_LUCID
3970 /* Prevent lwlib/xlwmenu.c from crashing because of a bug
3971 whereby it fails to get any font. */
3972 xlwmenu_default_font = f->output_data.x->font;
3973 #endif
3975 x_default_parameter (f, parms, Qborder_width, make_number (2),
3976 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
3978 /* This defaults to 2 in order to match xterm. We recognize either
3979 internalBorderWidth or internalBorder (which is what xterm calls
3980 it). */
3981 if (NILP (Fassq (Qinternal_border_width, parms)))
3983 Lisp_Object value;
3985 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
3986 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
3987 if (! EQ (value, Qunbound))
3988 parms = Fcons (Fcons (Qinternal_border_width, value),
3989 parms);
3991 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
3992 "internalBorderWidth", "internalBorderWidth",
3993 RES_TYPE_NUMBER);
3994 x_default_parameter (f, parms, Qvertical_scroll_bars, Qleft,
3995 "verticalScrollBars", "ScrollBars",
3996 RES_TYPE_SYMBOL);
3998 /* Also do the stuff which must be set before the window exists. */
3999 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
4000 "foreground", "Foreground", RES_TYPE_STRING);
4001 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
4002 "background", "Background", RES_TYPE_STRING);
4003 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
4004 "pointerColor", "Foreground", RES_TYPE_STRING);
4005 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
4006 "cursorColor", "Foreground", RES_TYPE_STRING);
4007 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
4008 "borderColor", "BorderColor", RES_TYPE_STRING);
4009 x_default_parameter (f, parms, Qscreen_gamma, Qnil,
4010 "screenGamma", "ScreenGamma", RES_TYPE_FLOAT);
4012 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
4013 "scrollBarForeground",
4014 "ScrollBarForeground", 1);
4015 x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_background,
4016 "scrollBarBackground",
4017 "ScrollBarBackground", 0);
4019 /* Init faces before x_default_parameter is called for scroll-bar
4020 parameters because that function calls x_set_scroll_bar_width,
4021 which calls change_frame_size, which calls Fset_window_buffer,
4022 which runs hooks, which call Fvertical_motion. At the end, we
4023 end up in init_iterator with a null face cache, which should not
4024 happen. */
4025 init_frame_faces (f);
4027 x_default_parameter (f, parms, Qmenu_bar_lines, make_number (1),
4028 "menuBar", "MenuBar", RES_TYPE_NUMBER);
4029 x_default_parameter (f, parms, Qtool_bar_lines, make_number (0),
4030 "toolBar", "ToolBar", RES_TYPE_NUMBER);
4031 x_default_parameter (f, parms, Qbuffer_predicate, Qnil,
4032 "bufferPredicate", "BufferPredicate",
4033 RES_TYPE_SYMBOL);
4034 x_default_parameter (f, parms, Qtitle, Qnil,
4035 "title", "Title", RES_TYPE_STRING);
4037 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
4038 window_prompting = x_figure_window_size (f, parms);
4040 if (window_prompting & XNegative)
4042 if (window_prompting & YNegative)
4043 f->output_data.x->win_gravity = SouthEastGravity;
4044 else
4045 f->output_data.x->win_gravity = NorthEastGravity;
4047 else
4049 if (window_prompting & YNegative)
4050 f->output_data.x->win_gravity = SouthWestGravity;
4051 else
4052 f->output_data.x->win_gravity = NorthWestGravity;
4055 f->output_data.x->size_hint_flags = window_prompting;
4057 tem = x_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, RES_TYPE_BOOLEAN);
4058 f->no_split = minibuffer_only || EQ (tem, Qt);
4060 /* Create the X widget or window. Add the tool-bar height to the
4061 initial frame height so that the user gets a text display area of
4062 the size he specified with -g or via .Xdefaults. Later changes
4063 of the tool-bar height don't change the frame size. This is done
4064 so that users can create tall Emacs frames without having to
4065 guess how tall the tool-bar will get. */
4066 f->height += FRAME_TOOL_BAR_LINES (f);
4068 #ifdef USE_X_TOOLKIT
4069 x_window (f, window_prompting, minibuffer_only);
4070 #else
4071 x_window (f);
4072 #endif
4074 x_icon (f, parms);
4075 x_make_gc (f);
4077 /* Now consider the frame official. */
4078 FRAME_X_DISPLAY_INFO (f)->reference_count++;
4079 Vframe_list = Fcons (frame, Vframe_list);
4081 /* We need to do this after creating the X window, so that the
4082 icon-creation functions can say whose icon they're describing. */
4083 x_default_parameter (f, parms, Qicon_type, Qnil,
4084 "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL);
4086 x_default_parameter (f, parms, Qauto_raise, Qnil,
4087 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4088 x_default_parameter (f, parms, Qauto_lower, Qnil,
4089 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
4090 x_default_parameter (f, parms, Qcursor_type, Qbox,
4091 "cursorType", "CursorType", RES_TYPE_SYMBOL);
4092 x_default_parameter (f, parms, Qscroll_bar_width, Qnil,
4093 "scrollBarWidth", "ScrollBarWidth",
4094 RES_TYPE_NUMBER);
4096 /* Dimensions, especially f->height, must be done via change_frame_size.
4097 Change will not be effected unless different from the current
4098 f->height. */
4099 width = f->width;
4100 height = f->height;
4101 f->height = 0;
4102 SET_FRAME_WIDTH (f, 0);
4103 change_frame_size (f, height, width, 1, 0, 0);
4105 /* Set up faces after all frame parameters are known. */
4106 call1 (Qface_set_after_frame_default, frame);
4108 #ifdef USE_X_TOOLKIT
4109 /* Create the menu bar. */
4110 if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f))
4112 /* If this signals an error, we haven't set size hints for the
4113 frame and we didn't make it visible. */
4114 initialize_frame_menubar (f);
4116 /* This is a no-op, except under Motif where it arranges the
4117 main window for the widgets on it. */
4118 lw_set_main_areas (f->output_data.x->column_widget,
4119 f->output_data.x->menubar_widget,
4120 f->output_data.x->edit_widget);
4122 #endif /* USE_X_TOOLKIT */
4124 /* Tell the server what size and position, etc, we want, and how
4125 badly we want them. This should be done after we have the menu
4126 bar so that its size can be taken into account. */
4127 BLOCK_INPUT;
4128 x_wm_set_size_hint (f, window_prompting, 0);
4129 UNBLOCK_INPUT;
4131 /* Make the window appear on the frame and enable display, unless
4132 the caller says not to. However, with explicit parent, Emacs
4133 cannot control visibility, so don't try. */
4134 if (! f->output_data.x->explicit_parent)
4136 Lisp_Object visibility;
4138 visibility = x_get_arg (dpyinfo, parms, Qvisibility, 0, 0,
4139 RES_TYPE_SYMBOL);
4140 if (EQ (visibility, Qunbound))
4141 visibility = Qt;
4143 if (EQ (visibility, Qicon))
4144 x_iconify_frame (f);
4145 else if (! NILP (visibility))
4146 x_make_frame_visible (f);
4147 else
4148 /* Must have been Qnil. */
4152 UNGCPRO;
4153 return unbind_to (count, frame);
4156 /* FRAME is used only to get a handle on the X display. We don't pass the
4157 display info directly because we're called from frame.c, which doesn't
4158 know about that structure. */
4160 Lisp_Object
4161 x_get_focus_frame (frame)
4162 struct frame *frame;
4164 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (frame);
4165 Lisp_Object xfocus;
4166 if (! dpyinfo->x_focus_frame)
4167 return Qnil;
4169 XSETFRAME (xfocus, dpyinfo->x_focus_frame);
4170 return xfocus;
4174 DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0,
4175 "Internal function called by `color-defined-p', which see.")
4176 (color, frame)
4177 Lisp_Object color, frame;
4179 XColor foo;
4180 FRAME_PTR f = check_x_frame (frame);
4182 CHECK_STRING (color, 1);
4184 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
4185 return Qt;
4186 else
4187 return Qnil;
4190 DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0,
4191 "Internal function called by `color-values', which see.")
4192 (color, frame)
4193 Lisp_Object color, frame;
4195 XColor foo;
4196 FRAME_PTR f = check_x_frame (frame);
4198 CHECK_STRING (color, 1);
4200 if (x_defined_color (f, XSTRING (color)->data, &foo, 0))
4202 Lisp_Object rgb[3];
4204 rgb[0] = make_number (foo.red);
4205 rgb[1] = make_number (foo.green);
4206 rgb[2] = make_number (foo.blue);
4207 return Flist (3, rgb);
4209 else
4210 return Qnil;
4213 DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0,
4214 "Internal function called by `display-color-p', which see.")
4215 (display)
4216 Lisp_Object display;
4218 struct x_display_info *dpyinfo = check_x_display_info (display);
4220 if (dpyinfo->n_planes <= 2)
4221 return Qnil;
4223 switch (dpyinfo->visual->class)
4225 case StaticColor:
4226 case PseudoColor:
4227 case TrueColor:
4228 case DirectColor:
4229 return Qt;
4231 default:
4232 return Qnil;
4236 DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p,
4237 0, 1, 0,
4238 "Return t if the X display supports shades of gray.\n\
4239 Note that color displays do support shades of gray.\n\
4240 The optional argument DISPLAY specifies which display to ask about.\n\
4241 DISPLAY should be either a frame or a display name (a string).\n\
4242 If omitted or nil, that stands for the selected frame's display.")
4243 (display)
4244 Lisp_Object display;
4246 struct x_display_info *dpyinfo = check_x_display_info (display);
4248 if (dpyinfo->n_planes <= 1)
4249 return Qnil;
4251 switch (dpyinfo->visual->class)
4253 case StaticColor:
4254 case PseudoColor:
4255 case TrueColor:
4256 case DirectColor:
4257 case StaticGray:
4258 case GrayScale:
4259 return Qt;
4261 default:
4262 return Qnil;
4266 DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width,
4267 0, 1, 0,
4268 "Returns the width in pixels of the X display DISPLAY.\n\
4269 The optional argument DISPLAY specifies which display to ask about.\n\
4270 DISPLAY should be either a frame or a display name (a string).\n\
4271 If omitted or nil, that stands for the selected frame's display.")
4272 (display)
4273 Lisp_Object display;
4275 struct x_display_info *dpyinfo = check_x_display_info (display);
4277 return make_number (dpyinfo->width);
4280 DEFUN ("x-display-pixel-height", Fx_display_pixel_height,
4281 Sx_display_pixel_height, 0, 1, 0,
4282 "Returns the height in pixels of the X display DISPLAY.\n\
4283 The optional argument DISPLAY specifies which display to ask about.\n\
4284 DISPLAY should be either a frame or a display name (a string).\n\
4285 If omitted or nil, that stands for the selected frame's display.")
4286 (display)
4287 Lisp_Object display;
4289 struct x_display_info *dpyinfo = check_x_display_info (display);
4291 return make_number (dpyinfo->height);
4294 DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes,
4295 0, 1, 0,
4296 "Returns the number of bitplanes of the X display DISPLAY.\n\
4297 The optional argument DISPLAY specifies which display to ask about.\n\
4298 DISPLAY should be either a frame or a display name (a string).\n\
4299 If omitted or nil, that stands for the selected frame's display.")
4300 (display)
4301 Lisp_Object display;
4303 struct x_display_info *dpyinfo = check_x_display_info (display);
4305 return make_number (dpyinfo->n_planes);
4308 DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells,
4309 0, 1, 0,
4310 "Returns the number of color cells of the X display DISPLAY.\n\
4311 The optional argument DISPLAY specifies which display to ask about.\n\
4312 DISPLAY should be either a frame or a display name (a string).\n\
4313 If omitted or nil, that stands for the selected frame's display.")
4314 (display)
4315 Lisp_Object display;
4317 struct x_display_info *dpyinfo = check_x_display_info (display);
4319 return make_number (DisplayCells (dpyinfo->display,
4320 XScreenNumberOfScreen (dpyinfo->screen)));
4323 DEFUN ("x-server-max-request-size", Fx_server_max_request_size,
4324 Sx_server_max_request_size,
4325 0, 1, 0,
4326 "Returns the maximum request size of the X server of display DISPLAY.\n\
4327 The optional argument DISPLAY specifies which display to ask about.\n\
4328 DISPLAY should be either a frame or a display name (a string).\n\
4329 If omitted or nil, that stands for the selected frame's display.")
4330 (display)
4331 Lisp_Object display;
4333 struct x_display_info *dpyinfo = check_x_display_info (display);
4335 return make_number (MAXREQUEST (dpyinfo->display));
4338 DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0,
4339 "Returns the vendor ID string of the X server of display DISPLAY.\n\
4340 The optional argument DISPLAY specifies which display to ask about.\n\
4341 DISPLAY should be either a frame or a display name (a string).\n\
4342 If omitted or nil, that stands for the selected frame's display.")
4343 (display)
4344 Lisp_Object display;
4346 struct x_display_info *dpyinfo = check_x_display_info (display);
4347 char *vendor = ServerVendor (dpyinfo->display);
4349 if (! vendor) vendor = "";
4350 return build_string (vendor);
4353 DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0,
4354 "Returns the version numbers of the X server of display DISPLAY.\n\
4355 The value is a list of three integers: the major and minor\n\
4356 version numbers of the X Protocol in use, and the vendor-specific release\n\
4357 number. See also the function `x-server-vendor'.\n\n\
4358 The optional argument DISPLAY specifies which display to ask about.\n\
4359 DISPLAY should be either a frame or a display name (a string).\n\
4360 If omitted or nil, that stands for the selected frame's display.")
4361 (display)
4362 Lisp_Object display;
4364 struct x_display_info *dpyinfo = check_x_display_info (display);
4365 Display *dpy = dpyinfo->display;
4367 return Fcons (make_number (ProtocolVersion (dpy)),
4368 Fcons (make_number (ProtocolRevision (dpy)),
4369 Fcons (make_number (VendorRelease (dpy)), Qnil)));
4372 DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0,
4373 "Returns the number of screens on the X server of display DISPLAY.\n\
4374 The optional argument DISPLAY specifies which display to ask about.\n\
4375 DISPLAY should be either a frame or a display name (a string).\n\
4376 If omitted or nil, that stands for the selected frame's display.")
4377 (display)
4378 Lisp_Object display;
4380 struct x_display_info *dpyinfo = check_x_display_info (display);
4382 return make_number (ScreenCount (dpyinfo->display));
4385 DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0,
4386 "Returns the height in millimeters of the X display DISPLAY.\n\
4387 The optional argument DISPLAY specifies which display to ask about.\n\
4388 DISPLAY should be either a frame or a display name (a string).\n\
4389 If omitted or nil, that stands for the selected frame's display.")
4390 (display)
4391 Lisp_Object display;
4393 struct x_display_info *dpyinfo = check_x_display_info (display);
4395 return make_number (HeightMMOfScreen (dpyinfo->screen));
4398 DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0,
4399 "Returns the width in millimeters of the X display DISPLAY.\n\
4400 The optional argument DISPLAY specifies which display to ask about.\n\
4401 DISPLAY should be either a frame or a display name (a string).\n\
4402 If omitted or nil, that stands for the selected frame's display.")
4403 (display)
4404 Lisp_Object display;
4406 struct x_display_info *dpyinfo = check_x_display_info (display);
4408 return make_number (WidthMMOfScreen (dpyinfo->screen));
4411 DEFUN ("x-display-backing-store", Fx_display_backing_store,
4412 Sx_display_backing_store, 0, 1, 0,
4413 "Returns an indication of whether X display DISPLAY does backing store.\n\
4414 The value may be `always', `when-mapped', or `not-useful'.\n\
4415 The optional argument DISPLAY specifies which display to ask about.\n\
4416 DISPLAY should be either a frame or a display name (a string).\n\
4417 If omitted or nil, that stands for the selected frame's display.")
4418 (display)
4419 Lisp_Object display;
4421 struct x_display_info *dpyinfo = check_x_display_info (display);
4423 switch (DoesBackingStore (dpyinfo->screen))
4425 case Always:
4426 return intern ("always");
4428 case WhenMapped:
4429 return intern ("when-mapped");
4431 case NotUseful:
4432 return intern ("not-useful");
4434 default:
4435 error ("Strange value for BackingStore parameter of screen");
4439 DEFUN ("x-display-visual-class", Fx_display_visual_class,
4440 Sx_display_visual_class, 0, 1, 0,
4441 "Returns the visual class of the X display DISPLAY.\n\
4442 The value is one of the symbols `static-gray', `gray-scale',\n\
4443 `static-color', `pseudo-color', `true-color', or `direct-color'.\n\n\
4444 The optional argument DISPLAY specifies which display to ask about.\n\
4445 DISPLAY should be either a frame or a display name (a string).\n\
4446 If omitted or nil, that stands for the selected frame's display.")
4447 (display)
4448 Lisp_Object display;
4450 struct x_display_info *dpyinfo = check_x_display_info (display);
4452 switch (dpyinfo->visual->class)
4454 case StaticGray: return (intern ("static-gray"));
4455 case GrayScale: return (intern ("gray-scale"));
4456 case StaticColor: return (intern ("static-color"));
4457 case PseudoColor: return (intern ("pseudo-color"));
4458 case TrueColor: return (intern ("true-color"));
4459 case DirectColor: return (intern ("direct-color"));
4460 default:
4461 error ("Display has an unknown visual class");
4465 DEFUN ("x-display-save-under", Fx_display_save_under,
4466 Sx_display_save_under, 0, 1, 0,
4467 "Returns t if the X display DISPLAY supports the save-under feature.\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 if (DoesSaveUnders (dpyinfo->screen) == True)
4477 return Qt;
4478 else
4479 return Qnil;
4483 x_pixel_width (f)
4484 register struct frame *f;
4486 return PIXEL_WIDTH (f);
4490 x_pixel_height (f)
4491 register struct frame *f;
4493 return PIXEL_HEIGHT (f);
4497 x_char_width (f)
4498 register struct frame *f;
4500 return FONT_WIDTH (f->output_data.x->font);
4504 x_char_height (f)
4505 register struct frame *f;
4507 return f->output_data.x->line_height;
4511 x_screen_planes (f)
4512 register struct frame *f;
4514 return FRAME_X_DISPLAY_INFO (f)->n_planes;
4517 #if 0 /* These no longer seem like the right way to do things. */
4519 /* Draw a rectangle on the frame with left top corner including
4520 the character specified by LEFT_CHAR and TOP_CHAR. The rectangle is
4521 CHARS by LINES wide and long and is the color of the cursor. */
4523 void
4524 x_rectangle (f, gc, left_char, top_char, chars, lines)
4525 register struct frame *f;
4526 GC gc;
4527 register int top_char, left_char, chars, lines;
4529 int width;
4530 int height;
4531 int left = (left_char * FONT_WIDTH (f->output_data.x->font)
4532 + f->output_data.x->internal_border_width);
4533 int top = (top_char * f->output_data.x->line_height
4534 + f->output_data.x->internal_border_width);
4536 if (chars < 0)
4537 width = FONT_WIDTH (f->output_data.x->font) / 2;
4538 else
4539 width = FONT_WIDTH (f->output_data.x->font) * chars;
4540 if (lines < 0)
4541 height = f->output_data.x->line_height / 2;
4542 else
4543 height = f->output_data.x->line_height * lines;
4545 XDrawRectangle (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4546 gc, left, top, width, height);
4549 DEFUN ("x-draw-rectangle", Fx_draw_rectangle, Sx_draw_rectangle, 5, 5, 0,
4550 "Draw a rectangle on FRAME between coordinates specified by\n\
4551 numbers X0, Y0, X1, Y1 in the cursor pixel.")
4552 (frame, X0, Y0, X1, Y1)
4553 register Lisp_Object frame, X0, X1, Y0, Y1;
4555 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4557 CHECK_LIVE_FRAME (frame, 0);
4558 CHECK_NUMBER (X0, 0);
4559 CHECK_NUMBER (Y0, 1);
4560 CHECK_NUMBER (X1, 2);
4561 CHECK_NUMBER (Y1, 3);
4563 x0 = XINT (X0);
4564 x1 = XINT (X1);
4565 y0 = XINT (Y0);
4566 y1 = XINT (Y1);
4568 if (y1 > y0)
4570 top = y0;
4571 n_lines = y1 - y0 + 1;
4573 else
4575 top = y1;
4576 n_lines = y0 - y1 + 1;
4579 if (x1 > x0)
4581 left = x0;
4582 n_chars = x1 - x0 + 1;
4584 else
4586 left = x1;
4587 n_chars = x0 - x1 + 1;
4590 BLOCK_INPUT;
4591 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->cursor_gc,
4592 left, top, n_chars, n_lines);
4593 UNBLOCK_INPUT;
4595 return Qt;
4598 DEFUN ("x-erase-rectangle", Fx_erase_rectangle, Sx_erase_rectangle, 5, 5, 0,
4599 "Draw a rectangle drawn on FRAME between coordinates\n\
4600 X0, Y0, X1, Y1 in the regular background-pixel.")
4601 (frame, X0, Y0, X1, Y1)
4602 register Lisp_Object frame, X0, Y0, X1, Y1;
4604 register int x0, y0, x1, y1, top, left, n_chars, n_lines;
4606 CHECK_LIVE_FRAME (frame, 0);
4607 CHECK_NUMBER (X0, 0);
4608 CHECK_NUMBER (Y0, 1);
4609 CHECK_NUMBER (X1, 2);
4610 CHECK_NUMBER (Y1, 3);
4612 x0 = XINT (X0);
4613 x1 = XINT (X1);
4614 y0 = XINT (Y0);
4615 y1 = XINT (Y1);
4617 if (y1 > y0)
4619 top = y0;
4620 n_lines = y1 - y0 + 1;
4622 else
4624 top = y1;
4625 n_lines = y0 - y1 + 1;
4628 if (x1 > x0)
4630 left = x0;
4631 n_chars = x1 - x0 + 1;
4633 else
4635 left = x1;
4636 n_chars = x0 - x1 + 1;
4639 BLOCK_INPUT;
4640 x_rectangle (XFRAME (frame), XFRAME (frame)->output_data.x->reverse_gc,
4641 left, top, n_chars, n_lines);
4642 UNBLOCK_INPUT;
4644 return Qt;
4647 /* Draw lines around the text region beginning at the character position
4648 TOP_X, TOP_Y and ending at BOTTOM_X and BOTTOM_Y. GC specifies the
4649 pixel and line characteristics. */
4651 #define line_len(line) (FRAME_CURRENT_GLYPHS (f)->used[(line)])
4653 static void
4654 outline_region (f, gc, top_x, top_y, bottom_x, bottom_y)
4655 register struct frame *f;
4656 GC gc;
4657 int top_x, top_y, bottom_x, bottom_y;
4659 register int ibw = f->output_data.x->internal_border_width;
4660 register int font_w = FONT_WIDTH (f->output_data.x->font);
4661 register int font_h = f->output_data.x->line_height;
4662 int y = top_y;
4663 int x = line_len (y);
4664 XPoint *pixel_points
4665 = (XPoint *) alloca (((bottom_y - top_y + 2) * 4) * sizeof (XPoint));
4666 register XPoint *this_point = pixel_points;
4668 /* Do the horizontal top line/lines */
4669 if (top_x == 0)
4671 this_point->x = ibw;
4672 this_point->y = ibw + (font_h * top_y);
4673 this_point++;
4674 if (x == 0)
4675 this_point->x = ibw + (font_w / 2); /* Half-size for newline chars. */
4676 else
4677 this_point->x = ibw + (font_w * x);
4678 this_point->y = (this_point - 1)->y;
4680 else
4682 this_point->x = ibw;
4683 this_point->y = ibw + (font_h * (top_y + 1));
4684 this_point++;
4685 this_point->x = ibw + (font_w * top_x);
4686 this_point->y = (this_point - 1)->y;
4687 this_point++;
4688 this_point->x = (this_point - 1)->x;
4689 this_point->y = ibw + (font_h * top_y);
4690 this_point++;
4691 this_point->x = ibw + (font_w * x);
4692 this_point->y = (this_point - 1)->y;
4695 /* Now do the right side. */
4696 while (y < bottom_y)
4697 { /* Right vertical edge */
4698 this_point++;
4699 this_point->x = (this_point - 1)->x;
4700 this_point->y = ibw + (font_h * (y + 1));
4701 this_point++;
4703 y++; /* Horizontal connection to next line */
4704 x = line_len (y);
4705 if (x == 0)
4706 this_point->x = ibw + (font_w / 2);
4707 else
4708 this_point->x = ibw + (font_w * x);
4710 this_point->y = (this_point - 1)->y;
4713 /* Now do the bottom and connect to the top left point. */
4714 this_point->x = ibw + (font_w * (bottom_x + 1));
4716 this_point++;
4717 this_point->x = (this_point - 1)->x;
4718 this_point->y = ibw + (font_h * (bottom_y + 1));
4719 this_point++;
4720 this_point->x = ibw;
4721 this_point->y = (this_point - 1)->y;
4722 this_point++;
4723 this_point->x = pixel_points->x;
4724 this_point->y = pixel_points->y;
4726 XDrawLines (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
4727 gc, pixel_points,
4728 (this_point - pixel_points + 1), CoordModeOrigin);
4731 DEFUN ("x-contour-region", Fx_contour_region, Sx_contour_region, 1, 1, 0,
4732 "Highlight the region between point and the character under the mouse\n\
4733 selected frame.")
4734 (event)
4735 register Lisp_Object event;
4737 register int x0, y0, x1, y1;
4738 register struct frame *f = selected_frame;
4739 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4740 register int p1, p2;
4742 CHECK_CONS (event, 0);
4744 BLOCK_INPUT;
4745 x0 = XINT (Fcar (Fcar (event)));
4746 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4748 /* If the mouse is past the end of the line, don't that area. */
4749 /* ReWrite this... */
4751 /* Where the cursor is. */
4752 x1 = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4753 y1 = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4755 if (y1 > y0) /* point below mouse */
4756 outline_region (f, f->output_data.x->cursor_gc,
4757 x0, y0, x1, y1);
4758 else if (y1 < y0) /* point above mouse */
4759 outline_region (f, f->output_data.x->cursor_gc,
4760 x1, y1, x0, y0);
4761 else /* same line: draw horizontal rectangle */
4763 if (x1 > x0)
4764 x_rectangle (f, f->output_data.x->cursor_gc,
4765 x0, y0, (x1 - x0 + 1), 1);
4766 else if (x1 < x0)
4767 x_rectangle (f, f->output_data.x->cursor_gc,
4768 x1, y1, (x0 - x1 + 1), 1);
4771 XFlush (FRAME_X_DISPLAY (f));
4772 UNBLOCK_INPUT;
4774 return Qnil;
4777 DEFUN ("x-uncontour-region", Fx_uncontour_region, Sx_uncontour_region, 1, 1, 0,
4778 "Erase any highlighting of the region between point and the character\n\
4779 at X, Y on the selected frame.")
4780 (event)
4781 register Lisp_Object event;
4783 register int x0, y0, x1, y1;
4784 register struct frame *f = selected_frame;
4785 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4787 BLOCK_INPUT;
4788 x0 = XINT (Fcar (Fcar (event)));
4789 y0 = XINT (Fcar (Fcdr (Fcar (event))));
4790 x1 = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4791 y1 = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4793 if (y1 > y0) /* point below mouse */
4794 outline_region (f, f->output_data.x->reverse_gc,
4795 x0, y0, x1, y1);
4796 else if (y1 < y0) /* point above mouse */
4797 outline_region (f, f->output_data.x->reverse_gc,
4798 x1, y1, x0, y0);
4799 else /* same line: draw horizontal rectangle */
4801 if (x1 > x0)
4802 x_rectangle (f, f->output_data.x->reverse_gc,
4803 x0, y0, (x1 - x0 + 1), 1);
4804 else if (x1 < x0)
4805 x_rectangle (f, f->output_data.x->reverse_gc,
4806 x1, y1, (x0 - x1 + 1), 1);
4808 UNBLOCK_INPUT;
4810 return Qnil;
4813 #if 0
4814 int contour_begin_x, contour_begin_y;
4815 int contour_end_x, contour_end_y;
4816 int contour_npoints;
4818 /* Clip the top part of the contour lines down (and including) line Y_POS.
4819 If X_POS is in the middle (rather than at the end) of the line, drop
4820 down a line at that character. */
4822 static void
4823 clip_contour_top (y_pos, x_pos)
4825 register XPoint *begin = contour_lines[y_pos].top_left;
4826 register XPoint *end;
4827 register int npoints;
4828 register struct display_line *line = selected_frame->phys_lines[y_pos + 1];
4830 if (x_pos >= line->len - 1) /* Draw one, straight horizontal line. */
4832 end = contour_lines[y_pos].top_right;
4833 npoints = (end - begin + 1);
4834 XDrawLines (x_current_display, contour_window,
4835 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4837 bcopy (end, begin + 1, contour_last_point - end + 1);
4838 contour_last_point -= (npoints - 2);
4839 XDrawLines (x_current_display, contour_window,
4840 contour_erase_gc, begin, 2, CoordModeOrigin);
4841 XFlush (x_current_display);
4843 /* Now, update contour_lines structure. */
4845 /* ______. */
4846 else /* |________*/
4848 register XPoint *p = begin + 1;
4849 end = contour_lines[y_pos].bottom_right;
4850 npoints = (end - begin + 1);
4851 XDrawLines (x_current_display, contour_window,
4852 contour_erase_gc, begin_erase, npoints, CoordModeOrigin);
4854 p->y = begin->y;
4855 p->x = ibw + (font_w * (x_pos + 1));
4856 p++;
4857 p->y = begin->y + font_h;
4858 p->x = (p - 1)->x;
4859 bcopy (end, begin + 3, contour_last_point - end + 1);
4860 contour_last_point -= (npoints - 5);
4861 XDrawLines (x_current_display, contour_window,
4862 contour_erase_gc, begin, 4, CoordModeOrigin);
4863 XFlush (x_current_display);
4865 /* Now, update contour_lines structure. */
4869 /* Erase the top horizontal lines of the contour, and then extend
4870 the contour upwards. */
4872 static void
4873 extend_contour_top (line)
4877 static void
4878 clip_contour_bottom (x_pos, y_pos)
4879 int x_pos, y_pos;
4883 static void
4884 extend_contour_bottom (x_pos, y_pos)
4888 DEFUN ("x-select-region", Fx_select_region, Sx_select_region, 1, 1, "e",
4890 (event)
4891 Lisp_Object event;
4893 register struct frame *f = selected_frame;
4894 struct window *w = XWINDOW (FRAME_SELECTED_WINDOW (f));
4895 register int point_x = WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x);
4896 register int point_y = WINDOW_TO_FRAME_PIXEL_Y (w, w->cursor.y);
4897 register int mouse_below_point;
4898 register Lisp_Object obj;
4899 register int x_contour_x, x_contour_y;
4901 x_contour_x = x_mouse_x;
4902 x_contour_y = x_mouse_y;
4903 if (x_contour_y > point_y || (x_contour_y == point_y
4904 && x_contour_x > point_x))
4906 mouse_below_point = 1;
4907 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4908 x_contour_x, x_contour_y);
4910 else
4912 mouse_below_point = 0;
4913 outline_region (f, f->output_data.x->cursor_gc, x_contour_x, x_contour_y,
4914 point_x, point_y);
4917 while (1)
4919 obj = read_char (-1, 0, 0, Qnil, 0);
4920 if (!CONSP (obj))
4921 break;
4923 if (mouse_below_point)
4925 if (x_mouse_y <= point_y) /* Flipped. */
4927 mouse_below_point = 0;
4929 outline_region (f, f->output_data.x->reverse_gc, point_x, point_y,
4930 x_contour_x, x_contour_y);
4931 outline_region (f, f->output_data.x->cursor_gc, x_mouse_x, x_mouse_y,
4932 point_x, point_y);
4934 else if (x_mouse_y < x_contour_y) /* Bottom clipped. */
4936 clip_contour_bottom (x_mouse_y);
4938 else if (x_mouse_y > x_contour_y) /* Bottom extended. */
4940 extend_bottom_contour (x_mouse_y);
4943 x_contour_x = x_mouse_x;
4944 x_contour_y = x_mouse_y;
4946 else /* mouse above or same line as point */
4948 if (x_mouse_y >= point_y) /* Flipped. */
4950 mouse_below_point = 1;
4952 outline_region (f, f->output_data.x->reverse_gc,
4953 x_contour_x, x_contour_y, point_x, point_y);
4954 outline_region (f, f->output_data.x->cursor_gc, point_x, point_y,
4955 x_mouse_x, x_mouse_y);
4957 else if (x_mouse_y > x_contour_y) /* Top clipped. */
4959 clip_contour_top (x_mouse_y);
4961 else if (x_mouse_y < x_contour_y) /* Top extended. */
4963 extend_contour_top (x_mouse_y);
4968 unread_command_event = obj;
4969 if (mouse_below_point)
4971 contour_begin_x = point_x;
4972 contour_begin_y = point_y;
4973 contour_end_x = x_contour_x;
4974 contour_end_y = x_contour_y;
4976 else
4978 contour_begin_x = x_contour_x;
4979 contour_begin_y = x_contour_y;
4980 contour_end_x = point_x;
4981 contour_end_y = point_y;
4984 #endif
4986 DEFUN ("x-horizontal-line", Fx_horizontal_line, Sx_horizontal_line, 1, 1, "e",
4988 (event)
4989 Lisp_Object event;
4991 register Lisp_Object obj;
4992 struct frame *f = selected_frame;
4993 register struct window *w = XWINDOW (selected_window);
4994 register GC line_gc = f->output_data.x->cursor_gc;
4995 register GC erase_gc = f->output_data.x->reverse_gc;
4996 #if 0
4997 char dash_list[] = {6, 4, 6, 4};
4998 int dashes = 4;
4999 XGCValues gc_values;
5000 #endif
5001 register int previous_y;
5002 register int line = (x_mouse_y + 1) * f->output_data.x->line_height
5003 + f->output_data.x->internal_border_width;
5004 register int left = f->output_data.x->internal_border_width
5005 + (WINDOW_LEFT_MARGIN (w)
5006 * FONT_WIDTH (f->output_data.x->font));
5007 register int right = left + (w->width
5008 * FONT_WIDTH (f->output_data.x->font))
5009 - f->output_data.x->internal_border_width;
5011 #if 0
5012 BLOCK_INPUT;
5013 gc_values.foreground = f->output_data.x->cursor_pixel;
5014 gc_values.background = f->output_data.x->background_pixel;
5015 gc_values.line_width = 1;
5016 gc_values.line_style = LineOnOffDash;
5017 gc_values.cap_style = CapRound;
5018 gc_values.join_style = JoinRound;
5020 line_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5021 GCLineStyle | GCJoinStyle | GCCapStyle
5022 | GCLineWidth | GCForeground | GCBackground,
5023 &gc_values);
5024 XSetDashes (FRAME_X_DISPLAY (f), line_gc, 0, dash_list, dashes);
5025 gc_values.foreground = f->output_data.x->background_pixel;
5026 gc_values.background = f->output_data.x->foreground_pixel;
5027 erase_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5028 GCLineStyle | GCJoinStyle | GCCapStyle
5029 | GCLineWidth | GCForeground | GCBackground,
5030 &gc_values);
5031 XSetDashes (FRAME_X_DISPLAY (f), erase_gc, 0, dash_list, dashes);
5032 UNBLOCK_INPUT;
5033 #endif
5035 while (1)
5037 BLOCK_INPUT;
5038 if (x_mouse_y >= XINT (w->top)
5039 && x_mouse_y < XINT (w->top) + XINT (w->height) - 1)
5041 previous_y = x_mouse_y;
5042 line = (x_mouse_y + 1) * f->output_data.x->line_height
5043 + f->output_data.x->internal_border_width;
5044 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5045 line_gc, left, line, right, line);
5047 XFlush (FRAME_X_DISPLAY (f));
5048 UNBLOCK_INPUT;
5052 obj = read_char (-1, 0, 0, Qnil, 0);
5053 if (!CONSP (obj)
5054 || (! EQ (Fcar (Fcdr (Fcdr (obj))),
5055 Qvertical_scroll_bar))
5056 || x_mouse_grabbed)
5058 BLOCK_INPUT;
5059 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5060 erase_gc, left, line, right, line);
5061 unread_command_event = obj;
5062 #if 0
5063 XFreeGC (FRAME_X_DISPLAY (f), line_gc);
5064 XFreeGC (FRAME_X_DISPLAY (f), erase_gc);
5065 #endif
5066 UNBLOCK_INPUT;
5067 return Qnil;
5070 while (x_mouse_y == previous_y);
5072 BLOCK_INPUT;
5073 XDrawLine (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
5074 erase_gc, left, line, right, line);
5075 UNBLOCK_INPUT;
5078 #endif
5080 #if 0
5081 /* These keep track of the rectangle following the pointer. */
5082 int mouse_track_top, mouse_track_left, mouse_track_width;
5084 /* Offset in buffer of character under the pointer, or 0. */
5085 int mouse_buffer_offset;
5087 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 0, 0, 0,
5088 "Track the pointer.")
5091 static Cursor current_pointer_shape;
5092 FRAME_PTR f = x_mouse_frame;
5094 BLOCK_INPUT;
5095 if (EQ (Vmouse_frame_part, Qtext_part)
5096 && (current_pointer_shape != f->output_data.x->nontext_cursor))
5098 unsigned char c;
5099 struct buffer *buf;
5101 current_pointer_shape = f->output_data.x->nontext_cursor;
5102 XDefineCursor (FRAME_X_DISPLAY (f),
5103 FRAME_X_WINDOW (f),
5104 current_pointer_shape);
5106 buf = XBUFFER (XWINDOW (Vmouse_window)->buffer);
5107 c = *(BUF_CHAR_ADDRESS (buf, mouse_buffer_offset));
5109 else if (EQ (Vmouse_frame_part, Qmodeline_part)
5110 && (current_pointer_shape != f->output_data.x->modeline_cursor))
5112 current_pointer_shape = f->output_data.x->modeline_cursor;
5113 XDefineCursor (FRAME_X_DISPLAY (f),
5114 FRAME_X_WINDOW (f),
5115 current_pointer_shape);
5118 XFlush (FRAME_X_DISPLAY (f));
5119 UNBLOCK_INPUT;
5121 #endif
5123 #if 0
5124 DEFUN ("x-track-pointer", Fx_track_pointer, Sx_track_pointer, 1, 1, "e",
5125 "Draw rectangle around character under mouse pointer, if there is one.")
5126 (event)
5127 Lisp_Object event;
5129 struct window *w = XWINDOW (Vmouse_window);
5130 struct frame *f = XFRAME (WINDOW_FRAME (w));
5131 struct buffer *b = XBUFFER (w->buffer);
5132 Lisp_Object obj;
5134 if (! EQ (Vmouse_window, selected_window))
5135 return Qnil;
5137 if (EQ (event, Qnil))
5139 int x, y;
5141 x_read_mouse_position (selected_frame, &x, &y);
5144 BLOCK_INPUT;
5145 mouse_track_width = 0;
5146 mouse_track_left = mouse_track_top = -1;
5150 if ((x_mouse_x != mouse_track_left
5151 && (x_mouse_x < mouse_track_left
5152 || x_mouse_x > (mouse_track_left + mouse_track_width)))
5153 || x_mouse_y != mouse_track_top)
5155 int hp = 0; /* Horizontal position */
5156 int len = FRAME_CURRENT_GLYPHS (f)->used[x_mouse_y];
5157 int p = FRAME_CURRENT_GLYPHS (f)->bufp[x_mouse_y];
5158 int tab_width = XINT (b->tab_width);
5159 int ctl_arrow_p = !NILP (b->ctl_arrow);
5160 unsigned char c;
5161 int mode_line_vpos = XFASTINT (w->height) + XFASTINT (w->top) - 1;
5162 int in_mode_line = 0;
5164 if (! FRAME_CURRENT_GLYPHS (f)->enable[x_mouse_y])
5165 break;
5167 /* Erase previous rectangle. */
5168 if (mouse_track_width)
5170 x_rectangle (f, f->output_data.x->reverse_gc,
5171 mouse_track_left, mouse_track_top,
5172 mouse_track_width, 1);
5174 if ((mouse_track_left == f->phys_cursor_x
5175 || mouse_track_left == f->phys_cursor_x - 1)
5176 && mouse_track_top == f->phys_cursor_y)
5178 x_display_cursor (f, 1);
5182 mouse_track_left = x_mouse_x;
5183 mouse_track_top = x_mouse_y;
5184 mouse_track_width = 0;
5186 if (mouse_track_left > len) /* Past the end of line. */
5187 goto draw_or_not;
5189 if (mouse_track_top == mode_line_vpos)
5191 in_mode_line = 1;
5192 goto draw_or_not;
5195 if (tab_width <= 0 || tab_width > 20) tab_width = 8;
5198 c = FETCH_BYTE (p);
5199 if (len == f->width && hp == len - 1 && c != '\n')
5200 goto draw_or_not;
5202 switch (c)
5204 case '\t':
5205 mouse_track_width = tab_width - (hp % tab_width);
5206 p++;
5207 hp += mouse_track_width;
5208 if (hp > x_mouse_x)
5210 mouse_track_left = hp - mouse_track_width;
5211 goto draw_or_not;
5213 continue;
5215 case '\n':
5216 mouse_track_width = -1;
5217 goto draw_or_not;
5219 default:
5220 if (ctl_arrow_p && (c < 040 || c == 0177))
5222 if (p > ZV)
5223 goto draw_or_not;
5225 mouse_track_width = 2;
5226 p++;
5227 hp +=2;
5228 if (hp > x_mouse_x)
5230 mouse_track_left = hp - mouse_track_width;
5231 goto draw_or_not;
5234 else
5236 mouse_track_width = 1;
5237 p++;
5238 hp++;
5240 continue;
5243 while (hp <= x_mouse_x);
5245 draw_or_not:
5246 if (mouse_track_width) /* Over text; use text pointer shape. */
5248 XDefineCursor (FRAME_X_DISPLAY (f),
5249 FRAME_X_WINDOW (f),
5250 f->output_data.x->text_cursor);
5251 x_rectangle (f, f->output_data.x->cursor_gc,
5252 mouse_track_left, mouse_track_top,
5253 mouse_track_width, 1);
5255 else if (in_mode_line)
5256 XDefineCursor (FRAME_X_DISPLAY (f),
5257 FRAME_X_WINDOW (f),
5258 f->output_data.x->modeline_cursor);
5259 else
5260 XDefineCursor (FRAME_X_DISPLAY (f),
5261 FRAME_X_WINDOW (f),
5262 f->output_data.x->nontext_cursor);
5265 XFlush (FRAME_X_DISPLAY (f));
5266 UNBLOCK_INPUT;
5268 obj = read_char (-1, 0, 0, Qnil, 0);
5269 BLOCK_INPUT;
5271 while (CONSP (obj) /* Mouse event */
5272 && EQ (Fcar (Fcdr (Fcdr (obj))), Qnil) /* Not scroll bar */
5273 && EQ (Vmouse_depressed, Qnil) /* Only motion events */
5274 && EQ (Vmouse_window, selected_window) /* In this window */
5275 && x_mouse_frame);
5277 unread_command_event = obj;
5279 if (mouse_track_width)
5281 x_rectangle (f, f->output_data.x->reverse_gc,
5282 mouse_track_left, mouse_track_top,
5283 mouse_track_width, 1);
5284 mouse_track_width = 0;
5285 if ((mouse_track_left == f->phys_cursor_x
5286 || mouse_track_left - 1 == f->phys_cursor_x)
5287 && mouse_track_top == f->phys_cursor_y)
5289 x_display_cursor (f, 1);
5292 XDefineCursor (FRAME_X_DISPLAY (f),
5293 FRAME_X_WINDOW (f),
5294 f->output_data.x->nontext_cursor);
5295 XFlush (FRAME_X_DISPLAY (f));
5296 UNBLOCK_INPUT;
5298 return Qnil;
5300 #endif
5302 #if 0
5303 #include "glyphs.h"
5305 /* Draw a pixmap specified by IMAGE_DATA of dimensions WIDTH and HEIGHT
5306 on the frame F at position X, Y. */
5308 x_draw_pixmap (f, x, y, image_data, width, height)
5309 struct frame *f;
5310 int x, y, width, height;
5311 char *image_data;
5313 Pixmap image;
5315 image = XCreateBitmapFromData (FRAME_X_DISPLAY (f),
5316 FRAME_X_WINDOW (f), image_data,
5317 width, height);
5318 XCopyPlane (FRAME_X_DISPLAY (f), image, FRAME_X_WINDOW (f),
5319 f->output_data.x->normal_gc, 0, 0, width, height, x, y);
5321 #endif
5323 #if 0 /* I'm told these functions are superfluous
5324 given the ability to bind function keys. */
5326 #ifdef HAVE_X11
5327 DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
5328 "Rebind X keysym KEYSYM, with MODIFIERS, to generate NEWSTRING.\n\
5329 KEYSYM is a string which conforms to the X keysym definitions found\n\
5330 in X11/keysymdef.h, sans the initial XK_. MODIFIERS is nil or a\n\
5331 list of strings specifying modifier keys such as Control_L, which must\n\
5332 also be depressed for NEWSTRING to appear.")
5333 (x_keysym, modifiers, newstring)
5334 register Lisp_Object x_keysym;
5335 register Lisp_Object modifiers;
5336 register Lisp_Object newstring;
5338 char *rawstring;
5339 register KeySym keysym;
5340 KeySym modifier_list[16];
5342 check_x ();
5343 CHECK_STRING (x_keysym, 1);
5344 CHECK_STRING (newstring, 3);
5346 keysym = XStringToKeysym ((char *) XSTRING (x_keysym)->data);
5347 if (keysym == NoSymbol)
5348 error ("Keysym does not exist");
5350 if (NILP (modifiers))
5351 XRebindKeysym (x_current_display, keysym, modifier_list, 0,
5352 XSTRING (newstring)->data,
5353 STRING_BYTES (XSTRING (newstring)));
5354 else
5356 register Lisp_Object rest, mod;
5357 register int i = 0;
5359 for (rest = modifiers; !NILP (rest); rest = Fcdr (rest))
5361 if (i == 16)
5362 error ("Can't have more than 16 modifiers");
5364 mod = Fcar (rest);
5365 CHECK_STRING (mod, 3);
5366 modifier_list[i] = XStringToKeysym ((char *) XSTRING (mod)->data);
5367 #ifndef HAVE_X11R5
5368 if (modifier_list[i] == NoSymbol
5369 || !(IsModifierKey (modifier_list[i])
5370 || ((unsigned)(modifier_list[i]) == XK_Mode_switch)
5371 || ((unsigned)(modifier_list[i]) == XK_Num_Lock)))
5372 #else
5373 if (modifier_list[i] == NoSymbol
5374 || !IsModifierKey (modifier_list[i]))
5375 #endif
5376 error ("Element is not a modifier keysym");
5377 i++;
5380 XRebindKeysym (x_current_display, keysym, modifier_list, i,
5381 XSTRING (newstring)->data,
5382 STRING_BYTES (XSTRING (newstring)));
5385 return Qnil;
5388 DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
5389 "Rebind KEYCODE to list of strings STRINGS.\n\
5390 STRINGS should be a list of 16 elements, one for each shift combination.\n\
5391 nil as element means don't change.\n\
5392 See the documentation of `x-rebind-key' for more information.")
5393 (keycode, strings)
5394 register Lisp_Object keycode;
5395 register Lisp_Object strings;
5397 register Lisp_Object item;
5398 register unsigned char *rawstring;
5399 KeySym rawkey, modifier[1];
5400 int strsize;
5401 register unsigned i;
5403 check_x ();
5404 CHECK_NUMBER (keycode, 1);
5405 CHECK_CONS (strings, 2);
5406 rawkey = (KeySym) ((unsigned) (XINT (keycode))) & 255;
5407 for (i = 0; i <= 15; strings = Fcdr (strings), i++)
5409 item = Fcar (strings);
5410 if (!NILP (item))
5412 CHECK_STRING (item, 2);
5413 strsize = STRING_BYTES (XSTRING (item));
5414 rawstring = (unsigned char *) xmalloc (strsize);
5415 bcopy (XSTRING (item)->data, rawstring, strsize);
5416 modifier[1] = 1 << i;
5417 XRebindKeysym (x_current_display, rawkey, modifier, 1,
5418 rawstring, strsize);
5421 return Qnil;
5423 #endif /* HAVE_X11 */
5424 #endif /* 0 */
5426 #ifndef HAVE_XSCREENNUMBEROFSCREEN
5428 XScreenNumberOfScreen (scr)
5429 register Screen *scr;
5431 register Display *dpy;
5432 register Screen *dpyscr;
5433 register int i;
5435 dpy = scr->display;
5436 dpyscr = dpy->screens;
5438 for (i = 0; i < dpy->nscreens; i++, dpyscr++)
5439 if (scr == dpyscr)
5440 return i;
5442 return -1;
5444 #endif /* not HAVE_XSCREENNUMBEROFSCREEN */
5446 Visual *
5447 select_visual (dpy, screen, depth)
5448 Display *dpy;
5449 Screen *screen;
5450 unsigned int *depth;
5452 Visual *v;
5453 XVisualInfo *vinfo, vinfo_template;
5454 int n_visuals;
5456 v = DefaultVisualOfScreen (screen);
5458 #ifdef HAVE_X11R4
5459 vinfo_template.visualid = XVisualIDFromVisual (v);
5460 #else
5461 vinfo_template.visualid = v->visualid;
5462 #endif
5464 vinfo_template.screen = XScreenNumberOfScreen (screen);
5466 vinfo = XGetVisualInfo (dpy,
5467 VisualIDMask | VisualScreenMask, &vinfo_template,
5468 &n_visuals);
5469 if (n_visuals != 1)
5470 fatal ("Can't get proper X visual info");
5472 if ((1 << vinfo->depth) == vinfo->colormap_size)
5473 *depth = vinfo->depth;
5474 else
5476 int i = 0;
5477 int n = vinfo->colormap_size - 1;
5478 while (n)
5480 n = n >> 1;
5481 i++;
5483 *depth = i;
5486 XFree ((char *) vinfo);
5487 return v;
5490 /* Return the X display structure for the display named NAME.
5491 Open a new connection if necessary. */
5493 struct x_display_info *
5494 x_display_info_for_name (name)
5495 Lisp_Object name;
5497 Lisp_Object names;
5498 struct x_display_info *dpyinfo;
5500 CHECK_STRING (name, 0);
5502 if (! EQ (Vwindow_system, intern ("x")))
5503 error ("Not using X Windows");
5505 for (dpyinfo = x_display_list, names = x_display_name_list;
5506 dpyinfo;
5507 dpyinfo = dpyinfo->next, names = XCDR (names))
5509 Lisp_Object tem;
5510 tem = Fstring_equal (XCAR (XCAR (names)), name);
5511 if (!NILP (tem))
5512 return dpyinfo;
5515 /* Use this general default value to start with. */
5516 Vx_resource_name = Vinvocation_name;
5518 validate_x_resource_name ();
5520 dpyinfo = x_term_init (name, (unsigned char *)0,
5521 (char *) XSTRING (Vx_resource_name)->data);
5523 if (dpyinfo == 0)
5524 error ("Cannot connect to X server %s", XSTRING (name)->data);
5526 x_in_use = 1;
5527 XSETFASTINT (Vwindow_system_version, 11);
5529 return dpyinfo;
5532 DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection,
5533 1, 3, 0, "Open a connection to an X server.\n\
5534 DISPLAY is the name of the display to connect to.\n\
5535 Optional second arg XRM-STRING is a string of resources in xrdb format.\n\
5536 If the optional third arg MUST-SUCCEED is non-nil,\n\
5537 terminate Emacs if we can't open the connection.")
5538 (display, xrm_string, must_succeed)
5539 Lisp_Object display, xrm_string, must_succeed;
5541 unsigned char *xrm_option;
5542 struct x_display_info *dpyinfo;
5544 CHECK_STRING (display, 0);
5545 if (! NILP (xrm_string))
5546 CHECK_STRING (xrm_string, 1);
5548 if (! EQ (Vwindow_system, intern ("x")))
5549 error ("Not using X Windows");
5551 if (! NILP (xrm_string))
5552 xrm_option = (unsigned char *) XSTRING (xrm_string)->data;
5553 else
5554 xrm_option = (unsigned char *) 0;
5556 validate_x_resource_name ();
5558 /* This is what opens the connection and sets x_current_display.
5559 This also initializes many symbols, such as those used for input. */
5560 dpyinfo = x_term_init (display, xrm_option,
5561 (char *) XSTRING (Vx_resource_name)->data);
5563 if (dpyinfo == 0)
5565 if (!NILP (must_succeed))
5566 fatal ("Cannot connect to X server %s.\n\
5567 Check the DISPLAY environment variable or use `-d'.\n\
5568 Also use the `xhost' program to verify that it is set to permit\n\
5569 connections from your machine.\n",
5570 XSTRING (display)->data);
5571 else
5572 error ("Cannot connect to X server %s", XSTRING (display)->data);
5575 x_in_use = 1;
5577 XSETFASTINT (Vwindow_system_version, 11);
5578 return Qnil;
5581 DEFUN ("x-close-connection", Fx_close_connection,
5582 Sx_close_connection, 1, 1, 0,
5583 "Close the connection to DISPLAY's X server.\n\
5584 For DISPLAY, specify either a frame or a display name (a string).\n\
5585 If DISPLAY is nil, that stands for the selected frame's display.")
5586 (display)
5587 Lisp_Object display;
5589 struct x_display_info *dpyinfo = check_x_display_info (display);
5590 int i;
5592 if (dpyinfo->reference_count > 0)
5593 error ("Display still has frames on it");
5595 BLOCK_INPUT;
5596 /* Free the fonts in the font table. */
5597 for (i = 0; i < dpyinfo->n_fonts; i++)
5598 if (dpyinfo->font_table[i].name)
5600 xfree (dpyinfo->font_table[i].name);
5601 /* Don't free the full_name string;
5602 it is always shared with something else. */
5603 XFreeFont (dpyinfo->display, dpyinfo->font_table[i].font);
5606 x_destroy_all_bitmaps (dpyinfo);
5607 XSetCloseDownMode (dpyinfo->display, DestroyAll);
5609 #ifdef USE_X_TOOLKIT
5610 XtCloseDisplay (dpyinfo->display);
5611 #else
5612 XCloseDisplay (dpyinfo->display);
5613 #endif
5615 x_delete_display (dpyinfo);
5616 UNBLOCK_INPUT;
5618 return Qnil;
5621 DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0,
5622 "Return the list of display names that Emacs has connections to.")
5625 Lisp_Object tail, result;
5627 result = Qnil;
5628 for (tail = x_display_name_list; ! NILP (tail); tail = XCDR (tail))
5629 result = Fcons (XCAR (XCAR (tail)), result);
5631 return result;
5634 DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0,
5635 "If ON is non-nil, report X errors as soon as the erring request is made.\n\
5636 If ON is nil, allow buffering of requests.\n\
5637 Turning on synchronization prohibits the Xlib routines from buffering\n\
5638 requests and seriously degrades performance, but makes debugging much\n\
5639 easier.\n\
5640 The optional second argument DISPLAY specifies which display to act on.\n\
5641 DISPLAY should be either a frame or a display name (a string).\n\
5642 If DISPLAY is omitted or nil, that stands for the selected frame's display.")
5643 (on, display)
5644 Lisp_Object display, on;
5646 struct x_display_info *dpyinfo = check_x_display_info (display);
5648 XSynchronize (dpyinfo->display, !EQ (on, Qnil));
5650 return Qnil;
5653 /* Wait for responses to all X commands issued so far for frame F. */
5655 void
5656 x_sync (f)
5657 FRAME_PTR f;
5659 BLOCK_INPUT;
5660 XSync (FRAME_X_DISPLAY (f), False);
5661 UNBLOCK_INPUT;
5665 /***********************************************************************
5666 Image types
5667 ***********************************************************************/
5669 /* Value is the number of elements of vector VECTOR. */
5671 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
5673 /* List of supported image types. Use define_image_type to add new
5674 types. Use lookup_image_type to find a type for a given symbol. */
5676 static struct image_type *image_types;
5678 /* A list of symbols, one for each supported image type. */
5680 Lisp_Object Vimage_types;
5682 /* The symbol `image' which is the car of the lists used to represent
5683 images in Lisp. */
5685 extern Lisp_Object Qimage;
5687 /* The symbol `xbm' which is used as the type symbol for XBM images. */
5689 Lisp_Object Qxbm;
5691 /* Keywords. */
5693 Lisp_Object QCtype, QCdata, QCascent, QCmargin, QCrelief;
5694 extern Lisp_Object QCwidth, QCheight, QCforeground, QCbackground, QCfile;
5695 Lisp_Object QCalgorithm, QCcolor_symbols, QCheuristic_mask;
5696 Lisp_Object QCindex;
5698 /* Other symbols. */
5700 Lisp_Object Qlaplace;
5702 /* Time in seconds after which images should be removed from the cache
5703 if not displayed. */
5705 Lisp_Object Vimage_cache_eviction_delay;
5707 /* Function prototypes. */
5709 static void define_image_type P_ ((struct image_type *type));
5710 static struct image_type *lookup_image_type P_ ((Lisp_Object symbol));
5711 static void image_error P_ ((char *format, Lisp_Object, Lisp_Object));
5712 static void x_laplace P_ ((struct frame *, struct image *));
5713 static int x_build_heuristic_mask P_ ((struct frame *, struct image *,
5714 Lisp_Object));
5717 /* Define a new image type from TYPE. This adds a copy of TYPE to
5718 image_types and adds the symbol *TYPE->type to Vimage_types. */
5720 static void
5721 define_image_type (type)
5722 struct image_type *type;
5724 /* Make a copy of TYPE to avoid a bus error in a dumped Emacs.
5725 The initialized data segment is read-only. */
5726 struct image_type *p = (struct image_type *) xmalloc (sizeof *p);
5727 bcopy (type, p, sizeof *p);
5728 p->next = image_types;
5729 image_types = p;
5730 Vimage_types = Fcons (*p->type, Vimage_types);
5734 /* Look up image type SYMBOL, and return a pointer to its image_type
5735 structure. Value is null if SYMBOL is not a known image type. */
5737 static INLINE struct image_type *
5738 lookup_image_type (symbol)
5739 Lisp_Object symbol;
5741 struct image_type *type;
5743 for (type = image_types; type; type = type->next)
5744 if (EQ (symbol, *type->type))
5745 break;
5747 return type;
5751 /* Value is non-zero if OBJECT is a valid Lisp image specification. A
5752 valid image specification is a list whose car is the symbol
5753 `image', and whose rest is a property list. The property list must
5754 contain a value for key `:type'. That value must be the name of a
5755 supported image type. The rest of the property list depends on the
5756 image type. */
5759 valid_image_p (object)
5760 Lisp_Object object;
5762 int valid_p = 0;
5764 if (CONSP (object) && EQ (XCAR (object), Qimage))
5766 Lisp_Object symbol = Fplist_get (XCDR (object), QCtype);
5767 struct image_type *type = lookup_image_type (symbol);
5769 if (type)
5770 valid_p = type->valid_p (object);
5773 return valid_p;
5777 /* Log error message with format string FORMAT and argument ARG.
5778 Signaling an error, e.g. when an image cannot be loaded, is not a
5779 good idea because this would interrupt redisplay, and the error
5780 message display would lead to another redisplay. This function
5781 therefore simply displays a message. */
5783 static void
5784 image_error (format, arg1, arg2)
5785 char *format;
5786 Lisp_Object arg1, arg2;
5788 add_to_log (format, arg1, arg2);
5793 /***********************************************************************
5794 Image specifications
5795 ***********************************************************************/
5797 enum image_value_type
5799 IMAGE_DONT_CHECK_VALUE_TYPE,
5800 IMAGE_STRING_VALUE,
5801 IMAGE_SYMBOL_VALUE,
5802 IMAGE_POSITIVE_INTEGER_VALUE,
5803 IMAGE_NON_NEGATIVE_INTEGER_VALUE,
5804 IMAGE_INTEGER_VALUE,
5805 IMAGE_FUNCTION_VALUE,
5806 IMAGE_NUMBER_VALUE,
5807 IMAGE_BOOL_VALUE
5810 /* Structure used when parsing image specifications. */
5812 struct image_keyword
5814 /* Name of keyword. */
5815 char *name;
5817 /* The type of value allowed. */
5818 enum image_value_type type;
5820 /* Non-zero means key must be present. */
5821 int mandatory_p;
5823 /* Used to recognize duplicate keywords in a property list. */
5824 int count;
5826 /* The value that was found. */
5827 Lisp_Object value;
5831 static int parse_image_spec P_ ((Lisp_Object, struct image_keyword *,
5832 int, Lisp_Object));
5833 static Lisp_Object image_spec_value P_ ((Lisp_Object, Lisp_Object, int *));
5836 /* Parse image spec SPEC according to KEYWORDS. A valid image spec
5837 has the format (image KEYWORD VALUE ...). One of the keyword/
5838 value pairs must be `:type TYPE'. KEYWORDS is a vector of
5839 image_keywords structures of size NKEYWORDS describing other
5840 allowed keyword/value pairs. Value is non-zero if SPEC is valid. */
5842 static int
5843 parse_image_spec (spec, keywords, nkeywords, type)
5844 Lisp_Object spec;
5845 struct image_keyword *keywords;
5846 int nkeywords;
5847 Lisp_Object type;
5849 int i;
5850 Lisp_Object plist;
5852 if (!CONSP (spec) || !EQ (XCAR (spec), Qimage))
5853 return 0;
5855 plist = XCDR (spec);
5856 while (CONSP (plist))
5858 Lisp_Object key, value;
5860 /* First element of a pair must be a symbol. */
5861 key = XCAR (plist);
5862 plist = XCDR (plist);
5863 if (!SYMBOLP (key))
5864 return 0;
5866 /* There must follow a value. */
5867 if (!CONSP (plist))
5868 return 0;
5869 value = XCAR (plist);
5870 plist = XCDR (plist);
5872 /* Find key in KEYWORDS. Error if not found. */
5873 for (i = 0; i < nkeywords; ++i)
5874 if (strcmp (keywords[i].name, XSYMBOL (key)->name->data) == 0)
5875 break;
5877 if (i == nkeywords)
5878 continue;
5880 /* Record that we recognized the keyword. If a keywords
5881 was found more than once, it's an error. */
5882 keywords[i].value = value;
5883 ++keywords[i].count;
5885 if (keywords[i].count > 1)
5886 return 0;
5888 /* Check type of value against allowed type. */
5889 switch (keywords[i].type)
5891 case IMAGE_STRING_VALUE:
5892 if (!STRINGP (value))
5893 return 0;
5894 break;
5896 case IMAGE_SYMBOL_VALUE:
5897 if (!SYMBOLP (value))
5898 return 0;
5899 break;
5901 case IMAGE_POSITIVE_INTEGER_VALUE:
5902 if (!INTEGERP (value) || XINT (value) <= 0)
5903 return 0;
5904 break;
5906 case IMAGE_NON_NEGATIVE_INTEGER_VALUE:
5907 if (!INTEGERP (value) || XINT (value) < 0)
5908 return 0;
5909 break;
5911 case IMAGE_DONT_CHECK_VALUE_TYPE:
5912 break;
5914 case IMAGE_FUNCTION_VALUE:
5915 value = indirect_function (value);
5916 if (SUBRP (value)
5917 || COMPILEDP (value)
5918 || (CONSP (value) && EQ (XCAR (value), Qlambda)))
5919 break;
5920 return 0;
5922 case IMAGE_NUMBER_VALUE:
5923 if (!INTEGERP (value) && !FLOATP (value))
5924 return 0;
5925 break;
5927 case IMAGE_INTEGER_VALUE:
5928 if (!INTEGERP (value))
5929 return 0;
5930 break;
5932 case IMAGE_BOOL_VALUE:
5933 if (!NILP (value) && !EQ (value, Qt))
5934 return 0;
5935 break;
5937 default:
5938 abort ();
5939 break;
5942 if (EQ (key, QCtype) && !EQ (type, value))
5943 return 0;
5946 /* Check that all mandatory fields are present. */
5947 for (i = 0; i < nkeywords; ++i)
5948 if (keywords[i].mandatory_p && keywords[i].count == 0)
5949 return 0;
5951 return NILP (plist);
5955 /* Return the value of KEY in image specification SPEC. Value is nil
5956 if KEY is not present in SPEC. if FOUND is not null, set *FOUND
5957 to 1 if KEY was found in SPEC, set it to 0 otherwise. */
5959 static Lisp_Object
5960 image_spec_value (spec, key, found)
5961 Lisp_Object spec, key;
5962 int *found;
5964 Lisp_Object tail;
5966 xassert (valid_image_p (spec));
5968 for (tail = XCDR (spec);
5969 CONSP (tail) && CONSP (XCDR (tail));
5970 tail = XCDR (XCDR (tail)))
5972 if (EQ (XCAR (tail), key))
5974 if (found)
5975 *found = 1;
5976 return XCAR (XCDR (tail));
5980 if (found)
5981 *found = 0;
5982 return Qnil;
5988 /***********************************************************************
5989 Image type independent image structures
5990 ***********************************************************************/
5992 static struct image *make_image P_ ((Lisp_Object spec, unsigned hash));
5993 static void free_image P_ ((struct frame *f, struct image *img));
5996 /* Allocate and return a new image structure for image specification
5997 SPEC. SPEC has a hash value of HASH. */
5999 static struct image *
6000 make_image (spec, hash)
6001 Lisp_Object spec;
6002 unsigned hash;
6004 struct image *img = (struct image *) xmalloc (sizeof *img);
6006 xassert (valid_image_p (spec));
6007 bzero (img, sizeof *img);
6008 img->type = lookup_image_type (image_spec_value (spec, QCtype, NULL));
6009 xassert (img->type != NULL);
6010 img->spec = spec;
6011 img->data.lisp_val = Qnil;
6012 img->ascent = DEFAULT_IMAGE_ASCENT;
6013 img->hash = hash;
6014 return img;
6018 /* Free image IMG which was used on frame F, including its resources. */
6020 static void
6021 free_image (f, img)
6022 struct frame *f;
6023 struct image *img;
6025 if (img)
6027 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6029 /* Remove IMG from the hash table of its cache. */
6030 if (img->prev)
6031 img->prev->next = img->next;
6032 else
6033 c->buckets[img->hash % IMAGE_CACHE_BUCKETS_SIZE] = img->next;
6035 if (img->next)
6036 img->next->prev = img->prev;
6038 c->images[img->id] = NULL;
6040 /* Free resources, then free IMG. */
6041 img->type->free (f, img);
6042 xfree (img);
6047 /* Prepare image IMG for display on frame F. Must be called before
6048 drawing an image. */
6050 void
6051 prepare_image_for_display (f, img)
6052 struct frame *f;
6053 struct image *img;
6055 EMACS_TIME t;
6057 /* We're about to display IMG, so set its timestamp to `now'. */
6058 EMACS_GET_TIME (t);
6059 img->timestamp = EMACS_SECS (t);
6061 /* If IMG doesn't have a pixmap yet, load it now, using the image
6062 type dependent loader function. */
6063 if (img->pixmap == 0 && !img->load_failed_p)
6064 img->load_failed_p = img->type->load (f, img) == 0;
6069 /***********************************************************************
6070 Helper functions for X image types
6071 ***********************************************************************/
6073 static void x_clear_image P_ ((struct frame *f, struct image *img));
6074 static unsigned long x_alloc_image_color P_ ((struct frame *f,
6075 struct image *img,
6076 Lisp_Object color_name,
6077 unsigned long dflt));
6079 /* Free X resources of image IMG which is used on frame F. */
6081 static void
6082 x_clear_image (f, img)
6083 struct frame *f;
6084 struct image *img;
6086 if (img->pixmap)
6088 BLOCK_INPUT;
6089 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
6090 img->pixmap = 0;
6091 UNBLOCK_INPUT;
6094 if (img->ncolors)
6096 int class = FRAME_X_DISPLAY_INFO (f)->visual->class;
6098 /* If display has an immutable color map, freeing colors is not
6099 necessary and some servers don't allow it. So don't do it. */
6100 if (class != StaticColor
6101 && class != StaticGray
6102 && class != TrueColor)
6104 Colormap cmap;
6105 BLOCK_INPUT;
6106 cmap = DefaultColormapOfScreen (FRAME_X_DISPLAY_INFO (f)->screen);
6107 XFreeColors (FRAME_X_DISPLAY (f), cmap, img->colors,
6108 img->ncolors, 0);
6109 UNBLOCK_INPUT;
6112 xfree (img->colors);
6113 img->colors = NULL;
6114 img->ncolors = 0;
6119 /* Allocate color COLOR_NAME for image IMG on frame F. If color
6120 cannot be allocated, use DFLT. Add a newly allocated color to
6121 IMG->colors, so that it can be freed again. Value is the pixel
6122 color. */
6124 static unsigned long
6125 x_alloc_image_color (f, img, color_name, dflt)
6126 struct frame *f;
6127 struct image *img;
6128 Lisp_Object color_name;
6129 unsigned long dflt;
6131 XColor color;
6132 unsigned long result;
6134 xassert (STRINGP (color_name));
6136 if (x_defined_color (f, XSTRING (color_name)->data, &color, 1))
6138 /* This isn't called frequently so we get away with simply
6139 reallocating the color vector to the needed size, here. */
6140 ++img->ncolors;
6141 img->colors =
6142 (unsigned long *) xrealloc (img->colors,
6143 img->ncolors * sizeof *img->colors);
6144 img->colors[img->ncolors - 1] = color.pixel;
6145 result = color.pixel;
6147 else
6148 result = dflt;
6150 return result;
6155 /***********************************************************************
6156 Image Cache
6157 ***********************************************************************/
6159 static void cache_image P_ ((struct frame *f, struct image *img));
6162 /* Return a new, initialized image cache that is allocated from the
6163 heap. Call free_image_cache to free an image cache. */
6165 struct image_cache *
6166 make_image_cache ()
6168 struct image_cache *c = (struct image_cache *) xmalloc (sizeof *c);
6169 int size;
6171 bzero (c, sizeof *c);
6172 c->size = 50;
6173 c->images = (struct image **) xmalloc (c->size * sizeof *c->images);
6174 size = IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets;
6175 c->buckets = (struct image **) xmalloc (size);
6176 bzero (c->buckets, size);
6177 return c;
6181 /* Free image cache of frame F. Be aware that X frames share images
6182 caches. */
6184 void
6185 free_image_cache (f)
6186 struct frame *f;
6188 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6189 if (c)
6191 int i;
6193 /* Cache should not be referenced by any frame when freed. */
6194 xassert (c->refcount == 0);
6196 for (i = 0; i < c->used; ++i)
6197 free_image (f, c->images[i]);
6198 xfree (c->images);
6199 xfree (c);
6200 xfree (c->buckets);
6201 FRAME_X_IMAGE_CACHE (f) = NULL;
6206 /* Clear image cache of frame F. FORCE_P non-zero means free all
6207 images. FORCE_P zero means clear only images that haven't been
6208 displayed for some time. Should be called from time to time to
6209 reduce the number of loaded images. If image-eviction-seconds is
6210 non-nil, this frees images in the cache which weren't displayed for
6211 at least that many seconds. */
6213 void
6214 clear_image_cache (f, force_p)
6215 struct frame *f;
6216 int force_p;
6218 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6220 if (c && INTEGERP (Vimage_cache_eviction_delay))
6222 EMACS_TIME t;
6223 unsigned long old;
6224 int i, any_freed_p = 0;
6226 EMACS_GET_TIME (t);
6227 old = EMACS_SECS (t) - XFASTINT (Vimage_cache_eviction_delay);
6229 for (i = 0; i < c->used; ++i)
6231 struct image *img = c->images[i];
6232 if (img != NULL
6233 && (force_p
6234 || (img->timestamp > old)))
6236 free_image (f, img);
6237 any_freed_p = 1;
6241 /* We may be clearing the image cache because, for example,
6242 Emacs was iconified for a longer period of time. In that
6243 case, current matrices may still contain references to
6244 images freed above. So, clear these matrices. */
6245 if (any_freed_p)
6247 clear_current_matrices (f);
6248 ++windows_or_buffers_changed;
6254 DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache,
6255 0, 1, 0,
6256 "Clear the image cache of FRAME.\n\
6257 FRAME nil or omitted means use the selected frame.\n\
6258 FRAME t means clear the image caches of all frames.")
6259 (frame)
6260 Lisp_Object frame;
6262 if (EQ (frame, Qt))
6264 Lisp_Object tail;
6266 FOR_EACH_FRAME (tail, frame)
6267 if (FRAME_X_P (XFRAME (frame)))
6268 clear_image_cache (XFRAME (frame), 1);
6270 else
6271 clear_image_cache (check_x_frame (frame), 1);
6273 return Qnil;
6277 /* Return the id of image with Lisp specification SPEC on frame F.
6278 SPEC must be a valid Lisp image specification (see valid_image_p). */
6281 lookup_image (f, spec)
6282 struct frame *f;
6283 Lisp_Object spec;
6285 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6286 struct image *img;
6287 int i;
6288 unsigned hash;
6289 struct gcpro gcpro1;
6290 EMACS_TIME now;
6292 /* F must be a window-system frame, and SPEC must be a valid image
6293 specification. */
6294 xassert (FRAME_WINDOW_P (f));
6295 xassert (valid_image_p (spec));
6297 GCPRO1 (spec);
6299 /* Look up SPEC in the hash table of the image cache. */
6300 hash = sxhash (spec, 0);
6301 i = hash % IMAGE_CACHE_BUCKETS_SIZE;
6303 for (img = c->buckets[i]; img; img = img->next)
6304 if (img->hash == hash && !NILP (Fequal (img->spec, spec)))
6305 break;
6307 /* If not found, create a new image and cache it. */
6308 if (img == NULL)
6310 img = make_image (spec, hash);
6311 cache_image (f, img);
6312 img->load_failed_p = img->type->load (f, img) == 0;
6313 xassert (!interrupt_input_blocked);
6315 /* If we can't load the image, and we don't have a width and
6316 height, use some arbitrary width and height so that we can
6317 draw a rectangle for it. */
6318 if (img->load_failed_p)
6320 Lisp_Object value;
6322 value = image_spec_value (spec, QCwidth, NULL);
6323 img->width = (INTEGERP (value)
6324 ? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
6325 value = image_spec_value (spec, QCheight, NULL);
6326 img->height = (INTEGERP (value)
6327 ? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
6329 else
6331 /* Handle image type independent image attributes
6332 `:ascent PERCENT', `:margin MARGIN', `:relief RELIEF'. */
6333 Lisp_Object ascent, margin, relief, algorithm, heuristic_mask;
6334 Lisp_Object file;
6336 ascent = image_spec_value (spec, QCascent, NULL);
6337 if (INTEGERP (ascent))
6338 img->ascent = XFASTINT (ascent);
6340 margin = image_spec_value (spec, QCmargin, NULL);
6341 if (INTEGERP (margin) && XINT (margin) >= 0)
6342 img->margin = XFASTINT (margin);
6344 relief = image_spec_value (spec, QCrelief, NULL);
6345 if (INTEGERP (relief))
6347 img->relief = XINT (relief);
6348 img->margin += abs (img->relief);
6351 /* Should we apply a Laplace edge-detection algorithm? */
6352 algorithm = image_spec_value (spec, QCalgorithm, NULL);
6353 if (img->pixmap && EQ (algorithm, Qlaplace))
6354 x_laplace (f, img);
6356 /* Should we built a mask heuristically? */
6357 heuristic_mask = image_spec_value (spec, QCheuristic_mask, NULL);
6358 if (img->pixmap && !img->mask && !NILP (heuristic_mask))
6359 x_build_heuristic_mask (f, img, heuristic_mask);
6363 /* We're using IMG, so set its timestamp to `now'. */
6364 EMACS_GET_TIME (now);
6365 img->timestamp = EMACS_SECS (now);
6367 UNGCPRO;
6369 /* Value is the image id. */
6370 return img->id;
6374 /* Cache image IMG in the image cache of frame F. */
6376 static void
6377 cache_image (f, img)
6378 struct frame *f;
6379 struct image *img;
6381 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6382 int i;
6384 /* Find a free slot in c->images. */
6385 for (i = 0; i < c->used; ++i)
6386 if (c->images[i] == NULL)
6387 break;
6389 /* If no free slot found, maybe enlarge c->images. */
6390 if (i == c->used && c->used == c->size)
6392 c->size *= 2;
6393 c->images = (struct image **) xrealloc (c->images,
6394 c->size * sizeof *c->images);
6397 /* Add IMG to c->images, and assign IMG an id. */
6398 c->images[i] = img;
6399 img->id = i;
6400 if (i == c->used)
6401 ++c->used;
6403 /* Add IMG to the cache's hash table. */
6404 i = img->hash % IMAGE_CACHE_BUCKETS_SIZE;
6405 img->next = c->buckets[i];
6406 if (img->next)
6407 img->next->prev = img;
6408 img->prev = NULL;
6409 c->buckets[i] = img;
6413 /* Call FN on every image in the image cache of frame F. Used to mark
6414 Lisp Objects in the image cache. */
6416 void
6417 forall_images_in_image_cache (f, fn)
6418 struct frame *f;
6419 void (*fn) P_ ((struct image *img));
6421 if (FRAME_LIVE_P (f) && FRAME_X_P (f))
6423 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
6424 if (c)
6426 int i;
6427 for (i = 0; i < c->used; ++i)
6428 if (c->images[i])
6429 fn (c->images[i]);
6436 /***********************************************************************
6437 X support code
6438 ***********************************************************************/
6440 static int x_create_x_image_and_pixmap P_ ((struct frame *, int, int, int,
6441 XImage **, Pixmap *));
6442 static void x_destroy_x_image P_ ((XImage *));
6443 static void x_put_x_image P_ ((struct frame *, XImage *, Pixmap, int, int));
6446 /* Create an XImage and a pixmap of size WIDTH x HEIGHT for use on
6447 frame F. Set *XIMG and *PIXMAP to the XImage and Pixmap created.
6448 Set (*XIMG)->data to a raster of WIDTH x HEIGHT pixels allocated
6449 via xmalloc. Print error messages via image_error if an error
6450 occurs. Value is non-zero if successful. */
6452 static int
6453 x_create_x_image_and_pixmap (f, width, height, depth, ximg, pixmap)
6454 struct frame *f;
6455 int width, height, depth;
6456 XImage **ximg;
6457 Pixmap *pixmap;
6459 Display *display = FRAME_X_DISPLAY (f);
6460 Screen *screen = FRAME_X_SCREEN (f);
6461 Window window = FRAME_X_WINDOW (f);
6463 xassert (interrupt_input_blocked);
6465 if (depth <= 0)
6466 depth = DefaultDepthOfScreen (screen);
6467 *ximg = XCreateImage (display, DefaultVisualOfScreen (screen),
6468 depth, ZPixmap, 0, NULL, width, height,
6469 depth > 16 ? 32 : depth > 8 ? 16 : 8, 0);
6470 if (*ximg == NULL)
6472 image_error ("Unable to allocate X image", Qnil, Qnil);
6473 return 0;
6476 /* Allocate image raster. */
6477 (*ximg)->data = (char *) xmalloc ((*ximg)->bytes_per_line * height);
6479 /* Allocate a pixmap of the same size. */
6480 *pixmap = XCreatePixmap (display, window, width, height, depth);
6481 if (*pixmap == 0)
6483 x_destroy_x_image (*ximg);
6484 *ximg = NULL;
6485 image_error ("Unable to create X pixmap", Qnil, Qnil);
6486 return 0;
6489 return 1;
6493 /* Destroy XImage XIMG. Free XIMG->data. */
6495 static void
6496 x_destroy_x_image (ximg)
6497 XImage *ximg;
6499 xassert (interrupt_input_blocked);
6500 if (ximg)
6502 xfree (ximg->data);
6503 ximg->data = NULL;
6504 XDestroyImage (ximg);
6509 /* Put XImage XIMG into pixmap PIXMAP on frame F. WIDTH and HEIGHT
6510 are width and height of both the image and pixmap. */
6512 static void
6513 x_put_x_image (f, ximg, pixmap, width, height)
6514 struct frame *f;
6515 XImage *ximg;
6516 Pixmap pixmap;
6518 GC gc;
6520 xassert (interrupt_input_blocked);
6521 gc = XCreateGC (FRAME_X_DISPLAY (f), pixmap, 0, NULL);
6522 XPutImage (FRAME_X_DISPLAY (f), pixmap, gc, ximg, 0, 0, 0, 0, width, height);
6523 XFreeGC (FRAME_X_DISPLAY (f), gc);
6528 /***********************************************************************
6529 Searching files
6530 ***********************************************************************/
6532 static Lisp_Object x_find_image_file P_ ((Lisp_Object));
6534 /* Find image file FILE. Look in data-directory, then
6535 x-bitmap-file-path. Value is the full name of the file found, or
6536 nil if not found. */
6538 static Lisp_Object
6539 x_find_image_file (file)
6540 Lisp_Object file;
6542 Lisp_Object file_found, search_path;
6543 struct gcpro gcpro1, gcpro2;
6544 int fd;
6546 file_found = Qnil;
6547 search_path = Fcons (Vdata_directory, Vx_bitmap_file_path);
6548 GCPRO2 (file_found, search_path);
6550 /* Try to find FILE in data-directory, then x-bitmap-file-path. */
6551 fd = openp (search_path, file, "", &file_found, 0);
6553 if (fd < 0)
6554 file_found = Qnil;
6555 else
6556 close (fd);
6558 UNGCPRO;
6559 return file_found;
6564 /***********************************************************************
6565 XBM images
6566 ***********************************************************************/
6568 static int xbm_load P_ ((struct frame *f, struct image *img));
6569 static int xbm_load_image_from_file P_ ((struct frame *f, struct image *img,
6570 Lisp_Object file));
6571 static int xbm_image_p P_ ((Lisp_Object object));
6572 static int xbm_read_bitmap_file_data P_ ((char *, int *, int *,
6573 unsigned char **));
6576 /* Indices of image specification fields in xbm_format, below. */
6578 enum xbm_keyword_index
6580 XBM_TYPE,
6581 XBM_FILE,
6582 XBM_WIDTH,
6583 XBM_HEIGHT,
6584 XBM_DATA,
6585 XBM_FOREGROUND,
6586 XBM_BACKGROUND,
6587 XBM_ASCENT,
6588 XBM_MARGIN,
6589 XBM_RELIEF,
6590 XBM_ALGORITHM,
6591 XBM_HEURISTIC_MASK,
6592 XBM_LAST
6595 /* Vector of image_keyword structures describing the format
6596 of valid XBM image specifications. */
6598 static struct image_keyword xbm_format[XBM_LAST] =
6600 {":type", IMAGE_SYMBOL_VALUE, 1},
6601 {":file", IMAGE_STRING_VALUE, 0},
6602 {":width", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6603 {":height", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6604 {":data", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6605 {":foreground", IMAGE_STRING_VALUE, 0},
6606 {":background", IMAGE_STRING_VALUE, 0},
6607 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
6608 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
6609 {":relief", IMAGE_INTEGER_VALUE, 0},
6610 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
6611 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
6614 /* Structure describing the image type XBM. */
6616 static struct image_type xbm_type =
6618 &Qxbm,
6619 xbm_image_p,
6620 xbm_load,
6621 x_clear_image,
6622 NULL
6625 /* Tokens returned from xbm_scan. */
6627 enum xbm_token
6629 XBM_TK_IDENT = 256,
6630 XBM_TK_NUMBER
6634 /* Return non-zero if OBJECT is a valid XBM-type image specification.
6635 A valid specification is a list starting with the symbol `image'
6636 The rest of the list is a property list which must contain an
6637 entry `:type xbm..
6639 If the specification specifies a file to load, it must contain
6640 an entry `:file FILENAME' where FILENAME is a string.
6642 If the specification is for a bitmap loaded from memory it must
6643 contain `:width WIDTH', `:height HEIGHT', and `:data DATA', where
6644 WIDTH and HEIGHT are integers > 0. DATA may be:
6646 1. a string large enough to hold the bitmap data, i.e. it must
6647 have a size >= (WIDTH + 7) / 8 * HEIGHT
6649 2. a bool-vector of size >= WIDTH * HEIGHT
6651 3. a vector of strings or bool-vectors, one for each line of the
6652 bitmap.
6654 Both the file and data forms may contain the additional entries
6655 `:background COLOR' and `:foreground COLOR'. If not present,
6656 foreground and background of the frame on which the image is
6657 displayed, is used. */
6659 static int
6660 xbm_image_p (object)
6661 Lisp_Object object;
6663 struct image_keyword kw[XBM_LAST];
6665 bcopy (xbm_format, kw, sizeof kw);
6666 if (!parse_image_spec (object, kw, XBM_LAST, Qxbm))
6667 return 0;
6669 xassert (EQ (kw[XBM_TYPE].value, Qxbm));
6671 if (kw[XBM_FILE].count)
6673 if (kw[XBM_WIDTH].count || kw[XBM_HEIGHT].count || kw[XBM_DATA].count)
6674 return 0;
6676 else
6678 Lisp_Object data;
6679 int width, height;
6681 /* Entries for `:width', `:height' and `:data' must be present. */
6682 if (!kw[XBM_WIDTH].count
6683 || !kw[XBM_HEIGHT].count
6684 || !kw[XBM_DATA].count)
6685 return 0;
6687 data = kw[XBM_DATA].value;
6688 width = XFASTINT (kw[XBM_WIDTH].value);
6689 height = XFASTINT (kw[XBM_HEIGHT].value);
6691 /* Check type of data, and width and height against contents of
6692 data. */
6693 if (VECTORP (data))
6695 int i;
6697 /* Number of elements of the vector must be >= height. */
6698 if (XVECTOR (data)->size < height)
6699 return 0;
6701 /* Each string or bool-vector in data must be large enough
6702 for one line of the image. */
6703 for (i = 0; i < height; ++i)
6705 Lisp_Object elt = XVECTOR (data)->contents[i];
6707 if (STRINGP (elt))
6709 if (XSTRING (elt)->size
6710 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR)
6711 return 0;
6713 else if (BOOL_VECTOR_P (elt))
6715 if (XBOOL_VECTOR (elt)->size < width)
6716 return 0;
6718 else
6719 return 0;
6722 else if (STRINGP (data))
6724 if (XSTRING (data)->size
6725 < (width + BITS_PER_CHAR - 1) / BITS_PER_CHAR * height)
6726 return 0;
6728 else if (BOOL_VECTOR_P (data))
6730 if (XBOOL_VECTOR (data)->size < width * height)
6731 return 0;
6733 else
6734 return 0;
6737 /* Baseline must be a value between 0 and 100 (a percentage). */
6738 if (kw[XBM_ASCENT].count
6739 && XFASTINT (kw[XBM_ASCENT].value) > 100)
6740 return 0;
6742 return 1;
6746 /* Scan a bitmap file. FP is the stream to read from. Value is
6747 either an enumerator from enum xbm_token, or a character for a
6748 single-character token, or 0 at end of file. If scanning an
6749 identifier, store the lexeme of the identifier in SVAL. If
6750 scanning a number, store its value in *IVAL. */
6752 static int
6753 xbm_scan (fp, sval, ival)
6754 FILE *fp;
6755 char *sval;
6756 int *ival;
6758 int c;
6760 /* Skip white space. */
6761 while ((c = fgetc (fp)) != EOF && isspace (c))
6764 if (c == EOF)
6765 c = 0;
6766 else if (isdigit (c))
6768 int value = 0, digit;
6770 if (c == '0')
6772 c = fgetc (fp);
6773 if (c == 'x' || c == 'X')
6775 while ((c = fgetc (fp)) != EOF)
6777 if (isdigit (c))
6778 digit = c - '0';
6779 else if (c >= 'a' && c <= 'f')
6780 digit = c - 'a' + 10;
6781 else if (c >= 'A' && c <= 'F')
6782 digit = c - 'A' + 10;
6783 else
6784 break;
6785 value = 16 * value + digit;
6788 else if (isdigit (c))
6790 value = c - '0';
6791 while ((c = fgetc (fp)) != EOF
6792 && isdigit (c))
6793 value = 8 * value + c - '0';
6796 else
6798 value = c - '0';
6799 while ((c = fgetc (fp)) != EOF
6800 && isdigit (c))
6801 value = 10 * value + c - '0';
6804 if (c != EOF)
6805 ungetc (c, fp);
6806 *ival = value;
6807 c = XBM_TK_NUMBER;
6809 else if (isalpha (c) || c == '_')
6811 *sval++ = c;
6812 while ((c = fgetc (fp)) != EOF
6813 && (isalnum (c) || c == '_'))
6814 *sval++ = c;
6815 *sval = 0;
6816 if (c != EOF)
6817 ungetc (c, fp);
6818 c = XBM_TK_IDENT;
6821 return c;
6825 /* Replacement for XReadBitmapFileData which isn't available under old
6826 X versions. FILE is the name of the bitmap file to read. Set
6827 *WIDTH and *HEIGHT to the width and height of the image. Return in
6828 *DATA the bitmap data allocated with xmalloc. Value is non-zero if
6829 successful. */
6831 static int
6832 xbm_read_bitmap_file_data (file, width, height, data)
6833 char *file;
6834 int *width, *height;
6835 unsigned char **data;
6837 FILE *fp;
6838 char buffer[BUFSIZ];
6839 int padding_p = 0;
6840 int v10 = 0;
6841 int bytes_per_line, i, nbytes;
6842 unsigned char *p;
6843 int value;
6844 int LA1;
6846 #define match() \
6847 LA1 = xbm_scan (fp, buffer, &value)
6849 #define expect(TOKEN) \
6850 if (LA1 != (TOKEN)) \
6851 goto failure; \
6852 else \
6853 match ()
6855 #define expect_ident(IDENT) \
6856 if (LA1 == XBM_TK_IDENT && strcmp (buffer, (IDENT)) == 0) \
6857 match (); \
6858 else \
6859 goto failure
6861 fp = fopen (file, "r");
6862 if (fp == NULL)
6863 return 0;
6865 *width = *height = -1;
6866 *data = NULL;
6867 LA1 = xbm_scan (fp, buffer, &value);
6869 /* Parse defines for width, height and hot-spots. */
6870 while (LA1 == '#')
6872 match ();
6873 expect_ident ("define");
6874 expect (XBM_TK_IDENT);
6876 if (LA1 == XBM_TK_NUMBER);
6878 char *p = strrchr (buffer, '_');
6879 p = p ? p + 1 : buffer;
6880 if (strcmp (p, "width") == 0)
6881 *width = value;
6882 else if (strcmp (p, "height") == 0)
6883 *height = value;
6885 expect (XBM_TK_NUMBER);
6888 if (*width < 0 || *height < 0)
6889 goto failure;
6891 /* Parse bits. Must start with `static'. */
6892 expect_ident ("static");
6893 if (LA1 == XBM_TK_IDENT)
6895 if (strcmp (buffer, "unsigned") == 0)
6897 match ();
6898 expect_ident ("char");
6900 else if (strcmp (buffer, "short") == 0)
6902 match ();
6903 v10 = 1;
6904 if (*width % 16 && *width % 16 < 9)
6905 padding_p = 1;
6907 else if (strcmp (buffer, "char") == 0)
6908 match ();
6909 else
6910 goto failure;
6912 else
6913 goto failure;
6915 expect (XBM_TK_IDENT);
6916 expect ('[');
6917 expect (']');
6918 expect ('=');
6919 expect ('{');
6921 bytes_per_line = (*width + 7) / 8 + padding_p;
6922 nbytes = bytes_per_line * *height;
6923 p = *data = (char *) xmalloc (nbytes);
6925 if (v10)
6928 for (i = 0; i < nbytes; i += 2)
6930 int val = value;
6931 expect (XBM_TK_NUMBER);
6933 *p++ = val;
6934 if (!padding_p || ((i + 2) % bytes_per_line))
6935 *p++ = value >> 8;
6937 if (LA1 == ',' || LA1 == '}')
6938 match ();
6939 else
6940 goto failure;
6943 else
6945 for (i = 0; i < nbytes; ++i)
6947 int val = value;
6948 expect (XBM_TK_NUMBER);
6950 *p++ = val;
6952 if (LA1 == ',' || LA1 == '}')
6953 match ();
6954 else
6955 goto failure;
6959 fclose (fp);
6960 return 1;
6962 failure:
6964 fclose (fp);
6965 if (*data)
6967 xfree (*data);
6968 *data = NULL;
6970 return 0;
6972 #undef match
6973 #undef expect
6974 #undef expect_ident
6978 /* Load XBM image IMG which will be displayed on frame F from file
6979 SPECIFIED_FILE. Value is non-zero if successful. */
6981 static int
6982 xbm_load_image_from_file (f, img, specified_file)
6983 struct frame *f;
6984 struct image *img;
6985 Lisp_Object specified_file;
6987 int rc;
6988 unsigned char *data;
6989 int success_p = 0;
6990 Lisp_Object file;
6991 struct gcpro gcpro1;
6993 xassert (STRINGP (specified_file));
6994 file = Qnil;
6995 GCPRO1 (file);
6997 file = x_find_image_file (specified_file);
6998 if (!STRINGP (file))
7000 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7001 UNGCPRO;
7002 return 0;
7005 rc = xbm_read_bitmap_file_data (XSTRING (file)->data, &img->width,
7006 &img->height, &data);
7007 if (rc)
7009 int depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7010 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7011 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7012 Lisp_Object value;
7014 xassert (img->width > 0 && img->height > 0);
7016 /* Get foreground and background colors, maybe allocate colors. */
7017 value = image_spec_value (img->spec, QCforeground, NULL);
7018 if (!NILP (value))
7019 foreground = x_alloc_image_color (f, img, value, foreground);
7021 value = image_spec_value (img->spec, QCbackground, NULL);
7022 if (!NILP (value))
7023 background = x_alloc_image_color (f, img, value, background);
7025 BLOCK_INPUT;
7026 img->pixmap
7027 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7028 FRAME_X_WINDOW (f),
7029 data,
7030 img->width, img->height,
7031 foreground, background,
7032 depth);
7033 xfree (data);
7035 if (img->pixmap == 0)
7037 x_clear_image (f, img);
7038 image_error ("Unable to create X pixmap for `%s'", file, Qnil);
7040 else
7041 success_p = 1;
7043 UNBLOCK_INPUT;
7045 else
7046 image_error ("Error loading XBM image `%s'", img->spec, Qnil);
7048 UNGCPRO;
7049 return success_p;
7053 /* Fill image IMG which is used on frame F with pixmap data. Value is
7054 non-zero if successful. */
7056 static int
7057 xbm_load (f, img)
7058 struct frame *f;
7059 struct image *img;
7061 int success_p = 0;
7062 Lisp_Object file_name;
7064 xassert (xbm_image_p (img->spec));
7066 /* If IMG->spec specifies a file name, create a non-file spec from it. */
7067 file_name = image_spec_value (img->spec, QCfile, NULL);
7068 if (STRINGP (file_name))
7069 success_p = xbm_load_image_from_file (f, img, file_name);
7070 else
7072 struct image_keyword fmt[XBM_LAST];
7073 Lisp_Object data;
7074 int depth;
7075 unsigned long foreground = FRAME_FOREGROUND_PIXEL (f);
7076 unsigned long background = FRAME_BACKGROUND_PIXEL (f);
7077 char *bits;
7078 int parsed_p;
7080 /* Parse the list specification. */
7081 bcopy (xbm_format, fmt, sizeof fmt);
7082 parsed_p = parse_image_spec (img->spec, fmt, XBM_LAST, Qxbm);
7083 xassert (parsed_p);
7085 /* Get specified width, and height. */
7086 img->width = XFASTINT (fmt[XBM_WIDTH].value);
7087 img->height = XFASTINT (fmt[XBM_HEIGHT].value);
7088 xassert (img->width > 0 && img->height > 0);
7090 BLOCK_INPUT;
7092 if (fmt[XBM_ASCENT].count)
7093 img->ascent = XFASTINT (fmt[XBM_ASCENT].value);
7095 /* Get foreground and background colors, maybe allocate colors. */
7096 if (fmt[XBM_FOREGROUND].count)
7097 foreground = x_alloc_image_color (f, img, fmt[XBM_FOREGROUND].value,
7098 foreground);
7099 if (fmt[XBM_BACKGROUND].count)
7100 background = x_alloc_image_color (f, img, fmt[XBM_BACKGROUND].value,
7101 background);
7103 /* Set bits to the bitmap image data. */
7104 data = fmt[XBM_DATA].value;
7105 if (VECTORP (data))
7107 int i;
7108 char *p;
7109 int nbytes = (img->width + BITS_PER_CHAR - 1) / BITS_PER_CHAR;
7111 p = bits = (char *) alloca (nbytes * img->height);
7112 for (i = 0; i < img->height; ++i, p += nbytes)
7114 Lisp_Object line = XVECTOR (data)->contents[i];
7115 if (STRINGP (line))
7116 bcopy (XSTRING (line)->data, p, nbytes);
7117 else
7118 bcopy (XBOOL_VECTOR (line)->data, p, nbytes);
7121 else if (STRINGP (data))
7122 bits = XSTRING (data)->data;
7123 else
7124 bits = XBOOL_VECTOR (data)->data;
7126 /* Create the pixmap. */
7127 depth = DefaultDepthOfScreen (FRAME_X_SCREEN (f));
7128 img->pixmap
7129 = XCreatePixmapFromBitmapData (FRAME_X_DISPLAY (f),
7130 FRAME_X_WINDOW (f),
7131 bits,
7132 img->width, img->height,
7133 foreground, background,
7134 depth);
7135 if (img->pixmap)
7136 success_p = 1;
7137 else
7139 image_error ("Unable to create pixmap for XBM image `%s'",
7140 img->spec, Qnil);
7141 x_clear_image (f, img);
7144 UNBLOCK_INPUT;
7147 return success_p;
7152 /***********************************************************************
7153 XPM images
7154 ***********************************************************************/
7156 #if HAVE_XPM
7158 static int xpm_image_p P_ ((Lisp_Object object));
7159 static int xpm_load P_ ((struct frame *f, struct image *img));
7160 static int xpm_valid_color_symbols_p P_ ((Lisp_Object));
7162 #include "X11/xpm.h"
7164 /* The symbol `xpm' identifying XPM-format images. */
7166 Lisp_Object Qxpm;
7168 /* Indices of image specification fields in xpm_format, below. */
7170 enum xpm_keyword_index
7172 XPM_TYPE,
7173 XPM_FILE,
7174 XPM_DATA,
7175 XPM_ASCENT,
7176 XPM_MARGIN,
7177 XPM_RELIEF,
7178 XPM_ALGORITHM,
7179 XPM_HEURISTIC_MASK,
7180 XPM_COLOR_SYMBOLS,
7181 XPM_LAST
7184 /* Vector of image_keyword structures describing the format
7185 of valid XPM image specifications. */
7187 static struct image_keyword xpm_format[XPM_LAST] =
7189 {":type", IMAGE_SYMBOL_VALUE, 1},
7190 {":file", IMAGE_STRING_VALUE, 0},
7191 {":data", IMAGE_STRING_VALUE, 0},
7192 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7193 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7194 {":relief", IMAGE_INTEGER_VALUE, 0},
7195 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7196 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7197 {":color-symbols", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7200 /* Structure describing the image type XBM. */
7202 static struct image_type xpm_type =
7204 &Qxpm,
7205 xpm_image_p,
7206 xpm_load,
7207 x_clear_image,
7208 NULL
7212 /* Value is non-zero if COLOR_SYMBOLS is a valid color symbols list
7213 for XPM images. Such a list must consist of conses whose car and
7214 cdr are strings. */
7216 static int
7217 xpm_valid_color_symbols_p (color_symbols)
7218 Lisp_Object color_symbols;
7220 while (CONSP (color_symbols))
7222 Lisp_Object sym = XCAR (color_symbols);
7223 if (!CONSP (sym)
7224 || !STRINGP (XCAR (sym))
7225 || !STRINGP (XCDR (sym)))
7226 break;
7227 color_symbols = XCDR (color_symbols);
7230 return NILP (color_symbols);
7234 /* Value is non-zero if OBJECT is a valid XPM image specification. */
7236 static int
7237 xpm_image_p (object)
7238 Lisp_Object object;
7240 struct image_keyword fmt[XPM_LAST];
7241 bcopy (xpm_format, fmt, sizeof fmt);
7242 return (parse_image_spec (object, fmt, XPM_LAST, Qxpm)
7243 /* Either `:file' or `:data' must be present. */
7244 && fmt[XPM_FILE].count + fmt[XPM_DATA].count == 1
7245 /* Either no `:color-symbols' or it's a list of conses
7246 whose car and cdr are strings. */
7247 && (fmt[XPM_COLOR_SYMBOLS].count == 0
7248 || xpm_valid_color_symbols_p (fmt[XPM_COLOR_SYMBOLS].value))
7249 && (fmt[XPM_ASCENT].count == 0
7250 || XFASTINT (fmt[XPM_ASCENT].value) < 100));
7254 /* Load image IMG which will be displayed on frame F. Value is
7255 non-zero if successful. */
7257 static int
7258 xpm_load (f, img)
7259 struct frame *f;
7260 struct image *img;
7262 int rc, i;
7263 XpmAttributes attrs;
7264 Lisp_Object specified_file, color_symbols;
7266 /* Configure the XPM lib. Use the visual of frame F. Allocate
7267 close colors. Return colors allocated. */
7268 bzero (&attrs, sizeof attrs);
7269 attrs.visual = FRAME_X_DISPLAY_INFO (f)->visual;
7270 attrs.valuemask |= XpmVisual;
7271 attrs.valuemask |= XpmReturnAllocPixels;
7272 #ifdef XpmAllocCloseColors
7273 attrs.alloc_close_colors = 1;
7274 attrs.valuemask |= XpmAllocCloseColors;
7275 #else
7276 attrs.closeness = 600;
7277 attrs.valuemask |= XpmCloseness;
7278 #endif
7280 /* If image specification contains symbolic color definitions, add
7281 these to `attrs'. */
7282 color_symbols = image_spec_value (img->spec, QCcolor_symbols, NULL);
7283 if (CONSP (color_symbols))
7285 Lisp_Object tail;
7286 XpmColorSymbol *xpm_syms;
7287 int i, size;
7289 attrs.valuemask |= XpmColorSymbols;
7291 /* Count number of symbols. */
7292 attrs.numsymbols = 0;
7293 for (tail = color_symbols; CONSP (tail); tail = XCDR (tail))
7294 ++attrs.numsymbols;
7296 /* Allocate an XpmColorSymbol array. */
7297 size = attrs.numsymbols * sizeof *xpm_syms;
7298 xpm_syms = (XpmColorSymbol *) alloca (size);
7299 bzero (xpm_syms, size);
7300 attrs.colorsymbols = xpm_syms;
7302 /* Fill the color symbol array. */
7303 for (tail = color_symbols, i = 0;
7304 CONSP (tail);
7305 ++i, tail = XCDR (tail))
7307 Lisp_Object name = XCAR (XCAR (tail));
7308 Lisp_Object color = XCDR (XCAR (tail));
7309 xpm_syms[i].name = (char *) alloca (XSTRING (name)->size + 1);
7310 strcpy (xpm_syms[i].name, XSTRING (name)->data);
7311 xpm_syms[i].value = (char *) alloca (XSTRING (color)->size + 1);
7312 strcpy (xpm_syms[i].value, XSTRING (color)->data);
7316 /* Create a pixmap for the image, either from a file, or from a
7317 string buffer containing data in the same format as an XPM file. */
7318 BLOCK_INPUT;
7319 specified_file = image_spec_value (img->spec, QCfile, NULL);
7320 if (STRINGP (specified_file))
7322 Lisp_Object file = x_find_image_file (specified_file);
7323 if (!STRINGP (file))
7325 image_error ("Cannot find image file `%s'", specified_file, Qnil);
7326 UNBLOCK_INPUT;
7327 return 0;
7330 rc = XpmReadFileToPixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7331 XSTRING (file)->data, &img->pixmap, &img->mask,
7332 &attrs);
7334 else
7336 Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL);
7337 rc = XpmCreatePixmapFromBuffer (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
7338 XSTRING (buffer)->data,
7339 &img->pixmap, &img->mask,
7340 &attrs);
7342 UNBLOCK_INPUT;
7344 if (rc == XpmSuccess)
7346 /* Remember allocated colors. */
7347 img->ncolors = attrs.nalloc_pixels;
7348 img->colors = (unsigned long *) xmalloc (img->ncolors
7349 * sizeof *img->colors);
7350 for (i = 0; i < attrs.nalloc_pixels; ++i)
7351 img->colors[i] = attrs.alloc_pixels[i];
7353 img->width = attrs.width;
7354 img->height = attrs.height;
7355 xassert (img->width > 0 && img->height > 0);
7357 /* The call to XpmFreeAttributes below frees attrs.alloc_pixels. */
7358 BLOCK_INPUT;
7359 XpmFreeAttributes (&attrs);
7360 UNBLOCK_INPUT;
7362 else
7364 switch (rc)
7366 case XpmOpenFailed:
7367 image_error ("Error opening XPM file (%s)", img->spec, Qnil);
7368 break;
7370 case XpmFileInvalid:
7371 image_error ("Invalid XPM file (%s)", img->spec, Qnil);
7372 break;
7374 case XpmNoMemory:
7375 image_error ("Out of memory (%s)", img->spec, Qnil);
7376 break;
7378 case XpmColorFailed:
7379 image_error ("Color allocation error (%s)", img->spec, Qnil);
7380 break;
7382 default:
7383 image_error ("Unknown error (%s)", img->spec, Qnil);
7384 break;
7388 return rc == XpmSuccess;
7391 #endif /* HAVE_XPM != 0 */
7394 /***********************************************************************
7395 Color table
7396 ***********************************************************************/
7398 /* An entry in the color table mapping an RGB color to a pixel color. */
7400 struct ct_color
7402 int r, g, b;
7403 unsigned long pixel;
7405 /* Next in color table collision list. */
7406 struct ct_color *next;
7409 /* The bucket vector size to use. Must be prime. */
7411 #define CT_SIZE 101
7413 /* Value is a hash of the RGB color given by R, G, and B. */
7415 #define CT_HASH_RGB(R, G, B) (((R) << 16) ^ ((G) << 8) ^ (B))
7417 /* The color hash table. */
7419 struct ct_color **ct_table;
7421 /* Number of entries in the color table. */
7423 int ct_colors_allocated;
7425 /* Function prototypes. */
7427 static void init_color_table P_ ((void));
7428 static void free_color_table P_ ((void));
7429 static unsigned long *colors_in_color_table P_ ((int *n));
7430 static unsigned long lookup_rgb_color P_ ((struct frame *f, int r, int g, int b));
7431 static unsigned long lookup_pixel_color P_ ((struct frame *f, unsigned long p));
7434 /* Initialize the color table. */
7436 static void
7437 init_color_table ()
7439 int size = CT_SIZE * sizeof (*ct_table);
7440 ct_table = (struct ct_color **) xmalloc (size);
7441 bzero (ct_table, size);
7442 ct_colors_allocated = 0;
7446 /* Free memory associated with the color table. */
7448 static void
7449 free_color_table ()
7451 int i;
7452 struct ct_color *p, *next;
7454 for (i = 0; i < CT_SIZE; ++i)
7455 for (p = ct_table[i]; p; p = next)
7457 next = p->next;
7458 xfree (p);
7461 xfree (ct_table);
7462 ct_table = NULL;
7466 /* Value is a pixel color for RGB color R, G, B on frame F. If an
7467 entry for that color already is in the color table, return the
7468 pixel color of that entry. Otherwise, allocate a new color for R,
7469 G, B, and make an entry in the color table. */
7471 static unsigned long
7472 lookup_rgb_color (f, r, g, b)
7473 struct frame *f;
7474 int r, g, b;
7476 unsigned hash = CT_HASH_RGB (r, g, b);
7477 int i = hash % CT_SIZE;
7478 struct ct_color *p;
7480 for (p = ct_table[i]; p; p = p->next)
7481 if (p->r == r && p->g == g && p->b == b)
7482 break;
7484 if (p == NULL)
7486 XColor color;
7487 Colormap cmap;
7488 int rc;
7490 color.red = r;
7491 color.green = g;
7492 color.blue = b;
7494 BLOCK_INPUT;
7495 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7496 rc = x_alloc_nearest_color (f, cmap, &color);
7497 UNBLOCK_INPUT;
7499 if (rc)
7501 ++ct_colors_allocated;
7503 p = (struct ct_color *) xmalloc (sizeof *p);
7504 p->r = r;
7505 p->g = g;
7506 p->b = b;
7507 p->pixel = color.pixel;
7508 p->next = ct_table[i];
7509 ct_table[i] = p;
7511 else
7512 return FRAME_FOREGROUND_PIXEL (f);
7515 return p->pixel;
7519 /* Look up pixel color PIXEL which is used on frame F in the color
7520 table. If not already present, allocate it. Value is PIXEL. */
7522 static unsigned long
7523 lookup_pixel_color (f, pixel)
7524 struct frame *f;
7525 unsigned long pixel;
7527 int i = pixel % CT_SIZE;
7528 struct ct_color *p;
7530 for (p = ct_table[i]; p; p = p->next)
7531 if (p->pixel == pixel)
7532 break;
7534 if (p == NULL)
7536 XColor color;
7537 Colormap cmap;
7538 int rc;
7540 BLOCK_INPUT;
7542 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7543 color.pixel = pixel;
7544 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
7545 rc = x_alloc_nearest_color (f, cmap, &color);
7546 UNBLOCK_INPUT;
7548 if (rc)
7550 ++ct_colors_allocated;
7552 p = (struct ct_color *) xmalloc (sizeof *p);
7553 p->r = color.red;
7554 p->g = color.green;
7555 p->b = color.blue;
7556 p->pixel = pixel;
7557 p->next = ct_table[i];
7558 ct_table[i] = p;
7560 else
7561 return FRAME_FOREGROUND_PIXEL (f);
7564 return p->pixel;
7568 /* Value is a vector of all pixel colors contained in the color table,
7569 allocated via xmalloc. Set *N to the number of colors. */
7571 static unsigned long *
7572 colors_in_color_table (n)
7573 int *n;
7575 int i, j;
7576 struct ct_color *p;
7577 unsigned long *colors;
7579 if (ct_colors_allocated == 0)
7581 *n = 0;
7582 colors = NULL;
7584 else
7586 colors = (unsigned long *) xmalloc (ct_colors_allocated
7587 * sizeof *colors);
7588 *n = ct_colors_allocated;
7590 for (i = j = 0; i < CT_SIZE; ++i)
7591 for (p = ct_table[i]; p; p = p->next)
7592 colors[j++] = p->pixel;
7595 return colors;
7600 /***********************************************************************
7601 Algorithms
7602 ***********************************************************************/
7604 static void x_laplace_write_row P_ ((struct frame *, long *,
7605 int, XImage *, int));
7606 static void x_laplace_read_row P_ ((struct frame *, Colormap,
7607 XColor *, int, XImage *, int));
7610 /* Fill COLORS with RGB colors from row Y of image XIMG. F is the
7611 frame we operate on, CMAP is the color-map in effect, and WIDTH is
7612 the width of one row in the image. */
7614 static void
7615 x_laplace_read_row (f, cmap, colors, width, ximg, y)
7616 struct frame *f;
7617 Colormap cmap;
7618 XColor *colors;
7619 int width;
7620 XImage *ximg;
7621 int y;
7623 int x;
7625 for (x = 0; x < width; ++x)
7626 colors[x].pixel = XGetPixel (ximg, x, y);
7628 XQueryColors (FRAME_X_DISPLAY (f), cmap, colors, width);
7632 /* Write row Y of image XIMG. PIXELS is an array of WIDTH longs
7633 containing the pixel colors to write. F is the frame we are
7634 working on. */
7636 static void
7637 x_laplace_write_row (f, pixels, width, ximg, y)
7638 struct frame *f;
7639 long *pixels;
7640 int width;
7641 XImage *ximg;
7642 int y;
7644 int x;
7646 for (x = 0; x < width; ++x)
7647 XPutPixel (ximg, x, y, pixels[x]);
7651 /* Transform image IMG which is used on frame F with a Laplace
7652 edge-detection algorithm. The result is an image that can be used
7653 to draw disabled buttons, for example. */
7655 static void
7656 x_laplace (f, img)
7657 struct frame *f;
7658 struct image *img;
7660 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7661 XImage *ximg, *oimg;
7662 XColor *in[3];
7663 long *out;
7664 Pixmap pixmap;
7665 int x, y, i;
7666 long pixel;
7667 int in_y, out_y, rc;
7668 int mv2 = 45000;
7670 BLOCK_INPUT;
7672 /* Get the X image IMG->pixmap. */
7673 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
7674 0, 0, img->width, img->height, ~0, ZPixmap);
7676 /* Allocate 3 input rows, and one output row of colors. */
7677 for (i = 0; i < 3; ++i)
7678 in[i] = (XColor *) alloca (img->width * sizeof (XColor));
7679 out = (long *) alloca (img->width * sizeof (long));
7681 /* Create an X image for output. */
7682 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 0,
7683 &oimg, &pixmap);
7685 /* Fill first two rows. */
7686 x_laplace_read_row (f, cmap, in[0], img->width, ximg, 0);
7687 x_laplace_read_row (f, cmap, in[1], img->width, ximg, 1);
7688 in_y = 2;
7690 /* Write first row, all zeros. */
7691 init_color_table ();
7692 pixel = lookup_rgb_color (f, 0, 0, 0);
7693 for (x = 0; x < img->width; ++x)
7694 out[x] = pixel;
7695 x_laplace_write_row (f, out, img->width, oimg, 0);
7696 out_y = 1;
7698 for (y = 2; y < img->height; ++y)
7700 int rowa = y % 3;
7701 int rowb = (y + 2) % 3;
7703 x_laplace_read_row (f, cmap, in[rowa], img->width, ximg, in_y++);
7705 for (x = 0; x < img->width - 2; ++x)
7707 int r = in[rowa][x].red + mv2 - in[rowb][x + 2].red;
7708 int g = in[rowa][x].green + mv2 - in[rowb][x + 2].green;
7709 int b = in[rowa][x].blue + mv2 - in[rowb][x + 2].blue;
7711 out[x + 1] = lookup_rgb_color (f, r & 0xffff, g & 0xffff,
7712 b & 0xffff);
7715 x_laplace_write_row (f, out, img->width, oimg, out_y++);
7718 /* Write last line, all zeros. */
7719 for (x = 0; x < img->width; ++x)
7720 out[x] = pixel;
7721 x_laplace_write_row (f, out, img->width, oimg, out_y);
7723 /* Free the input image, and free resources of IMG. */
7724 XDestroyImage (ximg);
7725 x_clear_image (f, img);
7727 /* Put the output image into pixmap, and destroy it. */
7728 x_put_x_image (f, oimg, pixmap, img->width, img->height);
7729 x_destroy_x_image (oimg);
7731 /* Remember new pixmap and colors in IMG. */
7732 img->pixmap = pixmap;
7733 img->colors = colors_in_color_table (&img->ncolors);
7734 free_color_table ();
7736 UNBLOCK_INPUT;
7740 /* Build a mask for image IMG which is used on frame F. FILE is the
7741 name of an image file, for error messages. HOW determines how to
7742 determine the background color of IMG. If it is a list '(R G B)',
7743 with R, G, and B being integers >= 0, take that as the color of the
7744 background. Otherwise, determine the background color of IMG
7745 heuristically. Value is non-zero if successful. */
7747 static int
7748 x_build_heuristic_mask (f, img, how)
7749 struct frame *f;
7750 struct image *img;
7751 Lisp_Object how;
7753 Display *dpy = FRAME_X_DISPLAY (f);
7754 XImage *ximg, *mask_img;
7755 int x, y, rc, look_at_corners_p;
7756 unsigned long bg;
7758 BLOCK_INPUT;
7760 /* Create an image and pixmap serving as mask. */
7761 rc = x_create_x_image_and_pixmap (f, img->width, img->height, 1,
7762 &mask_img, &img->mask);
7763 if (!rc)
7765 UNBLOCK_INPUT;
7766 return 0;
7769 /* Get the X image of IMG->pixmap. */
7770 ximg = XGetImage (dpy, img->pixmap, 0, 0, img->width, img->height,
7771 ~0, ZPixmap);
7773 /* Determine the background color of ximg. If HOW is `(R G B)'
7774 take that as color. Otherwise, try to determine the color
7775 heuristically. */
7776 look_at_corners_p = 1;
7778 if (CONSP (how))
7780 int rgb[3], i = 0;
7782 while (i < 3
7783 && CONSP (how)
7784 && NATNUMP (XCAR (how)))
7786 rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
7787 how = XCDR (how);
7790 if (i == 3 && NILP (how))
7792 char color_name[30];
7793 XColor exact, color;
7794 Colormap cmap;
7796 sprintf (color_name, "#%04x%04x%04x", rgb[0], rgb[1], rgb[2]);
7798 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
7799 if (XLookupColor (dpy, cmap, color_name, &exact, &color))
7801 bg = color.pixel;
7802 look_at_corners_p = 0;
7807 if (look_at_corners_p)
7809 unsigned long corners[4];
7810 int i, best_count;
7812 /* Get the colors at the corners of ximg. */
7813 corners[0] = XGetPixel (ximg, 0, 0);
7814 corners[1] = XGetPixel (ximg, img->width - 1, 0);
7815 corners[2] = XGetPixel (ximg, img->width - 1, img->height - 1);
7816 corners[3] = XGetPixel (ximg, 0, img->height - 1);
7818 /* Choose the most frequently found color as background. */
7819 for (i = best_count = 0; i < 4; ++i)
7821 int j, n;
7823 for (j = n = 0; j < 4; ++j)
7824 if (corners[i] == corners[j])
7825 ++n;
7827 if (n > best_count)
7828 bg = corners[i], best_count = n;
7832 /* Set all bits in mask_img to 1 whose color in ximg is different
7833 from the background color bg. */
7834 for (y = 0; y < img->height; ++y)
7835 for (x = 0; x < img->width; ++x)
7836 XPutPixel (mask_img, x, y, XGetPixel (ximg, x, y) != bg);
7838 /* Put mask_img into img->mask. */
7839 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
7840 x_destroy_x_image (mask_img);
7841 XDestroyImage (ximg);
7843 UNBLOCK_INPUT;
7844 return 1;
7849 /***********************************************************************
7850 PBM (mono, gray, color)
7851 ***********************************************************************/
7853 static int pbm_image_p P_ ((Lisp_Object object));
7854 static int pbm_load P_ ((struct frame *f, struct image *img));
7855 static int pbm_scan_number P_ ((unsigned char **, unsigned char *));
7857 /* The symbol `pbm' identifying images of this type. */
7859 Lisp_Object Qpbm;
7861 /* Indices of image specification fields in gs_format, below. */
7863 enum pbm_keyword_index
7865 PBM_TYPE,
7866 PBM_FILE,
7867 PBM_DATA,
7868 PBM_ASCENT,
7869 PBM_MARGIN,
7870 PBM_RELIEF,
7871 PBM_ALGORITHM,
7872 PBM_HEURISTIC_MASK,
7873 PBM_LAST
7876 /* Vector of image_keyword structures describing the format
7877 of valid user-defined image specifications. */
7879 static struct image_keyword pbm_format[PBM_LAST] =
7881 {":type", IMAGE_SYMBOL_VALUE, 1},
7882 {":file", IMAGE_STRING_VALUE, 0},
7883 {":data", IMAGE_STRING_VALUE, 0},
7884 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
7885 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
7886 {":relief", IMAGE_INTEGER_VALUE, 0},
7887 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
7888 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
7891 /* Structure describing the image type `pbm'. */
7893 static struct image_type pbm_type =
7895 &Qpbm,
7896 pbm_image_p,
7897 pbm_load,
7898 x_clear_image,
7899 NULL
7903 /* Return non-zero if OBJECT is a valid PBM image specification. */
7905 static int
7906 pbm_image_p (object)
7907 Lisp_Object object;
7909 struct image_keyword fmt[PBM_LAST];
7911 bcopy (pbm_format, fmt, sizeof fmt);
7913 if (!parse_image_spec (object, fmt, PBM_LAST, Qpbm)
7914 || (fmt[PBM_ASCENT].count
7915 && XFASTINT (fmt[PBM_ASCENT].value) > 100))
7916 return 0;
7918 /* Must specify either :data or :file. */
7919 return fmt[PBM_DATA].count + fmt[PBM_FILE].count == 1;
7923 /* Scan a decimal number from *S and return it. Advance *S while
7924 reading the number. END is the end of the string. Value is -1 at
7925 end of input. */
7927 static int
7928 pbm_scan_number (s, end)
7929 unsigned char **s, *end;
7931 int c, val = -1;
7933 while (*s < end)
7935 /* Skip white-space. */
7936 while (*s < end && (c = *(*s)++, isspace (c)))
7939 if (c == '#')
7941 /* Skip comment to end of line. */
7942 while (*s < end && (c = *(*s)++, c != '\n'))
7945 else if (isdigit (c))
7947 /* Read decimal number. */
7948 val = c - '0';
7949 while (*s < end && (c = *(*s)++, isdigit (c)))
7950 val = 10 * val + c - '0';
7951 break;
7953 else
7954 break;
7957 return val;
7961 /* Read FILE into memory. Value is a pointer to a buffer allocated
7962 with xmalloc holding FILE's contents. Value is null if an error
7963 occured. *SIZE is set to the size of the file. */
7965 static char *
7966 pbm_read_file (file, size)
7967 Lisp_Object file;
7968 int *size;
7970 FILE *fp = NULL;
7971 char *buf = NULL;
7972 struct stat st;
7974 if (stat (XSTRING (file)->data, &st) == 0
7975 && (fp = fopen (XSTRING (file)->data, "r")) != NULL
7976 && (buf = (char *) xmalloc (st.st_size),
7977 fread (buf, 1, st.st_size, fp) == st.st_size))
7979 *size = st.st_size;
7980 fclose (fp);
7982 else
7984 if (fp)
7985 fclose (fp);
7986 if (buf)
7988 xfree (buf);
7989 buf = NULL;
7993 return buf;
7997 /* Load PBM image IMG for use on frame F. */
7999 static int
8000 pbm_load (f, img)
8001 struct frame *f;
8002 struct image *img;
8004 int raw_p, x, y;
8005 int width, height, max_color_idx = 0;
8006 XImage *ximg;
8007 Lisp_Object file, specified_file;
8008 enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type;
8009 struct gcpro gcpro1;
8010 unsigned char *contents = NULL;
8011 unsigned char *end, *p;
8012 int size;
8014 specified_file = image_spec_value (img->spec, QCfile, NULL);
8015 file = Qnil;
8016 GCPRO1 (file);
8018 if (STRINGP (specified_file))
8020 file = x_find_image_file (specified_file);
8021 if (!STRINGP (file))
8023 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8024 UNGCPRO;
8025 return 0;
8028 contents = pbm_read_file (file, &size);
8029 if (contents == NULL)
8031 image_error ("Error reading `%s'", file, Qnil);
8032 UNGCPRO;
8033 return 0;
8036 p = contents;
8037 end = contents + size;
8039 else
8041 Lisp_Object data;
8042 data = image_spec_value (img->spec, QCdata, NULL);
8043 p = XSTRING (data)->data;
8044 end = p + STRING_BYTES (XSTRING (data));
8047 /* Check magic number. */
8048 if (end - p < 2 || *p++ != 'P')
8050 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
8051 error:
8052 xfree (contents);
8053 UNGCPRO;
8054 return 0;
8057 switch (*p++)
8059 case '1':
8060 raw_p = 0, type = PBM_MONO;
8061 break;
8063 case '2':
8064 raw_p = 0, type = PBM_GRAY;
8065 break;
8067 case '3':
8068 raw_p = 0, type = PBM_COLOR;
8069 break;
8071 case '4':
8072 raw_p = 1, type = PBM_MONO;
8073 break;
8075 case '5':
8076 raw_p = 1, type = PBM_GRAY;
8077 break;
8079 case '6':
8080 raw_p = 1, type = PBM_COLOR;
8081 break;
8083 default:
8084 image_error ("Not a PBM image: `%s'", img->spec, Qnil);
8085 goto error;
8088 /* Read width, height, maximum color-component. Characters
8089 starting with `#' up to the end of a line are ignored. */
8090 width = pbm_scan_number (&p, end);
8091 height = pbm_scan_number (&p, end);
8093 if (type != PBM_MONO)
8095 max_color_idx = pbm_scan_number (&p, end);
8096 if (raw_p && max_color_idx > 255)
8097 max_color_idx = 255;
8100 if (width < 0
8101 || height < 0
8102 || (type != PBM_MONO && max_color_idx < 0))
8103 goto error;
8105 BLOCK_INPUT;
8106 if (!x_create_x_image_and_pixmap (f, width, height, 0,
8107 &ximg, &img->pixmap))
8109 UNBLOCK_INPUT;
8110 goto error;
8113 /* Initialize the color hash table. */
8114 init_color_table ();
8116 if (type == PBM_MONO)
8118 int c = 0, g;
8120 for (y = 0; y < height; ++y)
8121 for (x = 0; x < width; ++x)
8123 if (raw_p)
8125 if ((x & 7) == 0)
8126 c = *p++;
8127 g = c & 0x80;
8128 c <<= 1;
8130 else
8131 g = pbm_scan_number (&p, end);
8133 XPutPixel (ximg, x, y, (g
8134 ? FRAME_FOREGROUND_PIXEL (f)
8135 : FRAME_BACKGROUND_PIXEL (f)));
8138 else
8140 for (y = 0; y < height; ++y)
8141 for (x = 0; x < width; ++x)
8143 int r, g, b;
8145 if (type == PBM_GRAY)
8146 r = g = b = raw_p ? *p++ : pbm_scan_number (&p, end);
8147 else if (raw_p)
8149 r = *p++;
8150 g = *p++;
8151 b = *p++;
8153 else
8155 r = pbm_scan_number (&p, end);
8156 g = pbm_scan_number (&p, end);
8157 b = pbm_scan_number (&p, end);
8160 if (r < 0 || g < 0 || b < 0)
8162 xfree (ximg->data);
8163 ximg->data = NULL;
8164 XDestroyImage (ximg);
8165 UNBLOCK_INPUT;
8166 image_error ("Invalid pixel value in image `%s'",
8167 img->spec, Qnil);
8168 goto error;
8171 /* RGB values are now in the range 0..max_color_idx.
8172 Scale this to the range 0..0xffff supported by X. */
8173 r = (double) r * 65535 / max_color_idx;
8174 g = (double) g * 65535 / max_color_idx;
8175 b = (double) b * 65535 / max_color_idx;
8176 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8180 /* Store in IMG->colors the colors allocated for the image, and
8181 free the color table. */
8182 img->colors = colors_in_color_table (&img->ncolors);
8183 free_color_table ();
8185 /* Put the image into a pixmap. */
8186 x_put_x_image (f, ximg, img->pixmap, width, height);
8187 x_destroy_x_image (ximg);
8188 UNBLOCK_INPUT;
8190 img->width = width;
8191 img->height = height;
8193 UNGCPRO;
8194 xfree (contents);
8195 return 1;
8200 /***********************************************************************
8202 ***********************************************************************/
8204 #if HAVE_PNG
8206 #include <png.h>
8208 /* Function prototypes. */
8210 static int png_image_p P_ ((Lisp_Object object));
8211 static int png_load P_ ((struct frame *f, struct image *img));
8213 /* The symbol `png' identifying images of this type. */
8215 Lisp_Object Qpng;
8217 /* Indices of image specification fields in png_format, below. */
8219 enum png_keyword_index
8221 PNG_TYPE,
8222 PNG_DATA,
8223 PNG_FILE,
8224 PNG_ASCENT,
8225 PNG_MARGIN,
8226 PNG_RELIEF,
8227 PNG_ALGORITHM,
8228 PNG_HEURISTIC_MASK,
8229 PNG_LAST
8232 /* Vector of image_keyword structures describing the format
8233 of valid user-defined image specifications. */
8235 static struct image_keyword png_format[PNG_LAST] =
8237 {":type", IMAGE_SYMBOL_VALUE, 1},
8238 {":data", IMAGE_STRING_VALUE, 0},
8239 {":file", IMAGE_STRING_VALUE, 0},
8240 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8241 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8242 {":relief", IMAGE_INTEGER_VALUE, 0},
8243 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8244 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8247 /* Structure describing the image type `png'. */
8249 static struct image_type png_type =
8251 &Qpng,
8252 png_image_p,
8253 png_load,
8254 x_clear_image,
8255 NULL
8259 /* Return non-zero if OBJECT is a valid PNG image specification. */
8261 static int
8262 png_image_p (object)
8263 Lisp_Object object;
8265 struct image_keyword fmt[PNG_LAST];
8266 bcopy (png_format, fmt, sizeof fmt);
8268 if (!parse_image_spec (object, fmt, PNG_LAST, Qpng)
8269 || (fmt[PNG_ASCENT].count
8270 && XFASTINT (fmt[PNG_ASCENT].value) > 100))
8271 return 0;
8273 /* Must specify either the :data or :file keyword. */
8274 return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
8278 /* Error and warning handlers installed when the PNG library
8279 is initialized. */
8281 static void
8282 my_png_error (png_ptr, msg)
8283 png_struct *png_ptr;
8284 char *msg;
8286 xassert (png_ptr != NULL);
8287 image_error ("PNG error: %s", build_string (msg), Qnil);
8288 longjmp (png_ptr->jmpbuf, 1);
8292 static void
8293 my_png_warning (png_ptr, msg)
8294 png_struct *png_ptr;
8295 char *msg;
8297 xassert (png_ptr != NULL);
8298 image_error ("PNG warning: %s", build_string (msg), Qnil);
8301 /* Memory source for PNG decoding. */
8303 struct png_memory_storage
8305 unsigned char *bytes; /* The data */
8306 size_t len; /* How big is it? */
8307 int index; /* Where are we? */
8311 /* Function set as reader function when reading PNG image from memory.
8312 PNG_PTR is a pointer to the PNG control structure. Copy LENGTH
8313 bytes from the input to DATA. */
8315 static void
8316 png_read_from_memory (png_ptr, data, length)
8317 png_structp png_ptr;
8318 png_bytep data;
8319 png_size_t length;
8321 struct png_memory_storage *tbr
8322 = (struct png_memory_storage *) png_get_io_ptr (png_ptr);
8324 if (length > tbr->len - tbr->index)
8325 png_error (png_ptr, "Read error");
8327 bcopy (tbr->bytes + tbr->index, data, length);
8328 tbr->index = tbr->index + length;
8331 /* Load PNG image IMG for use on frame F. Value is non-zero if
8332 successful. */
8334 static int
8335 png_load (f, img)
8336 struct frame *f;
8337 struct image *img;
8339 Lisp_Object file, specified_file;
8340 Lisp_Object specified_data;
8341 int x, y, i;
8342 XImage *ximg, *mask_img = NULL;
8343 struct gcpro gcpro1;
8344 png_struct *png_ptr = NULL;
8345 png_info *info_ptr = NULL, *end_info = NULL;
8346 FILE *fp = NULL;
8347 png_byte sig[8];
8348 png_byte *pixels = NULL;
8349 png_byte **rows = NULL;
8350 png_uint_32 width, height;
8351 int bit_depth, color_type, interlace_type;
8352 png_byte channels;
8353 png_uint_32 row_bytes;
8354 int transparent_p;
8355 char *gamma_str;
8356 double screen_gamma, image_gamma;
8357 int intent;
8358 struct png_memory_storage tbr; /* Data to be read */
8360 /* Find out what file to load. */
8361 specified_file = image_spec_value (img->spec, QCfile, NULL);
8362 specified_data = image_spec_value (img->spec, QCdata, NULL);
8363 file = Qnil;
8364 GCPRO1 (file);
8366 if (NILP (specified_data))
8368 file = x_find_image_file (specified_file);
8369 if (!STRINGP (file))
8371 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8372 UNGCPRO;
8373 return 0;
8376 /* Open the image file. */
8377 fp = fopen (XSTRING (file)->data, "rb");
8378 if (!fp)
8380 image_error ("Cannot open image file `%s'", file, Qnil);
8381 UNGCPRO;
8382 fclose (fp);
8383 return 0;
8386 /* Check PNG signature. */
8387 if (fread (sig, 1, sizeof sig, fp) != sizeof sig
8388 || !png_check_sig (sig, sizeof sig))
8390 image_error ("Not a PNG file: `%s'", file, Qnil);
8391 UNGCPRO;
8392 fclose (fp);
8393 return 0;
8396 else
8398 /* Read from memory. */
8399 tbr.bytes = XSTRING (specified_data)->data;
8400 tbr.len = STRING_BYTES (XSTRING (specified_data));
8401 tbr.index = 0;
8403 /* Check PNG signature. */
8404 if (tbr.len < sizeof sig
8405 || !png_check_sig (tbr.bytes, sizeof sig))
8407 image_error ("Not a PNG image: `%s'", img->spec, Qnil);
8408 UNGCPRO;
8409 return 0;
8412 /* Need to skip past the signature. */
8413 tbr.bytes += sizeof (sig);
8416 /* Initialize read and info structs for PNG lib. */
8417 png_ptr = png_create_read_struct (PNG_LIBPNG_VER_STRING, NULL,
8418 my_png_error, my_png_warning);
8419 if (!png_ptr)
8421 if (fp) fclose (fp);
8422 UNGCPRO;
8423 return 0;
8426 info_ptr = png_create_info_struct (png_ptr);
8427 if (!info_ptr)
8429 png_destroy_read_struct (&png_ptr, NULL, NULL);
8430 if (fp) fclose (fp);
8431 UNGCPRO;
8432 return 0;
8435 end_info = png_create_info_struct (png_ptr);
8436 if (!end_info)
8438 png_destroy_read_struct (&png_ptr, &info_ptr, NULL);
8439 if (fp) fclose (fp);
8440 UNGCPRO;
8441 return 0;
8444 /* Set error jump-back. We come back here when the PNG library
8445 detects an error. */
8446 if (setjmp (png_ptr->jmpbuf))
8448 error:
8449 if (png_ptr)
8450 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8451 xfree (pixels);
8452 xfree (rows);
8453 if (fp) fclose (fp);
8454 UNGCPRO;
8455 return 0;
8458 /* Read image info. */
8459 if (!NILP (specified_data))
8460 png_set_read_fn (png_ptr, (void *) &tbr, png_read_from_memory);
8461 else
8462 png_init_io (png_ptr, fp);
8464 png_set_sig_bytes (png_ptr, sizeof sig);
8465 png_read_info (png_ptr, info_ptr);
8466 png_get_IHDR (png_ptr, info_ptr, &width, &height, &bit_depth, &color_type,
8467 &interlace_type, NULL, NULL);
8469 /* If image contains simply transparency data, we prefer to
8470 construct a clipping mask. */
8471 if (png_get_valid (png_ptr, info_ptr, PNG_INFO_tRNS))
8472 transparent_p = 1;
8473 else
8474 transparent_p = 0;
8476 /* This function is easier to write if we only have to handle
8477 one data format: RGB or RGBA with 8 bits per channel. Let's
8478 transform other formats into that format. */
8480 /* Strip more than 8 bits per channel. */
8481 if (bit_depth == 16)
8482 png_set_strip_16 (png_ptr);
8484 /* Expand data to 24 bit RGB, or 8 bit grayscale, with alpha channel
8485 if available. */
8486 png_set_expand (png_ptr);
8488 /* Convert grayscale images to RGB. */
8489 if (color_type == PNG_COLOR_TYPE_GRAY
8490 || color_type == PNG_COLOR_TYPE_GRAY_ALPHA)
8491 png_set_gray_to_rgb (png_ptr);
8493 /* The value 2.2 is a guess for PC monitors from PNG example.c. */
8494 gamma_str = getenv ("SCREEN_GAMMA");
8495 screen_gamma = gamma_str ? atof (gamma_str) : 2.2;
8497 /* Tell the PNG lib to handle gamma correction for us. */
8499 #if defined(PNG_READ_sRGB_SUPPORTED) || defined(PNG_WRITE_sRGB_SUPPORTED)
8500 if (png_get_sRGB (png_ptr, info_ptr, &intent))
8501 /* There is a special chunk in the image specifying the gamma. */
8502 png_set_sRGB (png_ptr, info_ptr, intent);
8503 else
8504 #endif
8505 if (png_get_gAMA (png_ptr, info_ptr, &image_gamma))
8506 /* Image contains gamma information. */
8507 png_set_gamma (png_ptr, screen_gamma, image_gamma);
8508 else
8509 /* Use a default of 0.5 for the image gamma. */
8510 png_set_gamma (png_ptr, screen_gamma, 0.5);
8512 /* Handle alpha channel by combining the image with a background
8513 color. Do this only if a real alpha channel is supplied. For
8514 simple transparency, we prefer a clipping mask. */
8515 if (!transparent_p)
8517 png_color_16 *image_background;
8519 if (png_get_bKGD (png_ptr, info_ptr, &image_background))
8520 /* Image contains a background color with which to
8521 combine the image. */
8522 png_set_background (png_ptr, image_background,
8523 PNG_BACKGROUND_GAMMA_FILE, 1, 1.0);
8524 else
8526 /* Image does not contain a background color with which
8527 to combine the image data via an alpha channel. Use
8528 the frame's background instead. */
8529 XColor color;
8530 Colormap cmap;
8531 png_color_16 frame_background;
8533 BLOCK_INPUT;
8534 cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
8535 color.pixel = FRAME_BACKGROUND_PIXEL (f);
8536 XQueryColor (FRAME_X_DISPLAY (f), cmap, &color);
8537 UNBLOCK_INPUT;
8539 bzero (&frame_background, sizeof frame_background);
8540 frame_background.red = color.red;
8541 frame_background.green = color.green;
8542 frame_background.blue = color.blue;
8544 png_set_background (png_ptr, &frame_background,
8545 PNG_BACKGROUND_GAMMA_SCREEN, 0, 1.0);
8549 /* Update info structure. */
8550 png_read_update_info (png_ptr, info_ptr);
8552 /* Get number of channels. Valid values are 1 for grayscale images
8553 and images with a palette, 2 for grayscale images with transparency
8554 information (alpha channel), 3 for RGB images, and 4 for RGB
8555 images with alpha channel, i.e. RGBA. If conversions above were
8556 sufficient we should only have 3 or 4 channels here. */
8557 channels = png_get_channels (png_ptr, info_ptr);
8558 xassert (channels == 3 || channels == 4);
8560 /* Number of bytes needed for one row of the image. */
8561 row_bytes = png_get_rowbytes (png_ptr, info_ptr);
8563 /* Allocate memory for the image. */
8564 pixels = (png_byte *) xmalloc (row_bytes * height * sizeof *pixels);
8565 rows = (png_byte **) xmalloc (height * sizeof *rows);
8566 for (i = 0; i < height; ++i)
8567 rows[i] = pixels + i * row_bytes;
8569 /* Read the entire image. */
8570 png_read_image (png_ptr, rows);
8571 png_read_end (png_ptr, info_ptr);
8572 if (fp)
8574 fclose (fp);
8575 fp = NULL;
8578 BLOCK_INPUT;
8580 /* Create the X image and pixmap. */
8581 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg,
8582 &img->pixmap))
8584 UNBLOCK_INPUT;
8585 goto error;
8588 /* Create an image and pixmap serving as mask if the PNG image
8589 contains an alpha channel. */
8590 if (channels == 4
8591 && !transparent_p
8592 && !x_create_x_image_and_pixmap (f, width, height, 1,
8593 &mask_img, &img->mask))
8595 x_destroy_x_image (ximg);
8596 XFreePixmap (FRAME_X_DISPLAY (f), img->pixmap);
8597 img->pixmap = 0;
8598 UNBLOCK_INPUT;
8599 goto error;
8602 /* Fill the X image and mask from PNG data. */
8603 init_color_table ();
8605 for (y = 0; y < height; ++y)
8607 png_byte *p = rows[y];
8609 for (x = 0; x < width; ++x)
8611 unsigned r, g, b;
8613 r = *p++ << 8;
8614 g = *p++ << 8;
8615 b = *p++ << 8;
8616 XPutPixel (ximg, x, y, lookup_rgb_color (f, r, g, b));
8618 /* An alpha channel, aka mask channel, associates variable
8619 transparency with an image. Where other image formats
8620 support binary transparency---fully transparent or fully
8621 opaque---PNG allows up to 254 levels of partial transparency.
8622 The PNG library implements partial transparency by combining
8623 the image with a specified background color.
8625 I'm not sure how to handle this here nicely: because the
8626 background on which the image is displayed may change, for
8627 real alpha channel support, it would be necessary to create
8628 a new image for each possible background.
8630 What I'm doing now is that a mask is created if we have
8631 boolean transparency information. Otherwise I'm using
8632 the frame's background color to combine the image with. */
8634 if (channels == 4)
8636 if (mask_img)
8637 XPutPixel (mask_img, x, y, *p > 0);
8638 ++p;
8643 /* Remember colors allocated for this image. */
8644 img->colors = colors_in_color_table (&img->ncolors);
8645 free_color_table ();
8647 /* Clean up. */
8648 png_destroy_read_struct (&png_ptr, &info_ptr, &end_info);
8649 xfree (rows);
8650 xfree (pixels);
8652 img->width = width;
8653 img->height = height;
8655 /* Put the image into the pixmap, then free the X image and its buffer. */
8656 x_put_x_image (f, ximg, img->pixmap, width, height);
8657 x_destroy_x_image (ximg);
8659 /* Same for the mask. */
8660 if (mask_img)
8662 x_put_x_image (f, mask_img, img->mask, img->width, img->height);
8663 x_destroy_x_image (mask_img);
8666 UNBLOCK_INPUT;
8667 UNGCPRO;
8668 return 1;
8671 #endif /* HAVE_PNG != 0 */
8675 /***********************************************************************
8676 JPEG
8677 ***********************************************************************/
8679 #if HAVE_JPEG
8681 /* Work around a warning about HAVE_STDLIB_H being redefined in
8682 jconfig.h. */
8683 #ifdef HAVE_STDLIB_H
8684 #define HAVE_STDLIB_H_1
8685 #undef HAVE_STDLIB_H
8686 #endif /* HAVE_STLIB_H */
8688 #include <jpeglib.h>
8689 #include <jerror.h>
8690 #include <setjmp.h>
8692 #ifdef HAVE_STLIB_H_1
8693 #define HAVE_STDLIB_H 1
8694 #endif
8696 static int jpeg_image_p P_ ((Lisp_Object object));
8697 static int jpeg_load P_ ((struct frame *f, struct image *img));
8699 /* The symbol `jpeg' identifying images of this type. */
8701 Lisp_Object Qjpeg;
8703 /* Indices of image specification fields in gs_format, below. */
8705 enum jpeg_keyword_index
8707 JPEG_TYPE,
8708 JPEG_DATA,
8709 JPEG_FILE,
8710 JPEG_ASCENT,
8711 JPEG_MARGIN,
8712 JPEG_RELIEF,
8713 JPEG_ALGORITHM,
8714 JPEG_HEURISTIC_MASK,
8715 JPEG_LAST
8718 /* Vector of image_keyword structures describing the format
8719 of valid user-defined image specifications. */
8721 static struct image_keyword jpeg_format[JPEG_LAST] =
8723 {":type", IMAGE_SYMBOL_VALUE, 1},
8724 {":data", IMAGE_STRING_VALUE, 0},
8725 {":file", IMAGE_STRING_VALUE, 0},
8726 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
8727 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
8728 {":relief", IMAGE_INTEGER_VALUE, 0},
8729 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
8730 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
8733 /* Structure describing the image type `jpeg'. */
8735 static struct image_type jpeg_type =
8737 &Qjpeg,
8738 jpeg_image_p,
8739 jpeg_load,
8740 x_clear_image,
8741 NULL
8745 /* Return non-zero if OBJECT is a valid JPEG image specification. */
8747 static int
8748 jpeg_image_p (object)
8749 Lisp_Object object;
8751 struct image_keyword fmt[JPEG_LAST];
8753 bcopy (jpeg_format, fmt, sizeof fmt);
8755 if (!parse_image_spec (object, fmt, JPEG_LAST, Qjpeg)
8756 || (fmt[JPEG_ASCENT].count
8757 && XFASTINT (fmt[JPEG_ASCENT].value) > 100))
8758 return 0;
8760 /* Must specify either the :data or :file keyword. */
8761 return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
8765 struct my_jpeg_error_mgr
8767 struct jpeg_error_mgr pub;
8768 jmp_buf setjmp_buffer;
8771 static void
8772 my_error_exit (cinfo)
8773 j_common_ptr cinfo;
8775 struct my_jpeg_error_mgr *mgr = (struct my_jpeg_error_mgr *) cinfo->err;
8776 longjmp (mgr->setjmp_buffer, 1);
8779 /* Init source method for JPEG data source manager. Called by
8780 jpeg_read_header() before any data is actually read. See
8781 libjpeg.doc from the JPEG lib distribution. */
8783 static void
8784 our_init_source (cinfo)
8785 j_decompress_ptr cinfo;
8790 /* Fill input buffer method for JPEG data source manager. Called
8791 whenever more data is needed. We read the whole image in one step,
8792 so this only adds a fake end of input marker at the end. */
8794 static boolean
8795 our_fill_input_buffer (cinfo)
8796 j_decompress_ptr cinfo;
8798 /* Insert a fake EOI marker. */
8799 struct jpeg_source_mgr *src = cinfo->src;
8800 static JOCTET buffer[2];
8802 buffer[0] = (JOCTET) 0xFF;
8803 buffer[1] = (JOCTET) JPEG_EOI;
8805 src->next_input_byte = buffer;
8806 src->bytes_in_buffer = 2;
8807 return TRUE;
8811 /* Method to skip over NUM_BYTES bytes in the image data. CINFO->src
8812 is the JPEG data source manager. */
8814 static void
8815 our_skip_input_data (cinfo, num_bytes)
8816 j_decompress_ptr cinfo;
8817 long num_bytes;
8819 struct jpeg_source_mgr *src = (struct jpeg_source_mgr *) cinfo->src;
8821 if (src)
8823 if (num_bytes > src->bytes_in_buffer)
8824 ERREXIT (cinfo, JERR_INPUT_EOF);
8826 src->bytes_in_buffer -= num_bytes;
8827 src->next_input_byte += num_bytes;
8832 /* Method to terminate data source. Called by
8833 jpeg_finish_decompress() after all data has been processed. */
8835 static void
8836 our_term_source (cinfo)
8837 j_decompress_ptr cinfo;
8842 /* Set up the JPEG lib for reading an image from DATA which contains
8843 LEN bytes. CINFO is the decompression info structure created for
8844 reading the image. */
8846 static void
8847 jpeg_memory_src (cinfo, data, len)
8848 j_decompress_ptr cinfo;
8849 JOCTET *data;
8850 unsigned int len;
8852 struct jpeg_source_mgr *src;
8854 if (cinfo->src == NULL)
8856 /* First time for this JPEG object? */
8857 cinfo->src = (struct jpeg_source_mgr *)
8858 (*cinfo->mem->alloc_small) ((j_common_ptr) cinfo, JPOOL_PERMANENT,
8859 sizeof (struct jpeg_source_mgr));
8860 src = (struct jpeg_source_mgr *) cinfo->src;
8861 src->next_input_byte = data;
8864 src = (struct jpeg_source_mgr *) cinfo->src;
8865 src->init_source = our_init_source;
8866 src->fill_input_buffer = our_fill_input_buffer;
8867 src->skip_input_data = our_skip_input_data;
8868 src->resync_to_restart = jpeg_resync_to_restart; /* Use default method. */
8869 src->term_source = our_term_source;
8870 src->bytes_in_buffer = len;
8871 src->next_input_byte = data;
8875 /* Load image IMG for use on frame F. Patterned after example.c
8876 from the JPEG lib. */
8878 static int
8879 jpeg_load (f, img)
8880 struct frame *f;
8881 struct image *img;
8883 struct jpeg_decompress_struct cinfo;
8884 struct my_jpeg_error_mgr mgr;
8885 Lisp_Object file, specified_file;
8886 Lisp_Object specified_data;
8887 FILE *fp = NULL;
8888 JSAMPARRAY buffer;
8889 int row_stride, x, y;
8890 XImage *ximg = NULL;
8891 int rc;
8892 unsigned long *colors;
8893 int width, height;
8894 struct gcpro gcpro1;
8896 /* Open the JPEG file. */
8897 specified_file = image_spec_value (img->spec, QCfile, NULL);
8898 specified_data = image_spec_value (img->spec, QCdata, NULL);
8899 file = Qnil;
8900 GCPRO1 (file);
8902 if (NILP (specified_data))
8904 file = x_find_image_file (specified_file);
8905 if (!STRINGP (file))
8907 image_error ("Cannot find image file `%s'", specified_file, Qnil);
8908 UNGCPRO;
8909 return 0;
8912 fp = fopen (XSTRING (file)->data, "r");
8913 if (fp == NULL)
8915 image_error ("Cannot open `%s'", file, Qnil);
8916 UNGCPRO;
8917 return 0;
8921 /* Customize libjpeg's error handling to call my_error_exit when an
8922 error is detected. This function will perform a longjmp. */
8923 mgr.pub.error_exit = my_error_exit;
8924 cinfo.err = jpeg_std_error (&mgr.pub);
8926 if ((rc = setjmp (mgr.setjmp_buffer)) != 0)
8928 if (rc == 1)
8930 /* Called from my_error_exit. Display a JPEG error. */
8931 char buffer[JMSG_LENGTH_MAX];
8932 cinfo.err->format_message ((j_common_ptr) &cinfo, buffer);
8933 image_error ("Error reading JPEG image `%s': %s", img->spec,
8934 build_string (buffer));
8937 /* Close the input file and destroy the JPEG object. */
8938 if (fp)
8939 fclose (fp);
8940 jpeg_destroy_decompress (&cinfo);
8942 BLOCK_INPUT;
8944 /* If we already have an XImage, free that. */
8945 x_destroy_x_image (ximg);
8947 /* Free pixmap and colors. */
8948 x_clear_image (f, img);
8950 UNBLOCK_INPUT;
8951 UNGCPRO;
8952 return 0;
8955 /* Create the JPEG decompression object. Let it read from fp.
8956 Read the JPEG image header. */
8957 jpeg_create_decompress (&cinfo);
8959 if (NILP (specified_data))
8960 jpeg_stdio_src (&cinfo, fp);
8961 else
8962 jpeg_memory_src (&cinfo, XSTRING (specified_data)->data,
8963 STRING_BYTES (XSTRING (specified_data)));
8965 jpeg_read_header (&cinfo, TRUE);
8967 /* Customize decompression so that color quantization will be used.
8968 Start decompression. */
8969 cinfo.quantize_colors = TRUE;
8970 jpeg_start_decompress (&cinfo);
8971 width = img->width = cinfo.output_width;
8972 height = img->height = cinfo.output_height;
8974 BLOCK_INPUT;
8976 /* Create X image and pixmap. */
8977 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
8979 UNBLOCK_INPUT;
8980 longjmp (mgr.setjmp_buffer, 2);
8983 /* Allocate colors. When color quantization is used,
8984 cinfo.actual_number_of_colors has been set with the number of
8985 colors generated, and cinfo.colormap is a two-dimensional array
8986 of color indices in the range 0..cinfo.actual_number_of_colors.
8987 No more than 255 colors will be generated. */
8989 int i, ir, ig, ib;
8991 if (cinfo.out_color_components > 2)
8992 ir = 0, ig = 1, ib = 2;
8993 else if (cinfo.out_color_components > 1)
8994 ir = 0, ig = 1, ib = 0;
8995 else
8996 ir = 0, ig = 0, ib = 0;
8998 /* Use the color table mechanism because it handles colors that
8999 cannot be allocated nicely. Such colors will be replaced with
9000 a default color, and we don't have to care about which colors
9001 can be freed safely, and which can't. */
9002 init_color_table ();
9003 colors = (unsigned long *) alloca (cinfo.actual_number_of_colors
9004 * sizeof *colors);
9006 for (i = 0; i < cinfo.actual_number_of_colors; ++i)
9008 /* Multiply RGB values with 255 because X expects RGB values
9009 in the range 0..0xffff. */
9010 int r = cinfo.colormap[ir][i] << 8;
9011 int g = cinfo.colormap[ig][i] << 8;
9012 int b = cinfo.colormap[ib][i] << 8;
9013 colors[i] = lookup_rgb_color (f, r, g, b);
9016 /* Remember those colors actually allocated. */
9017 img->colors = colors_in_color_table (&img->ncolors);
9018 free_color_table ();
9021 /* Read pixels. */
9022 row_stride = width * cinfo.output_components;
9023 buffer = cinfo.mem->alloc_sarray ((j_common_ptr) &cinfo, JPOOL_IMAGE,
9024 row_stride, 1);
9025 for (y = 0; y < height; ++y)
9027 jpeg_read_scanlines (&cinfo, buffer, 1);
9028 for (x = 0; x < cinfo.output_width; ++x)
9029 XPutPixel (ximg, x, y, colors[buffer[0][x]]);
9032 /* Clean up. */
9033 jpeg_finish_decompress (&cinfo);
9034 jpeg_destroy_decompress (&cinfo);
9035 if (fp)
9036 fclose (fp);
9038 /* Put the image into the pixmap. */
9039 x_put_x_image (f, ximg, img->pixmap, width, height);
9040 x_destroy_x_image (ximg);
9041 UNBLOCK_INPUT;
9042 UNGCPRO;
9043 return 1;
9046 #endif /* HAVE_JPEG */
9050 /***********************************************************************
9051 TIFF
9052 ***********************************************************************/
9054 #if HAVE_TIFF
9056 #include <tiffio.h>
9058 static int tiff_image_p P_ ((Lisp_Object object));
9059 static int tiff_load P_ ((struct frame *f, struct image *img));
9061 /* The symbol `tiff' identifying images of this type. */
9063 Lisp_Object Qtiff;
9065 /* Indices of image specification fields in tiff_format, below. */
9067 enum tiff_keyword_index
9069 TIFF_TYPE,
9070 TIFF_DATA,
9071 TIFF_FILE,
9072 TIFF_ASCENT,
9073 TIFF_MARGIN,
9074 TIFF_RELIEF,
9075 TIFF_ALGORITHM,
9076 TIFF_HEURISTIC_MASK,
9077 TIFF_LAST
9080 /* Vector of image_keyword structures describing the format
9081 of valid user-defined image specifications. */
9083 static struct image_keyword tiff_format[TIFF_LAST] =
9085 {":type", IMAGE_SYMBOL_VALUE, 1},
9086 {":data", IMAGE_STRING_VALUE, 0},
9087 {":file", IMAGE_STRING_VALUE, 0},
9088 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9089 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9090 {":relief", IMAGE_INTEGER_VALUE, 0},
9091 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9092 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9095 /* Structure describing the image type `tiff'. */
9097 static struct image_type tiff_type =
9099 &Qtiff,
9100 tiff_image_p,
9101 tiff_load,
9102 x_clear_image,
9103 NULL
9107 /* Return non-zero if OBJECT is a valid TIFF image specification. */
9109 static int
9110 tiff_image_p (object)
9111 Lisp_Object object;
9113 struct image_keyword fmt[TIFF_LAST];
9114 bcopy (tiff_format, fmt, sizeof fmt);
9116 if (!parse_image_spec (object, fmt, TIFF_LAST, Qtiff)
9117 || (fmt[TIFF_ASCENT].count
9118 && XFASTINT (fmt[TIFF_ASCENT].value) > 100))
9119 return 0;
9121 /* Must specify either the :data or :file keyword. */
9122 return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
9126 /* Reading from a memory buffer for TIFF images Based on the PNG
9127 memory source, but we have to provide a lot of extra functions.
9128 Blah.
9130 We really only need to implement read and seek, but I am not
9131 convinced that the TIFF library is smart enough not to destroy
9132 itself if we only hand it the function pointers we need to
9133 override. */
9135 typedef struct
9137 unsigned char *bytes;
9138 size_t len;
9139 int index;
9141 tiff_memory_source;
9143 static size_t
9144 tiff_read_from_memory (data, buf, size)
9145 thandle_t data;
9146 tdata_t buf;
9147 tsize_t size;
9149 tiff_memory_source *src = (tiff_memory_source *) data;
9151 if (size > src->len - src->index)
9152 return (size_t) -1;
9153 bcopy (src->bytes + src->index, buf, size);
9154 src->index += size;
9155 return size;
9158 static size_t
9159 tiff_write_from_memory (data, buf, size)
9160 thandle_t data;
9161 tdata_t buf;
9162 tsize_t size;
9164 return (size_t) -1;
9167 static toff_t
9168 tiff_seek_in_memory (data, off, whence)
9169 thandle_t data;
9170 toff_t off;
9171 int whence;
9173 tiff_memory_source *src = (tiff_memory_source *) data;
9174 int idx;
9176 switch (whence)
9178 case SEEK_SET: /* Go from beginning of source. */
9179 idx = off;
9180 break;
9182 case SEEK_END: /* Go from end of source. */
9183 idx = src->len + off;
9184 break;
9186 case SEEK_CUR: /* Go from current position. */
9187 idx = src->index + off;
9188 break;
9190 default: /* Invalid `whence'. */
9191 return -1;
9194 if (idx > src->len || idx < 0)
9195 return -1;
9197 src->index = idx;
9198 return src->index;
9201 static int
9202 tiff_close_memory (data)
9203 thandle_t data;
9205 /* NOOP */
9206 return 0;
9209 static int
9210 tiff_mmap_memory (data, pbase, psize)
9211 thandle_t data;
9212 tdata_t *pbase;
9213 toff_t *psize;
9215 /* It is already _IN_ memory. */
9216 return 0;
9219 static void
9220 tiff_unmap_memory (data, base, size)
9221 thandle_t data;
9222 tdata_t base;
9223 toff_t size;
9225 /* We don't need to do this. */
9228 static toff_t
9229 tiff_size_of_memory (data)
9230 thandle_t data;
9232 return ((tiff_memory_source *) data)->len;
9235 /* Load TIFF image IMG for use on frame F. Value is non-zero if
9236 successful. */
9238 static int
9239 tiff_load (f, img)
9240 struct frame *f;
9241 struct image *img;
9243 Lisp_Object file, specified_file;
9244 Lisp_Object specified_data;
9245 TIFF *tiff;
9246 int width, height, x, y;
9247 uint32 *buf;
9248 int rc;
9249 XImage *ximg;
9250 struct gcpro gcpro1;
9251 tiff_memory_source memsrc;
9253 specified_file = image_spec_value (img->spec, QCfile, NULL);
9254 specified_data = image_spec_value (img->spec, QCdata, NULL);
9255 file = Qnil;
9256 GCPRO1 (file);
9258 if (NILP (specified_data))
9260 /* Read from a file */
9261 file = x_find_image_file (specified_file);
9262 if (!STRINGP (file))
9264 image_error ("Cannot find image file `%s'", file, Qnil);
9265 UNGCPRO;
9266 return 0;
9269 /* Try to open the image file. */
9270 tiff = TIFFOpen (XSTRING (file)->data, "r");
9271 if (tiff == NULL)
9273 image_error ("Cannot open `%s'", file, Qnil);
9274 UNGCPRO;
9275 return 0;
9278 else
9280 /* Memory source! */
9281 memsrc.bytes = XSTRING (specified_data)->data;
9282 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9283 memsrc.index = 0;
9285 tiff = TIFFClientOpen ("memory_source", "r", &memsrc,
9286 (TIFFReadWriteProc) tiff_read_from_memory,
9287 (TIFFReadWriteProc) tiff_write_from_memory,
9288 tiff_seek_in_memory,
9289 tiff_close_memory,
9290 tiff_size_of_memory,
9291 tiff_mmap_memory,
9292 tiff_unmap_memory);
9294 if (!tiff)
9296 image_error ("Cannot open memory source for `%s'", img->spec, Qnil);
9297 UNGCPRO;
9298 return 0;
9302 /* Get width and height of the image, and allocate a raster buffer
9303 of width x height 32-bit values. */
9304 TIFFGetField (tiff, TIFFTAG_IMAGEWIDTH, &width);
9305 TIFFGetField (tiff, TIFFTAG_IMAGELENGTH, &height);
9306 buf = (uint32 *) xmalloc (width * height * sizeof *buf);
9308 rc = TIFFReadRGBAImage (tiff, width, height, buf, 0);
9309 TIFFClose (tiff);
9310 if (!rc)
9312 image_error ("Error reading TIFF image `%s'", img->spec, Qnil);
9313 xfree (buf);
9314 UNGCPRO;
9315 return 0;
9318 BLOCK_INPUT;
9320 /* Create the X image and pixmap. */
9321 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9323 UNBLOCK_INPUT;
9324 xfree (buf);
9325 UNGCPRO;
9326 return 0;
9329 /* Initialize the color table. */
9330 init_color_table ();
9332 /* Process the pixel raster. Origin is in the lower-left corner. */
9333 for (y = 0; y < height; ++y)
9335 uint32 *row = buf + y * width;
9337 for (x = 0; x < width; ++x)
9339 uint32 abgr = row[x];
9340 int r = TIFFGetR (abgr) << 8;
9341 int g = TIFFGetG (abgr) << 8;
9342 int b = TIFFGetB (abgr) << 8;
9343 XPutPixel (ximg, x, height - 1 - y, lookup_rgb_color (f, r, g, b));
9347 /* Remember the colors allocated for the image. Free the color table. */
9348 img->colors = colors_in_color_table (&img->ncolors);
9349 free_color_table ();
9351 /* Put the image into the pixmap, then free the X image and its buffer. */
9352 x_put_x_image (f, ximg, img->pixmap, width, height);
9353 x_destroy_x_image (ximg);
9354 xfree (buf);
9355 UNBLOCK_INPUT;
9357 img->width = width;
9358 img->height = height;
9360 UNGCPRO;
9361 return 1;
9364 #endif /* HAVE_TIFF != 0 */
9368 /***********************************************************************
9370 ***********************************************************************/
9372 #if HAVE_GIF
9374 #include <gif_lib.h>
9376 static int gif_image_p P_ ((Lisp_Object object));
9377 static int gif_load P_ ((struct frame *f, struct image *img));
9379 /* The symbol `gif' identifying images of this type. */
9381 Lisp_Object Qgif;
9383 /* Indices of image specification fields in gif_format, below. */
9385 enum gif_keyword_index
9387 GIF_TYPE,
9388 GIF_DATA,
9389 GIF_FILE,
9390 GIF_ASCENT,
9391 GIF_MARGIN,
9392 GIF_RELIEF,
9393 GIF_ALGORITHM,
9394 GIF_HEURISTIC_MASK,
9395 GIF_IMAGE,
9396 GIF_LAST
9399 /* Vector of image_keyword structures describing the format
9400 of valid user-defined image specifications. */
9402 static struct image_keyword gif_format[GIF_LAST] =
9404 {":type", IMAGE_SYMBOL_VALUE, 1},
9405 {":data", IMAGE_STRING_VALUE, 0},
9406 {":file", IMAGE_STRING_VALUE, 0},
9407 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9408 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9409 {":relief", IMAGE_INTEGER_VALUE, 0},
9410 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9411 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9412 {":image", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0}
9415 /* Structure describing the image type `gif'. */
9417 static struct image_type gif_type =
9419 &Qgif,
9420 gif_image_p,
9421 gif_load,
9422 x_clear_image,
9423 NULL
9426 /* Return non-zero if OBJECT is a valid GIF image specification. */
9428 static int
9429 gif_image_p (object)
9430 Lisp_Object object;
9432 struct image_keyword fmt[GIF_LAST];
9433 bcopy (gif_format, fmt, sizeof fmt);
9435 if (!parse_image_spec (object, fmt, GIF_LAST, Qgif)
9436 || (fmt[GIF_ASCENT].count
9437 && XFASTINT (fmt[GIF_ASCENT].value) > 100))
9438 return 0;
9440 /* Must specify either the :data or :file keyword. */
9441 return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
9444 /* Reading a GIF image from memory
9445 Based on the PNG memory stuff to a certain extent. */
9447 typedef struct
9449 unsigned char *bytes;
9450 size_t len;
9451 int index;
9453 gif_memory_source;
9455 /* Make the current memory source available to gif_read_from_memory.
9456 It's done this way because not all versions of libungif support
9457 a UserData field in the GifFileType structure. */
9458 static gif_memory_source *current_gif_memory_src;
9460 static int
9461 gif_read_from_memory (file, buf, len)
9462 GifFileType *file;
9463 GifByteType *buf;
9464 int len;
9466 gif_memory_source *src = current_gif_memory_src;
9468 if (len > src->len - src->index)
9469 return -1;
9471 bcopy (src->bytes + src->index, buf, len);
9472 src->index += len;
9473 return len;
9477 /* Load GIF image IMG for use on frame F. Value is non-zero if
9478 successful. */
9480 static int
9481 gif_load (f, img)
9482 struct frame *f;
9483 struct image *img;
9485 Lisp_Object file, specified_file;
9486 Lisp_Object specified_data;
9487 int rc, width, height, x, y, i;
9488 XImage *ximg;
9489 ColorMapObject *gif_color_map;
9490 unsigned long pixel_colors[256];
9491 GifFileType *gif;
9492 struct gcpro gcpro1;
9493 Lisp_Object image;
9494 int ino, image_left, image_top, image_width, image_height;
9495 gif_memory_source memsrc;
9496 unsigned char *raster;
9498 specified_file = image_spec_value (img->spec, QCfile, NULL);
9499 specified_data = image_spec_value (img->spec, QCdata, NULL);
9500 file = Qnil;
9501 GCPRO1 (file);
9503 if (NILP (specified_data))
9505 file = x_find_image_file (specified_file);
9506 if (!STRINGP (file))
9508 image_error ("Cannot find image file `%s'", specified_file, Qnil);
9509 UNGCPRO;
9510 return 0;
9513 /* Open the GIF file. */
9514 gif = DGifOpenFileName (XSTRING (file)->data);
9515 if (gif == NULL)
9517 image_error ("Cannot open `%s'", file, Qnil);
9518 UNGCPRO;
9519 return 0;
9522 else
9524 /* Read from memory! */
9525 current_gif_memory_src = &memsrc;
9526 memsrc.bytes = XSTRING (specified_data)->data;
9527 memsrc.len = STRING_BYTES (XSTRING (specified_data));
9528 memsrc.index = 0;
9530 gif = DGifOpen(&memsrc, gif_read_from_memory);
9531 if (!gif)
9533 image_error ("Cannot open memory source `%s'", img->spec, Qnil);
9534 UNGCPRO;
9535 return 0;
9539 /* Read entire contents. */
9540 rc = DGifSlurp (gif);
9541 if (rc == GIF_ERROR)
9543 image_error ("Error reading `%s'", img->spec, Qnil);
9544 DGifCloseFile (gif);
9545 UNGCPRO;
9546 return 0;
9549 image = image_spec_value (img->spec, QCindex, NULL);
9550 ino = INTEGERP (image) ? XFASTINT (image) : 0;
9551 if (ino >= gif->ImageCount)
9553 image_error ("Invalid image number `%s' in image `%s'",
9554 image, img->spec);
9555 DGifCloseFile (gif);
9556 UNGCPRO;
9557 return 0;
9560 width = img->width = gif->SWidth;
9561 height = img->height = gif->SHeight;
9563 BLOCK_INPUT;
9565 /* Create the X image and pixmap. */
9566 if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap))
9568 UNBLOCK_INPUT;
9569 DGifCloseFile (gif);
9570 UNGCPRO;
9571 return 0;
9574 /* Allocate colors. */
9575 gif_color_map = gif->SavedImages[ino].ImageDesc.ColorMap;
9576 if (!gif_color_map)
9577 gif_color_map = gif->SColorMap;
9578 init_color_table ();
9579 bzero (pixel_colors, sizeof pixel_colors);
9581 for (i = 0; i < gif_color_map->ColorCount; ++i)
9583 int r = gif_color_map->Colors[i].Red << 8;
9584 int g = gif_color_map->Colors[i].Green << 8;
9585 int b = gif_color_map->Colors[i].Blue << 8;
9586 pixel_colors[i] = lookup_rgb_color (f, r, g, b);
9589 img->colors = colors_in_color_table (&img->ncolors);
9590 free_color_table ();
9592 /* Clear the part of the screen image that are not covered by
9593 the image from the GIF file. Full animated GIF support
9594 requires more than can be done here (see the gif89 spec,
9595 disposal methods). Let's simply assume that the part
9596 not covered by a sub-image is in the frame's background color. */
9597 image_top = gif->SavedImages[ino].ImageDesc.Top;
9598 image_left = gif->SavedImages[ino].ImageDesc.Left;
9599 image_width = gif->SavedImages[ino].ImageDesc.Width;
9600 image_height = gif->SavedImages[ino].ImageDesc.Height;
9602 for (y = 0; y < image_top; ++y)
9603 for (x = 0; x < width; ++x)
9604 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9606 for (y = image_top + image_height; y < height; ++y)
9607 for (x = 0; x < width; ++x)
9608 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9610 for (y = image_top; y < image_top + image_height; ++y)
9612 for (x = 0; x < image_left; ++x)
9613 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9614 for (x = image_left + image_width; x < width; ++x)
9615 XPutPixel (ximg, x, y, FRAME_BACKGROUND_PIXEL (f));
9618 /* Read the GIF image into the X image. We use a local variable
9619 `raster' here because RasterBits below is a char *, and invites
9620 problems with bytes >= 0x80. */
9621 raster = (unsigned char *) gif->SavedImages[ino].RasterBits;
9623 if (gif->SavedImages[ino].ImageDesc.Interlace)
9625 static int interlace_start[] = {0, 4, 2, 1};
9626 static int interlace_increment[] = {8, 8, 4, 2};
9627 int pass, inc;
9628 int row = interlace_start[0];
9630 pass = 0;
9632 for (y = 0; y < image_height; y++)
9634 if (row >= image_height)
9636 row = interlace_start[++pass];
9637 while (row >= image_height)
9638 row = interlace_start[++pass];
9641 for (x = 0; x < image_width; x++)
9643 int i = raster[(y * image_width) + x];
9644 XPutPixel (ximg, x + image_left, row + image_top,
9645 pixel_colors[i]);
9648 row += interlace_increment[pass];
9651 else
9653 for (y = 0; y < image_height; ++y)
9654 for (x = 0; x < image_width; ++x)
9656 int i = raster[y * image_width + x];
9657 XPutPixel (ximg, x + image_left, y + image_top, pixel_colors[i]);
9661 DGifCloseFile (gif);
9663 /* Put the image into the pixmap, then free the X image and its buffer. */
9664 x_put_x_image (f, ximg, img->pixmap, width, height);
9665 x_destroy_x_image (ximg);
9666 UNBLOCK_INPUT;
9668 UNGCPRO;
9669 return 1;
9672 #endif /* HAVE_GIF != 0 */
9676 /***********************************************************************
9677 Ghostscript
9678 ***********************************************************************/
9680 static int gs_image_p P_ ((Lisp_Object object));
9681 static int gs_load P_ ((struct frame *f, struct image *img));
9682 static void gs_clear_image P_ ((struct frame *f, struct image *img));
9684 /* The symbol `postscript' identifying images of this type. */
9686 Lisp_Object Qpostscript;
9688 /* Keyword symbols. */
9690 Lisp_Object QCloader, QCbounding_box, QCpt_width, QCpt_height;
9692 /* Indices of image specification fields in gs_format, below. */
9694 enum gs_keyword_index
9696 GS_TYPE,
9697 GS_PT_WIDTH,
9698 GS_PT_HEIGHT,
9699 GS_FILE,
9700 GS_LOADER,
9701 GS_BOUNDING_BOX,
9702 GS_ASCENT,
9703 GS_MARGIN,
9704 GS_RELIEF,
9705 GS_ALGORITHM,
9706 GS_HEURISTIC_MASK,
9707 GS_LAST
9710 /* Vector of image_keyword structures describing the format
9711 of valid user-defined image specifications. */
9713 static struct image_keyword gs_format[GS_LAST] =
9715 {":type", IMAGE_SYMBOL_VALUE, 1},
9716 {":pt-width", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9717 {":pt-height", IMAGE_POSITIVE_INTEGER_VALUE, 1},
9718 {":file", IMAGE_STRING_VALUE, 1},
9719 {":loader", IMAGE_FUNCTION_VALUE, 0},
9720 {":bounding-box", IMAGE_DONT_CHECK_VALUE_TYPE, 1},
9721 {":ascent", IMAGE_NON_NEGATIVE_INTEGER_VALUE, 0},
9722 {":margin", IMAGE_POSITIVE_INTEGER_VALUE, 0},
9723 {":relief", IMAGE_INTEGER_VALUE, 0},
9724 {":algorithm", IMAGE_DONT_CHECK_VALUE_TYPE, 0},
9725 {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}
9728 /* Structure describing the image type `ghostscript'. */
9730 static struct image_type gs_type =
9732 &Qpostscript,
9733 gs_image_p,
9734 gs_load,
9735 gs_clear_image,
9736 NULL
9740 /* Free X resources of Ghostscript image IMG which is used on frame F. */
9742 static void
9743 gs_clear_image (f, img)
9744 struct frame *f;
9745 struct image *img;
9747 /* IMG->data.ptr_val may contain a recorded colormap. */
9748 xfree (img->data.ptr_val);
9749 x_clear_image (f, img);
9753 /* Return non-zero if OBJECT is a valid Ghostscript image
9754 specification. */
9756 static int
9757 gs_image_p (object)
9758 Lisp_Object object;
9760 struct image_keyword fmt[GS_LAST];
9761 Lisp_Object tem;
9762 int i;
9764 bcopy (gs_format, fmt, sizeof fmt);
9766 if (!parse_image_spec (object, fmt, GS_LAST, Qpostscript)
9767 || (fmt[GS_ASCENT].count
9768 && XFASTINT (fmt[GS_ASCENT].value) > 100))
9769 return 0;
9771 /* Bounding box must be a list or vector containing 4 integers. */
9772 tem = fmt[GS_BOUNDING_BOX].value;
9773 if (CONSP (tem))
9775 for (i = 0; i < 4; ++i, tem = XCDR (tem))
9776 if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
9777 return 0;
9778 if (!NILP (tem))
9779 return 0;
9781 else if (VECTORP (tem))
9783 if (XVECTOR (tem)->size != 4)
9784 return 0;
9785 for (i = 0; i < 4; ++i)
9786 if (!INTEGERP (XVECTOR (tem)->contents[i]))
9787 return 0;
9789 else
9790 return 0;
9792 return 1;
9796 /* Load Ghostscript image IMG for use on frame F. Value is non-zero
9797 if successful. */
9799 static int
9800 gs_load (f, img)
9801 struct frame *f;
9802 struct image *img;
9804 char buffer[100];
9805 Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width;
9806 struct gcpro gcpro1, gcpro2;
9807 Lisp_Object frame;
9808 double in_width, in_height;
9809 Lisp_Object pixel_colors = Qnil;
9811 /* Compute pixel size of pixmap needed from the given size in the
9812 image specification. Sizes in the specification are in pt. 1 pt
9813 = 1/72 in, xdpi and ydpi are stored in the frame's X display
9814 info. */
9815 pt_width = image_spec_value (img->spec, QCpt_width, NULL);
9816 in_width = XFASTINT (pt_width) / 72.0;
9817 img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx;
9818 pt_height = image_spec_value (img->spec, QCpt_height, NULL);
9819 in_height = XFASTINT (pt_height) / 72.0;
9820 img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy;
9822 /* Create the pixmap. */
9823 BLOCK_INPUT;
9824 xassert (img->pixmap == 0);
9825 img->pixmap = XCreatePixmap (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9826 img->width, img->height,
9827 DefaultDepthOfScreen (FRAME_X_SCREEN (f)));
9828 UNBLOCK_INPUT;
9830 if (!img->pixmap)
9832 image_error ("Unable to create pixmap for `%s'", img->spec, Qnil);
9833 return 0;
9836 /* Call the loader to fill the pixmap. It returns a process object
9837 if successful. We do not record_unwind_protect here because
9838 other places in redisplay like calling window scroll functions
9839 don't either. Let the Lisp loader use `unwind-protect' instead. */
9840 GCPRO2 (window_and_pixmap_id, pixel_colors);
9842 sprintf (buffer, "%lu %lu",
9843 (unsigned long) FRAME_X_WINDOW (f),
9844 (unsigned long) img->pixmap);
9845 window_and_pixmap_id = build_string (buffer);
9847 sprintf (buffer, "%lu %lu",
9848 FRAME_FOREGROUND_PIXEL (f),
9849 FRAME_BACKGROUND_PIXEL (f));
9850 pixel_colors = build_string (buffer);
9852 XSETFRAME (frame, f);
9853 loader = image_spec_value (img->spec, QCloader, NULL);
9854 if (NILP (loader))
9855 loader = intern ("gs-load-image");
9857 img->data.lisp_val = call6 (loader, frame, img->spec,
9858 make_number (img->width),
9859 make_number (img->height),
9860 window_and_pixmap_id,
9861 pixel_colors);
9862 UNGCPRO;
9863 return PROCESSP (img->data.lisp_val);
9867 /* Kill the Ghostscript process that was started to fill PIXMAP on
9868 frame F. Called from XTread_socket when receiving an event
9869 telling Emacs that Ghostscript has finished drawing. */
9871 void
9872 x_kill_gs_process (pixmap, f)
9873 Pixmap pixmap;
9874 struct frame *f;
9876 struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
9877 int class, i;
9878 struct image *img;
9880 /* Find the image containing PIXMAP. */
9881 for (i = 0; i < c->used; ++i)
9882 if (c->images[i]->pixmap == pixmap)
9883 break;
9885 /* Kill the GS process. We should have found PIXMAP in the image
9886 cache and its image should contain a process object. */
9887 xassert (i < c->used);
9888 img = c->images[i];
9889 xassert (PROCESSP (img->data.lisp_val));
9890 Fkill_process (img->data.lisp_val, Qnil);
9891 img->data.lisp_val = Qnil;
9893 /* On displays with a mutable colormap, figure out the colors
9894 allocated for the image by looking at the pixels of an XImage for
9895 img->pixmap. */
9896 class = FRAME_X_DISPLAY_INFO (f)->visual->class;
9897 if (class != StaticColor && class != StaticGray && class != TrueColor)
9899 XImage *ximg;
9901 BLOCK_INPUT;
9903 /* Try to get an XImage for img->pixmep. */
9904 ximg = XGetImage (FRAME_X_DISPLAY (f), img->pixmap,
9905 0, 0, img->width, img->height, ~0, ZPixmap);
9906 if (ximg)
9908 int x, y;
9910 /* Initialize the color table. */
9911 init_color_table ();
9913 /* For each pixel of the image, look its color up in the
9914 color table. After having done so, the color table will
9915 contain an entry for each color used by the image. */
9916 for (y = 0; y < img->height; ++y)
9917 for (x = 0; x < img->width; ++x)
9919 unsigned long pixel = XGetPixel (ximg, x, y);
9920 lookup_pixel_color (f, pixel);
9923 /* Record colors in the image. Free color table and XImage. */
9924 img->colors = colors_in_color_table (&img->ncolors);
9925 free_color_table ();
9926 XDestroyImage (ximg);
9928 #if 0 /* This doesn't seem to be the case. If we free the colors
9929 here, we get a BadAccess later in x_clear_image when
9930 freeing the colors. */
9931 /* We have allocated colors once, but Ghostscript has also
9932 allocated colors on behalf of us. So, to get the
9933 reference counts right, free them once. */
9934 if (img->ncolors)
9936 Colormap cmap = DefaultColormapOfScreen (FRAME_X_SCREEN (f));
9937 XFreeColors (FRAME_X_DISPLAY (f), cmap,
9938 img->colors, img->ncolors, 0);
9940 #endif
9942 else
9943 image_error ("Cannot get X image of `%s'; colors will not be freed",
9944 img->spec, Qnil);
9946 UNBLOCK_INPUT;
9952 /***********************************************************************
9953 Window properties
9954 ***********************************************************************/
9956 DEFUN ("x-change-window-property", Fx_change_window_property,
9957 Sx_change_window_property, 2, 3, 0,
9958 "Change window property PROP to VALUE on the X window of FRAME.\n\
9959 PROP and VALUE must be strings. FRAME nil or omitted means use the\n\
9960 selected frame. Value is VALUE.")
9961 (prop, value, frame)
9962 Lisp_Object frame, prop, value;
9964 struct frame *f = check_x_frame (frame);
9965 Atom prop_atom;
9967 CHECK_STRING (prop, 1);
9968 CHECK_STRING (value, 2);
9970 BLOCK_INPUT;
9971 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9972 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
9973 prop_atom, XA_STRING, 8, PropModeReplace,
9974 XSTRING (value)->data, XSTRING (value)->size);
9976 /* Make sure the property is set when we return. */
9977 XFlush (FRAME_X_DISPLAY (f));
9978 UNBLOCK_INPUT;
9980 return value;
9984 DEFUN ("x-delete-window-property", Fx_delete_window_property,
9985 Sx_delete_window_property, 1, 2, 0,
9986 "Remove window property PROP from X window of FRAME.\n\
9987 FRAME nil or omitted means use the selected frame. Value is PROP.")
9988 (prop, frame)
9989 Lisp_Object prop, frame;
9991 struct frame *f = check_x_frame (frame);
9992 Atom prop_atom;
9994 CHECK_STRING (prop, 1);
9995 BLOCK_INPUT;
9996 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
9997 XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), prop_atom);
9999 /* Make sure the property is removed when we return. */
10000 XFlush (FRAME_X_DISPLAY (f));
10001 UNBLOCK_INPUT;
10003 return prop;
10007 DEFUN ("x-window-property", Fx_window_property, Sx_window_property,
10008 1, 2, 0,
10009 "Value is the value of window property PROP on FRAME.\n\
10010 If FRAME is nil or omitted, use the selected frame. Value is nil\n\
10011 if FRAME hasn't a property with name PROP or if PROP has no string\n\
10012 value.")
10013 (prop, frame)
10014 Lisp_Object prop, frame;
10016 struct frame *f = check_x_frame (frame);
10017 Atom prop_atom;
10018 int rc;
10019 Lisp_Object prop_value = Qnil;
10020 char *tmp_data = NULL;
10021 Atom actual_type;
10022 int actual_format;
10023 unsigned long actual_size, bytes_remaining;
10025 CHECK_STRING (prop, 1);
10026 BLOCK_INPUT;
10027 prop_atom = XInternAtom (FRAME_X_DISPLAY (f), XSTRING (prop)->data, False);
10028 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10029 prop_atom, 0, 0, False, XA_STRING,
10030 &actual_type, &actual_format, &actual_size,
10031 &bytes_remaining, (unsigned char **) &tmp_data);
10032 if (rc == Success)
10034 int size = bytes_remaining;
10036 XFree (tmp_data);
10037 tmp_data = NULL;
10039 rc = XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10040 prop_atom, 0, bytes_remaining,
10041 False, XA_STRING,
10042 &actual_type, &actual_format,
10043 &actual_size, &bytes_remaining,
10044 (unsigned char **) &tmp_data);
10045 if (rc == Success)
10046 prop_value = make_string (tmp_data, size);
10048 XFree (tmp_data);
10051 UNBLOCK_INPUT;
10052 return prop_value;
10057 /***********************************************************************
10058 Busy cursor
10059 ***********************************************************************/
10061 /* If non-null, an asynchronous timer that, when it expires, displays
10062 a busy cursor on all frames. */
10064 static struct atimer *busy_cursor_atimer;
10066 /* Non-zero means a busy cursor is currently shown. */
10068 static int busy_cursor_shown_p;
10070 /* Number of seconds to wait before displaying a busy cursor. */
10072 static Lisp_Object Vbusy_cursor_delay;
10074 /* Default number of seconds to wait before displaying a busy
10075 cursor. */
10077 #define DEFAULT_BUSY_CURSOR_DELAY 1
10079 /* Function prototypes. */
10081 static void show_busy_cursor P_ ((struct atimer *));
10082 static void hide_busy_cursor P_ ((void));
10085 /* Cancel a currently active busy-cursor timer, and start a new one. */
10087 void
10088 start_busy_cursor ()
10090 EMACS_TIME delay;
10091 int secs, usecs = 0;
10093 cancel_busy_cursor ();
10095 if (INTEGERP (Vbusy_cursor_delay)
10096 && XINT (Vbusy_cursor_delay) > 0)
10097 secs = XFASTINT (Vbusy_cursor_delay);
10098 else if (FLOATP (Vbusy_cursor_delay)
10099 && XFLOAT_DATA (Vbusy_cursor_delay) > 0)
10101 Lisp_Object tem;
10102 tem = Ftruncate (Vbusy_cursor_delay, Qnil);
10103 secs = XFASTINT (tem);
10104 usecs = (XFLOAT_DATA (Vbusy_cursor_delay) - secs) * 1000000;
10106 else
10107 secs = DEFAULT_BUSY_CURSOR_DELAY;
10109 EMACS_SET_SECS_USECS (delay, secs, usecs);
10110 busy_cursor_atimer = start_atimer (ATIMER_RELATIVE, delay,
10111 show_busy_cursor, NULL);
10115 /* Cancel the busy cursor timer if active, hide a busy cursor if
10116 shown. */
10118 void
10119 cancel_busy_cursor ()
10121 if (busy_cursor_atimer)
10123 cancel_atimer (busy_cursor_atimer);
10124 busy_cursor_atimer = NULL;
10127 if (busy_cursor_shown_p)
10128 hide_busy_cursor ();
10132 /* Timer function of busy_cursor_atimer. TIMER is equal to
10133 busy_cursor_atimer.
10135 Display a busy cursor on all frames by mapping the frames'
10136 busy_window. Set the busy_p flag in the frames' output_data.x
10137 structure to indicate that a busy cursor is shown on the
10138 frames. */
10140 static void
10141 show_busy_cursor (timer)
10142 struct atimer *timer;
10144 /* The timer implementation will cancel this timer automatically
10145 after this function has run. Set busy_cursor_atimer to null
10146 so that we know the timer doesn't have to be canceled. */
10147 busy_cursor_atimer = NULL;
10149 if (!busy_cursor_shown_p)
10151 Lisp_Object rest, frame;
10153 BLOCK_INPUT;
10155 FOR_EACH_FRAME (rest, frame)
10156 if (FRAME_X_P (XFRAME (frame)))
10158 struct frame *f = XFRAME (frame);
10160 f->output_data.x->busy_p = 1;
10162 if (!f->output_data.x->busy_window)
10164 unsigned long mask = CWCursor;
10165 XSetWindowAttributes attrs;
10167 attrs.cursor = f->output_data.x->busy_cursor;
10169 f->output_data.x->busy_window
10170 = XCreateWindow (FRAME_X_DISPLAY (f),
10171 FRAME_OUTER_WINDOW (f),
10172 0, 0, 32000, 32000, 0, 0,
10173 InputOnly,
10174 CopyFromParent,
10175 mask, &attrs);
10178 XMapRaised (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
10179 XFlush (FRAME_X_DISPLAY (f));
10182 busy_cursor_shown_p = 1;
10183 UNBLOCK_INPUT;
10188 /* Hide the busy cursor on all frames, if it is currently shown. */
10190 static void
10191 hide_busy_cursor ()
10193 if (busy_cursor_shown_p)
10195 Lisp_Object rest, frame;
10197 BLOCK_INPUT;
10198 FOR_EACH_FRAME (rest, frame)
10200 struct frame *f = XFRAME (frame);
10202 if (FRAME_X_P (f)
10203 /* Watch out for newly created frames. */
10204 && f->output_data.x->busy_window)
10206 XUnmapWindow (FRAME_X_DISPLAY (f), f->output_data.x->busy_window);
10207 /* Sync here because XTread_socket looks at the busy_p flag
10208 that is reset to zero below. */
10209 XSync (FRAME_X_DISPLAY (f), False);
10210 f->output_data.x->busy_p = 0;
10214 busy_cursor_shown_p = 0;
10215 UNBLOCK_INPUT;
10221 /***********************************************************************
10222 Tool tips
10223 ***********************************************************************/
10225 static Lisp_Object x_create_tip_frame P_ ((struct x_display_info *,
10226 Lisp_Object));
10228 /* The frame of a currently visible tooltip, or null. */
10230 struct frame *tip_frame;
10232 /* If non-nil, a timer started that hides the last tooltip when it
10233 fires. */
10235 Lisp_Object tip_timer;
10236 Window tip_window;
10238 /* Create a frame for a tooltip on the display described by DPYINFO.
10239 PARMS is a list of frame parameters. Value is the frame. */
10241 static Lisp_Object
10242 x_create_tip_frame (dpyinfo, parms)
10243 struct x_display_info *dpyinfo;
10244 Lisp_Object parms;
10246 struct frame *f;
10247 Lisp_Object frame, tem;
10248 Lisp_Object name;
10249 long window_prompting = 0;
10250 int width, height;
10251 int count = specpdl_ptr - specpdl;
10252 struct gcpro gcpro1, gcpro2, gcpro3;
10253 struct kboard *kb;
10255 check_x ();
10257 /* Use this general default value to start with until we know if
10258 this frame has a specified name. */
10259 Vx_resource_name = Vinvocation_name;
10261 #ifdef MULTI_KBOARD
10262 kb = dpyinfo->kboard;
10263 #else
10264 kb = &the_only_kboard;
10265 #endif
10267 /* Get the name of the frame to use for resource lookup. */
10268 name = x_get_arg (dpyinfo, parms, Qname, "name", "Name", RES_TYPE_STRING);
10269 if (!STRINGP (name)
10270 && !EQ (name, Qunbound)
10271 && !NILP (name))
10272 error ("Invalid frame name--not a string or nil");
10273 Vx_resource_name = name;
10275 frame = Qnil;
10276 GCPRO3 (parms, name, frame);
10277 tip_frame = f = make_frame (1);
10278 XSETFRAME (frame, f);
10279 FRAME_CAN_HAVE_SCROLL_BARS (f) = 0;
10281 f->output_method = output_x_window;
10282 f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output));
10283 bzero (f->output_data.x, sizeof (struct x_output));
10284 f->output_data.x->icon_bitmap = -1;
10285 f->output_data.x->fontset = -1;
10286 f->icon_name = Qnil;
10287 FRAME_X_DISPLAY_INFO (f) = dpyinfo;
10288 #ifdef MULTI_KBOARD
10289 FRAME_KBOARD (f) = kb;
10290 #endif
10291 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10292 f->output_data.x->explicit_parent = 0;
10294 /* Set the name; the functions to which we pass f expect the name to
10295 be set. */
10296 if (EQ (name, Qunbound) || NILP (name))
10298 f->name = build_string (dpyinfo->x_id_name);
10299 f->explicit_name = 0;
10301 else
10303 f->name = name;
10304 f->explicit_name = 1;
10305 /* use the frame's title when getting resources for this frame. */
10306 specbind (Qx_resource_name, name);
10309 /* Create fontsets from `global_fontset_alist' before handling fonts. */
10310 for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCDR (tem))
10311 fs_register_fontset (f, XCAR (tem));
10313 /* Extract the window parameters from the supplied values
10314 that are needed to determine window geometry. */
10316 Lisp_Object font;
10318 font = x_get_arg (dpyinfo, parms, Qfont, "font", "Font", RES_TYPE_STRING);
10320 BLOCK_INPUT;
10321 /* First, try whatever font the caller has specified. */
10322 if (STRINGP (font))
10324 tem = Fquery_fontset (font, Qnil);
10325 if (STRINGP (tem))
10326 font = x_new_fontset (f, XSTRING (tem)->data);
10327 else
10328 font = x_new_font (f, XSTRING (font)->data);
10331 /* Try out a font which we hope has bold and italic variations. */
10332 if (!STRINGP (font))
10333 font = x_new_font (f, "-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
10334 if (!STRINGP (font))
10335 font = x_new_font (f, "-misc-fixed-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10336 if (! STRINGP (font))
10337 font = x_new_font (f, "-*-*-medium-r-normal-*-*-140-*-*-c-*-iso8859-1");
10338 if (! STRINGP (font))
10339 /* This was formerly the first thing tried, but it finds too many fonts
10340 and takes too long. */
10341 font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1");
10342 /* If those didn't work, look for something which will at least work. */
10343 if (! STRINGP (font))
10344 font = x_new_font (f, "-*-fixed-*-*-*-*-*-140-*-*-c-*-iso8859-1");
10345 UNBLOCK_INPUT;
10346 if (! STRINGP (font))
10347 font = build_string ("fixed");
10349 x_default_parameter (f, parms, Qfont, font,
10350 "font", "Font", RES_TYPE_STRING);
10353 x_default_parameter (f, parms, Qborder_width, make_number (2),
10354 "borderWidth", "BorderWidth", RES_TYPE_NUMBER);
10356 /* This defaults to 2 in order to match xterm. We recognize either
10357 internalBorderWidth or internalBorder (which is what xterm calls
10358 it). */
10359 if (NILP (Fassq (Qinternal_border_width, parms)))
10361 Lisp_Object value;
10363 value = x_get_arg (dpyinfo, parms, Qinternal_border_width,
10364 "internalBorder", "internalBorder", RES_TYPE_NUMBER);
10365 if (! EQ (value, Qunbound))
10366 parms = Fcons (Fcons (Qinternal_border_width, value),
10367 parms);
10370 x_default_parameter (f, parms, Qinternal_border_width, make_number (1),
10371 "internalBorderWidth", "internalBorderWidth",
10372 RES_TYPE_NUMBER);
10374 /* Also do the stuff which must be set before the window exists. */
10375 x_default_parameter (f, parms, Qforeground_color, build_string ("black"),
10376 "foreground", "Foreground", RES_TYPE_STRING);
10377 x_default_parameter (f, parms, Qbackground_color, build_string ("white"),
10378 "background", "Background", RES_TYPE_STRING);
10379 x_default_parameter (f, parms, Qmouse_color, build_string ("black"),
10380 "pointerColor", "Foreground", RES_TYPE_STRING);
10381 x_default_parameter (f, parms, Qcursor_color, build_string ("black"),
10382 "cursorColor", "Foreground", RES_TYPE_STRING);
10383 x_default_parameter (f, parms, Qborder_color, build_string ("black"),
10384 "borderColor", "BorderColor", RES_TYPE_STRING);
10386 /* Init faces before x_default_parameter is called for scroll-bar
10387 parameters because that function calls x_set_scroll_bar_width,
10388 which calls change_frame_size, which calls Fset_window_buffer,
10389 which runs hooks, which call Fvertical_motion. At the end, we
10390 end up in init_iterator with a null face cache, which should not
10391 happen. */
10392 init_frame_faces (f);
10394 f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window;
10395 window_prompting = x_figure_window_size (f, parms);
10397 if (window_prompting & XNegative)
10399 if (window_prompting & YNegative)
10400 f->output_data.x->win_gravity = SouthEastGravity;
10401 else
10402 f->output_data.x->win_gravity = NorthEastGravity;
10404 else
10406 if (window_prompting & YNegative)
10407 f->output_data.x->win_gravity = SouthWestGravity;
10408 else
10409 f->output_data.x->win_gravity = NorthWestGravity;
10412 f->output_data.x->size_hint_flags = window_prompting;
10414 XSetWindowAttributes attrs;
10415 unsigned long mask;
10417 BLOCK_INPUT;
10418 mask = CWBackPixel | CWOverrideRedirect | CWSaveUnder | CWEventMask;
10419 /* Window managers looks at the override-redirect flag to
10420 determine whether or net to give windows a decoration (Xlib
10421 3.2.8). */
10422 attrs.override_redirect = True;
10423 attrs.save_under = True;
10424 attrs.background_pixel = FRAME_BACKGROUND_PIXEL (f);
10425 /* Arrange for getting MapNotify and UnmapNotify events. */
10426 attrs.event_mask = StructureNotifyMask;
10427 tip_window
10428 = FRAME_X_WINDOW (f)
10429 = XCreateWindow (FRAME_X_DISPLAY (f),
10430 FRAME_X_DISPLAY_INFO (f)->root_window,
10431 /* x, y, width, height */
10432 0, 0, 1, 1,
10433 /* Border. */
10435 CopyFromParent, InputOutput, CopyFromParent,
10436 mask, &attrs);
10437 UNBLOCK_INPUT;
10440 x_make_gc (f);
10442 x_default_parameter (f, parms, Qauto_raise, Qnil,
10443 "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10444 x_default_parameter (f, parms, Qauto_lower, Qnil,
10445 "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN);
10446 x_default_parameter (f, parms, Qcursor_type, Qbox,
10447 "cursorType", "CursorType", RES_TYPE_SYMBOL);
10449 /* Dimensions, especially f->height, must be done via change_frame_size.
10450 Change will not be effected unless different from the current
10451 f->height. */
10452 width = f->width;
10453 height = f->height;
10454 f->height = 0;
10455 SET_FRAME_WIDTH (f, 0);
10456 change_frame_size (f, height, width, 1, 0, 0);
10458 f->no_split = 1;
10460 UNGCPRO;
10462 /* It is now ok to make the frame official even if we get an error
10463 below. And the frame needs to be on Vframe_list or making it
10464 visible won't work. */
10465 Vframe_list = Fcons (frame, Vframe_list);
10467 /* Now that the frame is official, it counts as a reference to
10468 its display. */
10469 FRAME_X_DISPLAY_INFO (f)->reference_count++;
10471 return unbind_to (count, frame);
10475 DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 4, 0,
10476 "Show STRING in a \"tooltip\" window on frame FRAME.\n\
10477 A tooltip window is a small X window displaying STRING at\n\
10478 the current mouse position.\n\
10479 FRAME nil or omitted means use the selected frame.\n\
10480 PARMS is an optional list of frame parameters which can be\n\
10481 used to change the tooltip's appearance.\n\
10482 Automatically hide the tooltip after TIMEOUT seconds.\n\
10483 TIMEOUT nil means use the default timeout of 5 seconds.")
10484 (string, frame, parms, timeout)
10485 Lisp_Object string, frame, parms, timeout;
10487 struct frame *f;
10488 struct window *w;
10489 Window root, child;
10490 Lisp_Object buffer;
10491 struct buffer *old_buffer;
10492 struct text_pos pos;
10493 int i, width, height;
10494 int root_x, root_y, win_x, win_y;
10495 unsigned pmask;
10496 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
10497 int old_windows_or_buffers_changed = windows_or_buffers_changed;
10498 int count = specpdl_ptr - specpdl;
10500 specbind (Qinhibit_redisplay, Qt);
10502 GCPRO4 (string, parms, frame, timeout);
10504 CHECK_STRING (string, 0);
10505 f = check_x_frame (frame);
10506 if (NILP (timeout))
10507 timeout = make_number (5);
10508 else
10509 CHECK_NATNUM (timeout, 2);
10511 /* Hide a previous tip, if any. */
10512 Fx_hide_tip ();
10514 /* Add default values to frame parameters. */
10515 if (NILP (Fassq (Qname, parms)))
10516 parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms);
10517 if (NILP (Fassq (Qinternal_border_width, parms)))
10518 parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms);
10519 if (NILP (Fassq (Qborder_width, parms)))
10520 parms = Fcons (Fcons (Qborder_width, make_number (1)), parms);
10521 if (NILP (Fassq (Qborder_color, parms)))
10522 parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms);
10523 if (NILP (Fassq (Qbackground_color, parms)))
10524 parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")),
10525 parms);
10527 /* Create a frame for the tooltip, and record it in the global
10528 variable tip_frame. */
10529 frame = x_create_tip_frame (FRAME_X_DISPLAY_INFO (f), parms);
10530 tip_frame = f = XFRAME (frame);
10532 /* Set up the frame's root window. Currently we use a size of 80
10533 columns x 40 lines. If someone wants to show a larger tip, he
10534 will loose. I don't think this is a realistic case. */
10535 w = XWINDOW (FRAME_ROOT_WINDOW (f));
10536 w->left = w->top = make_number (0);
10537 w->width = 80;
10538 w->height = 40;
10539 adjust_glyphs (f);
10540 w->pseudo_window_p = 1;
10542 /* Display the tooltip text in a temporary buffer. */
10543 buffer = Fget_buffer_create (build_string (" *tip*"));
10544 Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer);
10545 old_buffer = current_buffer;
10546 set_buffer_internal_1 (XBUFFER (buffer));
10547 Ferase_buffer ();
10548 Finsert (make_number (1), &string);
10549 clear_glyph_matrix (w->desired_matrix);
10550 clear_glyph_matrix (w->current_matrix);
10551 SET_TEXT_POS (pos, BEGV, BEGV_BYTE);
10552 try_window (FRAME_ROOT_WINDOW (f), pos);
10554 /* Compute width and height of the tooltip. */
10555 width = height = 0;
10556 for (i = 0; i < w->desired_matrix->nrows; ++i)
10558 struct glyph_row *row = &w->desired_matrix->rows[i];
10559 struct glyph *last;
10560 int row_width;
10562 /* Stop at the first empty row at the end. */
10563 if (!row->enabled_p || !row->displays_text_p)
10564 break;
10566 /* Let the row go over the full width of the frame. */
10567 row->full_width_p = 1;
10569 /* There's a glyph at the end of rows that is use to place
10570 the cursor there. Don't include the width of this glyph. */
10571 if (row->used[TEXT_AREA])
10573 last = &row->glyphs[TEXT_AREA][row->used[TEXT_AREA] - 1];
10574 row_width = row->pixel_width - last->pixel_width;
10576 else
10577 row_width = row->pixel_width;
10579 height += row->height;
10580 width = max (width, row_width);
10583 /* Add the frame's internal border to the width and height the X
10584 window should have. */
10585 height += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10586 width += 2 * FRAME_INTERNAL_BORDER_WIDTH (f);
10588 /* Move the tooltip window where the mouse pointer is. Resize and
10589 show it. */
10590 BLOCK_INPUT;
10591 XQueryPointer (FRAME_X_DISPLAY (f), FRAME_X_DISPLAY_INFO (f)->root_window,
10592 &root, &child, &root_x, &root_y, &win_x, &win_y, &pmask);
10593 XMoveResizeWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
10594 root_x + 5, root_y - height - 5, width, height);
10595 XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f));
10596 UNBLOCK_INPUT;
10598 /* Draw into the window. */
10599 w->must_be_updated_p = 1;
10600 update_single_window (w, 1);
10602 /* Restore original current buffer. */
10603 set_buffer_internal_1 (old_buffer);
10604 windows_or_buffers_changed = old_windows_or_buffers_changed;
10606 /* Let the tip disappear after timeout seconds. */
10607 tip_timer = call3 (intern ("run-at-time"), timeout, Qnil,
10608 intern ("x-hide-tip"));
10610 UNGCPRO;
10611 return unbind_to (count, Qnil);
10615 DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0,
10616 "Hide the current tooltip window, if there is any.\n\
10617 Value is t is tooltip was open, nil otherwise.")
10620 int count = specpdl_ptr - specpdl;
10621 int deleted_p = 0;
10623 specbind (Qinhibit_redisplay, Qt);
10625 if (!NILP (tip_timer))
10627 call1 (intern ("cancel-timer"), tip_timer);
10628 tip_timer = Qnil;
10631 if (tip_frame)
10633 Lisp_Object frame;
10635 XSETFRAME (frame, tip_frame);
10636 Fdelete_frame (frame, Qt);
10637 tip_frame = NULL;
10638 deleted_p = 1;
10641 return unbind_to (count, deleted_p ? Qt : Qnil);
10646 /***********************************************************************
10647 File selection dialog
10648 ***********************************************************************/
10650 #ifdef USE_MOTIF
10652 /* Callback for "OK" and "Cancel" on file selection dialog. */
10654 static void
10655 file_dialog_cb (widget, client_data, call_data)
10656 Widget widget;
10657 XtPointer call_data, client_data;
10659 int *result = (int *) client_data;
10660 XmAnyCallbackStruct *cb = (XmAnyCallbackStruct *) call_data;
10661 *result = cb->reason;
10665 DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 4, 0,
10666 "Read file name, prompting with PROMPT in directory DIR.\n\
10667 Use a file selection dialog.\n\
10668 Select DEFAULT-FILENAME in the dialog's file selection box, if\n\
10669 specified. Don't let the user enter a file name in the file\n\
10670 selection dialog's entry field, if MUSTMATCH is non-nil.")
10671 (prompt, dir, default_filename, mustmatch)
10672 Lisp_Object prompt, dir, default_filename, mustmatch;
10674 int result;
10675 struct frame *f = SELECTED_FRAME ();
10676 Lisp_Object file = Qnil;
10677 Widget dialog, text, list, help;
10678 Arg al[10];
10679 int ac = 0;
10680 extern XtAppContext Xt_app_con;
10681 char *title;
10682 XmString dir_xmstring, pattern_xmstring;
10683 int popup_activated_flag;
10684 int count = specpdl_ptr - specpdl;
10685 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
10687 GCPRO5 (prompt, dir, default_filename, mustmatch, file);
10688 CHECK_STRING (prompt, 0);
10689 CHECK_STRING (dir, 1);
10691 /* Prevent redisplay. */
10692 specbind (Qinhibit_redisplay, Qt);
10694 BLOCK_INPUT;
10696 /* Create the dialog with PROMPT as title, using DIR as initial
10697 directory and using "*" as pattern. */
10698 dir = Fexpand_file_name (dir, Qnil);
10699 dir_xmstring = XmStringCreateLocalized (XSTRING (dir)->data);
10700 pattern_xmstring = XmStringCreateLocalized ("*");
10702 XtSetArg (al[ac], XmNtitle, XSTRING (prompt)->data); ++ac;
10703 XtSetArg (al[ac], XmNdirectory, dir_xmstring); ++ac;
10704 XtSetArg (al[ac], XmNpattern, pattern_xmstring); ++ac;
10705 XtSetArg (al[ac], XmNresizePolicy, XmRESIZE_GROW); ++ac;
10706 XtSetArg (al[ac], XmNdialogStyle, XmDIALOG_APPLICATION_MODAL); ++ac;
10707 dialog = XmCreateFileSelectionDialog (f->output_data.x->widget,
10708 "fsb", al, ac);
10709 XmStringFree (dir_xmstring);
10710 XmStringFree (pattern_xmstring);
10712 /* Add callbacks for OK and Cancel. */
10713 XtAddCallback (dialog, XmNokCallback, file_dialog_cb,
10714 (XtPointer) &result);
10715 XtAddCallback (dialog, XmNcancelCallback, file_dialog_cb,
10716 (XtPointer) &result);
10718 /* Disable the help button since we can't display help. */
10719 help = XmFileSelectionBoxGetChild (dialog, XmDIALOG_HELP_BUTTON);
10720 XtSetSensitive (help, False);
10722 /* Mark OK button as default. */
10723 XtVaSetValues (XmFileSelectionBoxGetChild (dialog, XmDIALOG_OK_BUTTON),
10724 XmNshowAsDefault, True, NULL);
10726 /* If MUSTMATCH is non-nil, disable the file entry field of the
10727 dialog, so that the user must select a file from the files list
10728 box. We can't remove it because we wouldn't have a way to get at
10729 the result file name, then. */
10730 text = XmFileSelectionBoxGetChild (dialog, XmDIALOG_TEXT);
10731 if (!NILP (mustmatch))
10733 Widget label;
10734 label = XmFileSelectionBoxGetChild (dialog, XmDIALOG_SELECTION_LABEL);
10735 XtSetSensitive (text, False);
10736 XtSetSensitive (label, False);
10739 /* Manage the dialog, so that list boxes get filled. */
10740 XtManageChild (dialog);
10742 /* Select DEFAULT_FILENAME in the files list box. DEFAULT_FILENAME
10743 must include the path for this to work. */
10744 list = XmFileSelectionBoxGetChild (dialog, XmDIALOG_LIST);
10745 if (STRINGP (default_filename))
10747 XmString default_xmstring;
10748 int item_pos;
10750 default_xmstring
10751 = XmStringCreateLocalized (XSTRING (default_filename)->data);
10753 if (!XmListItemExists (list, default_xmstring))
10755 /* Add a new item if DEFAULT_FILENAME is not in the list. */
10756 XmListAddItem (list, default_xmstring, 0);
10757 item_pos = 0;
10759 else
10760 item_pos = XmListItemPos (list, default_xmstring);
10761 XmStringFree (default_xmstring);
10763 /* Select the item and scroll it into view. */
10764 XmListSelectPos (list, item_pos, True);
10765 XmListSetPos (list, item_pos);
10768 /* Process all events until the user presses Cancel or OK. */
10769 for (result = 0; result == 0;)
10771 XEvent event;
10772 Widget widget, parent;
10774 XtAppNextEvent (Xt_app_con, &event);
10776 /* See if the receiver of the event is one of the widgets of
10777 the file selection dialog. If so, dispatch it. If not,
10778 discard it. */
10779 widget = XtWindowToWidget (event.xany.display, event.xany.window);
10780 parent = widget;
10781 while (parent && parent != dialog)
10782 parent = XtParent (parent);
10784 if (parent == dialog
10785 || (event.type == Expose
10786 && !process_expose_from_menu (event)))
10787 XtDispatchEvent (&event);
10790 /* Get the result. */
10791 if (result == XmCR_OK)
10793 XmString text;
10794 String data;
10796 XtVaGetValues (dialog, XmNtextString, &text, 0);
10797 XmStringGetLtoR (text, XmFONTLIST_DEFAULT_TAG, &data);
10798 XmStringFree (text);
10799 file = build_string (data);
10800 XtFree (data);
10802 else
10803 file = Qnil;
10805 /* Clean up. */
10806 XtUnmanageChild (dialog);
10807 XtDestroyWidget (dialog);
10808 UNBLOCK_INPUT;
10809 UNGCPRO;
10811 /* Make "Cancel" equivalent to C-g. */
10812 if (NILP (file))
10813 Fsignal (Qquit, Qnil);
10815 return unbind_to (count, file);
10818 #endif /* USE_MOTIF */
10821 /***********************************************************************
10822 Tests
10823 ***********************************************************************/
10825 #if GLYPH_DEBUG
10827 DEFUN ("imagep", Fimagep, Simagep, 1, 1, 0,
10828 "Value is non-nil if SPEC is a valid image specification.")
10829 (spec)
10830 Lisp_Object spec;
10832 return valid_image_p (spec) ? Qt : Qnil;
10836 DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0, "")
10837 (spec)
10838 Lisp_Object spec;
10840 int id = -1;
10842 if (valid_image_p (spec))
10843 id = lookup_image (SELECTED_FRAME (), spec);
10845 debug_print (spec);
10846 return make_number (id);
10849 #endif /* GLYPH_DEBUG != 0 */
10853 /***********************************************************************
10854 Initialization
10855 ***********************************************************************/
10857 void
10858 syms_of_xfns ()
10860 /* This is zero if not using X windows. */
10861 x_in_use = 0;
10863 /* The section below is built by the lisp expression at the top of the file,
10864 just above where these variables are declared. */
10865 /*&&& init symbols here &&&*/
10866 Qauto_raise = intern ("auto-raise");
10867 staticpro (&Qauto_raise);
10868 Qauto_lower = intern ("auto-lower");
10869 staticpro (&Qauto_lower);
10870 Qbar = intern ("bar");
10871 staticpro (&Qbar);
10872 Qborder_color = intern ("border-color");
10873 staticpro (&Qborder_color);
10874 Qborder_width = intern ("border-width");
10875 staticpro (&Qborder_width);
10876 Qbox = intern ("box");
10877 staticpro (&Qbox);
10878 Qcursor_color = intern ("cursor-color");
10879 staticpro (&Qcursor_color);
10880 Qcursor_type = intern ("cursor-type");
10881 staticpro (&Qcursor_type);
10882 Qgeometry = intern ("geometry");
10883 staticpro (&Qgeometry);
10884 Qicon_left = intern ("icon-left");
10885 staticpro (&Qicon_left);
10886 Qicon_top = intern ("icon-top");
10887 staticpro (&Qicon_top);
10888 Qicon_type = intern ("icon-type");
10889 staticpro (&Qicon_type);
10890 Qicon_name = intern ("icon-name");
10891 staticpro (&Qicon_name);
10892 Qinternal_border_width = intern ("internal-border-width");
10893 staticpro (&Qinternal_border_width);
10894 Qleft = intern ("left");
10895 staticpro (&Qleft);
10896 Qright = intern ("right");
10897 staticpro (&Qright);
10898 Qmouse_color = intern ("mouse-color");
10899 staticpro (&Qmouse_color);
10900 Qnone = intern ("none");
10901 staticpro (&Qnone);
10902 Qparent_id = intern ("parent-id");
10903 staticpro (&Qparent_id);
10904 Qscroll_bar_width = intern ("scroll-bar-width");
10905 staticpro (&Qscroll_bar_width);
10906 Qsuppress_icon = intern ("suppress-icon");
10907 staticpro (&Qsuppress_icon);
10908 Qundefined_color = intern ("undefined-color");
10909 staticpro (&Qundefined_color);
10910 Qvertical_scroll_bars = intern ("vertical-scroll-bars");
10911 staticpro (&Qvertical_scroll_bars);
10912 Qvisibility = intern ("visibility");
10913 staticpro (&Qvisibility);
10914 Qwindow_id = intern ("window-id");
10915 staticpro (&Qwindow_id);
10916 Qouter_window_id = intern ("outer-window-id");
10917 staticpro (&Qouter_window_id);
10918 Qx_frame_parameter = intern ("x-frame-parameter");
10919 staticpro (&Qx_frame_parameter);
10920 Qx_resource_name = intern ("x-resource-name");
10921 staticpro (&Qx_resource_name);
10922 Quser_position = intern ("user-position");
10923 staticpro (&Quser_position);
10924 Quser_size = intern ("user-size");
10925 staticpro (&Quser_size);
10926 Qscroll_bar_foreground = intern ("scroll-bar-foreground");
10927 staticpro (&Qscroll_bar_foreground);
10928 Qscroll_bar_background = intern ("scroll-bar-background");
10929 staticpro (&Qscroll_bar_background);
10930 Qscreen_gamma = intern ("screen-gamma");
10931 staticpro (&Qscreen_gamma);
10932 /* This is the end of symbol initialization. */
10934 /* Text property `display' should be nonsticky by default. */
10935 Vtext_property_default_nonsticky
10936 = Fcons (Fcons (Qdisplay, Qt), Vtext_property_default_nonsticky);
10939 Qlaplace = intern ("laplace");
10940 staticpro (&Qlaplace);
10942 Qface_set_after_frame_default = intern ("face-set-after-frame-default");
10943 staticpro (&Qface_set_after_frame_default);
10945 Fput (Qundefined_color, Qerror_conditions,
10946 Fcons (Qundefined_color, Fcons (Qerror, Qnil)));
10947 Fput (Qundefined_color, Qerror_message,
10948 build_string ("Undefined color"));
10950 init_x_parm_symbols ();
10952 DEFVAR_LISP ("x-bitmap-file-path", &Vx_bitmap_file_path,
10953 "List of directories to search for bitmap files for X.");
10954 Vx_bitmap_file_path = decode_env_path ((char *) 0, PATH_BITMAPS);
10956 DEFVAR_LISP ("x-pointer-shape", &Vx_pointer_shape,
10957 "The shape of the pointer when over text.\n\
10958 Changing the value does not affect existing frames\n\
10959 unless you set the mouse color.");
10960 Vx_pointer_shape = Qnil;
10962 DEFVAR_LISP ("x-resource-name", &Vx_resource_name,
10963 "The name Emacs uses to look up X resources.\n\
10964 `x-get-resource' uses this as the first component of the instance name\n\
10965 when requesting resource values.\n\
10966 Emacs initially sets `x-resource-name' to the name under which Emacs\n\
10967 was invoked, or to the value specified with the `-name' or `-rn'\n\
10968 switches, if present.\n\
10970 It may be useful to bind this variable locally around a call\n\
10971 to `x-get-resource'. See also the variable `x-resource-class'.");
10972 Vx_resource_name = Qnil;
10974 DEFVAR_LISP ("x-resource-class", &Vx_resource_class,
10975 "The class Emacs uses to look up X resources.\n\
10976 `x-get-resource' uses this as the first component of the instance class\n\
10977 when requesting resource values.\n\
10978 Emacs initially sets `x-resource-class' to \"Emacs\".\n\
10980 Setting this variable permanently is not a reasonable thing to do,\n\
10981 but binding this variable locally around a call to `x-get-resource'\n\
10982 is a reasonable practice. See also the variable `x-resource-name'.");
10983 Vx_resource_class = build_string (EMACS_CLASS);
10985 #if 0 /* This doesn't really do anything. */
10986 DEFVAR_LISP ("x-nontext-pointer-shape", &Vx_nontext_pointer_shape,
10987 "The shape of the pointer when not over text.\n\
10988 This variable takes effect when you create a new frame\n\
10989 or when you set the mouse color.");
10990 #endif
10991 Vx_nontext_pointer_shape = Qnil;
10993 DEFVAR_LISP ("x-busy-pointer-shape", &Vx_busy_pointer_shape,
10994 "The shape of the pointer when Emacs is busy.\n\
10995 This variable takes effect when you create a new frame\n\
10996 or when you set the mouse color.");
10997 Vx_busy_pointer_shape = Qnil;
10999 DEFVAR_BOOL ("display-busy-cursor", &display_busy_cursor_p,
11000 "Non-zero means Emacs displays a busy cursor on window systems.");
11001 display_busy_cursor_p = 1;
11003 DEFVAR_LISP ("busy-cursor-delay", &Vbusy_cursor_delay,
11004 "*Seconds to wait before displaying a busy-cursor.\n\
11005 Value must be an integer or float.");
11006 Vbusy_cursor_delay = make_number (DEFAULT_BUSY_CURSOR_DELAY);
11008 #if 0 /* This doesn't really do anything. */
11009 DEFVAR_LISP ("x-mode-pointer-shape", &Vx_mode_pointer_shape,
11010 "The shape of the pointer when over the mode line.\n\
11011 This variable takes effect when you create a new frame\n\
11012 or when you set the mouse color.");
11013 #endif
11014 Vx_mode_pointer_shape = Qnil;
11016 DEFVAR_LISP ("x-sensitive-text-pointer-shape",
11017 &Vx_sensitive_text_pointer_shape,
11018 "The shape of the pointer when over mouse-sensitive text.\n\
11019 This variable takes effect when you create a new frame\n\
11020 or when you set the mouse color.");
11021 Vx_sensitive_text_pointer_shape = Qnil;
11023 DEFVAR_LISP ("x-cursor-fore-pixel", &Vx_cursor_fore_pixel,
11024 "A string indicating the foreground color of the cursor box.");
11025 Vx_cursor_fore_pixel = Qnil;
11027 DEFVAR_LISP ("x-no-window-manager", &Vx_no_window_manager,
11028 "Non-nil if no X window manager is in use.\n\
11029 Emacs doesn't try to figure this out; this is always nil\n\
11030 unless you set it to something else.");
11031 /* We don't have any way to find this out, so set it to nil
11032 and maybe the user would like to set it to t. */
11033 Vx_no_window_manager = Qnil;
11035 DEFVAR_LISP ("x-pixel-size-width-font-regexp",
11036 &Vx_pixel_size_width_font_regexp,
11037 "Regexp matching a font name whose width is the same as `PIXEL_SIZE'.\n\
11039 Since Emacs gets width of a font matching with this regexp from\n\
11040 PIXEL_SIZE field of the name, font finding mechanism gets faster for\n\
11041 such a font. This is especially effective for such large fonts as\n\
11042 Chinese, Japanese, and Korean.");
11043 Vx_pixel_size_width_font_regexp = Qnil;
11045 DEFVAR_LISP ("image-cache-eviction-delay", &Vimage_cache_eviction_delay,
11046 "Time after which cached images are removed from the cache.\n\
11047 When an image has not been displayed this many seconds, remove it\n\
11048 from the image cache. Value must be an integer or nil with nil\n\
11049 meaning don't clear the cache.");
11050 Vimage_cache_eviction_delay = make_number (30 * 60);
11052 DEFVAR_LISP ("image-types", &Vimage_types,
11053 "List of supported image types.\n\
11054 Each element of the list is a symbol for a supported image type.");
11055 Vimage_types = Qnil;
11057 #ifdef USE_X_TOOLKIT
11058 Fprovide (intern ("x-toolkit"));
11059 #endif
11060 #ifdef USE_MOTIF
11061 Fprovide (intern ("motif"));
11062 #endif
11064 defsubr (&Sx_get_resource);
11066 /* X window properties. */
11067 defsubr (&Sx_change_window_property);
11068 defsubr (&Sx_delete_window_property);
11069 defsubr (&Sx_window_property);
11071 #if 0
11072 defsubr (&Sx_draw_rectangle);
11073 defsubr (&Sx_erase_rectangle);
11074 defsubr (&Sx_contour_region);
11075 defsubr (&Sx_uncontour_region);
11076 #endif
11077 defsubr (&Sxw_display_color_p);
11078 defsubr (&Sx_display_grayscale_p);
11079 defsubr (&Sxw_color_defined_p);
11080 defsubr (&Sxw_color_values);
11081 defsubr (&Sx_server_max_request_size);
11082 defsubr (&Sx_server_vendor);
11083 defsubr (&Sx_server_version);
11084 defsubr (&Sx_display_pixel_width);
11085 defsubr (&Sx_display_pixel_height);
11086 defsubr (&Sx_display_mm_width);
11087 defsubr (&Sx_display_mm_height);
11088 defsubr (&Sx_display_screens);
11089 defsubr (&Sx_display_planes);
11090 defsubr (&Sx_display_color_cells);
11091 defsubr (&Sx_display_visual_class);
11092 defsubr (&Sx_display_backing_store);
11093 defsubr (&Sx_display_save_under);
11094 #if 0
11095 defsubr (&Sx_rebind_key);
11096 defsubr (&Sx_rebind_keys);
11097 defsubr (&Sx_track_pointer);
11098 defsubr (&Sx_grab_pointer);
11099 defsubr (&Sx_ungrab_pointer);
11100 #endif
11101 defsubr (&Sx_parse_geometry);
11102 defsubr (&Sx_create_frame);
11103 #if 0
11104 defsubr (&Sx_horizontal_line);
11105 #endif
11106 defsubr (&Sx_open_connection);
11107 defsubr (&Sx_close_connection);
11108 defsubr (&Sx_display_list);
11109 defsubr (&Sx_synchronize);
11111 /* Setting callback functions for fontset handler. */
11112 get_font_info_func = x_get_font_info;
11114 #if 0 /* This function pointer doesn't seem to be used anywhere.
11115 And the pointer assigned has the wrong type, anyway. */
11116 list_fonts_func = x_list_fonts;
11117 #endif
11119 load_font_func = x_load_font;
11120 find_ccl_program_func = x_find_ccl_program;
11121 query_font_func = x_query_font;
11122 set_frame_fontset_func = x_set_font;
11123 check_window_system_func = check_x;
11125 /* Images. */
11126 Qxbm = intern ("xbm");
11127 staticpro (&Qxbm);
11128 QCtype = intern (":type");
11129 staticpro (&QCtype);
11130 QCalgorithm = intern (":algorithm");
11131 staticpro (&QCalgorithm);
11132 QCheuristic_mask = intern (":heuristic-mask");
11133 staticpro (&QCheuristic_mask);
11134 QCcolor_symbols = intern (":color-symbols");
11135 staticpro (&QCcolor_symbols);
11136 QCdata = intern (":data");
11137 staticpro (&QCdata);
11138 QCascent = intern (":ascent");
11139 staticpro (&QCascent);
11140 QCmargin = intern (":margin");
11141 staticpro (&QCmargin);
11142 QCrelief = intern (":relief");
11143 staticpro (&QCrelief);
11144 Qpostscript = intern ("postscript");
11145 staticpro (&Qpostscript);
11146 QCloader = intern (":loader");
11147 staticpro (&QCloader);
11148 QCbounding_box = intern (":bounding-box");
11149 staticpro (&QCbounding_box);
11150 QCpt_width = intern (":pt-width");
11151 staticpro (&QCpt_width);
11152 QCpt_height = intern (":pt-height");
11153 staticpro (&QCpt_height);
11154 QCindex = intern (":index");
11155 staticpro (&QCindex);
11156 Qpbm = intern ("pbm");
11157 staticpro (&Qpbm);
11159 #if HAVE_XPM
11160 Qxpm = intern ("xpm");
11161 staticpro (&Qxpm);
11162 #endif
11164 #if HAVE_JPEG
11165 Qjpeg = intern ("jpeg");
11166 staticpro (&Qjpeg);
11167 #endif
11169 #if HAVE_TIFF
11170 Qtiff = intern ("tiff");
11171 staticpro (&Qtiff);
11172 #endif
11174 #if HAVE_GIF
11175 Qgif = intern ("gif");
11176 staticpro (&Qgif);
11177 #endif
11179 #if HAVE_PNG
11180 Qpng = intern ("png");
11181 staticpro (&Qpng);
11182 #endif
11184 defsubr (&Sclear_image_cache);
11186 #if GLYPH_DEBUG
11187 defsubr (&Simagep);
11188 defsubr (&Slookup_image);
11189 #endif
11191 busy_cursor_atimer = NULL;
11192 busy_cursor_shown_p = 0;
11194 defsubr (&Sx_show_tip);
11195 defsubr (&Sx_hide_tip);
11196 staticpro (&tip_timer);
11197 tip_timer = Qnil;
11199 #ifdef USE_MOTIF
11200 defsubr (&Sx_file_dialog);
11201 #endif
11205 void
11206 init_xfns ()
11208 image_types = NULL;
11209 Vimage_types = Qnil;
11211 define_image_type (&xbm_type);
11212 define_image_type (&gs_type);
11213 define_image_type (&pbm_type);
11215 #if HAVE_XPM
11216 define_image_type (&xpm_type);
11217 #endif
11219 #if HAVE_JPEG
11220 define_image_type (&jpeg_type);
11221 #endif
11223 #if HAVE_TIFF
11224 define_image_type (&tiff_type);
11225 #endif
11227 #if HAVE_GIF
11228 define_image_type (&gif_type);
11229 #endif
11231 #if HAVE_PNG
11232 define_image_type (&png_type);
11233 #endif
11236 #endif /* HAVE_X_WINDOWS */