diff options
Diffstat (limited to 'src/haikufns.c')
-rw-r--r-- | src/haikufns.c | 3256 |
1 files changed, 3256 insertions, 0 deletions
diff --git a/src/haikufns.c b/src/haikufns.c new file mode 100644 index 00000000000..711202c5df3 --- /dev/null +++ b/src/haikufns.c @@ -0,0 +1,3256 @@ +/* Haiku window system support + Copyright (C) 2021-2022 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or (at +your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include <math.h> + +#include "lisp.h" +#include "frame.h" +#include "blockinput.h" +#include "termchar.h" +#include "font.h" +#include "keyboard.h" +#include "buffer.h" +#include "dispextern.h" + +#include "haikugui.h" +#include "haikuterm.h" +#include "haiku_support.h" +#include "termhooks.h" + +#include "bitmaps/leftptr.xbm" +#include "bitmaps/leftpmsk.xbm" + +#include <stdlib.h> + +#include <kernel/OS.h> + +#define RGB_TO_ULONG(r, g, b) \ + (((r) << 16) | ((g) << 8) | (b)); +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) + +/* The frame of the currently visible tooltip. */ +Lisp_Object tip_frame; + +/* The X and Y deltas of the last call to `x-show-tip'. */ +Lisp_Object tip_dx, tip_dy; + +/* The window-system window corresponding to the frame of the + currently visible tooltip. */ +static Window tip_window; + +/* A timer that hides or deletes the currently visible tooltip when it + fires. */ +static Lisp_Object tip_timer; + +/* STRING argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_string; + +/* Normalized FRAME argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_frame; + +/* PARMS argument of last `x-show-tip' call. */ +static Lisp_Object tip_last_parms; + +static void haiku_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); +static void haiku_set_title (struct frame *, Lisp_Object, Lisp_Object); + +/* The number of references to an image cache. */ +static ptrdiff_t image_cache_refcount; + +static Lisp_Object +get_geometry_from_preferences (struct haiku_display_info *dpyinfo, + Lisp_Object parms) +{ + struct { + const char *val; + const char *cls; + Lisp_Object tem; + } r[] = { + { "width", "Width", Qwidth }, + { "height", "Height", Qheight }, + { "left", "Left", Qleft }, + { "top", "Top", Qtop }, + }; + + int i; + for (i = 0; i < ARRAYELTS (r); ++i) + { + if (NILP (Fassq (r[i].tem, parms))) + { + Lisp_Object value + = gui_display_get_arg (dpyinfo, parms, r[i].tem, r[i].val, r[i].cls, + RES_TYPE_NUMBER); + if (! BASE_EQ (value, Qunbound)) + parms = Fcons (Fcons (r[i].tem, value), parms); + } + } + + return parms; +} + +/* Update the left and top offsets of F after its decorators + change. */ +static void +haiku_update_after_decoration_change (struct frame *f) +{ + /* Don't reset offsets during initial frame creation, since the + contents of f->left_pos and f->top_pos won't be applied to the + window until `x-create-frame' finishes, so setting them here will + overwrite the offsets that the window should be moved to. */ + + if (!FRAME_OUTPUT_DATA (f)->configury_done) + return; + + be_send_move_frame_event (FRAME_HAIKU_WINDOW (f)); +} + +void +haiku_change_tool_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TOOL_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + FRAME_TOOL_BAR_HEIGHT (f) = height; + FRAME_TOOL_BAR_LINES (f) = lines; + store_frame_param (f, Qtool_bar_lines, make_fixnum (lines)); + + if (FRAME_HAIKU_WINDOW (f) && FRAME_TOOL_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); + + if (!f->tool_bar_resized) + { + /* As long as tool_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtool_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtool_bar_lines); + + f->tool_bar_resized = f->tool_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtool_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); + + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +void +haiku_change_tab_bar_height (struct frame *f, int height) +{ + int unit = FRAME_LINE_HEIGHT (f); + int old_height = FRAME_TAB_BAR_HEIGHT (f); + int lines = (height + unit - 1) / unit; + Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + + /* Make sure we redisplay all windows in this frame. */ + fset_redisplay (f); + + /* Recalculate tab bar and frame text sizes. */ + FRAME_TAB_BAR_HEIGHT (f) = height; + FRAME_TAB_BAR_LINES (f) = lines; + store_frame_param (f, Qtab_bar_lines, make_fixnum (lines)); + + if (FRAME_HAIKU_WINDOW (f) && FRAME_TAB_BAR_HEIGHT (f) == 0) + { + clear_frame (f); + clear_current_matrices (f); + } + + if ((height < old_height) && WINDOWP (f->tab_bar_window)) + clear_glyph_matrix (XWINDOW (f->tab_bar_window)->current_matrix); + + if (!f->tab_bar_resized) + { + /* As long as tab_bar_resized is false, effectively try to change + F's native height. */ + if (NILP (fullscreen) || EQ (fullscreen, Qfullwidth)) + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 1, false, Qtab_bar_lines); + else + adjust_frame_size (f, -1, -1, 4, false, Qtab_bar_lines); + + f->tab_bar_resized = f->tab_bar_redisplayed; + } + else + /* Any other change may leave the native size of F alone. */ + adjust_frame_size (f, -1, -1, 3, false, Qtab_bar_lines); + + /* adjust_frame_size might not have done anything, garbage frame + here. */ + adjust_frame_glyphs (f); + SET_FRAME_GARBAGED (f); + if (FRAME_HAIKU_WINDOW (f)) + haiku_clear_under_internal_border (f); +} + +static void +haiku_set_no_focus_on_map (struct frame *f, Lisp_Object value, + Lisp_Object oldval) +{ + if (!EQ (value, oldval)) + FRAME_NO_FOCUS_ON_MAP (f) = !NILP (value); +} + +static void +haiku_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int nlines; + + /* Treat tool bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + haiku_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + +static void +haiku_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + if (FRAME_TOOLTIP_P (f)) + return; + int olines = FRAME_TAB_BAR_LINES (f); + int nlines; + + /* Treat tab bars like menu bars. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + /* Use VALUE only if an int >= 0. */ + if (RANGED_FIXNUMP (0, value, INT_MAX)) + nlines = XFIXNAT (value); + else + nlines = 0; + + if (nlines != olines && (olines == 0 || nlines == 0)) + haiku_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); +} + +void +gamma_correct (struct frame *f, Emacs_Color *color) +{ + if (f->gamma) + { + color->red = (pow (color->red / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->green = (pow (color->green / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->blue = (pow (color->blue / 65535.0, f->gamma) + * 65535.0 + 0.5); + color->pixel = RGB_TO_ULONG (color->red / 256, + color->green / 256, + color->blue / 256); + } +} + +int +haiku_get_color (const char *name, Emacs_Color *color) +{ + unsigned short r16, g16, b16; + Lisp_Object tem, col; + int32 clr, rc; + uint32_t ui_color; + ptrdiff_t size, i; + Lisp_Object string; + + if (parse_color_spec (name, &r16, &g16, &b16)) + { + color->pixel = RGB_TO_ULONG (r16 / 256, g16 / 256, b16 / 256); + color->red = r16; + color->green = g16; + color->blue = b16; + return 0; + } + else + { + block_input (); + eassert (x_display_list && !NILP (x_display_list->color_map)); + tem = x_display_list->color_map; + for (; CONSP (tem); tem = XCDR (tem)) + { + col = XCAR (tem); + + if (CONSP (col) && !xstrcasecmp (SSDATA (XCAR (col)), name)) + { + clr = XFIXNUM (XCDR (col)); + color->pixel = clr; + color->red = RED_FROM_ULONG (clr) * 257; + color->green = GREEN_FROM_ULONG (clr) * 257; + color->blue = BLUE_FROM_ULONG (clr) * 257; + unblock_input (); + return 0; + } + } + unblock_input (); + } + + rc = 1; + if (VECTORP (Vhaiku_allowed_ui_colors)) + { + size = ASIZE (Vhaiku_allowed_ui_colors); + + for (i = 0; i < size; ++i) + { + string = AREF (Vhaiku_allowed_ui_colors, i); + + block_input (); + if (STRINGP (string) && !strcmp (SSDATA (string), name)) + rc = be_get_ui_color (name, &ui_color); + unblock_input (); + } + } + + if (!rc) + { + color->pixel = ui_color; + color->red = RED_FROM_ULONG (ui_color) * 257; + color->green = GREEN_FROM_ULONG (ui_color) * 257; + color->blue = BLUE_FROM_ULONG (ui_color) * 257; + } + + return rc; +} + +static struct haiku_display_info * +haiku_display_info_for_name (Lisp_Object name) +{ + CHECK_STRING (name); + + if (!strcmp (SSDATA (name), "be")) + { + if (x_display_list) + return x_display_list; + + return haiku_term_init (); + } + + error ("Haiku displays can only be named \"be\""); +} + +static struct haiku_display_info * +check_haiku_display_info (Lisp_Object object) +{ + struct haiku_display_info *dpyinfo = NULL; + + if (NILP (object)) + { + struct frame *sf = XFRAME (selected_frame); + + if (FRAME_HAIKU_P (sf) && FRAME_LIVE_P (sf)) + dpyinfo = FRAME_DISPLAY_INFO (sf); + else if (x_display_list) + dpyinfo = x_display_list; + else + error ("Haiku windowing not present"); + } + else if (TERMINALP (object)) + { + struct terminal *t = decode_live_terminal (object); + + if (t->type != output_haiku) + error ("Terminal %d is not a Haiku display", t->id); + + dpyinfo = t->display_info.haiku; + } + else if (STRINGP (object)) + dpyinfo = haiku_display_info_for_name (object); + else + { + struct frame *f = decode_window_system_frame (object); + dpyinfo = FRAME_DISPLAY_INFO (f); + } + + return dpyinfo; +} + +static void +haiku_set_title_bar_text (struct frame *f, Lisp_Object text) +{ + if (FRAME_HAIKU_WINDOW (f)) + { + block_input (); + BWindow_retitle (FRAME_HAIKU_WINDOW (f), SSDATA (ENCODE_UTF_8 (text))); + unblock_input (); + } +} + +static void +haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +{ + /* Don't change the title if it's already NAME. */ + if (EQ (name, f->title)) + return; + + update_mode_lines = 26; + + fset_title (f, name); + + if (NILP (name)) + name = f->name; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_child_frame_border_width (struct frame *f, + Lisp_Object arg, Lisp_Object oldval) +{ + int border; + + if (NILP (arg)) + border = -1; + else if (RANGED_FIXNUMP (0, arg, INT_MAX)) + border = XFIXNAT (arg); + else + signal_error ("Invalid child frame border width", arg); + + if (border != FRAME_CHILD_FRAME_BORDER_WIDTH (f)) + { + f->child_frame_border_width = border; + + if (FRAME_HAIKU_WINDOW (f)) + adjust_frame_size (f, -1, -1, 3, 0, Qchild_frame_border_width); + + SET_FRAME_GARBAGED (f); + } +} + +static void +haiku_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + struct frame *p = NULL; + block_input (); + if (!NILP (new_value) + && (!FRAMEP (new_value) + || !FRAME_LIVE_P (p = XFRAME (new_value)) + || !FRAME_HAIKU_P (p))) + { + store_frame_param (f, Qparent_frame, old_value); + unblock_input (); + error ("Invalid specification of `parent-frame'"); + } + + if (EQ (new_value, old_value)) + { + unblock_input (); + return; + } + + if (!NILP (old_value)) + { + EmacsWindow_unparent (FRAME_HAIKU_WINDOW (f)); + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + } + + if (!NILP (new_value)) + { + EmacsWindow_parent_to (FRAME_HAIKU_WINDOW (f), + FRAME_HAIKU_WINDOW (p)); + BWindow_set_offset (FRAME_HAIKU_WINDOW (f), + f->left_pos, f->top_pos); + + /* This isn't actually used for anything, but makes the + `parent-id' parameter correct. */ + FRAME_OUTPUT_DATA (f)->parent_desc = FRAME_HAIKU_WINDOW (p); + } + fset_parent_frame (f, new_value); + unblock_input (); +} + +static void +haiku_set_z_group (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + int rc; + + /* Tooltip frames can't have Z groups, since the window feel is + overridden during frame creation. */ + if (FRAME_TOOLTIP_P (f)) + return; + + rc = 1; + block_input (); + + if (NILP (new_value)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_NONE); + FRAME_Z_GROUP (f) = z_group_none; + } + else if (EQ (new_value, Qabove)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_ABOVE); + FRAME_Z_GROUP (f) = z_group_above; + } + else if (EQ (new_value, Qbelow)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_BELOW); + FRAME_Z_GROUP (f) = z_group_below; + } + else + rc = 0; + + unblock_input (); + + if (!rc) + error ("Invalid z-group specification"); + + /* Setting the Z-group can change the frame's decorator. */ + haiku_update_after_decoration_change (f); +} + +static void +haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + haiku_set_name (f, arg, 1); +} + +static void +haiku_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ + if (!EQ (new_value, old_value)) + FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); + + block_input (); + if (FRAME_HAIKU_WINDOW (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), + FRAME_NO_ACCEPT_FOCUS (f)); + unblock_input (); +} + +static void +initial_setup_back_buffer (struct frame *f) +{ + block_input (); + if (NILP (CDR (Fassq (Qinhibit_double_buffering, f->param_alist)))) + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); + unblock_input (); +} + +static void +unwind_create_frame (Lisp_Object frame) +{ + struct frame *f = XFRAME (frame); + + /* If frame is already dead, nothing to do. This can happen if the + display is disconnected after the frame has become official, but + before x_create_frame removes the unwind protect. */ + if (!FRAME_LIVE_P (f)) + return; + + /* If frame is ``official'', nothing to do. */ + if (NILP (Fmemq (frame, Vframe_list))) + { +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + struct haiku_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif + + /* If the frame's image cache refcount is still the same as our + private shadow variable, it means we are unwinding a frame + for which we didn't yet call init_frame_faces, where the + refcount is incremented. Therefore, we increment it here, so + that free_frame_faces, called in free_frame_resources later, + will not mistakenly decrement the counter that was not + incremented yet to account for this new frame. */ + if (FRAME_IMAGE_CACHE (f) != NULL + && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) + FRAME_IMAGE_CACHE (f)->refcount++; + + haiku_free_frame_resources (f); + free_glyphs (f); + +#if defined GLYPH_DEBUG && defined ENABLE_CHECKING + /* Check that reference counts are indeed correct. */ + if (dpyinfo->terminal->image_cache) + eassert (dpyinfo->terminal->image_cache->refcount == image_cache_refcount); +#endif + } +} + +static void +unwind_create_tip_frame (Lisp_Object frame) +{ + unwind_create_frame (frame); + tip_window = NULL; + tip_frame = Qnil; +} + +static unsigned long +haiku_decode_color (struct frame *f, Lisp_Object color_name) +{ + Emacs_Color cdef; + + CHECK_STRING (color_name); + + if (!haiku_get_color (SSDATA (color_name), &cdef)) + return cdef.pixel; + + signal_error ("Undefined color", color_name); +} + +static void +haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output; + unsigned long fg, old_fg; + + fg = haiku_decode_color (f, arg); + old_fg = FRAME_FOREGROUND_PIXEL (f); + FRAME_FOREGROUND_PIXEL (f) = fg; + output = FRAME_OUTPUT_DATA (f); + + if (FRAME_HAIKU_WINDOW (f)) + { + if (output->cursor_color.pixel == old_fg) + haiku_query_color (fg, &output->cursor_color); + + update_face_from_frame_parameter (f, Qforeground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +static Lisp_Object +haiku_create_frame (Lisp_Object parms) +{ + struct frame *f, *cascade_target; + Lisp_Object frame, tem; + Lisp_Object name; + bool minibuffer_only = false; + long window_prompting = 0; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object display; + struct haiku_display_info *dpyinfo = NULL; + struct kboard *kb; + + if (x_display_list->focused_frame) + cascade_target = x_display_list->focused_frame; + else if (x_display_list->focus_event_frame) + cascade_target = x_display_list->focus_event_frame; + else + cascade_target = NULL; + + /* Always cascade from the most toplevel frame. */ + + while (cascade_target && FRAME_PARENT_FRAME (cascade_target)) + cascade_target = FRAME_PARENT_FRAME (cascade_target); + + parms = Fcopy_alist (parms); + + Vx_resource_name = Vinvocation_name; + + display = gui_display_get_arg (dpyinfo, parms, Qterminal, 0, 0, + RES_TYPE_STRING); + if (BASE_EQ (display, Qunbound)) + display = Qnil; + dpyinfo = check_haiku_display_info (display); + kb = dpyinfo->terminal->kboard; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + name = gui_display_get_arg (dpyinfo, parms, Qname, 0, 0, + RES_TYPE_STRING); + if (!STRINGP (name) + && ! BASE_EQ (name, Qunbound) + && ! NILP (name)) + error ("Invalid frame name--not a string or nil"); + + if (STRINGP (name)) + Vx_resource_name = name; + + /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ + /* No need to protect DISPLAY because that's not used after passing + it to make_frame_without_minibuffer. */ + frame = Qnil; + tem = gui_display_get_arg (dpyinfo, parms, Qminibuffer, + "minibuffer", "Minibuffer", + RES_TYPE_SYMBOL); + if (EQ (tem, Qnone) || NILP (tem)) + f = make_frame_without_minibuffer (Qnil, kb, display); + else if (EQ (tem, Qonly)) + { + f = make_minibuffer_frame (); + minibuffer_only = 1; + } + else if (WINDOWP (tem)) + f = make_frame_without_minibuffer (tem, kb, display); + else + f = make_frame (1); + + XSETFRAME (frame, f); + + f->terminal = dpyinfo->terminal; + + f->output_method = output_haiku; + f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; + + fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, + "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name)) + fset_icon_name (f, Qnil); + + FRAME_DISPLAY_INFO (f) = dpyinfo; + + /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ + record_unwind_protect (unwind_create_frame, frame); + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (BASE_EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) + { + fset_name (f, Vinvocation_name); + f->explicit_name = 0; + } + else + { + fset_name (f, name); + f->explicit_name = 1; + specbind (Qx_resource_name, name); + } + +#ifdef USE_BE_CAIRO + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif +#endif + register_font_driver (&haikufont_driver, f); + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + FRAME_RIF (f)->default_font_parameter (f, parms); + + if (!FRAME_FONT (f)) + { + delete_frame (frame, Qnoelisp); + error ("Invalid frame font"); + } + + gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), + "borderwidth", "BorderWidth", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (0), + "internalBorderWidth", "InternalBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, + "childFrameBorderWidth", "childFrameBorderWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qvertical_scroll_bars, Qt, + "verticalScrollBars", "VerticalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qhorizontal_scroll_bars, Qnil, + "horizontalScrollBars", "HorizontalScrollBars", + RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qmouse_color, build_string ("font-color"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qline_spacing, Qnil, + "lineSpacing", "LineSpacing", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qleft_fringe, Qnil, + "leftFringe", "LeftFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qright_fringe, Qnil, + "rightFringe", "RightFringe", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + init_frame_faces (f); + + /* Read comment about this code in corresponding place in xfns.c. */ + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); + if (FIXNUMP (tem)) + store_frame_param (f, Qmin_width, tem); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); + 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, 1, + Qx_create_frame_1); + + gui_default_parameter (f, parms, Qno_focus_on_map, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qno_accept_focus, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* The resources controlling the menu-bar, tool-bar, and tab-bar are + processed specially at startup, and reflected in the mode + variables; ignore them here. */ + gui_default_parameter (f, parms, Qmenu_bar_lines, + NILP (Vmenu_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtab_bar_lines, + NILP (Vtab_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qtool_bar_lines, + NILP (Vtool_bar_mode) + ? make_fixnum (0) : make_fixnum (1), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbuffer_predicate, Qnil, "bufferPredicate", + "BufferPredicate", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qtitle, Qnil, "title", "Title", + RES_TYPE_STRING); + + parms = get_geometry_from_preferences (dpyinfo, parms); + window_prompting = gui_figure_window_size (f, parms, false, true); + + tem = gui_display_get_arg (dpyinfo, parms, Qunsplittable, 0, 0, + RES_TYPE_BOOLEAN); + f->no_split = minibuffer_only || (!BASE_EQ (tem, Qunbound) && !NILP (tem)); + + f->terminal->reference_count++; + + FRAME_OUTPUT_DATA (f)->window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + + if (!FRAME_OUTPUT_DATA (f)->window) + xsignal1 (Qerror, build_unibyte_string ("Could not create window")); + + block_input (); + if (!minibuffer_only && FRAME_EXTERNAL_MENU_BAR (f)) + initialize_frame_menubar (f); + unblock_input (); + + Vframe_list = Fcons (frame, Vframe_list); + + Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms, + Qparent_frame, NULL, NULL, + RES_TYPE_SYMBOL); + + if (BASE_EQ (parent_frame, Qunbound) + || NILP (parent_frame) + || !FRAMEP (parent_frame) + || !FRAME_LIVE_P (XFRAME (parent_frame))) + parent_frame = Qnil; + + /* It doesn't make sense to center child frames, the resulting + position makes no sense. */ + if (!NILP (parent_frame)) + window_prompting |= PPosition; + + fset_parent_frame (f, parent_frame); + store_frame_param (f, Qparent_frame, parent_frame); + + if (!NILP (parent_frame)) + haiku_set_parent_frame (f, parent_frame, Qnil); + + gui_default_parameter (f, parms, Qundecorated, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qoverride_redirect, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qicon_type, Qnil, + "bitmapIcon", "BitmapIcon", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qscroll_bar_width, Qnil, + "scrollBarWidth", "ScrollBarWidth", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qscroll_bar_height, Qnil, + "scrollBarHeight", "ScrollBarHeight", + RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qfullscreen, Qnil, + "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + f->can_set_window_size = true; + + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qx_create_frame_2); + + Lisp_Object visibility; + + visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + if (BASE_EQ (visibility, Qunbound)) + visibility = Qt; + if (EQ (visibility, Qicon)) + haiku_iconify_frame (f); + else if (!NILP (visibility)) + haiku_visualize_frame (f); + else /* Qnil */ + { + f->was_invisible = true; + } + + if (FRAME_HAS_MINIBUF_P (f) + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + kset_default_minibuffer_frame (kb, frame); + + /* Set whether or not frame synchronization is enabled. */ + gui_default_parameter (f, parms, Quse_frame_synchronization, Qt, + NULL, NULL, RES_TYPE_BOOLEAN); + + gui_default_parameter (f, parms, Qz_group, Qnil, + NULL, NULL, RES_TYPE_SYMBOL); + + for (tem = parms; CONSP (tem); tem = XCDR (tem)) + if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) + fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); + + block_input (); + if (window_prompting & (USPosition | PPosition)) + haiku_set_offset (f, f->left_pos, f->top_pos, 1); + else if (cascade_target) + haiku_set_offset (f, cascade_target->left_pos + 15, + cascade_target->top_pos + 15, 1); + else + BWindow_center_on_screen (FRAME_HAIKU_WINDOW (f)); + unblock_input (); + + FRAME_OUTPUT_DATA (f)->configury_done = true; + + if (f->want_fullscreen != FULLSCREEN_NONE) + FRAME_TERMINAL (f)->fullscreen_hook (f); + + /* Make sure windows on this frame appear in calls to next-window + and similar functions. */ + Vwindow_list = Qnil; + + return unbind_to (count, frame); +} + +/* Create a frame for a tooltip. PARMS is a list of frame parameters. + TEXT is the string to display in the tip frame. Value is the + frame. + + Note that functions called here, esp. gui_default_parameter can + signal errors, for instance when a specified color name is + undefined. We have to make sure that we're in a consistent state + when this happens. */ + +static Lisp_Object +haiku_create_tip_frame (Lisp_Object parms) +{ + struct frame *f; + Lisp_Object frame; + Lisp_Object name; + specpdl_ref count = SPECPDL_INDEX (); + bool face_change_before = face_change; + struct haiku_display_info *dpyinfo = x_display_list; + + if (!dpyinfo->terminal->name) + error ("Terminal is not live, can't create new frames on it"); + + parms = Fcopy_alist (parms); + + /* Get the name of the frame to use for resource lookup. */ + name = gui_display_get_arg (dpyinfo, parms, Qname, "name", "Name", + RES_TYPE_STRING); + if (!STRINGP (name) + && !BASE_EQ (name, Qunbound) + && !NILP (name)) + error ("Invalid frame name--not a string or nil"); + + frame = Qnil; + f = make_frame (false); + f->wants_modeline = false; + XSETFRAME (frame, f); + record_unwind_protect (unwind_create_tip_frame, frame); + + f->terminal = dpyinfo->terminal; + + /* By setting the output method, we're essentially saying that + the frame is live, as per FRAME_LIVE_P. If we get a signal + from this point on, x_destroy_window might screw up reference + counts etc. */ + f->output_method = output_haiku; + f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; + + f->tooltip = true; + fset_icon_name (f, Qnil); + FRAME_DISPLAY_INFO (f) = dpyinfo; + + FRAME_OUTPUT_DATA (f)->parent_desc = NULL; + + /* Set the name; the functions to which we pass f expect the name to + be set. */ + if (BASE_EQ (name, Qunbound) || NILP (name)) + f->explicit_name = false; + else + { + fset_name (f, name); + f->explicit_name = true; + /* use the frame's title when getting resources for this frame. */ + specbind (Qx_resource_name, name); + } + +#ifdef USE_BE_CAIRO + register_font_driver (&ftcrfont_driver, f); +#ifdef HAVE_HARFBUZZ + register_font_driver (&ftcrhbfont_driver, f); +#endif +#endif + register_font_driver (&haikufont_driver, f); + + image_cache_refcount = + FRAME_IMAGE_CACHE (f) ? FRAME_IMAGE_CACHE (f)->refcount : 0; + + gui_default_parameter (f, parms, Qfont_backend, Qnil, + "fontBackend", "FontBackend", RES_TYPE_STRING); + + /* Extract the window parameters from the supplied values that are + needed to determine window geometry. */ + FRAME_RIF (f)->default_font_parameter (f, parms); + + /* This defaults to 1 in order to match xterm. We recognize either + internalBorderWidth or internalBorder (which is what xterm calls + it). */ + if (NILP (Fassq (Qinternal_border_width, parms))) + { + Lisp_Object value; + + value = gui_display_get_arg (dpyinfo, parms, Qinternal_border_width, + "internalBorder", "internalBorder", + RES_TYPE_NUMBER); + if (! BASE_EQ (value, Qunbound)) + parms = Fcons (Fcons (Qinternal_border_width, value), + parms); + } + + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (1), + "internalBorderWidth", "internalBorderWidth", + RES_TYPE_NUMBER); + + gui_default_parameter (f, parms, Qright_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qbottom_divider_width, make_fixnum (0), + NULL, NULL, RES_TYPE_NUMBER); + + /* Also do the stuff which must be set before the window exists. */ + gui_default_parameter (f, parms, Qforeground_color, build_string ("black"), + "foreground", "Foreground", RES_TYPE_STRING); + + gui_default_parameter (f, parms, Qbackground_color, build_string ("white"), + "background", "Background", RES_TYPE_STRING); + + /* FIXME: is there a better method to tell Emacs to not recolor the + cursors other than setting the color to a special value? */ + gui_default_parameter (f, parms, Qmouse_color, build_string ("font-color"), + "pointerColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qcursor_color, build_string ("black"), + "cursorColor", "Foreground", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qborder_color, build_string ("black"), + "borderColor", "BorderColor", RES_TYPE_STRING); + gui_default_parameter (f, parms, Qno_special_glyphs, Qnil, + NULL, NULL, RES_TYPE_BOOLEAN); + + /* Init faces before gui_default_parameter is called for the + scroll-bar-width parameter because otherwise we end up in + init_iterator with a null face cache, which should not happen. */ + init_frame_faces (f); + + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + + gui_figure_window_size (f, parms, false, false); + + { + void *window; + + block_input (); + window = BWindow_new (&FRAME_OUTPUT_DATA (f)->view); + + FRAME_OUTPUT_DATA (f)->window = window; + if (!window) + emacs_abort (); + + BWindow_set_tooltip_decoration (window); + unblock_input (); + } + + gui_default_parameter (f, parms, Qauto_raise, Qnil, + "autoRaise", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qauto_lower, Qnil, + "autoLower", "AutoRaiseLower", RES_TYPE_BOOLEAN); + gui_default_parameter (f, parms, Qcursor_type, Qbox, + "cursorType", "CursorType", RES_TYPE_SYMBOL); + gui_default_parameter (f, parms, Qalpha, Qnil, + "alpha", "Alpha", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qalpha_background, Qnil, + "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + + initial_setup_back_buffer (f); + + /* Add `tooltip' frame parameter's default value. */ + if (NILP (Fframe_parameter (frame, Qtooltip))) + { + AUTO_FRAME_ARG (arg, Qtooltip, Qt); + Fmodify_frame_parameters (frame, arg); + } + + /* FIXME - can this be done in a similar way to normal frames? + https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */ + + { + Lisp_Object disptype; + + if (be_get_display_planes () == 1) + disptype = Qmono; + else if (be_is_display_grayscale ()) + disptype = Qgrayscale; + else + disptype = Qcolor; + + if (NILP (Fframe_parameter (frame, Qdisplay_type))) + { + AUTO_FRAME_ARG (arg, Qdisplay_type, disptype); + Fmodify_frame_parameters (frame, arg); + } + } + + /* Set up faces after all frame parameters are known. This call + also merges in face attributes specified for new frames. + + Frame parameters may be changed if .Xdefaults contains + specifications for the default font. For example, if there is an + `Emacs.default.attributeBackground: pink', the `background-color' + attribute of the frame gets set, which let's the internal border + of the tooltip frame appear in pink. Prevent this. */ + { + Lisp_Object bg = Fframe_parameter (frame, Qbackground_color); + + call2 (Qface_set_after_frame_default, frame, Qnil); + + if (!EQ (bg, Fframe_parameter (frame, Qbackground_color))) + { + AUTO_FRAME_ARG (arg, Qbackground_color, bg); + Fmodify_frame_parameters (frame, arg); + } + } + + f->no_split = true; + + /* Now that the frame will be official, it counts as a reference to + its display and terminal. */ + f->terminal->reference_count++; + + /* It is now ok to make the frame official even if we get an error + below. And the frame needs to be on Vframe_list or making it + visible won't work. */ + Vframe_list = Fcons (frame, Vframe_list); + f->can_set_window_size = true; + adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), + 0, true, Qtip_frame); + + /* Setting attributes of faces of the tooltip frame from resources + and similar will set face_change, which leads to the clearing of + all current matrices. Since this isn't necessary here, avoid it + by resetting face_change to the value it had before we created + the tip frame. */ + face_change = face_change_before; + + /* Discard the unwind_protect. */ + return unbind_to (count, frame); +} + + +static void +compute_tip_xy (struct frame *f, + Lisp_Object parms, Lisp_Object dx, Lisp_Object dy, + int width, int height, int *root_x, int *root_y) +{ + Lisp_Object left, top, right, bottom; + int min_x = 0, min_y = 0, max_x = 0, max_y = 0; + + /* User-specified position? */ + left = Fcdr (Fassq (Qleft, parms)); + top = Fcdr (Fassq (Qtop, parms)); + right = Fcdr (Fassq (Qright, parms)); + bottom = Fcdr (Fassq (Qbottom, parms)); + + /* Move the tooltip window where the mouse pointer is. Resize and + show it. */ + if ((!FIXNUMP (left) && !FIXNUMP (right)) + || (!FIXNUMP (top) && !FIXNUMP (bottom))) + { + int x, y; + + /* Default min and max values. */ + min_x = 0; + min_y = 0; + + be_get_screen_dimensions (&max_x, &max_y); + + max_x = max_x - 1; + max_y = max_y - 1; + + block_input (); + BView_get_mouse (FRAME_HAIKU_VIEW (f), &x, &y); + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &x, &y); + *root_x = x; + *root_y = y; + unblock_input (); + } + + 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 + XFIXNUM (dy) + height <= max_y) + /* It fits below the pointer */ + *root_y += XFIXNUM (dy); + else if (height + XFIXNUM (dy) + min_y <= *root_y) + /* It fits above the pointer. */ + *root_y -= height + XFIXNUM (dy); + else + /* Put it on the top. */ + *root_y = min_y; + + 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 + XFIXNUM (dx) + width <= max_x) + /* It fits to the right of the pointer. */ + *root_x += XFIXNUM (dx); + else if (width + XFIXNUM (dx) + min_x <= *root_x) + /* It fits to the left of the pointer. */ + *root_x -= width + XFIXNUM (dx); + else + /* Put it left justified on the screen -- it ought to fit that way. */ + *root_x = min_x; +} + +static Lisp_Object +haiku_hide_tip (bool delete) +{ + Lisp_Object it, frame; + + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + FOR_EACH_FRAME (it, frame) + if (FRAME_WINDOW_P (XFRAME (frame)) + && FRAME_HAIKU_VIEW (XFRAME (frame))) + BView_set_tooltip (FRAME_HAIKU_VIEW (XFRAME (frame)), NULL); + + if (NILP (tip_frame) + || (!delete && !NILP (tip_frame) + && !FRAME_VISIBLE_P (XFRAME (tip_frame)))) + return Qnil; + else + { + Lisp_Object was_open = Qnil; + + specpdl_ref count = SPECPDL_INDEX (); + specbind (Qinhibit_redisplay, Qt); + specbind (Qinhibit_quit, Qt); + + if (!NILP (tip_frame)) + { + if (FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (delete) + { + delete_frame (tip_frame, Qnil); + tip_frame = Qnil; + } + else + haiku_unvisualize_frame (XFRAME (tip_frame)); + + was_open = Qt; + } + else + tip_frame = Qnil; + } + else + tip_frame = Qnil; + + return unbind_to (count, was_open); + } +} + +static void +haiku_set_undecorated (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (EQ (new_value, old_value)) + return; + + block_input (); + FRAME_UNDECORATED (f) = !NILP (new_value); + BWindow_change_decoration (FRAME_HAIKU_WINDOW (f), NILP (new_value)); + unblock_input (); + + haiku_update_after_decoration_change (f); +} + +static void +haiku_set_override_redirect (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + if (EQ (new_value, old_value)) + return; + + block_input (); + BWindow_set_override_redirect (FRAME_HAIKU_WINDOW (f), + !NILP (new_value)); + FRAME_OVERRIDE_REDIRECT (f) = !NILP (new_value); + unblock_input (); + + haiku_update_after_decoration_change (f); +} + +static void +haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +{ + int nlines; + + if (FRAME_TOOLTIP_P (f)) + return; + + if (TYPE_RANGED_FIXNUMP (int, value)) + nlines = XFIXNUM (value); + else + nlines = 0; + + fset_redisplay (f); + + if (nlines) + { + FRAME_EXTERNAL_MENU_BAR (f) = 1; + if (FRAME_HAIKU_P (f) && !FRAME_HAIKU_MENU_BAR (f)) + XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = 1; + } + else + { + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + + if (FRAME_EXTERNAL_MENU_BAR (f)) + free_frame_menubar (f); + + FRAME_EXTERNAL_MENU_BAR (f) = 0; + FRAME_HAIKU_MENU_BAR (f) = 0; + } + + adjust_frame_glyphs (f); +} + +/* Return geometric attributes of FRAME. According to the value of + ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner + edges of FRAME, the root window edges of frame (Qroot_edges). Any + other value means to return the geometry as returned by + Fx_frame_geometry. */ +static Lisp_Object +frame_geometry (Lisp_Object frame, Lisp_Object attribute) +{ + struct frame *f, *parent; + void *window; + int outer_x, outer_y, outer_width, outer_height; + int right_off, bottom_off, top_off; + int native_x, native_y; + + f = decode_window_system_frame (frame); + parent = FRAME_PARENT_FRAME (f); + window = FRAME_HAIKU_WINDOW (f); + + be_lock_window (window); + be_get_window_decorator_frame (window, &outer_x, &outer_y, + &outer_width, &outer_height); + be_get_window_decorator_dimensions (window, NULL, &top_off, + &right_off, &bottom_off); + be_unlock_window (window); + + native_x = FRAME_OUTPUT_DATA (f)->frame_x; + native_y = FRAME_OUTPUT_DATA (f)->frame_y; + + if (parent) + { + /* Adjust all the coordinates by the coordinates of the parent + frame. */ + outer_x -= FRAME_OUTPUT_DATA (parent)->frame_x; + outer_y -= FRAME_OUTPUT_DATA (parent)->frame_y; + native_x -= FRAME_OUTPUT_DATA (parent)->frame_x; + native_y -= FRAME_OUTPUT_DATA (parent)->frame_y; + } + + if (EQ (attribute, Qouter_edges)) + return list4i (outer_x, outer_y, + outer_x + outer_width, + outer_y + outer_height); + else if (EQ (attribute, Qnative_edges)) + return list4i (native_x, native_y, + native_x + FRAME_PIXEL_WIDTH (f), + native_y + FRAME_PIXEL_HEIGHT (f)); + else if (EQ (attribute, Qinner_edges)) + return list4i (native_x + FRAME_INTERNAL_BORDER_WIDTH (f), + native_y + FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_MENU_BAR_HEIGHT (f) + FRAME_TOOL_BAR_HEIGHT (f), + native_x - FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_PIXEL_WIDTH (f), + native_y + FRAME_PIXEL_HEIGHT (f) + - FRAME_INTERNAL_BORDER_WIDTH (f)); + + else + return list (Fcons (Qouter_position, + Fcons (make_fixnum (outer_x), + make_fixnum (outer_y))), + Fcons (Qouter_size, + Fcons (make_fixnum (outer_width), + make_fixnum (outer_height))), + Fcons (Qexternal_border_size, + Fcons (make_fixnum (right_off), + make_fixnum (bottom_off))), + Fcons (Qtitle_bar_size, + Fcons (make_fixnum (outer_width), + make_fixnum (top_off))), + Fcons (Qmenu_bar_external, Qnil), + Fcons (Qmenu_bar_size, + Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) + - (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_MENU_BAR_HEIGHT (f)))), + Fcons (Qtool_bar_external, Qnil), + Fcons (Qtool_bar_position, Qtop), + Fcons (Qtool_bar_size, + Fcons (make_fixnum (FRAME_PIXEL_WIDTH (f) + - (FRAME_INTERNAL_BORDER_WIDTH (f) * 2)), + make_fixnum (FRAME_TOOL_BAR_HEIGHT (f)))), + Fcons (Qinternal_border_width, + make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)))); +} + +void +haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long background; + + background = haiku_decode_color (f, arg); + + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + FRAME_BACKGROUND_PIXEL (f) = background; + + if (FRAME_HAIKU_VIEW (f)) + { + BView_draw_lock (FRAME_HAIKU_DRAWABLE (f), false, 0, 0, 0, 0); + BView_SetViewColor (FRAME_HAIKU_DRAWABLE (f), background); + BView_draw_unlock (FRAME_HAIKU_DRAWABLE (f)); + + FRAME_OUTPUT_DATA (f)->cursor_fg = background; + update_face_from_frame_parameter (f, Qbackground_color, arg); + + if (FRAME_VISIBLE_P (f)) + redraw_frame (f); + } +} + +void +haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + unsigned long fore_pixel, pixel; + + pixel = haiku_decode_color (f, arg); + + if (!NILP (Vx_cursor_fore_pixel)) + { + fore_pixel = haiku_decode_color (f, Vx_cursor_fore_pixel); + FRAME_OUTPUT_DATA (f)->cursor_fg = fore_pixel; + } + else + FRAME_OUTPUT_DATA (f)->cursor_fg = FRAME_BACKGROUND_PIXEL (f); + + haiku_query_color (pixel, &FRAME_CURSOR_COLOR (f)); + + if (FRAME_VISIBLE_P (f)) + { + gui_update_cursor (f, false); + gui_update_cursor (f, true); + } + + update_face_from_frame_parameter (f, Qcursor_color, arg); +} + +void +haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + set_frame_cursor_types (f, arg); +} + +unsigned long +haiku_get_pixel (haiku bitmap, int x, int y) +{ + unsigned char *data; + int32_t bytes_per_row; + int mono_p, left, right, top, bottom, byte; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < 0 || x > right - left || y < 0 || y > bottom - top) + emacs_abort (); + + if (!mono_p) + return ((uint32_t *) (data + (bytes_per_row * y)))[x]; + + byte = y * bytes_per_row + x / 8; + return data[byte] & (1 << (x % 8)); +} + +void +haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) +{ + unsigned char *data, *byte; + int32_t bytes_per_row; + int mono_p, left, right, top, bottom; + ptrdiff_t off, bit, xoff; + + data = BBitmap_data (bitmap); + BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, + &bytes_per_row, &mono_p); + + if (x < 0 || x > right - left || y < 0 || y > bottom - top) + emacs_abort (); + + if (mono_p) + { + off = y * bytes_per_row; + bit = x % 8; + xoff = x / 8; + + byte = data + off + xoff; + if (!pixel) + *byte &= ~(1 << bit); + else + *byte |= 1 << bit; + } + else + ((uint32_t *) (data + (bytes_per_row * y)))[x] = pixel; +} + +void +haiku_free_frame_resources (struct frame *f) +{ + haiku window, drawable, mbar; + Mouse_HLInfo *hlinfo; + struct haiku_display_info *dpyinfo; + Lisp_Object bar; + struct scroll_bar *b; + + check_window_system (f); + block_input (); + + hlinfo = MOUSE_HL_INFO (f); + window = FRAME_HAIKU_WINDOW (f); + drawable = FRAME_HAIKU_VIEW (f); + mbar = FRAME_HAIKU_MENU_BAR (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + free_frame_faces (f); + haiku_free_custom_cursors (f); + + /* Free scroll bars */ + for (bar = FRAME_SCROLL_BARS (f); !NILP (bar); bar = b->next) + { + b = XSCROLL_BAR (bar); + haiku_scroll_bar_remove (b); + } + + if (f == dpyinfo->highlight_frame) + dpyinfo->highlight_frame = 0; + if (f == dpyinfo->focused_frame) + dpyinfo->focused_frame = 0; + if (f == dpyinfo->last_mouse_motion_frame) + dpyinfo->last_mouse_motion_frame = NULL; + if (f == dpyinfo->last_mouse_frame) + dpyinfo->last_mouse_frame = NULL; + if (f == dpyinfo->focus_event_frame) + dpyinfo->focus_event_frame = NULL; + + if (f == hlinfo->mouse_face_mouse_frame) + reset_mouse_highlight (hlinfo); + + if (mbar) + { + BMenuBar_delete (mbar); + if (f->output_data.haiku->menu_bar_open_p) + { + --popup_activated_p; + f->output_data.haiku->menu_bar_open_p = 0; + } + } + + if (drawable) + BView_emacs_delete (drawable); + + if (window) + BWindow_quit (window); + + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + + xfree (FRAME_OUTPUT_DATA (f)); + FRAME_OUTPUT_DATA (f) = NULL; + + unblock_input (); +} + +void +haiku_iconify_frame (struct frame *frame) +{ + if (FRAME_ICONIFIED_P (frame)) + return; + + SET_FRAME_VISIBLE (frame, false); + SET_FRAME_ICONIFIED (frame, true); + + block_input (); + BWindow_iconify (FRAME_HAIKU_WINDOW (frame)); + unblock_input (); +} + +void +haiku_visualize_frame (struct frame *f) +{ + block_input (); + + if (!FRAME_VISIBLE_P (f)) + { + if (FRAME_NO_FOCUS_ON_MAP (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 1); + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 1); + if (FRAME_NO_FOCUS_ON_MAP (f) && + !FRAME_NO_ACCEPT_FOCUS (f)) + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + + haiku_set_offset (f, f->left_pos, f->top_pos, 0); + + SET_FRAME_VISIBLE (f, 1); + SET_FRAME_ICONIFIED (f, 0); + } + + unblock_input (); +} + +void +haiku_unvisualize_frame (struct frame *f) +{ + block_input (); + + BWindow_set_visible (FRAME_HAIKU_WINDOW (f), 0); + BWindow_sync (FRAME_HAIKU_WINDOW (f)); + SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, 0); + + unblock_input (); +} + +void +haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) +{ + int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); + int new_width = check_int_nonnegative (arg); + + if (new_width == old_width) + return; + + f->internal_border_width = new_width; + + if (FRAME_HAIKU_WINDOW (f)) + { + adjust_frame_size (f, -1, -1, 3, 0, Qinternal_border_width); + haiku_clear_under_internal_border (f); + } + + SET_FRAME_GARBAGED (f); +} + +void +haiku_set_frame_visible_invisible (struct frame *f, bool visible_p) +{ + if (visible_p) + haiku_visualize_frame (f); + else + haiku_unvisualize_frame (f); +} + +void +frame_set_mouse_pixel_position (struct frame *f, int pix_x, int pix_y) +{ + block_input (); + + BView_convert_to_screen (FRAME_HAIKU_VIEW (f), &pix_x, &pix_y); + be_warp_pointer (pix_x, pix_y); + + unblock_input (); +} + +void +haiku_query_color (uint32_t col, Emacs_Color *color_def) +{ + color_def->red = RED_FROM_ULONG (col) * 257; + color_def->green = GREEN_FROM_ULONG (col) * 257; + color_def->blue = BLUE_FROM_ULONG (col) * 257; + + color_def->pixel = col; +} + +Display_Info * +check_x_display_info (Lisp_Object object) +{ + return check_haiku_display_info (object); +} + +/* Rename frame F to NAME. If NAME is nil, set F's name to the + default name. If EXPLICIT_P is non-zero, that indicates Lisp code + is setting the name, not redisplay; in that case, set F's name to + NAME and set F->explicit_name; if NAME is nil, clear + F->explicit_name. + + If EXPLICIT_P is zero, it means redisplay is setting the name; the + name provided will be ignored if explicit_name is set. */ +void +haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p) +{ + struct haiku_display_info *dpyinfo; + + if (explicit_p) + { + if (f->explicit_name && NILP (name)) + update_mode_lines = 37; + + f->explicit_name = !NILP (name); + } + else if (f->explicit_name) + return; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + if (NILP (name)) + name = dpyinfo->default_name; + + if (!NILP (Fstring_equal (name, f->name))) + return; + + fset_name (f, name); + + if (!NILP (f->title)) + name = f->title; + + haiku_set_title_bar_text (f, name); +} + +static void +haiku_set_inhibit_double_buffering (struct frame *f, + Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + if (FRAME_HAIKU_WINDOW (f)) + { +#ifndef USE_BE_CAIRO + if (NILP (new_value)) +#endif + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); +#ifndef USE_BE_CAIRO + else + EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); +#endif + + SET_FRAME_GARBAGED (f); + } + unblock_input (); +} + +static void +haiku_set_sticky (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + block_input (); + BWindow_set_sticky (FRAME_HAIKU_WINDOW (f), !NILP (new_value)); + unblock_input (); +} + +struct user_cursor_info +{ + /* A pointer to the Lisp_Object describing the cursor. */ + Lisp_Object *lisp_cursor; + + /* The offset of the cursor in the `struct haiku_output' of each + frame. */ + ptrdiff_t output_offset; + + /* The offset of the default value of the cursor in the display + info structure. */ + ptrdiff_t default_offset; +}; + +struct user_cursor_bitmap_info +{ + /* A bitmap to use instead of the font cursor to create cursors in a + certain color. */ + const void *bits; + + /* The mask for that bitmap. */ + const void *mask; + + /* The dimensions of the cursor bitmap. */ + int width, height; + + /* The position inside the cursor bitmap corresponding to the + position of the mouse pointer. */ + int x, y; +}; + +#define INIT_USER_CURSOR(lisp, cursor) \ + { (lisp), offsetof (struct haiku_output, cursor), \ + offsetof (struct haiku_display_info, cursor) } + +struct user_cursor_info custom_cursors[] = + { + INIT_USER_CURSOR (&Vx_pointer_shape, text_cursor), + INIT_USER_CURSOR (NULL, nontext_cursor), + INIT_USER_CURSOR (NULL, modeline_cursor), + INIT_USER_CURSOR (&Vx_sensitive_text_pointer_shape, hand_cursor), + INIT_USER_CURSOR (&Vx_hourglass_pointer_shape, hourglass_cursor), + INIT_USER_CURSOR (NULL, horizontal_drag_cursor), + INIT_USER_CURSOR (NULL, vertical_drag_cursor), + INIT_USER_CURSOR (NULL, left_edge_cursor), + INIT_USER_CURSOR (NULL, top_left_corner_cursor), + INIT_USER_CURSOR (NULL, top_edge_cursor), + INIT_USER_CURSOR (NULL, top_right_corner_cursor), + INIT_USER_CURSOR (NULL, right_edge_cursor), + INIT_USER_CURSOR (NULL, bottom_right_corner_cursor), + INIT_USER_CURSOR (NULL, bottom_edge_cursor), + INIT_USER_CURSOR (NULL, bottom_left_corner_cursor), + INIT_USER_CURSOR (NULL, no_cursor), + }; + +struct user_cursor_bitmap_info cursor_bitmaps[] = + { + { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, /* text_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* nontext_cursor */ + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, /* modeline_cursor */ + { hand_ptr_bits, hand_ptrmask_bits, 15, 15, 4, 3 }, /* hand_cursor */ + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, /* hourglass_cursor */ + { horizd_ptr_bits, horizd_ptrmask_bits, 15, 15, 7, 7 }, /* horizontal_drag_cursor */ + { vertd_ptr_bits, vertd_ptrmask_bits, 15, 15, 7, 7 }, /* vertical_drag_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* left_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* top_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* right_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_right_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_edge_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* bottom_left_corner_cursor */ + { NULL, NULL, 0, 0, 0, 0 }, /* no_cursor */ + }; + +/* Array of cursor bitmaps for each system cursor ID. This is used to + color in user-specified cursors. */ +struct user_cursor_bitmap_info cursor_bitmaps_for_id[28] = + { + { NULL, NULL, 0, 0, 0, 0 }, + { left_ptr_bits, left_ptrmsk_bits, 16, 16, 3, 1 }, + { ibeam_ptr_bits, ibeam_ptrmask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { cross_ptr_bits, cross_ptrmask_bits, 30, 30, 15, 15 }, + { NULL, NULL, 0, 0, 0, 0 }, + { hand_ptr_bits, hand_ptrmask_bits, 15, 15, 4, 3 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { hourglass_bits, hourglass_mask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { horizd_ptr_bits, horizd_ptrmask_bits, 15, 15, 7, 7 }, + { vertd_ptr_bits, vertd_ptrmask_bits, 15, 15, 7, 7 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + { NULL, NULL, 0, 0, 0, 0 }, + }; + +static void * +haiku_create_colored_cursor (struct user_cursor_bitmap_info *info, + uint32_t foreground, uint32_t background) +{ + const char *bits, *mask; + void *bitmap, *cursor; + int width, height, bytes_per_line, x, y; + + bits = info->bits; + mask = info->mask; + width = info->width; + height = info->height; + bytes_per_line = (width + 7) / 8; + + bitmap = BBitmap_new (width, height, false); + + if (!bitmap) + memory_full (SIZE_MAX); + + for (y = 0; y < height; ++y) + { + for (x = 0; x < width; ++x) + { + if (mask[x / 8] >> (x % 8) & 1) + haiku_put_pixel (bitmap, x, y, + (bits[x / 8] >> (x % 8) & 1 + ? (foreground | 255u << 24) + : (background | 255u << 24))); + else + haiku_put_pixel (bitmap, x, y, 0); + } + + mask += bytes_per_line; + bits += bytes_per_line; + } + + cursor = be_create_pixmap_cursor (bitmap, info->x, info->y); + BBitmap_free (bitmap); + + return cursor; +} + +/* Free all cursors on F that were allocated specifically for the + frame. */ +void +haiku_free_custom_cursors (struct frame *f) +{ + struct user_cursor_info *cursor; + struct haiku_output *output; + struct haiku_display_info *dpyinfo; + Emacs_Cursor *frame_cursor; + Emacs_Cursor *display_cursor; + int i; + + output = FRAME_OUTPUT_DATA (f); + dpyinfo = FRAME_DISPLAY_INFO (f); + + for (i = 0; i < ARRAYELTS (custom_cursors); ++i) + { + cursor = &custom_cursors[i]; + frame_cursor = (Emacs_Cursor *) ((char *) output + + cursor->output_offset); + display_cursor = (Emacs_Cursor *) ((char *) dpyinfo + + cursor->default_offset); + + if (*frame_cursor != *display_cursor && *frame_cursor) + { + if (output->current_cursor == *frame_cursor) + output->current_cursor = *display_cursor; + + be_delete_cursor (*frame_cursor); + } + + *frame_cursor = *display_cursor; + } +} + +static void +haiku_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ + struct haiku_output *output; + Emacs_Cursor *frame_cursor, old, *recolored; + int i, n, rc; + bool color_specified_p; + Emacs_Color color; + + CHECK_STRING (arg); + color_specified_p = true; + + if (!strcmp (SSDATA (arg), "font-color")) + color_specified_p = false; + else + rc = haiku_get_color (SSDATA (arg), &color); + + if (color_specified_p && rc) + signal_error ("Undefined color", arg); + + output = FRAME_OUTPUT_DATA (f); + + /* This will also reset all the cursors back to their default + values. */ + haiku_free_custom_cursors (f); + + for (i = 0; i < ARRAYELTS (custom_cursors); ++i) + { + frame_cursor = (Emacs_Cursor *) ((char *) output + + custom_cursors[i].output_offset); + old = *frame_cursor; + + if (custom_cursors[i].lisp_cursor + && FIXNUMP (*custom_cursors[i].lisp_cursor)) + { + if (!RANGED_FIXNUMP (0, *custom_cursors[i].lisp_cursor, + 28)) /* 28 is the largest Haiku cursor ID. */ + signal_error ("Invalid cursor", + *custom_cursors[i].lisp_cursor); + + n = XFIXNUM (*custom_cursors[i].lisp_cursor); + + if (color_specified_p && cursor_bitmaps_for_id[n].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps_for_id[n], + color.pixel, + FRAME_BACKGROUND_PIXEL (f)); + + if (recolored) + { + *frame_cursor = recolored; + continue; + } + } + + /* Create and set the custom cursor. */ + *frame_cursor = be_create_cursor_from_id (n); + } + else if (color_specified_p && cursor_bitmaps[i].bits) + { + recolored + = haiku_create_colored_cursor (&cursor_bitmaps[i], color.pixel, + FRAME_BACKGROUND_PIXEL (f)); + + if (recolored) + *frame_cursor = recolored; + } + } + + /* This function can be called before the frame's window is + created. */ + if (FRAME_HAIKU_WINDOW (f)) + { + if (output->current_cursor == old + && old != *frame_cursor) + { + output->current_cursor = *frame_cursor; + + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + *frame_cursor); + } + } + + update_face_from_frame_parameter (f, Qmouse_color, arg); +} + +static void +haiku_set_use_frame_synchronization (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) +{ + be_set_use_frame_synchronization (FRAME_HAIKU_VIEW (f), !NILP (arg)); +} + + + +DEFUN ("haiku-set-mouse-absolute-pixel-position", + Fhaiku_set_mouse_absolute_pixel_position, + Shaiku_set_mouse_absolute_pixel_position, 2, 2, 0, + doc: /* Move mouse pointer to a pixel position at (X, Y). The +coordinates X and Y are interpreted to start from the top-left +corner of the screen. */) + (Lisp_Object x, Lisp_Object y) +{ + int xval = check_integer_range (x, INT_MIN, INT_MAX); + int yval = check_integer_range (y, INT_MIN, INT_MAX); + + if (!x_display_list) + error ("Window system not initialized"); + + block_input (); + be_warp_pointer (xval, yval); + unblock_input (); + return Qnil; +} + +DEFUN ("haiku-mouse-absolute-pixel-position", Fhaiku_mouse_absolute_pixel_position, + Shaiku_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the coordinates of +the mouse cursor position in pixels relative to a position (0, 0) of the +selected frame's display. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + void *view; + int x, y; + + if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f)) + return Qnil; + + block_input (); + view = FRAME_HAIKU_VIEW (f); + BView_get_mouse (view, &x, &y); + BView_convert_to_screen (view, &x, &y); + unblock_input (); + + return Fcons (make_fixnum (x), make_fixnum (y)); +} + +DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qnil : Qt; +} + +DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + + CHECK_STRING (color); + decode_window_system_frame (frame); + + return haiku_get_color (SSDATA (color), &col) ? Qnil : Qt; +} + +DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object color, Lisp_Object frame) +{ + Emacs_Color col; + int rc; + + CHECK_STRING (color); + decode_window_system_frame (frame); + + block_input (); + rc = haiku_get_color (SSDATA (color), &col); + unblock_input (); + + if (rc) + return Qnil; + + return list3i (col.red, col.green, col.blue); +} + +DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qt : Qnil; +} + +DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, + 1, 3, 0, doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object display, Lisp_Object resource_string, Lisp_Object must_succeed) +{ + CHECK_STRING (display); + + if (NILP (Fstring_equal (display, build_string ("be")))) + { + if (!NILP (must_succeed)) + fatal ("Invalid display %s", SDATA (display)); + else + signal_error ("Invalid display", display); + } + + if (x_display_list) + { + if (!NILP (must_succeed)) + fatal ("A display is already open"); + else + error ("A display is already open"); + } + + haiku_term_init (); + return Qnil; +} + +DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + int width, height; + check_haiku_display_info (terminal); + + be_get_screen_dimensions (&width, &height); + return make_fixnum (width); +} + +DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) + +{ + int width, height; + check_haiku_display_info (terminal); + + be_get_screen_dimensions (&width, &height); + return make_fixnum (height); +} + +DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + int width, height; + + be_get_screen_dimensions (&width, &height); + return make_fixnum (height / (dpyinfo->resy / 25.4)); +} + + +DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); + int width, height; + + be_get_screen_dimensions (&width, &height); + return make_fixnum (width / (dpyinfo->resx / 25.4)); +} + +DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, + 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object parms) +{ + return haiku_create_frame (parms); +} + +DEFUN ("x-display-visual-class", Fx_display_visual_class, + Sx_display_visual_class, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + int planes; + bool grayscale_p; + + check_haiku_display_info (terminal); + + grayscale_p = be_is_display_grayscale (); + if (grayscale_p) + return Qstatic_gray; + + planes = be_get_display_planes (); + if (planes == 8) + return Qstatic_color; + + return Qtrue_color; +} + +DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, + 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 *f, *tip_f; + struct window *w; + int root_x, root_y; + struct buffer *old_buffer; + struct text_pos pos; + int width, height; + int old_windows_or_buffers_changed = windows_or_buffers_changed; + specpdl_ref count = SPECPDL_INDEX (); + Lisp_Object window, size, tip_buf; + bool displayed; +#ifdef ENABLE_CHECKING + struct glyph_row *row, *end; +#endif + AUTO_STRING (tip, " *tip*"); + + specbind (Qinhibit_redisplay, Qt); + + CHECK_STRING (string); + if (SCHARS (string) == 0) + string = make_unibyte_string (" ", 1); + + if (NILP (frame)) + frame = selected_frame; + f = decode_window_system_frame (frame); + + if (NILP (timeout)) + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); + + if (NILP (dx)) + dx = make_fixnum (5); + else + CHECK_FIXNUM (dx); + + if (NILP (dy)) + dy = make_fixnum (-10); + else + CHECK_FIXNUM (dy); + + tip_dx = dx; + tip_dy = dy; + + if (use_system_tooltips) + { + int root_x, root_y; + CHECK_STRING (string); + if (STRING_MULTIBYTE (string)) + string = ENCODE_UTF_8 (string); + + if (NILP (frame)) + frame = selected_frame; + + struct frame *f = decode_window_system_frame (frame); + block_input (); + + char *str = xstrdup (SSDATA (string)); + int height = be_plain_font_height (); + int width; + char *tok = strtok (str, "\n"); + width = be_string_width_with_plain_font (tok); + + while ((tok = strtok (NULL, "\n"))) + { + height = be_plain_font_height (); + int w = be_string_width_with_plain_font (tok); + if (w > width) + w = width; + } + free (str); + + height += 16; /* Default margin. */ + width += 16; /* Ditto. Unfortunately there isn't a more + reliable way to get it. */ + compute_tip_xy (f, parms, dx, dy, width, height, &root_x, &root_y); + BView_convert_from_screen (FRAME_HAIKU_VIEW (f), &root_x, &root_y); + be_show_sticky_tooltip (FRAME_HAIKU_VIEW (f), SSDATA (string), + root_x, root_y); + unblock_input (); + goto start_timer; + } + + if (!NILP (tip_frame) && FRAME_LIVE_P (XFRAME (tip_frame))) + { + if (FRAME_VISIBLE_P (XFRAME (tip_frame)) + && !NILP (Fequal_including_properties (tip_last_string, string)) + && !NILP (Fequal (tip_last_parms, parms))) + { + /* Only DX and DY have changed. */ + tip_f = XFRAME (tip_frame); + if (!NILP (tip_timer)) + { + call1 (Qcancel_timer, tip_timer); + tip_timer = Qnil; + } + + block_input (); + compute_tip_xy (tip_f, parms, dx, dy, FRAME_PIXEL_WIDTH (tip_f), + FRAME_PIXEL_HEIGHT (tip_f), &root_x, &root_y); + BWindow_set_offset (FRAME_HAIKU_WINDOW (tip_f), root_x, root_y); + unblock_input (); + + goto start_timer; + } + 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 + 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); + parm = Fcar (elt); + /* The left, top, right and bottom parameters are handled + by compute_tip_xy so they can be ignored here. */ + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) + && !EQ (parm, Qright) && !EQ (parm, Qbottom)) + { + last = Fassq (parm, tip_last_parms); + if (NILP (Fequal (Fcdr (elt), Fcdr (last)))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + else + tip_last_parms = + call2 (Qassq_delete_all, parm, tip_last_parms); + } + + /* Now check if every parameter in what is left of + tip_last_parms with a non-nil value has an association in + PARMS. */ + for (tail = tip_last_parms; CONSP (tail); tail = XCDR (tail)) + { + elt = XCAR (tail); + parm = Fcar (elt); + if (!EQ (parm, Qleft) && !EQ (parm, Qtop) && !EQ (parm, Qright) + && !EQ (parm, Qbottom) && !NILP (Fcdr (elt))) + { + /* We lost, delete the old tooltip. */ + delete = true; + break; + } + } + + haiku_hide_tip (delete); + } + else + haiku_hide_tip (true); + } + else + haiku_hide_tip (true); + + tip_last_frame = frame; + tip_last_string = string; + tip_last_parms = parms; + + if (NILP (tip_frame) || !FRAME_LIVE_P (XFRAME (tip_frame))) + { + /* Add default values to frame parameters. */ + 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_fixnum (3)), parms); + if (NILP (Fassq (Qborder_width, 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); + 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 + variable tip_frame. */ + if (NILP (tip_frame = haiku_create_tip_frame (parms))) + /* Creating the tip frame failed. */ + return unbind_to (count, Qnil); + } + + tip_f = XFRAME (tip_frame); + window = FRAME_ROOT_WINDOW (tip_f); + tip_buf = Fget_buffer_create (tip, Qnil); + /* 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_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; + /* Try to avoid that `other-window' select us (Bug#47207). */ + Fset_window_parameter (window, Qno_other_window, Qt); + + /* Set up the frame's root window. Note: The following code does not + try to size the window or its frame correctly. Its only purpose is + to make the subsequent text size calculations work. The right + sizes should get installed when the toolkit gets back to us. */ + w->left_col = 0; + w->top_line = 0; + w->pixel_left = 0; + w->pixel_top = 0; + + if (CONSP (Vx_max_tooltip_size) + && RANGED_FIXNUMP (1, XCAR (Vx_max_tooltip_size), INT_MAX) + && RANGED_FIXNUMP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) + { + w->total_cols = XFIXNAT (XCAR (Vx_max_tooltip_size)); + w->total_lines = XFIXNAT (XCDR (Vx_max_tooltip_size)); + } + else + { + w->total_cols = 80; + w->total_lines = 40; + } + + w->pixel_width = w->total_cols * FRAME_COLUMN_WIDTH (tip_f); + w->pixel_height = w->total_lines * FRAME_LINE_HEIGHT (tip_f); + FRAME_TOTAL_COLS (tip_f) = w->total_cols; + adjust_frame_glyphs (tip_f); + + /* Insert STRING into root window's buffer and fit the frame to the + buffer. */ + specpdl_ref count_1 = SPECPDL_INDEX (); + old_buffer = current_buffer; + set_buffer_internal_1 (XBUFFER (w->contents)); + bset_truncate_lines (current_buffer, Qnil); + specbind (Qinhibit_read_only, Qt); + specbind (Qinhibit_modification_hooks, Qt); + specbind (Qinhibit_point_motion_hooks, Qt); + Ferase_buffer (); + Finsert (1, &string); + clear_glyph_matrix (w->desired_matrix); + clear_glyph_matrix (w->current_matrix); + SET_TEXT_POS (pos, BEGV, BEGV_BYTE); + displayed = try_window (window, pos, TRY_WINDOW_IGNORE_FONTS_CHANGE); + + if (!displayed && NILP (Vx_max_tooltip_size)) + { +#ifdef ENABLE_CHECKING + row = w->desired_matrix->rows; + end = w->desired_matrix->rows + w->desired_matrix->nrows; + + while (row < end) + { + if (!row->displays_text_p + || row->ends_at_zv_p) + break; + ++row; + } + + eassert (row < end && row->ends_at_zv_p); +#endif + } + + /* Calculate size of tooltip window. */ + size = Fwindow_text_pixel_size (window, Qnil, Qnil, Qnil, + make_fixnum (w->pixel_height), Qnil, + Qnil); + /* Add the frame's internal border to calculated size. */ + 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. */ + block_input (); + void *wnd = FRAME_HAIKU_WINDOW (tip_f); + BWindow_resize (wnd, width, height); + /* The window decorator might cause the actual width and height to + be larger than WIDTH and HEIGHT, so use the actual sizes. */ + BWindow_dimensions (wnd, &width, &height); + BView_resize_to (FRAME_HAIKU_VIEW (tip_f), width, height); + BView_set_view_cursor (FRAME_HAIKU_VIEW (tip_f), + FRAME_OUTPUT_DATA (f)->current_cursor); + BWindow_set_offset (wnd, root_x, root_y); + BWindow_set_visible (wnd, true); + SET_FRAME_VISIBLE (tip_f, true); + FRAME_PIXEL_WIDTH (tip_f) = width; + FRAME_PIXEL_HEIGHT (tip_f) = height; + BWindow_sync (wnd); + + /* This is needed because the app server resets the cursor whenever + a new window is mapped, so we won't see the cursor set on the + tooltip if the mouse pointer isn't actually over it. */ + BView_set_view_cursor (FRAME_HAIKU_VIEW (f), + FRAME_OUTPUT_DATA (f)->current_cursor); + unblock_input (); + + w->must_be_updated_p = true; + update_single_window (w); + flush_frame (tip_f); + set_buffer_internal_1 (old_buffer); + unbind_to (count_1, Qnil); + windows_or_buffers_changed = old_windows_or_buffers_changed; + + start_timer: + /* Let the tip disappear after timeout seconds. */ + tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip); + + return unbind_to (count, Qnil); +} + +DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + return haiku_hide_tip (!tooltip_reuse_hidden_frame); +} + +DEFUN ("x-close-connection", Fx_close_connection, Sx_close_connection, 1, 1, 0, + doc: /* SKIP: real doc in xfns.c. */ + attributes: noreturn) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + error ("Cannot close Haiku displays"); +} + +DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, + doc: /* SKIP: real doc in xfns.c. */) + (void) +{ + if (!x_display_list) + return Qnil; + + return list1 (XCAR (x_display_list->name_list_element)); +} + +DEFUN ("x-server-vendor", Fx_server_vendor, Sx_server_vendor, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return build_string ("Haiku, Inc."); +} + +DEFUN ("x-server-version", Fx_server_version, Sx_server_version, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return list3i (5, 1, 1); +} + +DEFUN ("x-display-screens", Fx_display_screens, Sx_display_screens, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + return make_fixnum (be_get_display_screens ()); +} + +DEFUN ("haiku-get-version-string", Fhaiku_get_version_string, + Shaiku_get_version_string, 0, 0, 0, + doc: /* Return a string describing the current Haiku version. */) + (void) +{ + char buf[1024]; + + be_get_version_string ((char *) &buf, sizeof buf); + return build_string (buf); +} + +DEFUN ("x-display-color-cells", Fx_display_color_cells, Sx_display_color_cells, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_color_cells ()); +} + +DEFUN ("x-display-planes", Fx_display_planes, Sx_display_planes, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + check_haiku_display_info (terminal); + + return make_fixnum (be_get_display_planes ()); +} + +DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object frame) +{ + struct frame *f = decode_window_system_frame (frame); + + return EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? Qt : Qnil; +} + +DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_store, + 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct frame *f; + + if (FRAMEP (terminal)) + { + f = decode_window_system_frame (terminal); + + if (FRAME_HAIKU_VIEW (f) + && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + return FRAME_PARENT_FRAME (f) ? Qwhen_mapped : Qalways; + else + return Qnot_useful; + } + else + { + check_haiku_display_info (terminal); + return Qnot_useful; + } +} + +DEFUN ("haiku-frame-geometry", Fhaiku_frame_geometry, Shaiku_frame_geometry, 0, 1, 0, + doc: /* Return geometric attributes of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is an association list of the attributes listed below. All height +and width values are in pixels. + +`outer-position' is a cons of the outer left and top edges of FRAME + relative to the origin - the position (0, 0) - of FRAME's display. + +`outer-size' is a cons of the outer width and height of FRAME. The + outer size includes the title bar and the external borders as well as + any menu and/or tool bar of frame. + +`external-border-size' is a cons of the horizontal and vertical width of + FRAME's external borders as supplied by the window manager. + +`title-bar-size' is a cons of the width and height of the title bar of + FRAME as supplied by the window manager. If both of them are zero, + FRAME has no title bar. If only the width is zero, Emacs was not + able to retrieve the width information. + +`menu-bar-external', if non-nil, means the menu bar is external (never + included in the inner edges of FRAME). + +`menu-bar-size' is a cons of the width and height of the menu bar of + FRAME. + +`tool-bar-external', if non-nil, means the tool bar is external (never + included in the inner edges of FRAME). + +`tool-bar-position' tells on which side the tool bar on FRAME is and can + be one of `left', `top', `right' or `bottom'. If this is nil, FRAME + has no tool bar. + +`tool-bar-size' is a cons of the width and height of the tool bar of + FRAME. + +`internal-border-width' is the width of the internal border of + FRAME. */) + (Lisp_Object frame) +{ + return frame_geometry (frame, Qnil); +} + +DEFUN ("haiku-frame-edges", Fhaiku_frame_edges, Shaiku_frame_edges, 0, 2, 0, + doc: /* Return edge coordinates of FRAME. +FRAME must be a live frame and defaults to the selected one. The return +value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are +in pixels relative to the origin - the position (0, 0) - of FRAME's +display. + +If optional argument TYPE is the symbol `outer-edges', return the outer +edges of FRAME. The outer edges comprise the decorations of the window +manager (like the title bar or external borders) as well as any external +menu or tool bar of FRAME. If optional argument TYPE is the symbol +`native-edges' or nil, return the native edges of FRAME. The native +edges exclude the decorations of the window manager and any external +menu or tool bar of FRAME. If TYPE is the symbol `inner-edges', return +the inner edges of FRAME. These edges exclude title bar, any borders, +menu bar or tool bar of FRAME. */) + (Lisp_Object frame, Lisp_Object type) +{ + return frame_geometry (frame, ((EQ (type, Qouter_edges) + || EQ (type, Qinner_edges)) + ? type + : Qnative_edges)); +} + +DEFUN ("haiku-read-file-name", Fhaiku_read_file_name, Shaiku_read_file_name, 1, 6, 0, + doc: /* Use a graphical panel to read a file name, using prompt PROMPT. +Optional arg FRAME specifies a frame on which to display the file panel. +If it is nil, the current frame is used instead. +The frame being used will be brought to the front of +the display after the file panel is closed. +Optional arg DIR, if non-nil, supplies a default directory. +Optional arg MUSTMATCH, if non-nil, means the returned file or +directory must exist. +Optional arg DIR_ONLY_P, if non-nil, means choose only directories. +Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry field. */) + (Lisp_Object prompt, Lisp_Object frame, Lisp_Object dir, + Lisp_Object mustmatch, Lisp_Object dir_only_p, Lisp_Object save_text) +{ + struct frame *f; + char *file_name; + Lisp_Object value; + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); + + if (!NILP (dir)) + { + CHECK_STRING (dir); + dir = ENCODE_FILE (dir); + } + + if (!NILP (save_text)) + CHECK_STRING (save_text); + + if (NILP (frame)) + frame = selected_frame; + + CHECK_STRING (prompt); + + f = decode_window_system_frame (frame); + + ++popup_activated_p; + unrequest_sigio (); + file_name = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (dir) : NULL, + !NILP (mustmatch), !NILP (dir_only_p), + FRAME_HAIKU_WINDOW (f), + (!NILP (save_text) + ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL), + SSDATA (ENCODE_UTF_8 (prompt)), + process_pending_signals); + request_sigio (); + --popup_activated_p; + + if (!file_name) + quit (); + + value = build_string (file_name); + free (file_name); + + return DECODE_FILE (value); +} + +DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, + 2, 2, 0, doc: /* Place STRING by the key RESOURCE in the resource database. +It can later be retrieved with `x-get-resource'. */) + (Lisp_Object resource, Lisp_Object string) +{ + CHECK_STRING (resource); + if (!NILP (string)) + CHECK_STRING (string); + + put_xrm_resource (resource, string); + return Qnil; +} + +DEFUN ("haiku-frame-list-z-order", Fhaiku_frame_list_z_order, + Shaiku_frame_list_z_order, 0, 1, 0, + doc: /* Return list of Emacs' frames, in Z (stacking) order. +If TERMINAL is non-nil and specifies a live frame, return the child +frames of that frame in Z (stacking) order. + +As it is impossible to reliably determine the frame stacking order on +Haiku, the selected frame is always the first element of the returned +list, while the rest are not guaranteed to be in any particular order. + +Frames are listed from topmost (first) to bottommost (last). */) + (Lisp_Object terminal) +{ + Lisp_Object frames = Qnil; + Lisp_Object head, tail; + Lisp_Object sel = Qnil; + + FOR_EACH_FRAME (head, tail) + { + struct frame *f = XFRAME (tail); + if (!FRAME_HAIKU_P (f) || + (FRAMEP (terminal) && + FRAME_LIVE_P (XFRAME (terminal)) && + !EQ (terminal, get_frame_param (f, Qparent_frame)))) + continue; + + if (EQ (tail, selected_frame)) + sel = tail; + else + frames = Fcons (tail, frames); + } + + if (NILP (sel)) + return frames; + + return Fcons (sel, frames); +} + +DEFUN ("x-display-save-under", Fx_display_save_under, + Sx_display_save_under, 0, 1, 0, + doc: /* SKIP: real doc in xfns.c. */) + (Lisp_Object terminal) +{ + struct frame *f; + check_haiku_display_info (terminal); + + if (FRAMEP (terminal)) + { + f = decode_window_system_frame (terminal); + return ((FRAME_HAIKU_VIEW (f) + && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + ? Qt : Qnil); + } + + return Qnil; +} + +DEFUN ("haiku-frame-restack", Fhaiku_frame_restack, Shaiku_frame_restack, 2, 3, 0, + doc: /* Restack FRAME1 below FRAME2. +This means that if both frames are visible and the display areas of +these frames overlap, FRAME2 (partially) obscures FRAME1. If optional +third argument ABOVE is non-nil, restack FRAME1 above FRAME2. This +means that if both frames are visible and the display areas of these +frames overlap, FRAME1 (partially) obscures FRAME2. + +Some window managers may refuse to restack windows. */) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) +{ + struct frame *f1 = decode_window_system_frame (frame1); + struct frame *f2 = decode_window_system_frame (frame2); + + block_input (); + + if (NILP (above)) + { + /* If the window that is currently active will be sent behind + another window, make the window that it is being sent behind + active first, to avoid both windows being moved to the back of + the display. */ + + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f1)) + /* But don't do this if any of the frames involved have + child frames, since they are guaranteed to be in front of + their toplevel parents. */ + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f2)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f1), + FRAME_HAIKU_WINDOW (f2)); + } + else + { + if (BWindow_is_active (FRAME_HAIKU_WINDOW (f2)) + && !FRAME_PARENT_FRAME (f1) + && !FRAME_PARENT_FRAME (f2)) + { + BWindow_activate (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + } + + BWindow_send_behind (FRAME_HAIKU_WINDOW (f2), + FRAME_HAIKU_WINDOW (f1)); + } + BWindow_sync (FRAME_HAIKU_WINDOW (f1)); + BWindow_sync (FRAME_HAIKU_WINDOW (f2)); + + unblock_input (); + + return Qnil; +} + +DEFUN ("haiku-save-session-reply", Fhaiku_save_session_reply, + Shaiku_save_session_reply, 1, 1, 0, + doc: /* Reply to a `save-session' event. +QUIT-REPLY means whether or not all files were saved and program +termination should proceed. + +Calls to this function must be balanced by the amount of +`save-session' events received. This is done automatically, so do not +call this function yourself. */) + (Lisp_Object quit_reply) +{ + struct haiku_session_manager_reply reply; + reply.quit_reply = !NILP (quit_reply); + + block_input (); + unrequest_sigio (); + write_port (port_emacs_to_session_manager, 0, &reply, + sizeof reply); + request_sigio (); + unblock_input (); + + return Qnil; +} + +DEFUN ("haiku-display-monitor-attributes-list", + Fhaiku_display_monitor_attributes_list, + Shaiku_display_monitor_attributes_list, + 0, 1, 0, + doc: /* Return a list of physical monitor attributes on the display TERMINAL. + +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. + +Internal use only, use `display-monitor-attributes-list' instead. */) + (Lisp_Object terminal) +{ + struct MonitorInfo monitor; + struct haiku_display_info *dpyinfo; + Lisp_Object frames, tail, tem; + + dpyinfo = check_haiku_display_info (terminal); + frames = Qnil; + + FOR_EACH_FRAME (tail, tem) + { + maybe_quit (); + + if (FRAME_HAIKU_P (XFRAME (tem)) + && !FRAME_TOOLTIP_P (XFRAME (tem))) + frames = Fcons (tem, frames); + } + + monitor.geom.x = 0; + monitor.geom.y = 0; + be_get_screen_dimensions ((int *) &monitor.geom.width, + (int *) &monitor.geom.height); + + monitor.mm_width = (monitor.geom.width + / (dpyinfo->resx / 25.4)); + monitor.mm_height = (monitor.geom.height + / (dpyinfo->resy / 25.4)); + monitor.name = (char *) "BeOS monitor"; + + if (!be_get_explicit_workarea ((int *) &monitor.work.x, + (int *) &monitor.work.y, + (int *) &monitor.work.width, + (int *) &monitor.work.height)) + monitor.work = monitor.geom; + + return make_monitor_attribute_list (&monitor, 1, 0, + make_vector (1, frames), + "fallback"); +} + +frame_parm_handler haiku_frame_parm_handlers[] = + { + gui_set_autoraise, + gui_set_autolower, + haiku_set_background_color, + NULL, /* x_set_border_color */ + gui_set_border_width, + haiku_set_cursor_color, + haiku_set_cursor_type, + gui_set_font, + haiku_set_foreground_color, + NULL, /* set icon name */ + NULL, /* set icon type */ + haiku_set_child_frame_border_width, + haiku_set_internal_border_width, + gui_set_right_divider_width, + gui_set_bottom_divider_width, + haiku_set_menu_bar_lines, + haiku_set_mouse_color, + haiku_explicitly_set_name, + gui_set_scroll_bar_width, + gui_set_scroll_bar_height, + haiku_set_title, + gui_set_unsplittable, + gui_set_vertical_scroll_bars, + gui_set_horizontal_scroll_bars, + gui_set_visibility, + haiku_set_tab_bar_lines, + haiku_set_tool_bar_lines, + NULL, /* set scroll bar fg */ + NULL, /* set scroll bar bkg */ + gui_set_screen_gamma, + gui_set_line_spacing, + gui_set_left_fringe, + gui_set_right_fringe, + NULL, /* x wait for wm */ + gui_set_fullscreen, + gui_set_font_backend, + gui_set_alpha, + haiku_set_sticky, + NULL, /* set tool bar pos */ + haiku_set_inhibit_double_buffering, + haiku_set_undecorated, + haiku_set_parent_frame, + NULL, /* set skip taskbar */ + haiku_set_no_focus_on_map, + haiku_set_no_accept_focus, + haiku_set_z_group, + haiku_set_override_redirect, + gui_set_no_special_glyphs, + gui_set_alpha_background, + haiku_set_use_frame_synchronization, + }; + +void +syms_of_haikufns (void) +{ + DEFSYM (Qfont_parameter, "font-parameter"); + DEFSYM (Qcancel_timer, "cancel-timer"); + DEFSYM (Qassq_delete_all, "assq-delete-all"); + + DEFSYM (Qrun_at_time, "run-at-time"); + DEFSYM (Qx_hide_tip, "x-hide-tip"); + + DEFSYM (Qalways, "always"); + DEFSYM (Qnot_useful, "not-useful"); + DEFSYM (Qwhen_mapped, "when-mapped"); + DEFSYM (Qtooltip_reuse_hidden_frame, "tooltip-reuse-hidden-frame"); + + DEFSYM (Qstatic_color, "static-color"); + DEFSYM (Qstatic_gray, "static-gray"); + DEFSYM (Qtrue_color, "true-color"); + DEFSYM (Qmono, "mono"); + DEFSYM (Qgrayscale, "grayscale"); + DEFSYM (Qcolor, "color"); + + defsubr (&Sx_hide_tip); + defsubr (&Sxw_display_color_p); + defsubr (&Sx_display_grayscale_p); + defsubr (&Sx_open_connection); + defsubr (&Sx_create_frame); + defsubr (&Sx_display_pixel_width); + defsubr (&Sx_display_pixel_height); + defsubr (&Sxw_color_values); + defsubr (&Sxw_color_defined_p); + defsubr (&Sx_display_visual_class); + defsubr (&Sx_show_tip); + defsubr (&Sx_display_mm_height); + defsubr (&Sx_display_mm_width); + defsubr (&Sx_close_connection); + defsubr (&Sx_display_list); + defsubr (&Sx_server_vendor); + defsubr (&Sx_server_version); + defsubr (&Sx_display_screens); + defsubr (&Shaiku_get_version_string); + defsubr (&Sx_display_color_cells); + defsubr (&Sx_display_planes); + defsubr (&Shaiku_set_mouse_absolute_pixel_position); + defsubr (&Shaiku_mouse_absolute_pixel_position); + defsubr (&Shaiku_frame_geometry); + defsubr (&Shaiku_frame_edges); + defsubr (&Sx_double_buffered_p); + defsubr (&Sx_display_backing_store); + defsubr (&Shaiku_read_file_name); + defsubr (&Shaiku_put_resource); + defsubr (&Shaiku_frame_list_z_order); + defsubr (&Sx_display_save_under); + defsubr (&Shaiku_frame_restack); + defsubr (&Shaiku_save_session_reply); + defsubr (&Shaiku_display_monitor_attributes_list); + + tip_timer = Qnil; + staticpro (&tip_timer); + tip_frame = Qnil; + staticpro (&tip_frame); + tip_last_frame = Qnil; + staticpro (&tip_last_frame); + tip_last_string = Qnil; + staticpro (&tip_last_string); + tip_last_parms = Qnil; + staticpro (&tip_last_parms); + tip_dx = Qnil; + staticpro (&tip_dx); + tip_dy = Qnil; + staticpro (&tip_dy); + + DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size, + doc: /* SKIP: real doc in xfns.c. */); + Vx_max_tooltip_size = Qnil; + + DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel, + doc: /* SKIP: real doc in xfns.c. */); + Vx_cursor_fore_pixel = Qnil; + + DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, + doc: /* SKIP: real doc in xfns.c. */); + Vx_pointer_shape = Qnil; + + DEFVAR_LISP ("x-hourglass-pointer-shape", Vx_hourglass_pointer_shape, + 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: /* SKIP: real doc in xfns.c. */); + Vx_sensitive_text_pointer_shape = Qnil; + + DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors, + doc: /* Vector of UI colors that Emacs can look up from the system. +If this is set up incorrectly, Emacs can crash when encoutering an +invalid color. */); + Vhaiku_allowed_ui_colors = Qnil; + +#ifdef USE_BE_CAIRO + DEFVAR_LISP ("cairo-version-string", Vcairo_version_string, + doc: /* Version info for cairo. */); + { + char cairo_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; + int len = sprintf (cairo_version, "%d.%d.%d", + CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, + CAIRO_VERSION_MICRO); + Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + } +#endif + + return; +} |