X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/536aa4668198bf4851356a8e3a57b7f8969014c3..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/xfns.c diff --git a/src/xfns.c b/src/xfns.c index 13b4c6e787..65edf6ddb9 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "xterm.h" +#include "menu.h" #include "frame.h" #include "window.h" #include "character.h" @@ -124,7 +125,6 @@ extern LWLIB_ID widget_id_tick; #define MAXREQUEST(dpy) (XMaxRequestSize (dpy)) -static Lisp_Object Qsuppress_icon; static Lisp_Object Qundefined_color; static Lisp_Object Qcompound_text, Qcancel_timer; Lisp_Object Qfont_param; @@ -329,8 +329,43 @@ x_real_positions (struct frame *f, int *xptr, int *yptr) *yptr = real_y; } - +/* Get the mouse position in frame relative coordinates. */ + +void +x_relative_mouse_position (struct frame *f, int *x, int *y) +{ + Window root, dummy_window; + int dummy; + + eassert (FRAME_X_P (f)); + + block_input (); + + XQueryPointer (FRAME_X_DISPLAY (f), + DefaultRootWindow (FRAME_X_DISPLAY (f)), + + /* The root window which contains the pointer. */ + &root, + /* Window pointer is on, not used */ + &dummy_window, + + /* The position on that root window. */ + x, y, + + /* x/y in dummy_window coordinates, not used. */ + &dummy, &dummy, + + /* Modifier keys and pointer buttons, about which + we don't care. */ + (unsigned int *) &dummy); + + unblock_input (); + + /* Translate root window coordinates to window coordinates. */ + *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f); + *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f); +} /* Gamma-correct COLOR on frame F. */ @@ -577,35 +612,6 @@ x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } } -static Cursor -make_invisible_cursor (struct frame *f) -{ - Display *dpy = FRAME_X_DISPLAY (f); - static char const no_data[] = { 0 }; - Pixmap pix; - XColor col; - Cursor c = 0; - - x_catch_errors (dpy); - pix = XCreateBitmapFromData (dpy, FRAME_DISPLAY_INFO (f)->root_window, - no_data, 1, 1); - if (! x_had_errors_p (dpy) && pix != None) - { - Cursor pixc; - col.pixel = 0; - col.red = col.green = col.blue = 0; - col.flags = DoRed | DoGreen | DoBlue; - pixc = XCreatePixmapCursor (dpy, pix, pix, &col, &col, 0, 0); - if (! x_had_errors_p (dpy) && pixc != None) - c = pixc; - XFreePixmap (dpy, pix); - } - - x_uncatch_errors (); - - return c; -} - static void x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { @@ -723,9 +729,6 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) XDefineCursor (dpy, FRAME_X_WINDOW (f), f->output_data.x->current_cursor = cursor); - if (FRAME_DISPLAY_INFO (f)->invisible_cursor == 0) - FRAME_DISPLAY_INFO (f)->invisible_cursor = make_invisible_cursor (f); - if (cursor != x->text_cursor && x->text_cursor != 0) XFreeCursor (dpy, x->text_cursor); @@ -1280,7 +1283,7 @@ x_encode_text (Lisp_Object string, Lisp_Object coding_system, int selectionp, coding.mode |= (CODING_MODE_SAFE_ENCODING | CODING_MODE_LAST_BLOCK); /* We suppress producing escape sequences for composition. */ coding.common_flags &= ~CODING_ANNOTATION_MASK; - coding.destination = xnmalloc (SCHARS (string), 2); + coding.destination = xnmalloc_atomic (SCHARS (string), 2); coding.dst_bytes = SCHARS (string) * 2; encode_coding_object (&coding, string, 0, 0, SCHARS (string), SBYTES (string), Qnil); @@ -1678,7 +1681,7 @@ xic_create_fontsetname (const char *base_fontname, int motif) if (xic_default_fontset == base_fontname) { /* There is no base font name, use the default. */ - fontsetname = xmalloc (strlen (base_fontname) + 2); + fontsetname = xmalloc_atomic (strlen (base_fontname) + 2); strcpy (fontsetname, base_fontname); } else @@ -1698,8 +1701,8 @@ xic_create_fontsetname (const char *base_fontname, int motif) /* As the font name doesn't conform to XLFD, we can't modify it to generalize it to allcs and allfamilies. Use the specified font plus the default. */ - fontsetname = xmalloc (strlen (base_fontname) - + strlen (xic_default_fontset) + 3); + fontsetname = xmalloc_atomic (strlen (base_fontname) + + strlen (xic_default_fontset) + 3); strcpy (fontsetname, base_fontname); strcat (fontsetname, sep); strcat (fontsetname, xic_default_fontset); @@ -1771,7 +1774,7 @@ xic_create_fontsetname (const char *base_fontname, int motif) /* Build the actual font set name. */ len = strlen (base_fontname) + strlen (font_allcs) + strlen (font_allfamilies) + strlen (font_all) + 5; - fontsetname = xmalloc (len); + fontsetname = xmalloc_atomic (len); strcpy (fontsetname, base_fontname); strcat (fontsetname, sep); strcat (fontsetname, font_allcs); @@ -2883,7 +2886,7 @@ This function is an internal primitive--use `make-frame' instead. */) int minibuffer_only = 0; long window_prompting = 0; int width, height; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object display; struct x_display_info *dpyinfo = NULL; @@ -3150,7 +3153,7 @@ This function is an internal primitive--use `make-frame' instead. */) could get an infloop in next_frame since the frame is not yet in Vframe_list. */ { - ptrdiff_t count2 = SPECPDL_INDEX (); + dynwind_begin (); record_unwind_protect (unwind_create_frame_1, inhibit_lisp_code); inhibit_lisp_code = Qt; @@ -3163,7 +3166,7 @@ This function is an internal primitive--use `make-frame' instead. */) ? make_number (0) : make_number (1), NULL, NULL, RES_TYPE_NUMBER); - unbind_to (count2, Qnil); + dynwind_end (); } x_default_parameter (f, parms, Qbuffer_predicate, Qnil, @@ -3311,7 +3314,8 @@ This function is an internal primitive--use `make-frame' instead. */) and similar functions. */ Vwindow_list = Qnil; - return unbind_to (count, frame); + dynwind_end (); + return frame; } @@ -4522,7 +4526,7 @@ FRAME. Default is to change on the edit X window. */) This applies even if long is more than 32 bits. The X library converts to 32 bits before sending to the X server. */ elsize = element_format == 32 ? sizeof (long) : element_format >> 3; - data = xnmalloc (nelements, elsize); + data = xnmalloc_atomic (nelements, elsize); x_fill_property_data (FRAME_X_DISPLAY (f), value, data, element_format); } @@ -4582,75 +4586,43 @@ FRAME nil or omitted means use the selected frame. Value is PROP. */) } -DEFUN ("x-window-property", Fx_window_property, Sx_window_property, - 1, 6, 0, - doc: /* Value is the value of window property PROP on FRAME. -If FRAME is nil or omitted, use the selected frame. - -On X Windows, the following optional arguments are also accepted: -If TYPE is nil or omitted, get the property as a string. -Otherwise TYPE is the name of the atom that denotes the type expected. -If SOURCE is non-nil, get the property on that window instead of from -FRAME. The number 0 denotes the root window. -If DELETE-P is non-nil, delete the property after retrieving it. -If VECTOR-RET-P is non-nil, don't return a string but a vector of values. - -On MS Windows, this function accepts but ignores those optional arguments. - -Value is nil if FRAME hasn't a property with name PROP or if PROP has -no value of TYPE (always string in the MS Windows case). */) - (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, - Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p) +static Lisp_Object +x_window_property_intern (struct frame *f, + Window target_window, + Atom prop_atom, + Atom target_type, + Lisp_Object delete_p, + Lisp_Object vector_ret_p, + bool *found) { - struct frame *f = decode_window_system_frame (frame); - Atom prop_atom; - int rc; - Lisp_Object prop_value = Qnil; unsigned char *tmp_data = NULL; + Lisp_Object prop_value = Qnil; Atom actual_type; - Atom target_type = XA_STRING; int actual_format; unsigned long actual_size, bytes_remaining; - Window target_window = FRAME_X_WINDOW (f); + int rc; struct gcpro gcpro1; GCPRO1 (prop_value); - CHECK_STRING (prop); - - if (! NILP (source)) - { - CONS_TO_INTEGER (source, Window, target_window); - if (! target_window) - target_window = FRAME_DISPLAY_INFO (f)->root_window; - } - - block_input (); - if (STRINGP (type)) - { - if (strcmp ("AnyPropertyType", SSDATA (type)) == 0) - target_type = AnyPropertyType; - else - target_type = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (type), False); - } - prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window, prop_atom, 0, 0, False, target_type, &actual_type, &actual_format, &actual_size, &bytes_remaining, &tmp_data); - if (rc == Success) - { - int size = bytes_remaining; + *found = actual_format != 0; + + if (rc == Success && *found) + { XFree (tmp_data); tmp_data = NULL; rc = XGetWindowProperty (FRAME_X_DISPLAY (f), target_window, - prop_atom, 0, bytes_remaining, - ! NILP (delete_p), target_type, - &actual_type, &actual_format, - &actual_size, &bytes_remaining, - &tmp_data); + prop_atom, 0, bytes_remaining, + ! NILP (delete_p), target_type, + &actual_type, &actual_format, + &actual_size, &bytes_remaining, + &tmp_data); if (rc == Success && tmp_data) { /* The man page for XGetWindowProperty says: @@ -4678,7 +4650,7 @@ no value of TYPE (always string in the MS Windows case). */) } if (NILP (vector_ret_p)) - prop_value = make_string ((char *) tmp_data, size); + prop_value = make_string ((char *) tmp_data, actual_size); else prop_value = x_property_data_to_lisp (f, tmp_data, @@ -4690,6 +4662,80 @@ no value of TYPE (always string in the MS Windows case). */) if (tmp_data) XFree (tmp_data); } + UNGCPRO; + return prop_value; +} + +DEFUN ("x-window-property", Fx_window_property, Sx_window_property, + 1, 6, 0, + doc: /* Value is the value of window property PROP on FRAME. +If FRAME is nil or omitted, use the selected frame. + +On X Windows, the following optional arguments are also accepted: +If TYPE is nil or omitted, get the property as a string. +Otherwise TYPE is the name of the atom that denotes the type expected. +If SOURCE is non-nil, get the property on that window instead of from +FRAME. The number 0 denotes the root window. +If DELETE-P is non-nil, delete the property after retrieving it. +If VECTOR-RET-P is non-nil, don't return a string but a vector of values. + +On MS Windows, this function accepts but ignores those optional arguments. + +Value is nil if FRAME hasn't a property with name PROP or if PROP has +no value of TYPE (always string in the MS Windows case). */) + (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, + Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p) +{ + struct frame *f = decode_window_system_frame (frame); + Atom prop_atom; + Lisp_Object prop_value = Qnil; + Atom target_type = XA_STRING; + Window target_window = FRAME_X_WINDOW (f); + struct gcpro gcpro1; + bool found; + + GCPRO1 (prop_value); + CHECK_STRING (prop); + + if (! NILP (source)) + { + CONS_TO_INTEGER (source, Window, target_window); + if (! target_window) + target_window = FRAME_DISPLAY_INFO (f)->root_window; + } + + block_input (); + if (STRINGP (type)) + { + if (strcmp ("AnyPropertyType", SSDATA (type)) == 0) + target_type = AnyPropertyType; + else + target_type = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (type), False); + } + + prop_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (prop), False); + prop_value = x_window_property_intern (f, + target_window, + prop_atom, + target_type, + delete_p, + vector_ret_p, + &found); + if (NILP (prop_value) + && ! found + && NILP (source) + && target_window != FRAME_OUTER_WINDOW (f)) + { + prop_value = x_window_property_intern (f, + FRAME_OUTER_WINDOW (f), + prop_atom, + target_type, + delete_p, + vector_ret_p, + &found); + } + + unblock_input (); UNGCPRO; return prop_value; @@ -4862,7 +4908,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object frame; Lisp_Object name; int width, height; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3; int face_change_count_before = face_change_count; Lisp_Object buffer; @@ -5161,7 +5207,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, face_change_count = face_change_count_before; /* Discard the unwind_protect. */ - return unbind_to (count, frame); + dynwind_end (); + return frame; } @@ -5259,7 +5306,7 @@ Text larger than the specified size is clipped. */) int i, width, height, seen_reversed_p; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int old_windows_or_buffers_changed = windows_or_buffers_changed; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qinhibit_redisplay, Qt); @@ -5520,7 +5567,8 @@ Text larger than the specified size is clipped. */) intern ("x-hide-tip")); UNGCPRO; - return unbind_to (count, Qnil); + dynwind_end (); + return Qnil; } @@ -5542,7 +5590,7 @@ Value is t if tooltip was open, nil otherwise. */) GCPRO2 (frame, timer); tip_frame = tip_timer = deleted = Qnil; - count = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qinhibit_redisplay, Qt); specbind (Qinhibit_quit, Qt); @@ -5585,7 +5633,8 @@ Value is t if tooltip was open, nil otherwise. */) } UNGCPRO; - return unbind_to (count, deleted); + dynwind_end (); + return deleted; } @@ -5669,7 +5718,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) Arg al[10]; int ac = 0; XmString dir_xmstring, pattern_xmstring; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; check_window_system (f); @@ -5808,7 +5857,8 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) decoded_file = DECODE_FILE (file); - return unbind_to (count, decoded_file); + dynwind_end (); + return decoded_file; } #endif /* USE_MOTIF */ @@ -5836,7 +5886,7 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) char *fn; Lisp_Object file = Qnil; Lisp_Object decoded_file; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; char *cdef_file; @@ -5880,7 +5930,8 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) decoded_file = DECODE_FILE (file); - return unbind_to (count, decoded_file); + dynwind_end (); + return decoded_file; } @@ -5900,7 +5951,7 @@ nil, it defaults to the selected frame. */) Lisp_Object font_param; char *default_name = NULL; struct gcpro gcpro1, gcpro2; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); if (popup_activated ()) error ("Trying to use a menu from within a menu-entry"); @@ -5932,7 +5983,8 @@ nil, it defaults to the selected frame. */) if (NILP (font)) Fsignal (Qquit, Qnil); - return unbind_to (count, font); + dynwind_end (); + return font; } #endif /* HAVE_FREETYPE */ @@ -6091,15 +6143,12 @@ frame_parm_handler x_frame_parm_handlers[] = void syms_of_xfns (void) { - /* The section below is built by the lisp expression at the top of the file, - just above where these variables are declared. */ - /*&&& init symbols here &&&*/ - DEFSYM (Qsuppress_icon, "suppress-icon"); +#include "xfns.x" + DEFSYM (Qundefined_color, "undefined-color"); DEFSYM (Qcompound_text, "compound-text"); DEFSYM (Qcancel_timer, "cancel-timer"); DEFSYM (Qfont_param, "font-parameter"); - /* This is the end of symbol initialization. */ Fput (Qundefined_color, Qerror_conditions, listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror)); @@ -6247,39 +6296,6 @@ When using Gtk+ tooltips, the tooltip face is not used. */); } #endif /* USE_GTK */ - /* X window properties. */ - defsubr (&Sx_change_window_property); - defsubr (&Sx_delete_window_property); - defsubr (&Sx_window_property); - - defsubr (&Sxw_display_color_p); - defsubr (&Sx_display_grayscale_p); - defsubr (&Sxw_color_defined_p); - defsubr (&Sxw_color_values); - defsubr (&Sx_server_max_request_size); - defsubr (&Sx_server_vendor); - defsubr (&Sx_server_version); - defsubr (&Sx_display_pixel_width); - defsubr (&Sx_display_pixel_height); - defsubr (&Sx_display_mm_width); - defsubr (&Sx_display_mm_height); - defsubr (&Sx_display_screens); - defsubr (&Sx_display_planes); - defsubr (&Sx_display_color_cells); - defsubr (&Sx_display_visual_class); - defsubr (&Sx_display_backing_store); - defsubr (&Sx_display_save_under); - defsubr (&Sx_display_monitor_attributes_list); - defsubr (&Sx_wm_set_size_hint); - defsubr (&Sx_create_frame); - defsubr (&Sx_open_connection); - defsubr (&Sx_close_connection); - defsubr (&Sx_display_list); - defsubr (&Sx_synchronize); - defsubr (&Sx_backspace_delete_keys_p); - - defsubr (&Sx_show_tip); - defsubr (&Sx_hide_tip); tip_timer = Qnil; staticpro (&tip_timer); tip_frame = Qnil; @@ -6287,13 +6303,4 @@ When using Gtk+ tooltips, the tooltip face is not used. */); last_show_tip_args = Qnil; staticpro (&last_show_tip_args); - - defsubr (&Sx_uses_old_gtk_dialog); -#if defined (USE_MOTIF) || defined (USE_GTK) - defsubr (&Sx_file_dialog); -#endif - -#if defined (USE_GTK) && defined (HAVE_FREETYPE) - defsubr (&Sx_select_font); -#endif }