diff options
Diffstat (limited to 'src/w32fns.c')
| -rw-r--r-- | src/w32fns.c | 956 |
1 files changed, 379 insertions, 577 deletions
diff --git a/src/w32fns.c b/src/w32fns.c index f9060ce5ac1..2c239dc7b49 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -457,12 +457,12 @@ if the entry is new. */) Lisp_Object oldrgb = Qnil; Lisp_Object entry; - CHECK_NUMBER (red); - CHECK_NUMBER (green); - CHECK_NUMBER (blue); + CHECK_FIXNUM (red); + CHECK_FIXNUM (green); + CHECK_FIXNUM (blue); CHECK_STRING (name); - XSETINT (rgb, RGB (XUINT (red), XUINT (green), XUINT (blue))); + XSETINT (rgb, RGB (XUFIXNUM (red), XUFIXNUM (green), XUFIXNUM (blue))); block_input (); @@ -748,7 +748,7 @@ w32_default_color_map (void) for (i = 0; i < ARRAYELTS (w32_color_map); pc++, i++) cmap = Fcons (Fcons (build_string (pc->name), - make_number (pc->colorref)), + make_fixnum (pc->colorref)), cmap); unblock_input (); @@ -828,7 +828,7 @@ add_system_logical_colors_to_map (Lisp_Object *system_colors) unsigned r, g, b; if (sscanf (color_buffer, " %u %u %u", &r, &g, &b) == 3) *system_colors = Fcons (Fcons (build_string (full_name_buffer), - make_number (RGB (r, g, b))), + make_fixnum (RGB (r, g, b))), *system_colors); name_size = sizeof (full_name_buffer) - SYSTEM_COLOR_PREFIX_LEN; @@ -1182,7 +1182,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, if (f) { /* Apply gamma correction. */ - w32_color_ref = XUINT (tem); + w32_color_ref = XUFIXNUM (tem); gamma_correct (f, &w32_color_ref); XSETINT (tem, w32_color_ref); } @@ -1198,7 +1198,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, /* check if color is already mapped */ while (entry) { - if (W32_COLOR (entry->entry) == XUINT (tem)) + if (W32_COLOR (entry->entry) == XUFIXNUM (tem)) break; prev = &entry->next; entry = entry->next; @@ -1208,7 +1208,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, { /* not already mapped, so add to list */ entry = xmalloc (sizeof (struct w32_palette_entry)); - SET_W32_COLOR (entry->entry, XUINT (tem)); + SET_W32_COLOR (entry->entry, XUFIXNUM (tem)); entry->next = NULL; *prev = entry; one_w32_display_info.num_colors++; @@ -1220,7 +1220,7 @@ w32_defined_color (struct frame *f, const char *color, XColor *color_def, /* Ensure COLORREF value is snapped to nearest color in (default) palette by simulating the PALETTERGB macro. This works whether or not the display device has a palette. */ - w32_color_ref = XUINT (tem) | 0x2000000; + w32_color_ref = XUFIXNUM (tem) | 0x2000000; color_def->pixel = w32_color_ref; color_def->red = GetRValue (w32_color_ref) * 256; @@ -1343,8 +1343,8 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_pointer_shape)) { - CHECK_NUMBER (Vx_pointer_shape); - cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XINT (Vx_pointer_shape)); + CHECK_FIXNUM (Vx_pointer_shape); + cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XFIXNUM (Vx_pointer_shape)); } else cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); @@ -1352,9 +1352,9 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_nontext_pointer_shape)) { - CHECK_NUMBER (Vx_nontext_pointer_shape); + CHECK_FIXNUM (Vx_nontext_pointer_shape); nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_nontext_pointer_shape)); + XFIXNUM (Vx_nontext_pointer_shape)); } else nontext_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_left_ptr); @@ -1362,9 +1362,9 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_hourglass_pointer_shape)) { - CHECK_NUMBER (Vx_hourglass_pointer_shape); + CHECK_FIXNUM (Vx_hourglass_pointer_shape); hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_hourglass_pointer_shape)); + XFIXNUM (Vx_hourglass_pointer_shape)); } else hourglass_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_watch); @@ -1373,9 +1373,9 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) x_check_errors (FRAME_W32_DISPLAY (f), "bad nontext pointer cursor: %s"); if (!EQ (Qnil, Vx_mode_pointer_shape)) { - CHECK_NUMBER (Vx_mode_pointer_shape); + CHECK_FIXNUM (Vx_mode_pointer_shape); mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_mode_pointer_shape)); + XFIXNUM (Vx_mode_pointer_shape)); } else mode_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_xterm); @@ -1383,20 +1383,20 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!EQ (Qnil, Vx_sensitive_text_pointer_shape)) { - CHECK_NUMBER (Vx_sensitive_text_pointer_shape); + CHECK_FIXNUM (Vx_sensitive_text_pointer_shape); hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_sensitive_text_pointer_shape)); + XFIXNUM (Vx_sensitive_text_pointer_shape)); } else hand_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), XC_crosshair); if (!NILP (Vx_window_horizontal_drag_shape)) { - CHECK_NUMBER (Vx_window_horizontal_drag_shape); + CHECK_FIXNUM (Vx_window_horizontal_drag_shape); horizontal_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_window_horizontal_drag_shape)); + XFIXNUM (Vx_window_horizontal_drag_shape)); } else horizontal_drag_cursor @@ -1404,10 +1404,10 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (!NILP (Vx_window_vertical_drag_shape)) { - CHECK_NUMBER (Vx_window_vertical_drag_shape); + CHECK_FIXNUM (Vx_window_vertical_drag_shape); vertical_drag_cursor = XCreateFontCursor (FRAME_W32_DISPLAY (f), - XINT (Vx_window_vertical_drag_shape)); + XFIXNUM (Vx_window_vertical_drag_shape)); } else vertical_drag_cursor @@ -1689,7 +1689,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldva int border; CHECK_TYPE_RANGED_INTEGER (int, arg); - border = max (XINT (arg), 0); + border = max (XFIXNUM (arg), 0); if (border != FRAME_INTERNAL_BORDER_WIDTH (f)) { @@ -1725,7 +1725,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) if (!FRAME_MINIBUF_ONLY_P (f) && !FRAME_PARENT_FRAME (f)) { boolean old = FRAME_EXTERNAL_MENU_BAR (f); - boolean new = (INTEGERP (value) && XINT (value) > 0) ? true : false; + boolean new = (FIXNUMP (value) && XFIXNUM (value) > 0) ? true : false; FRAME_MENU_BAR_LINES (f) = 0; FRAME_MENU_BAR_HEIGHT (f) = 0; @@ -1757,7 +1757,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) x_clear_under_internal_border (f); /* Don't store anything but 1 or 0 in the parameter. */ - store_frame_param (f, Qmenu_bar_lines, make_number (new ? 1 : 0)); + store_frame_param (f, Qmenu_bar_lines, make_fixnum (new ? 1 : 0)); } } } @@ -1780,8 +1780,8 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) return; /* Use VALUE only if an integer >= 0. */ - if (INTEGERP (value) && XINT (value) >= 0) - nlines = XFASTINT (value); + if (FIXNUMP (value) && XFIXNUM (value) >= 0) + nlines = XFIXNAT (value); else nlines = 0; @@ -1805,8 +1805,8 @@ x_change_tool_bar_height (struct frame *f, int height) FRAME_TOOL_BAR_HEIGHT (f) = height; FRAME_TOOL_BAR_LINES (f) = lines; /* Store `tool-bar-lines' and `height' frame parameters. */ - store_frame_param (f, Qtool_bar_lines, make_number (lines)); - store_frame_param (f, Qheight, make_number (FRAME_LINES (f))); + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + store_frame_param (f, Qheight, make_fixnum (FRAME_LINES (f))); if (FRAME_W32_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0) { @@ -2027,7 +2027,7 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value if (!NILP (new_value) && !FRAME_UNDECORATED (f)) { dwStyle = ((dwStyle & ~WS_THICKFRAME & ~WS_CAPTION) - | ((NUMBERP (border_width) && (XINT (border_width) > 0)) + | ((FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) ? WS_BORDER : false)); SetWindowLong (hwnd, GWL_STYLE, dwStyle); SetWindowPos (hwnd, HWND_TOP, 0, 0, 0, 0, @@ -2334,7 +2334,7 @@ w32_createwindow (struct frame *f, int *coords) if (FRAME_UNDECORATED (f)) { /* If we want a thin border, specify it here. */ - if (NUMBERP (border_width) && (XINT (border_width) > 0)) + if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -2350,7 +2350,7 @@ w32_createwindow (struct frame *f, int *coords) f->output_data.w32->dwStyle = WS_POPUP; /* If we want a thin border, specify it here. */ - if (NUMBERP (border_width) && (XINT (border_width) > 0)) + if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0)) f->output_data.w32->dwStyle |= WS_BORDER; } else @@ -2640,7 +2640,7 @@ setup_w32_kbdhook (void) if (w32_kbdhook_active) { IsDebuggerPresent_Proc is_debugger_present = (IsDebuggerPresent_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent"); if (is_debugger_present && is_debugger_present ()) return; } @@ -2655,7 +2655,7 @@ setup_w32_kbdhook (void) (https://support.microsoft.com/en-us/kb/124103) is used for NT 4 systems. */ GetConsoleWindow_Proc get_console = (GetConsoleWindow_Proc) - GetProcAddress (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow"); + get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow"); if (get_console != NULL) kbdhook.console = get_console (); @@ -3116,10 +3116,10 @@ map_keypad_keys (unsigned int virt_key, unsigned int extended) (Windows 2000 and later). */ static Lisp_Object w32_grabbed_keys; -#define HOTKEY(vk, mods) make_number (((vk) & 255) | ((mods) << 8)) -#define HOTKEY_ID(k) (XFASTINT (k) & 0xbfff) -#define HOTKEY_VK_CODE(k) (XFASTINT (k) & 255) -#define HOTKEY_MODIFIERS(k) (XFASTINT (k) >> 8) +#define HOTKEY(vk, mods) make_fixnum (((vk) & 255) | ((mods) << 8)) +#define HOTKEY_ID(k) (XFIXNAT (k) & 0xbfff) +#define HOTKEY_VK_CODE(k) (XFIXNAT (k) & 255) +#define HOTKEY_MODIFIERS(k) (XFIXNAT (k) >> 8) #define RAW_HOTKEY_ID(k) ((k) & 0xbfff) #define RAW_HOTKEY_VK_CODE(k) ((k) & 255) @@ -3140,7 +3140,7 @@ register_hot_keys (HWND hwnd) Lisp_Object key = XCAR (keylist); /* Deleted entries get set to nil. */ - if (!INTEGERP (key)) + if (!FIXNUMP (key)) continue; RegisterHotKey (hwnd, HOTKEY_ID (key), @@ -3157,7 +3157,7 @@ unregister_hot_keys (HWND hwnd) { Lisp_Object key = XCAR (keylist); - if (!INTEGERP (key)) + if (!FIXNUMP (key)) continue; UnregisterHotKey (hwnd, HOTKEY_ID (key)); @@ -4199,8 +4199,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) press of Space which we will ignore. */ if (GetAsyncKeyState (wParam) & 1) { - if (NUMBERP (Vw32_phantom_key_code)) - key = XUINT (Vw32_phantom_key_code) & 255; + if (FIXNUMP (Vw32_phantom_key_code)) + key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; dpyinfo->faked_key = key; @@ -4215,8 +4215,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { if (GetAsyncKeyState (wParam) & 1) { - if (NUMBERP (Vw32_phantom_key_code)) - key = XUINT (Vw32_phantom_key_code) & 255; + if (FIXNUMP (Vw32_phantom_key_code)) + key = XUFIXNUM (Vw32_phantom_key_code) & 255; else key = VK_SPACE; dpyinfo->faked_key = key; @@ -5413,11 +5413,11 @@ my_create_window (struct frame * f) if (EQ (left, Qunbound)) coords[0] = CW_USEDEFAULT; else - coords[0] = XINT (left); + coords[0] = XFIXNUM (left); if (EQ (top, Qunbound)) coords[1] = CW_USEDEFAULT; else - coords[1] = XINT (top); + coords[1] = XFIXNUM (top); if (!PostThreadMessage (dwWindowsThreadId, WM_EMACS_CREATEWINDOW, (WPARAM)f, (LPARAM)coords)) @@ -5529,8 +5529,8 @@ x_icon (struct frame *f, Lisp_Object parms) icon_y = x_get_arg (dpyinfo, parms, Qicon_top, 0, 0, RES_TYPE_NUMBER); if (!EQ (icon_x, Qunbound) && !EQ (icon_y, Qunbound)) { - CHECK_NUMBER (icon_x); - CHECK_NUMBER (icon_y); + CHECK_FIXNUM (icon_x); + CHECK_FIXNUM (icon_y); } else if (!EQ (icon_x, Qunbound) || !EQ (icon_y, Qunbound)) error ("Both left and top icon corners of icon must be specified"); @@ -5675,15 +5675,7 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, - doc: /* Make a new window, which is called a \"frame\" in Emacs terms. -Return an Emacs frame object. -PARAMETERS is an alist of frame parameters. -If the parameters specify that the frame should not have a minibuffer, -and do not specify a specific minibuffer window to use, -then `default-minibuffer-frame' must be a frame whose minibuffer can -be shared by the new frame. - -This function is an internal primitive--use `make-frame' instead. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object parameters) { struct frame *f; @@ -5736,7 +5728,7 @@ This function is an internal primitive--use `make-frame' instead. */) if (EQ (parent, Qunbound)) parent = Qnil; else if (!NILP (parent)) - CHECK_NUMBER (parent); + CHECK_FIXNUM (parent); /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ /* No need to protect DISPLAY because that's not used after passing @@ -5817,7 +5809,7 @@ This function is an internal primitive--use `make-frame' instead. */) { /* Cast to UINT_PTR shuts up compiler warnings about cast to pointer from integer of different size. */ - f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFASTINT (parent); + f->output_data.w32->parent_desc = (Window) (UINT_PTR) XFIXNAT (parent); f->output_data.w32->explicit_parent = true; } else @@ -5853,7 +5845,7 @@ This function is an internal primitive--use `make-frame' instead. */) x_default_font_parameter (f, parameters); /* Default BorderWidth to 0 to match other platforms. */ - x_default_parameter (f, parameters, Qborder_width, make_number (0), + x_default_parameter (f, parameters, Qborder_width, make_fixnum (0), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* We recognize either internalBorderWidth or internalBorder @@ -5869,11 +5861,11 @@ This function is an internal primitive--use `make-frame' instead. */) parameters); } - x_default_parameter (f, parameters, Qinternal_border_width, make_number (0), + x_default_parameter (f, parameters, Qinternal_border_width, make_fixnum (0), "internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER); - x_default_parameter (f, parameters, Qright_divider_width, make_number (0), + x_default_parameter (f, parameters, Qright_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); - x_default_parameter (f, parameters, Qbottom_divider_width, make_number (0), + x_default_parameter (f, parameters, Qbottom_divider_width, make_fixnum (0), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parameters, Qvertical_scroll_bars, Qright, "verticalScrollBars", "ScrollBars", RES_TYPE_SYMBOL); @@ -5929,11 +5921,11 @@ This function is an internal primitive--use `make-frame' instead. */) because `frame-windows-min-size' needs them. */ tem = x_get_arg (dpyinfo, parameters, Qmin_width, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_width, tem); tem = x_get_arg (dpyinfo, parameters, Qmin_height, NULL, NULL, RES_TYPE_NUMBER); - if (NUMBERP (tem)) + if (FIXNUMP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true, @@ -5946,16 +5938,16 @@ This function is an internal primitive--use `make-frame' instead. */) { x_default_parameter (f, parameters, Qmenu_bar_lines, NILP (Vmenu_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); } else /* No menu bar for child frames. */ - store_frame_param (f, Qmenu_bar_lines, make_number (0)); + store_frame_param (f, Qmenu_bar_lines, make_fixnum (0)); x_default_parameter (f, parameters, Qtool_bar_lines, NILP (Vtool_bar_mode) - ? make_number (0) : make_number (1), + ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); x_default_parameter (f, parameters, Qbuffer_predicate, Qnil, @@ -6102,8 +6094,7 @@ x_get_focus_frame (struct frame *frame) } DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, - doc: /* Internal function called by `color-defined-p', which see. -\(Note that the Nextstep version of this function ignores FRAME.) */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -6118,7 +6109,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, } DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, - doc: /* Internal function called by `color-values', which see. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object color, Lisp_Object frame) { XColor foo; @@ -6135,7 +6126,7 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, } DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, - doc: /* Internal function called by `display-color-p', which see. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6148,11 +6139,7 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, 0, 1, 0, - doc: /* Return t if DISPLAY supports shades of gray. -Note that color displays do support shades of gray. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6165,57 +6152,37 @@ If omitted or nil, that stands for the selected frame's display. */) DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, 0, 1, 0, - doc: /* Return the width in pixels of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. - -On \"multi-monitor\" setups this refers to the pixel width for all -physical monitors associated with DISPLAY. To get information for -each physical monitor, use `display-monitor-attributes-list'. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (x_display_pixel_width (dpyinfo)); + return make_fixnum (x_display_pixel_width (dpyinfo)); } DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, - doc: /* Return the height in pixels of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. - -On \"multi-monitor\" setups this refers to the pixel height for all -physical monitors associated with DISPLAY. To get information for -each physical monitor, use `display-monitor-attributes-list'. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (x_display_pixel_height (dpyinfo)); + return make_fixnum (x_display_pixel_height (dpyinfo)); } DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, 0, 1, 0, - doc: /* Return the number of bitplanes of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); - return make_number (dpyinfo->n_planes * dpyinfo->n_cbits); + return make_fixnum (dpyinfo->n_planes * dpyinfo->n_cbits); } DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, 0, 1, 0, - doc: /* Return the number of color cells of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6227,78 +6194,42 @@ If omitted or nil, that stands for the selected frame's display. */) * anyway. */ cap = 1 << min (dpyinfo->n_planes * dpyinfo->n_cbits, 24); - return make_number (cap); + return make_fixnum (cap); } DEFUN ("x-server-max-request-size", Fx_server_max_request_size, Sx_server_max_request_size, 0, 1, 0, - doc: /* Return the maximum request size of the server of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { - return make_number (1); + return make_fixnum (1); } DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, - doc: /* Return the "vendor ID" string of the GUI software on TERMINAL. - -\(Labeling every distributor as a "vendor" embodies the false assumption -that operating systems cannot be developed and distributed noncommercially.) - -For GNU and Unix systems, this queries the X server software; for -MS-Windows, this queries the OS. - -The optional argument TERMINAL specifies which display to ask about. -TERMINAL should be a terminal object, a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { return build_string ("Microsoft Corp."); } DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, - doc: /* Return the version numbers of the GUI software on TERMINAL. -The value is a list of three integers specifying the version of the GUI -software in use. - -For GNU and Unix system, the first 2 numbers are the version of the X -Protocol used on TERMINAL and the 3rd number is the distributor-specific -release number. For MS-Windows, the 3 numbers report the version and -the build number of the OS. - -See also the function `x-server-vendor'. - -The optional argument TERMINAL specifies which display to ask about. -TERMINAL should be a terminal object, a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { return list3i (w32_major_version, w32_minor_version, w32_build_number); } DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, - doc: /* Return the number of screens on the server of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { - return make_number (1); + return make_fixnum (1); } DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, - doc: /* Return the height in millimeters of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. - -On \"multi-monitor\" setups this refers to the height in millimeters for -all physical monitors associated with DISPLAY. To get information -for each physical monitor, use `display-monitor-attributes-list'. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6310,18 +6241,11 @@ for each physical monitor, use `display-monitor-attributes-list'. */) / GetDeviceCaps (hdc, VERTRES)); ReleaseDC (NULL, hdc); - return make_number (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5); + return make_fixnum (x_display_pixel_height (dpyinfo) * mm_per_pixel + 0.5); } DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, - doc: /* Return the width in millimeters of DISPLAY. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. - -On \"multi-monitor\" setups this refers to the width in millimeters for -all physical monitors associated with TERMINAL. To get information -for each physical monitor, use `display-monitor-attributes-list'. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6333,16 +6257,12 @@ for each physical monitor, use `display-monitor-attributes-list'. */) / GetDeviceCaps (hdc, HORZRES)); ReleaseDC (NULL, hdc); - return make_number (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5); + return make_fixnum (x_display_pixel_width (dpyinfo) * mm_per_pixel + 0.5); } DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, 0, 1, 0, - doc: /* Return an indication of whether DISPLAY does backing store. -The value may be `always', `when-mapped', or `not-useful'. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { return intern ("not-useful"); @@ -6350,13 +6270,7 @@ If omitted or nil, that stands for the selected frame's display. */) DEFUN ("x-display-visual-class", Fx_display_visual_class, Sx_display_visual_class, 0, 1, 0, - doc: /* Return the visual class of DISPLAY. -The value is one of the symbols `static-gray', `gray-scale', -`static-color', `pseudo-color', `true-color', or `direct-color'. - -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6365,7 +6279,7 @@ If omitted or nil, that stands for the selected frame's display. */) if (dpyinfo->has_palette) result = intern ("pseudo-color"); else if (dpyinfo->n_planes * dpyinfo->n_cbits == 1) - result = intern ("static-grey"); + result = intern ("static-gray"); else if (dpyinfo->n_planes * dpyinfo->n_cbits == 4) result = intern ("static-color"); else if (dpyinfo->n_planes * dpyinfo->n_cbits > 8) @@ -6376,10 +6290,7 @@ If omitted or nil, that stands for the selected frame's display. */) DEFUN ("x-display-save-under", Fx_display_save_under, Sx_display_save_under, 0, 1, 0, - doc: /* Return t if DISPLAY supports the save-under feature. -The optional argument DISPLAY specifies which display to ask about. -DISPLAY should be either a frame or a display name (a string). -If omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { return Qnil; @@ -6390,7 +6301,7 @@ w32_monitor_enum (HMONITOR monitor, HDC hdc, RECT *rcMonitor, LPARAM dwData) { Lisp_Object *monitor_list = (Lisp_Object *) dwData; - *monitor_list = Fcons (make_save_ptr (monitor), *monitor_list); + *monitor_list = Fcons (make_mint_ptr (monitor), *monitor_list); return TRUE; } @@ -6419,16 +6330,16 @@ w32_display_monitor_attributes_list (void) monitors = xmalloc (n_monitors * sizeof (*monitors)); for (i = 0; i < n_monitors; i++) { - monitors[i] = XSAVE_POINTER (XCAR (monitor_list), 0); + monitors[i] = xmint_pointer (XCAR (monitor_list)); monitor_list = XCDR (monitor_list); } - monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); + monitor_frames = Fmake_vector (make_fixnum (n_monitors), Qnil); FOR_EACH_FRAME (rest, frame) { struct frame *f = XFRAME (frame); - if (FRAME_W32_P (f) && !EQ (frame, tip_frame)) + if (FRAME_W32_P (f) && !FRAME_TOOLTIP_P (f)) { HMONITOR monitor = monitor_from_window_fn (FRAME_W32_WINDOW (f), @@ -6515,7 +6426,7 @@ w32_display_monitor_attributes_list_fallback (struct w32_display_info *dpyinfo) { struct frame *f = XFRAME (frame); - if (FRAME_W32_P (f) && !EQ (frame, tip_frame)) + if (FRAME_W32_P (f) && !FRAME_TOOLTIP_P (f)) frames = Fcons (frame, frames); } attributes = Fcons (Fcons (Qframes, frames), attributes); @@ -6644,12 +6555,7 @@ x_display_info_for_name (Lisp_Object name) } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, - 1, 3, 0, doc: /* Open a connection to a display server. -DISPLAY is the name of the display to connect to. -Optional second arg XRM-STRING is a string of resources in xrdb format. -If the optional third arg MUST-SUCCEED is non-nil, -terminate Emacs if we can't open the connection. -\(In the Nextstep version, the last two arguments are currently ignored.) */) + 1, 3, 0, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display, Lisp_Object xrm_string, Lisp_Object must_succeed) { char *xrm_option; @@ -6731,9 +6637,7 @@ terminate Emacs if we can't open the connection. DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, - doc: /* Close the connection to DISPLAY's server. -For DISPLAY, specify either a frame or a display name (a string). -If DISPLAY is nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object display) { struct w32_display_info *dpyinfo = check_x_display_info (display); @@ -6751,7 +6655,7 @@ If DISPLAY is nil, that stands for the selected frame's display. */) } DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, - doc: /* Return the list of display names that Emacs has connections to. */) + doc: /* SKIP: real doc in xfns.c. */) (void) { Lisp_Object result = Qnil; @@ -6764,17 +6668,7 @@ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, } DEFUN ("x-synchronize", Fx_synchronize, Sx_synchronize, 1, 2, 0, - doc: /* If ON is non-nil, report X errors as soon as the erring request is made. -This function only has an effect on X Windows. With MS Windows, it is -defined but does nothing. - -If ON is nil, allow buffering of requests. -Turning on synchronization prohibits the Xlib routines from buffering -requests and seriously degrades performance, but makes debugging much -easier. -The optional second argument TERMINAL specifies which display to act on. -TERMINAL should be a terminal object, a frame or a display name (a string). -If TERMINAL is omitted or nil, that stands for the selected frame's display. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object on, Lisp_Object display) { return Qnil; @@ -6790,21 +6684,7 @@ If TERMINAL is omitted or nil, that stands for the selected frame's display. */ DEFUN ("x-change-window-property", Fx_change_window_property, Sx_change_window_property, 2, 6, 0, - doc: /* Change window property PROP to VALUE on the X window of FRAME. -PROP must be a string. VALUE may be a string or a list of conses, -numbers and/or strings. If an element in the list is a string, it is -converted to an atom and the value of the Atom is used. If an element -is a cons, it is converted to a 32 bit number where the car is the 16 -top bits and the cdr is the lower 16 bits. - -FRAME nil or omitted means use the selected frame. -If TYPE is given and non-nil, it is the name of the type of VALUE. -If TYPE is not given or nil, the type is STRING. -FORMAT gives the size in bits of each element if VALUE is a list. -It must be one of 8, 16 or 32. -If VALUE is a string or FORMAT is nil or not given, FORMAT defaults to 8. -If OUTER-P is non-nil, the property is changed for the outer X window of -FRAME. Default is to change on the edit X window. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object prop, Lisp_Object value, Lisp_Object frame, Lisp_Object type, Lisp_Object format, Lisp_Object outer_p) { @@ -6830,8 +6710,7 @@ FRAME. Default is to change on the edit X window. */) DEFUN ("x-delete-window-property", Fx_delete_window_property, Sx_delete_window_property, 1, 2, 0, - doc: /* Remove window property PROP from X window of FRAME. -FRAME nil or omitted means use the selected frame. Value is PROP. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object prop, Lisp_Object frame) { struct frame *f = decode_window_system_frame (frame); @@ -6852,21 +6731,7 @@ 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). */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object prop, Lisp_Object frame, Lisp_Object type, Lisp_Object source, Lisp_Object delete_p, Lisp_Object vector_ret_p) { @@ -6921,20 +6786,25 @@ no value of TYPE (always string in the MS Windows case). */) static void compute_tip_xy (struct frame *, Lisp_Object, Lisp_Object, Lisp_Object, int, int, int *, int *); -/* The frame of a currently visible tooltip. */ - +/* The frame of the currently visible tooltip. */ Lisp_Object tip_frame; -/* If non-nil, a timer started that hides the last tooltip when it - fires. */ +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +Window tip_window; +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ Lisp_Object tip_timer; -Window tip_window; -/* If non-nil, a vector of 3 elements containing the last args - with which x-show-tip was called. See there. */ +/* STRING argument of last `x-show-tip' call. */ +Lisp_Object tip_last_string; -Lisp_Object last_show_tip_args; +/* Normalized FRAME argument of last `x-show-tip' call. */ +Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +Lisp_Object tip_last_parms; static void @@ -7007,6 +6877,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) FRAME_FONTSET (f) = -1; fset_icon_name (f, Qnil); + f->tooltip = true; #ifdef GLYPH_DEBUG image_cache_refcount = @@ -7041,7 +6912,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) that are needed to determine window geometry. */ x_default_font_parameter (f, parms); - x_default_parameter (f, parms, Qborder_width, make_number (2), + x_default_parameter (f, parms, Qborder_width, make_fixnum (2), "borderWidth", "BorderWidth", RES_TYPE_NUMBER); /* This defaults to 2 in order to match xterm. We recognize either internalBorderWidth or internalBorder (which is what xterm calls @@ -7057,7 +6928,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) parms); } - x_default_parameter (f, parms, Qinternal_border_width, make_number (1), + x_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), "internalBorderWidth", "internalBorderWidth", RES_TYPE_NUMBER); /* Also do the stuff which must be set before the window exists. */ @@ -7193,8 +7064,8 @@ compute_tip_xy (struct frame *f, /* Move the tooltip window where the mouse pointer is. Resize and show it. */ - if ((!INTEGERP (left) && !INTEGERP (right)) - || (!INTEGERP (top) && !INTEGERP (bottom))) + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) { POINT pt; @@ -7233,40 +7104,50 @@ compute_tip_xy (struct frame *f, } } - if (INTEGERP (top)) - *root_y = XINT (top); - else if (INTEGERP (bottom)) - *root_y = XINT (bottom) - height; - else if (*root_y + XINT (dy) <= min_y) + if (FIXNUMP (top)) + *root_y = XFIXNUM (top); + else if (FIXNUMP (bottom)) + *root_y = XFIXNUM (bottom) - height; + else if (*root_y + XFIXNUM (dy) <= min_y) *root_y = min_y; /* Can happen for negative dy */ - else if (*root_y + XINT (dy) + height <= max_y) + else if (*root_y + XFIXNUM (dy) + height <= max_y) /* It fits below the pointer */ - *root_y += XINT (dy); - else if (height + XINT (dy) + min_y <= *root_y) + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) /* It fits above the pointer. */ - *root_y -= height + XINT (dy); + *root_y -= height + XFIXNUM (dy); else /* Put it on the top. */ *root_y = min_y; - if (INTEGERP (left)) - *root_x = XINT (left); - else if (INTEGERP (right)) - *root_x = XINT (right) - width; - else if (*root_x + XINT (dx) <= min_x) + if (FIXNUMP (left)) + *root_x = XFIXNUM (left); + else if (FIXNUMP (right)) + *root_x = XFIXNUM (right) - width; + else if (*root_x + XFIXNUM (dx) <= min_x) *root_x = 0; /* Can happen for negative dx */ - else if (*root_x + XINT (dx) + width <= max_x) + else if (*root_x + XFIXNUM (dx) + width <= max_x) /* It fits to the right of the pointer. */ - *root_x += XINT (dx); - else if (width + XINT (dx) + min_x <= *root_x) + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) /* It fits to the left of the pointer. */ - *root_x -= width + XINT (dx); + *root_x -= width + XFIXNUM (dx); else /* Put it left justified on the screen -- it ought to fit that way. */ *root_x = min_x; } -/* Hide tooltip. Delete its frame if DELETE is true. */ +/** + * x_hide_tip: + * + * Hide currently visible tooltip and cancel its timer. + * + * This will try to make tooltip_frame invisible (if DELETE is false) + * or delete tooltip_frame (if DELETE is true). + * + * Return Qt if the tooltip was either deleted or made invisible, Qnil + * otherwise. + */ static Lisp_Object x_hide_tip (bool delete) { @@ -7291,15 +7172,20 @@ x_hide_tip (bool delete) if (FRAMEP (tip_frame)) { - if (delete) + if (FRAME_LIVE_P (XFRAME (tip_frame))) { - delete_frame (tip_frame, Qnil); - tip_frame = Qnil; + if (delete) + { + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + x_make_frame_invisible (XFRAME (tip_frame)); + + was_open = Qt; } else - x_make_frame_invisible (XFRAME (tip_frame)); - - was_open = Qt; + tip_frame = Qnil; } else tip_frame = Qnil; @@ -7310,36 +7196,9 @@ x_hide_tip (bool delete) DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, - doc: /* Show STRING in a \"tooltip\" window on frame FRAME. -A tooltip window is a small window displaying a string. - -This is an internal function; Lisp code should call `tooltip-show'. - -FRAME nil or omitted means use the selected frame. - -PARMS is an optional list of frame parameters which can be -used to change the tooltip's appearance. - -Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil -means use the default timeout of 5 seconds. - -If the list of frame parameters PARMS contains a `left' parameter, -display the tooltip at that x-position. If the list of frame parameters -PARMS contains no `left' but a `right' parameter, display the tooltip -right-adjusted at that x-position. Otherwise display it at the -x-position of the mouse, with offset DX added (default is 5 if DX isn't -specified). - -Likewise for the y-position: If a `top' frame parameter is specified, it -determines the position of the upper edge of the tooltip window. If a -`bottom' parameter but no `top' frame parameter is specified, it -determines the position of the lower edge of the tooltip window. -Otherwise display the tooltip window at the y-position of the mouse, -with offset DY added (default is -10). - -A tooltip's maximum size is specified by `x-max-tooltip-size'. -Text larger than the specified size is clipped. */) - (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object string, Lisp_Object frame, Lisp_Object parms, + Lisp_Object timeout, Lisp_Object dx, Lisp_Object dy) { struct frame *tip_f; struct window *w; @@ -7350,42 +7209,38 @@ Text larger than the specified size is clipped. */) int old_windows_or_buffers_changed = windows_or_buffers_changed; ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count_1; - Lisp_Object window, size; - Lisp_Object tip_buf; + Lisp_Object window, size, tip_buf; AUTO_STRING (tip, " *tip*"); specbind (Qinhibit_redisplay, Qt); CHECK_STRING (string); + + if (NILP (frame)) + frame = selected_frame; decode_window_system_frame (frame); + if (NILP (timeout)) - timeout = make_number (5); + timeout = make_fixnum (5); else - CHECK_NATNUM (timeout); + CHECK_FIXNAT (timeout); if (NILP (dx)) - dx = make_number (5); + dx = make_fixnum (5); else - CHECK_NUMBER (dx); + CHECK_FIXNUM (dx); if (NILP (dy)) - dy = make_number (-10); + dy = make_fixnum (-10); else - CHECK_NUMBER (dy); - - if (NILP (last_show_tip_args)) - last_show_tip_args = Fmake_vector (make_number (3), Qnil); + CHECK_FIXNUM (dy); if (FRAMEP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) { - Lisp_Object last_string = AREF (last_show_tip_args, 0); - Lisp_Object last_frame = AREF (last_show_tip_args, 1); - Lisp_Object last_parms = AREF (last_show_tip_args, 2); - if (FRAME_VISIBLE_P (XFRAME (tip_frame)) - && EQ (frame, last_frame) - && !NILP (Fequal_including_properties (last_string, string)) - && !NILP (Fequal (last_parms, parms))) + && EQ (frame, tip_last_frame) + && !NILP (Fequal_including_properties (string, tip_last_string)) + && !NILP (Fequal (parms, tip_last_parms))) { /* Only DX and DY have changed. */ tip_f = XFRAME (tip_frame); @@ -7419,14 +7274,14 @@ Text larger than the specified size is clipped. */) goto start_timer; } - else if (tooltip_reuse_hidden_frame && EQ (frame, last_frame)) + else if (tooltip_reuse_hidden_frame && EQ (frame, tip_last_frame)) { bool delete = false; Lisp_Object tail, elt, parm, last; /* Check if every parameter in PARMS has the same value in - last_parms. This may destruct last_parms which, however, - will be recreated below. */ + tip_last_parms. This may destruct tip_last_parms + which, however, will be recreated below. */ for (tail = parms; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); @@ -7436,7 +7291,7 @@ Text larger than the specified size is clipped. */) if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) && !EQ (parm, Qbottom)) { - last = Fassq (parm, last_parms); + last = Fassq (parm, tip_last_parms); if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) { /* We lost, delete the old tooltip. */ @@ -7444,15 +7299,17 @@ Text larger than the specified size is clipped. */) break; } else - last_parms = call2 (Qassq_delete_all, parm, last_parms); + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); } else - last_parms = call2 (Qassq_delete_all, parm, last_parms); + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); } - /* Now check if there's a parameter left in last_parms with a + /* Now check if there's a parameter left in tip_last_parms with a non-nil value. */ - for (tail = last_parms; CONSP (tail); tail = XCDR (tail)) + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); parm = Fcar (elt); @@ -7473,9 +7330,9 @@ Text larger than the specified size is clipped. */) else x_hide_tip (true); - ASET (last_show_tip_args, 0, string); - ASET (last_show_tip_args, 1, frame); - ASET (last_show_tip_args, 2, parms); + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; /* Block input until the tip has been fully drawn, to avoid crashes when drawing tips in menus. */ @@ -7487,16 +7344,17 @@ Text larger than the specified size is clipped. */) if (NILP (Fassq (Qname, parms))) parms = Fcons (Fcons (Qname, build_string ("tooltip")), parms); if (NILP (Fassq (Qinternal_border_width, parms))) - parms = Fcons (Fcons (Qinternal_border_width, make_number (3)), parms); + parms = Fcons (Fcons (Qinternal_border_width, make_fixnum (3)), parms); if (NILP (Fassq (Qborder_width, parms))) - parms = Fcons (Fcons (Qborder_width, make_number (1)), parms); + parms = Fcons (Fcons (Qborder_width, make_fixnum (1)), parms); if (NILP (Fassq (Qborder_color, parms))) - parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), parms); + parms = Fcons (Fcons (Qborder_color, build_string ("lightyellow")), + parms); if (NILP (Fassq (Qbackground_color, parms))) parms = Fcons (Fcons (Qbackground_color, build_string ("lightyellow")), parms); - /* Create a frame for the tooltip, and record it in the global + /* Create a frame for the tooltip and record it in the global variable tip_frame. */ struct frame *f; /* The value is unused. */ if (NILP (tip_frame = x_create_tip_frame (FRAME_DISPLAY_INFO (f), parms))) @@ -7512,8 +7370,8 @@ Text larger than the specified size is clipped. */) tip_buf = Fget_buffer_create (tip); /* We will mark the tip window a "pseudo-window" below, and such windows cannot have display margins. */ - bset_left_margin_cols (XBUFFER (tip_buf), make_number (0)); - bset_right_margin_cols (XBUFFER (tip_buf), make_number (0)); + bset_left_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); + bset_right_margin_cols (XBUFFER (tip_buf), make_fixnum (0)); set_window_buffer (window, tip_buf, false, false); w = XWINDOW (window); w->pseudo_window_p = true; @@ -7528,11 +7386,11 @@ Text larger than the specified size is clipped. */) w->pixel_top = 0; if (CONSP (Vx_max_tooltip_size) - && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX) - && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { - w->total_cols = XFASTINT (XCAR (Vx_max_tooltip_size)); - w->total_lines = XFASTINT (XCDR (Vx_max_tooltip_size)); + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); } else { @@ -7562,18 +7420,18 @@ Text larger than the specified size is clipped. */) try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); /* Calculate size of tooltip window. */ size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, - make_number (w->pixel_height), Qnil); + make_fixnum (w->pixel_height), Qnil); /* Add the frame's internal border to calculated size. */ - width = XINT (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); - height = XINT (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + width = XFIXNUM (Fcar (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); + height = XFIXNUM (Fcdr (size)) + 2 * FRAME_INTERNAL_BORDER_WIDTH (tip_f); /* Calculate position of tooltip frame. */ compute_tip_xy (tip_f, parms, dx, dy, width, height, &root_x, &root_y); /* Show tooltip frame. */ { RECT rect; - int pad = (NUMBERP (Vw32_tooltip_extra_pixels) - ? max (0, XINT (Vw32_tooltip_extra_pixels)) + int pad = (FIXNUMP (Vw32_tooltip_extra_pixels) + ? max (0, XFIXNUM (Vw32_tooltip_extra_pixels)) : FRAME_COLUMN_WIDTH (tip_f)); rect.left = rect.top = 0; @@ -7617,8 +7475,7 @@ Text larger than the specified size is clipped. */) DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, - doc: /* Hide the current tooltip window, if there is any. -Value is t if tooltip was open, nil otherwise. */) + doc: /* SKIP: real doc in xfns.c. */) (void) { return x_hide_tip (!tooltip_reuse_hidden_frame); @@ -7764,18 +7621,7 @@ w32_dialog_in_progress (Lisp_Object in_progress) } DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, - doc: /* Read file name, prompting with PROMPT in directory DIR. -Use a file selection dialog. Select DEFAULT-FILENAME in the dialog's file -selection box, if specified. If MUSTMATCH is non-nil, the returned file -or directory must exist. - -This function is only defined on NS, MS Windows, and X Windows with the -Motif or Gtk toolkits. With the Motif toolkit, ONLY-DIR-P is ignored. -Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. -On Windows 7 and later, the file selection dialog "remembers" the last -directory where the user selected a file, and will open that directory -instead of DIR on subsequent invocations of this function with the same -value of DIR as in previous invocations; this is standard Windows behavior. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object prompt, Lisp_Object dir, Lisp_Object default_filename, Lisp_Object mustmatch, Lisp_Object only_dir_p) { /* Filter index: 1: All Files, 2: Directories only */ @@ -8187,10 +8033,10 @@ If optional parameter FRAME is not specified, use selected frame. */) { struct frame *f = decode_window_system_frame (frame); - CHECK_NUMBER (command); + CHECK_FIXNUM (command); if (FRAME_W32_P (f)) - PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XINT (command), 0); + PostMessage (FRAME_W32_WINDOW (f), WM_SYSCOMMAND, XFIXNUM (command), 0); return Qnil; } @@ -8297,8 +8143,8 @@ a ShowWindow flag: } result = (intptr_t) ShellExecuteW (NULL, ops_w, doc_w, params_w, GUI_SDATA (current_dir), - (INTEGERP (show_flag) - ? XINT (show_flag) : SW_SHOWDEFAULT)); + (FIXNUMP (show_flag) + ? XFIXNUM (show_flag) : SW_SHOWDEFAULT)); if (result > 32) return Qt; @@ -8363,7 +8209,7 @@ a ShowWindow flag: if (c_isalpha (*p) && p[1] == ':' && IS_DIRECTORY_SEP (p[2])) document = Fsubstring_no_properties (document, - make_number (file_url_len), Qnil); + make_fixnum (file_url_len), Qnil); } /* We have a situation here. If DOCUMENT is a relative file name, but its name includes leading directories, i.e. it lives not in @@ -8373,7 +8219,7 @@ a ShowWindow flag: URL, for example. So we make it absolute only if it is an existing file; if it is a file that does not exist, tough. */ absdoc = Fexpand_file_name (document, Qnil); - /* Don't call file handlers for file-exists-p, since they might + /* Don't call file name handlers for file-exists-p, since they might attempt to access the file, which could fail or produce undesired consequences, see bug#16558 for an example. */ handler = Ffind_file_name_handler (absdoc, Qfile_exists_p); @@ -8455,7 +8301,7 @@ a ShowWindow flag: shexinfo_w.lpParameters = params_w; shexinfo_w.lpDirectory = current_dir_w; shexinfo_w.nShow = - (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XFIXNUM (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExW (&shexinfo_w); xfree (doc_w); } @@ -8490,7 +8336,7 @@ a ShowWindow flag: shexinfo_a.lpParameters = params_a; shexinfo_a.lpDirectory = current_dir_a; shexinfo_a.nShow = - (INTEGERP (show_flag) ? XINT (show_flag) : SW_SHOWDEFAULT); + (FIXNUMP (show_flag) ? XFIXNUM (show_flag) : SW_SHOWDEFAULT); success = ShellExecuteExA (&shexinfo_a); xfree (doc_w); xfree (doc_a); @@ -8566,14 +8412,14 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) if (CONSP (c) && lucid_event_type_list_p (c)) c = Fevent_convert_list (c); - if (! INTEGERP (c) && ! SYMBOLP (c)) + if (! FIXNUMP (c) && ! SYMBOLP (c)) error ("Key definition is invalid"); /* Work out the base key and the modifiers. */ if (SYMBOLP (c)) { c = parse_modifiers (c); - lisp_modifiers = XINT (Fcar (Fcdr (c))); + lisp_modifiers = XFIXNUM (Fcar (Fcdr (c))); c = Fcar (c); if (!SYMBOLP (c)) emacs_abort (); @@ -8584,11 +8430,11 @@ w32_parse_and_hook_hot_key (Lisp_Object key, int hook) else vk_code = lookup_vk_code (vkname); } - else if (INTEGERP (c)) + else if (FIXNUMP (c)) { - lisp_modifiers = XINT (c) & ~CHARACTERBITS; + lisp_modifiers = XFIXNUM (c) & ~CHARACTERBITS; /* Many ascii characters are their own virtual key code. */ - vk_code = XINT (c) & CHARACTERBITS; + vk_code = XFIXNUM (c) & CHARACTERBITS; } if (vk_code < 0 || vk_code > 255) @@ -8688,7 +8534,7 @@ any key combinations, otherwise nil. */) /* Notify input thread about new hot-key definition, so that it takes effect without needing to switch focus. */ PostThreadMessage (dwWindowsThreadId, WM_EMACS_REGISTER_HOT_KEY, - (WPARAM) XINT (key), 0); + (WPARAM) XFIXNUM (key), 0); } return key; @@ -8701,7 +8547,7 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, { Lisp_Object item; - if (!INTEGERP (key)) + if (!FIXNUMP (key)) key = w32_parse_and_hook_hot_key (key, 0); if (w32_kbdhook_active) @@ -8716,12 +8562,12 @@ DEFUN ("w32-unregister-hot-key", Fw32_unregister_hot_key, eassert (CONSP (item)); /* Pass the tail of the list as a pointer to a Lisp_Cons cell, so that it works in a --with-wide-int build as well. */ - lparam = (LPARAM) XUNTAG (item, Lisp_Cons); + lparam = (LPARAM) XUNTAG (item, Lisp_Cons, struct Lisp_Cons); /* Notify input thread about hot-key definition being removed, so that it takes effect without needing focus switch. */ if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_UNREGISTER_HOT_KEY, - (WPARAM) XINT (XCAR (item)), lparam)) + (WPARAM) XFIXNUM (XCAR (item)), lparam)) { MSG msg; GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); @@ -8748,7 +8594,7 @@ usage: (w32-reconstruct-hot-key ID) */) int vk_code, w32_modifiers; Lisp_Object key; - CHECK_NUMBER (hotkeyid); + CHECK_FIXNUM (hotkeyid); vk_code = HOTKEY_VK_CODE (hotkeyid); w32_modifiers = HOTKEY_MODIFIERS (hotkeyid); @@ -8756,7 +8602,7 @@ usage: (w32-reconstruct-hot-key ID) */) if (vk_code < 256 && lispy_function_keys[vk_code]) key = intern (lispy_function_keys[vk_code]); else - key = make_number (vk_code); + key = make_fixnum (vk_code); key = Fcons (key, Qnil); if (w32_modifiers & MOD_SHIFT) @@ -8796,18 +8642,18 @@ to change the state. */) return Qnil; if (!dwWindowsThreadId) - return make_number (w32_console_toggle_lock_key (vk_code, new_state)); + return make_fixnum (w32_console_toggle_lock_key (vk_code, new_state)); if (NILP (new_state)) lparam = -1; else - lparam = (XUINT (new_state)) & 1; + lparam = (XUFIXNUM (new_state)) & 1; if (PostThreadMessage (dwWindowsThreadId, WM_EMACS_TOGGLE_LOCK_KEY, (WPARAM) vk_code, lparam)) { MSG msg; GetMessage (&msg, NULL, WM_EMACS_DONE, WM_EMACS_DONE); - return make_number (msg.wParam); + return make_fixnum (msg.wParam); } return Qnil; } @@ -8941,32 +8787,32 @@ and width values are in pixels. return listn (CONSTYPE_HEAP, 10, Fcons (Qouter_position, - Fcons (make_number (left), make_number (top))), + Fcons (make_fixnum (left), make_fixnum (top))), Fcons (Qouter_size, - Fcons (make_number (right - left), - make_number (bottom - top))), + Fcons (make_fixnum (right - left), + make_fixnum (bottom - top))), Fcons (Qexternal_border_size, - Fcons (make_number (external_border_width), - make_number (external_border_height))), + Fcons (make_fixnum (external_border_width), + make_fixnum (external_border_height))), Fcons (Qtitle_bar_size, - Fcons (make_number (title_bar_width), - make_number (title_bar_height))), + Fcons (make_fixnum (title_bar_width), + make_fixnum (title_bar_height))), Fcons (Qmenu_bar_external, Qt), Fcons (Qmenu_bar_size, - Fcons (make_number + Fcons (make_fixnum (menu_bar.rcBar.right - menu_bar.rcBar.left), - make_number (menu_bar_height))), + make_fixnum (menu_bar_height))), Fcons (Qtool_bar_external, Qnil), Fcons (Qtool_bar_position, tool_bar_height ? Qtop : Qnil), Fcons (Qtool_bar_size, - Fcons (make_number + Fcons (make_fixnum (tool_bar_height ? (right - left - 2 * external_border_width - 2 * internal_border_width) : 0), - make_number (tool_bar_height))), + make_fixnum (tool_bar_height))), Fcons (Qinternal_border_width, - make_number (internal_border_width))); + make_fixnum (internal_border_width))); } DEFUN ("w32-frame-edges", Fw32_frame_edges, Sw32_frame_edges, 0, 2, 0, @@ -9003,10 +8849,10 @@ menu bar or tool bar of FRAME. */) unblock_input (); if (success) - return list4 (make_number (rectangle.left), - make_number (rectangle.top), - make_number (rectangle.right), - make_number (rectangle.bottom)); + return list4 (make_fixnum (rectangle.left), + make_fixnum (rectangle.top), + make_fixnum (rectangle.right), + make_fixnum (rectangle.bottom)); else return Qnil; } @@ -9045,16 +8891,16 @@ menu bar or tool bar of FRAME. */) { int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); - return list4 (make_number (left + internal_border_width), - make_number (top + return list4 (make_fixnum (left + internal_border_width), + make_fixnum (top + FRAME_TOOL_BAR_HEIGHT (f) + internal_border_width), - make_number (right - internal_border_width), - make_number (bottom - internal_border_width)); + make_fixnum (right - internal_border_width), + make_fixnum (bottom - internal_border_width)); } else - return list4 (make_number (left), make_number (top), - make_number (right), make_number (bottom)); + return list4 (make_fixnum (left), make_fixnum (top), + make_fixnum (right), make_fixnum (bottom)); } } @@ -9202,7 +9048,7 @@ selected frame's display. */) GetCursorPos (&pt); unblock_input (); - return Fcons (make_number (pt.x), make_number (pt.y)); + return Fcons (make_fixnum (pt.x), make_fixnum (pt.y)); } DEFUN ("w32-set-mouse-absolute-pixel-position", Fw32_set_mouse_absolute_pixel_position, @@ -9225,7 +9071,7 @@ The coordinates X and Y are interpreted in pixels relative to a position if (os_subtype == OS_NT && w32_major_version + w32_minor_version >= 6) ret = SystemParametersInfo (SPI_GETMOUSETRAILS, 0, &trail_num, 0); - SetCursorPos (XINT (x), XINT (y)); + SetCursorPos (XFIXNUM (x), XFIXNUM (y)); if (ret) SystemParametersInfo (SPI_SETMOUSETRAILS, trail_num, NULL, 0); unblock_input (); @@ -9233,115 +9079,6 @@ The coordinates X and Y are interpreted in pixels relative to a position return Qnil; } -DEFUN ("w32-battery-status", Fw32_battery_status, Sw32_battery_status, 0, 0, 0, - doc: /* Get power status information from Windows system. - -The following %-sequences are provided: -%L AC line status (verbose) -%B Battery status (verbose) -%b Battery status, empty means high, `-' means low, - `!' means critical, and `+' means charging -%p Battery load percentage -%s Remaining time (to charge or discharge) in seconds -%m Remaining time (to charge or discharge) in minutes -%h Remaining time (to charge or discharge) in hours -%t Remaining time (to charge or discharge) in the form `h:min' */) - (void) -{ - Lisp_Object status = Qnil; - - SYSTEM_POWER_STATUS system_status; - if (GetSystemPowerStatus (&system_status)) - { - Lisp_Object line_status, battery_status, battery_status_symbol; - Lisp_Object load_percentage, seconds, minutes, hours, remain; - - long seconds_left = (long) system_status.BatteryLifeTime; - - if (system_status.ACLineStatus == 0) - line_status = build_string ("off-line"); - else if (system_status.ACLineStatus == 1) - line_status = build_string ("on-line"); - else - line_status = build_string ("N/A"); - - if (system_status.BatteryFlag & 128) - { - battery_status = build_string ("N/A"); - battery_status_symbol = empty_unibyte_string; - } - else if (system_status.BatteryFlag & 8) - { - battery_status = build_string ("charging"); - battery_status_symbol = build_string ("+"); - if (system_status.BatteryFullLifeTime != -1L) - seconds_left = system_status.BatteryFullLifeTime - seconds_left; - } - else if (system_status.BatteryFlag & 4) - { - battery_status = build_string ("critical"); - battery_status_symbol = build_string ("!"); - } - else if (system_status.BatteryFlag & 2) - { - battery_status = build_string ("low"); - battery_status_symbol = build_string ("-"); - } - else if (system_status.BatteryFlag & 1) - { - battery_status = build_string ("high"); - battery_status_symbol = empty_unibyte_string; - } - else - { - battery_status = build_string ("medium"); - battery_status_symbol = empty_unibyte_string; - } - - if (system_status.BatteryLifePercent > 100) - load_percentage = build_string ("N/A"); - else - { - char buffer[16]; - snprintf (buffer, 16, "%d", system_status.BatteryLifePercent); - load_percentage = build_string (buffer); - } - - if (seconds_left < 0) - seconds = minutes = hours = remain = build_string ("N/A"); - else - { - long m; - double h; - char buffer[16]; - snprintf (buffer, 16, "%ld", seconds_left); - seconds = build_string (buffer); - - m = seconds_left / 60; - snprintf (buffer, 16, "%ld", m); - minutes = build_string (buffer); - - h = seconds_left / 3600.0; - snprintf (buffer, 16, "%3.1f", h); - hours = build_string (buffer); - - snprintf (buffer, 16, "%ld:%02ld", m / 60, m % 60); - remain = build_string (buffer); - } - - status = listn (CONSTYPE_HEAP, 8, - Fcons (make_number ('L'), line_status), - Fcons (make_number ('B'), battery_status), - Fcons (make_number ('b'), battery_status_symbol), - Fcons (make_number ('p'), load_percentage), - Fcons (make_number ('s'), seconds), - Fcons (make_number ('m'), minutes), - Fcons (make_number ('h'), hours), - Fcons (make_number ('t'), remain)); - } - return status; -} - #ifdef WINDOWSNT typedef BOOL (WINAPI *GetDiskFreeSpaceExW_Proc) @@ -9350,11 +9087,7 @@ typedef BOOL (WINAPI *GetDiskFreeSpaceExA_Proc) (LPCSTR, PULARGE_INTEGER, PULARGE_INTEGER, PULARGE_INTEGER); DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0, - doc: /* Return storage information about the file system FILENAME is on. -Value is a list of floats (TOTAL FREE AVAIL), where TOTAL is the total -storage of the file system, FREE is the free storage, and AVAIL is the -storage available to a non-superuser. All 3 numbers are in bytes. -If the underlying system call fails, value is nil. */) + doc: /* SKIP: Real doc in fileio.c. */) (Lisp_Object filename) { Lisp_Object encoded, value; @@ -9363,6 +9096,17 @@ If the underlying system call fails, value is nil. */) filename = Fexpand_file_name (filename, Qnil); encoded = ENCODE_FILE (filename); + /* If the file name has special constructs in it, + call the corresponding file name handler. */ + Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info); + if (!NILP (handler)) + { + value = call2 (handler, Qfile_system_info, encoded); + if (CONSP (value) || NILP (value)) + return value; + error ("Invalid handler in `file-name-handler-alist'"); + } + value = Qnil; /* Determining the required information on Windows turns out, sadly, @@ -9373,9 +9117,9 @@ If the underlying system call fails, value is nil. */) { HMODULE hKernel = GetModuleHandle ("kernel32"); GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW = - (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExW"); + (GetDiskFreeSpaceExW_Proc) get_proc_addr (hKernel, "GetDiskFreeSpaceExW"); GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA = - (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel, "GetDiskFreeSpaceExA"); + (GetDiskFreeSpaceExA_Proc) get_proc_addr (hKernel, "GetDiskFreeSpaceExA"); bool have_pfn_GetDiskFreeSpaceEx = ((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW) || (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA)); @@ -9687,8 +9431,8 @@ w32_console_toggle_lock_key (int vk_code, Lisp_Object new_state) int cur_state = (GetKeyState (vk_code) & 1); if (NILP (new_state) - || (NUMBERP (new_state) - && ((XUINT (new_state)) & 1) != cur_state)) + || (FIXNUMP (new_state) + && ((XUFIXNUM (new_state)) & 1) != cur_state)) { #ifdef WINDOWSNT faked_key = vk_code; @@ -9950,8 +9694,8 @@ get_dll_version (const char *dll_name) if (hdll) { - DLLGETVERSIONPROC pDllGetVersion - = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion"); + DLLGETVERSIONPROC pDllGetVersion = (DLLGETVERSIONPROC) + get_proc_addr (hdll, "DllGetVersion"); if (pDllGetVersion) { @@ -10315,7 +10059,7 @@ usage: (w32-notification-notify &rest PARAMS) */) /* Do it! */ retval = add_tray_notification (f, icon, tip, severity, timeout, title, msg); - return (retval < 0 ? Qnil : make_number (retval)); + return (retval < 0 ? Qnil : make_fixnum (retval)); } DEFUN ("w32-notification-close", @@ -10326,8 +10070,8 @@ DEFUN ("w32-notification-close", { struct frame *f = SELECTED_FRAME (); - if (INTEGERP (id)) - delete_tray_notification (f, XINT (id)); + if (FIXNUMP (id)) + delete_tray_notification (f, XFIXNUM (id)); return Qnil; } @@ -10335,6 +10079,72 @@ DEFUN ("w32-notification-close", #endif /* WINDOWSNT && !HAVE_DBUS */ +#ifdef WINDOWSNT +/*********************************************************************** + Reading Registry + ***********************************************************************/ +DEFUN ("w32-read-registry", + Fw32_read_registry, Sw32_read_registry, + 3, 3, 0, + doc: /* Return the value stored in MS-Windows Registry under ROOT/KEY/NAME. + +ROOT is a symbol, one of `HKCR', `HKCU', `HKLM', `HKU', or `HKCC'. +It can also be nil, which means try `HKCU', and if that fails, try `HKLM'. + +KEY and NAME must be strings, and NAME must not include slashes. +KEY can use either forward- or back-slashes. + +If the the named KEY or its subkey called NAME don't exist, or cannot +be accessed by the current user, the function returns nil. Otherwise, +the return value depends on the type of the data stored in Registry: + + If the data type is REG_NONE, the function returns t. + If the data type is REG_DWORD or REG_QWORD, the function returns + its integer value. If the value is too large for a fixnum, + the function returns a bignum. + If the data type is REG_BINARY, the function returns a vector whose + elements are individual bytes of the value. + If the data type is REG_SZ, the function returns a string. + If the data type is REG_EXPAND_SZ, the function returns a string + with all the %..% references to environment variables replaced + by the values of those variables. If the expansion fails, or + some variables are not defined in the environment, some or all + of the environment variables will remain unexpanded. + If the data type is REG_MULTI_SZ, the function returns a list whose + elements are the individual strings. + +Note that this function doesn't know whether a string value is a file +name, so file names will be returned with backslashes, which may need +to be converted to forward slashes by the caller. */) + (Lisp_Object root, Lisp_Object key, Lisp_Object name) +{ + CHECK_SYMBOL (root); + CHECK_STRING (key); + CHECK_STRING (name); + + HKEY rootkey = HKEY_CURRENT_USER; + if (EQ (root, QHKCR)) + rootkey = HKEY_CLASSES_ROOT; + else if (EQ (root, QHKCU)) + rootkey = HKEY_CURRENT_USER; + else if (EQ (root, QHKLM)) + rootkey = HKEY_LOCAL_MACHINE; + else if (EQ (root, QHKU)) + rootkey = HKEY_USERS; + else if (EQ (root, QHKCC)) + rootkey = HKEY_CURRENT_CONFIG; + else if (!NILP (root)) + error ("unknown root key: %s", SDATA (SYMBOL_NAME (root))); + + Lisp_Object val = w32_read_registry (rootkey, key, name); + if (NILP (val) && NILP (root)) + val = w32_read_registry (HKEY_LOCAL_MACHINE, key, name); + + return val; +} + +#endif /* WINDOWSNT */ + /*********************************************************************** Initialization ***********************************************************************/ @@ -10427,12 +10237,21 @@ syms_of_w32fns (void) DEFSYM (QCbody, ":body"); #endif +#ifdef WINDOWSNT + DEFSYM (QHKCR, "HKCR"); + DEFSYM (QHKCU, "HKCU"); + DEFSYM (QHKLM, "HKLM"); + DEFSYM (QHKU, "HKU"); + DEFSYM (QHKCC, "HKCC"); +#endif + /* Symbols used elsewhere, but only in MS-Windows-specific code. */ DEFSYM (Qgnutls, "gnutls"); DEFSYM (Qlibxml2, "libxml2"); DEFSYM (Qserif, "serif"); DEFSYM (Qzlib, "zlib"); DEFSYM (Qlcms2, "lcms2"); + DEFSYM (Qjson, "json"); Fput (Qundefined_color, Qerror_conditions, listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror)); @@ -10625,9 +10444,7 @@ bass-down, bass-boost, bass-up, treble-down, treble-up */); #if 0 /* TODO: Mouse cursor customization. */ DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, - doc: /* The shape of the pointer when over text. -Changing the value does not affect existing frames -unless you set the mouse color. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_pointer_shape = Qnil; Vx_nontext_pointer_shape = Qnil; @@ -10635,58 +10452,42 @@ unless you set the mouse color. */); Vx_mode_pointer_shape = Qnil; DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape, - doc: /* The shape of the pointer when Emacs is busy. -This variable takes effect when you create a new frame -or when you set the mouse color. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_hourglass_pointer_shape = Qnil; DEFVAR_LISP ("x-sensitive-text-pointer-shape", Vx_sensitive_text_pointer_shape, - doc: /* The shape of the pointer when over mouse-sensitive text. -This variable takes effect when you create a new frame -or when you set the mouse color. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_sensitive_text_pointer_shape = Qnil; DEFVAR_LISP ("x-window-horizontal-drag-cursor", Vx_window_horizontal_drag_shape, - doc: /* Pointer shape to use for indicating a window can be dragged horizontally. -This variable takes effect when you create a new frame -or when you set the mouse color. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_window_horizontal_drag_shape = Qnil; DEFVAR_LISP ("x-window-vertical-drag-cursor", Vx_window_vertical_drag_shape, - doc: /* Pointer shape to use for indicating a window can be dragged vertically. -This variable takes effect when you create a new frame -or when you set the mouse color. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_window_vertical_drag_shape = Qnil; #endif DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, - doc: /* A string indicating the foreground color of the cursor box. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, - doc: /* Maximum size for tooltips. -Value is a pair (COLUMNS . ROWS). Text larger than this is clipped. */); - Vx_max_tooltip_size = Fcons (make_number (80), make_number (40)); + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Fcons (make_fixnum (80), make_fixnum (40)); DEFVAR_LISP ("x-no-window-manager", Vx_no_window_manager, - doc: /* Non-nil if no window manager is in use. -Emacs doesn't try to figure this out; this is always nil -unless you set it to something else. */); + doc: /* SKIP: real doc in xfns.c. */); /* We don't have any way to find this out, so set it to nil and maybe the user would like to set it to t. */ Vx_no_window_manager = Qnil; DEFVAR_LISP ("x-pixel-size-width-font-regexp", Vx_pixel_size_width_font_regexp, - doc: /* Regexp matching a font name whose width is the same as `PIXEL_SIZE'. - -Since Emacs gets width of a font matching with this regexp from -PIXEL_SIZE field of the name, font finding mechanism gets faster for -such a font. This is especially effective for such large fonts as -Chinese, Japanese, and Korean. */); + doc: /* SKIP: real doc in xfns.c. */); Vx_pixel_size_width_font_regexp = Qnil; DEFVAR_LISP ("w32-bdf-filename-alist", @@ -10794,7 +10595,6 @@ tip frame. */); defsubr (&Sw32_reconstruct_hot_key); defsubr (&Sw32_toggle_lock_key); defsubr (&Sw32_window_exists_p); - defsubr (&Sw32_battery_status); defsubr (&Sw32__menu_bar_in_use); #if defined WINDOWSNT && !defined HAVE_DBUS defsubr (&Sw32_notification_notify); @@ -10802,6 +10602,7 @@ tip frame. */); #endif #ifdef WINDOWSNT + defsubr (&Sw32_read_registry); defsubr (&Sfile_system_info); defsubr (&Sdefault_printer_name); #endif @@ -10813,9 +10614,12 @@ tip frame. */); staticpro (&tip_timer); tip_frame = Qnil; staticpro (&tip_frame); - - last_show_tip_args = Qnil; - staticpro (&last_show_tip_args); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); defsubr (&Sx_file_dialog); #ifdef WINDOWSNT @@ -10852,9 +10656,8 @@ void w32_reset_stack_overflow_guard (void) { if (resetstkoflw == NULL) - resetstkoflw = - (_resetstkoflw_proc)GetProcAddress (GetModuleHandle ("msvcrt.dll"), - "_resetstkoflw"); + resetstkoflw = (_resetstkoflw_proc) + get_proc_addr (GetModuleHandle ("msvcrt.dll"), "_resetstkoflw"); /* We ignore the return value. If _resetstkoflw fails, the next stack overflow will crash the program. */ if (resetstkoflw != NULL) @@ -10928,9 +10731,8 @@ w32_backtrace (void **buffer, int limit) if (!s_pfn_CaptureStackBackTrace) { hm_kernel32 = LoadLibrary ("Kernel32.dll"); - s_pfn_CaptureStackBackTrace = - (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32, - "RtlCaptureStackBackTrace"); + s_pfn_CaptureStackBackTrace = (CaptureStackBackTrace_proc) + get_proc_addr (hm_kernel32, "RtlCaptureStackBackTrace"); } if (s_pfn_CaptureStackBackTrace) return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit), @@ -11063,29 +10865,29 @@ globals_of_w32fns (void) it dynamically. Do it once, here, instead of every time it is used. */ track_mouse_event_fn = (TrackMouseEvent_Proc) - GetProcAddress (user32_lib, "TrackMouseEvent"); + get_proc_addr (user32_lib, "TrackMouseEvent"); monitor_from_point_fn = (MonitorFromPoint_Proc) - GetProcAddress (user32_lib, "MonitorFromPoint"); + get_proc_addr (user32_lib, "MonitorFromPoint"); get_monitor_info_fn = (GetMonitorInfo_Proc) - GetProcAddress (user32_lib, "GetMonitorInfoA"); + get_proc_addr (user32_lib, "GetMonitorInfoA"); monitor_from_window_fn = (MonitorFromWindow_Proc) - GetProcAddress (user32_lib, "MonitorFromWindow"); + get_proc_addr (user32_lib, "MonitorFromWindow"); enum_display_monitors_fn = (EnumDisplayMonitors_Proc) - GetProcAddress (user32_lib, "EnumDisplayMonitors"); + get_proc_addr (user32_lib, "EnumDisplayMonitors"); get_title_bar_info_fn = (GetTitleBarInfo_Proc) - GetProcAddress (user32_lib, "GetTitleBarInfo"); + get_proc_addr (user32_lib, "GetTitleBarInfo"); { HMODULE imm32_lib = GetModuleHandle ("imm32.dll"); get_composition_string_fn = (ImmGetCompositionString_Proc) - GetProcAddress (imm32_lib, "ImmGetCompositionStringW"); + get_proc_addr (imm32_lib, "ImmGetCompositionStringW"); get_ime_context_fn = (ImmGetContext_Proc) - GetProcAddress (imm32_lib, "ImmGetContext"); + get_proc_addr (imm32_lib, "ImmGetContext"); release_ime_context_fn = (ImmReleaseContext_Proc) - GetProcAddress (imm32_lib, "ImmReleaseContext"); + get_proc_addr (imm32_lib, "ImmReleaseContext"); set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc) - GetProcAddress (imm32_lib, "ImmSetCompositionWindow"); + get_proc_addr (imm32_lib, "ImmSetCompositionWindow"); } except_code = 0; |