/* GDB parameters implemented in Guile. Copyright (C) 2008-2024 Free Software Foundation, Inc. This file is part of GDB. This program 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. This program 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 this program. If not, see . */ #include "value.h" #include "charset.h" #include "cli/cli-decode.h" #include "completer.h" #include "language.h" #include "arch-utils.h" #include "guile-internal.h" /* A GDB color. */ struct color_smob { /* This always appears first. */ gdb_smob base; /* Underlying value. */ ui_file_style::color color; }; static const char color_smob_name[] = "gdb:color"; /* The tag Guile knows the color smob by. */ static scm_t_bits color_smob_tag; /* Keywords used by make-color. */ static SCM colorspace_keyword; static const char *coscm_colorspace_name (color_space colorspace); /* Administrivia for color smobs. */ static int coscm_print_color_smob (SCM self, SCM port, scm_print_state *pstate) { const ui_file_style::color &color = coscm_get_color (self); gdbscm_printf (port, "#<%s", color_smob_name); gdbscm_printf (port, " %s", color.to_string ().c_str ()); gdbscm_printf (port, " %s", coscm_colorspace_name (color.colorspace ())); scm_puts (">", port); scm_remember_upto_here_1 (self); /* Non-zero means success. */ return 1; } /* Create an empty (uninitialized) color. */ static SCM coscm_make_color_smob (void) { color_smob *c_smob = (color_smob *) scm_gc_calloc (sizeof (color_smob), color_smob_name); SCM c_scm; c_smob->color = ui_file_style::color (ui_file_style::NONE); c_scm = scm_new_smob (color_smob_tag, (scm_t_bits) c_smob); gdbscm_init_gsmob (&c_smob->base); return c_scm; } /* Return the object that encapsulates COLOR. */ SCM coscm_scm_from_color (const ui_file_style::color &color) { SCM c_scm = coscm_make_color_smob (); color_smob *c_smob = (color_smob *) SCM_SMOB_DATA (c_scm); c_smob->color = color; return c_scm; } /* Return the color field of color_smob. */ const ui_file_style::color & coscm_get_color (SCM color_scm) { SCM_ASSERT_TYPE (coscm_is_color (color_scm), color_scm, SCM_ARG1, FUNC_NAME, _("")); color_smob *c_smob = (color_smob *) SCM_SMOB_DATA (color_scm); return c_smob->color; } /* Returns non-zero if SCM is a object. */ int coscm_is_color (SCM scm) { return SCM_SMOB_PREDICATE (color_smob_tag, scm); } /* (gdb:color? scm) -> boolean */ static SCM gdbscm_color_p (SCM scm) { return scm_from_bool (coscm_is_color (scm)); } static const scheme_integer_constant colorspaces[] = { { "COLORSPACE_MONOCHROME", (int) color_space::MONOCHROME }, { "COLORSPACE_ANSI_8COLOR", (int) color_space::ANSI_8COLOR }, { "COLORSPACE_AIXTERM_16COLOR", (int) color_space::AIXTERM_16COLOR }, { "COLORSPACE_XTERM_256COLOR", (int) color_space::XTERM_256COLOR }, { "COLORSPACE_RGB_24BIT", (int) color_space::RGB_24BIT }, END_INTEGER_CONSTANTS }; /* Return COLORSPACE as a string. */ static const char * coscm_colorspace_name (color_space colorspace) { for (int i = 0; colorspaces[i].name != nullptr; ++i) { if (colorspaces[i].value == static_cast (colorspace)) return colorspaces[i].name; } gdb_assert_not_reached ("bad color space"); } /* Free function for a color_smob. */ static size_t coscm_free_color_smob (SCM self) { (void) self; return 0; } /* Color Scheme functions. */ /* (make-color [value [#:color-space colorspace]]) -> VALUE is the value of the color. It may be SCM_UNDEFINED, string, number or list. COLORSPACE is the color space of the VALUE. It should be one of the COLORSPACE_* constants defined in the gdb module. The result is the Scheme object. */ static SCM gdbscm_make_color (SCM value_scm, SCM rest) { SCM colorspace_arg = SCM_UNDEFINED; color_space colorspace = color_space::MONOCHROME; scm_c_bind_keyword_arguments (FUNC_NAME, rest, static_cast (0), colorspace_keyword, &colorspace_arg, SCM_UNDEFINED); if (!SCM_UNBNDP (colorspace_arg)) { SCM_ASSERT_TYPE (scm_is_integer (colorspace_arg), colorspace_arg, SCM_ARG2, FUNC_NAME, _("int")); int colorspace_int = scm_to_int (colorspace_arg); if (!color_space_safe_cast (&colorspace, colorspace_int)) gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, scm_from_int (colorspace_int), _("invalid colorspace argument")); } ui_file_style::color color = ui_file_style::NONE; gdbscm_gdb_exception exc {}; try { if (SCM_UNBNDP (value_scm) || scm_is_integer (value_scm)) { int i = -1; if (scm_is_integer (value_scm)) { i = scm_to_int (value_scm); if (i < 0) gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, value_scm, _("negative color index")); } if (SCM_UNBNDP (colorspace_arg)) color = ui_file_style::color (i); else color = ui_file_style::color (colorspace, i); } else if (gdbscm_is_true (scm_list_p (value_scm))) { if (SCM_UNBNDP (colorspace_arg) || colorspace != color_space::RGB_24BIT) error (_("colorspace must be COLORSPACE_RGB_24BIT with " "value of list type.")); if (scm_ilength (value_scm) != 3) error (_("List value with RGB must be of size 3.")); uint8_t rgb[3] = {}; int i = 0; for (; i < 3 && !scm_is_eq (value_scm, SCM_EOL); ++i) { SCM item = scm_car (value_scm); SCM_ASSERT_TYPE (scm_is_integer (item), item, SCM_ARG1, FUNC_NAME, _("int")); int component = scm_to_int (item); if (component < 0 || component > UINT8_MAX) gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, item, _("invalid rgb component")); rgb[i] = static_cast (component); value_scm = scm_cdr (value_scm); } gdb_assert (i == 3); color = ui_file_style::color (rgb[0], rgb[1], rgb[2]); } else if (scm_is_string (value_scm)) { SCM exception; gdb::unique_xmalloc_ptr string = gdbscm_scm_to_host_string (value_scm, nullptr, &exception); if (string == nullptr) gdbscm_throw (exception); color = parse_var_color (string.get ()); if (!SCM_UNBNDP (colorspace_arg) && colorspace != color.colorspace ()) error (_("colorspace doesn't match to the value.")); } else scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, value_scm, "integer, string or list"); } catch (const gdb_exception &except) { exc = unpack (except); } GDBSCM_HANDLE_GDB_EXCEPTION (exc); return coscm_scm_from_color (color); } /* (color-string ) -> value */ static SCM gdbscm_color_string (SCM self) { const ui_file_style::color &color = coscm_get_color (self); std::string s = color.to_string (); return gdbscm_scm_from_host_string (s.c_str (), s.size ()); } /* (color-colorspace ) -> value */ static SCM gdbscm_color_colorspace (SCM self) { const ui_file_style::color &color = coscm_get_color (self); return scm_from_int (static_cast (color.colorspace ())); } /* (color-none? scm) -> boolean */ static SCM gdbscm_color_none_p (SCM self) { const ui_file_style::color &color = coscm_get_color (self); return scm_from_bool (color.is_none ()); } /* (color-indexed? scm) -> boolean */ static SCM gdbscm_color_indexed_p (SCM self) { const ui_file_style::color &color = coscm_get_color (self); return scm_from_bool (color.is_indexed ()); } /* (color-direct? scm) -> boolean */ static SCM gdbscm_color_direct_p (SCM self) { const ui_file_style::color &color = coscm_get_color (self); return scm_from_bool (color.is_direct ()); } /* (color-index ) -> value */ static SCM gdbscm_color_index (SCM self) { const ui_file_style::color &color = coscm_get_color (self); if (!color.is_indexed ()) gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self, "color is not indexed"); return scm_from_int (color.get_value ()); } /* (color-components ) -> value */ static SCM gdbscm_color_components (SCM self) { const ui_file_style::color &color = coscm_get_color (self); if (!color.is_direct ()) gdbscm_misc_error (FUNC_NAME, SCM_ARG1, self, "color is not direct"); uint8_t rgb[3] = {}; color.get_rgb (rgb); SCM red = scm_from_uint8 (rgb[0]); SCM green = scm_from_uint8 (rgb[1]); SCM blue = scm_from_uint8 (rgb[2]); return scm_list_3 (red, green, blue); } /* (color-escape-sequence is_fg) -> value */ static SCM gdbscm_color_escape_sequence (SCM self, SCM is_fg_scm) { const ui_file_style::color &color = coscm_get_color (self); SCM_ASSERT_TYPE (gdbscm_is_bool (is_fg_scm), is_fg_scm, SCM_ARG2, FUNC_NAME, _("boolean")); bool is_fg = gdbscm_is_true (is_fg_scm); std::string s = color.to_ansi (is_fg); return gdbscm_scm_from_host_string (s.c_str (), s.size ()); } /* Initialize the Scheme color support. */ static const scheme_function color_functions[] = { { "make-color", 0, 1, 1, as_a_scm_t_subr (gdbscm_make_color), "\ Make a GDB color object.\n\ \n\ Arguments: [value\n\ [#:color-space ]]\n\ value: The name of the color. It may be string, number with color index\n\ or list with RGB components.\n\ colorspace: The color space of the color, one of COLORSPACE_*." }, { "color?", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_p), "\ Return #t if the object is a object." }, { "color-none?", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_none_p), "\ Return #t if the object has default color." }, { "color-indexed?", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_indexed_p), "\ Return #t if the object is from indexed color space." }, { "color-direct?", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_direct_p), "\ Return #t if the object has direct color (e.g. RGB, CMY, CMYK)." }, { "color-string", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_string), "\ Return the textual representation of a object." }, { "color-colorspace", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_colorspace), "\ Return the color space of a object." }, { "color-index", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_index), "\ Return index of the color of a object in a palette." }, { "color-components", 1, 0, 0, as_a_scm_t_subr (gdbscm_color_components), "\ Return components of the direct object." }, { "color-escape-sequence", 2, 0, 0, as_a_scm_t_subr (gdbscm_color_escape_sequence), "\ Return string to change terminal's color to this." }, END_FUNCTIONS }; void gdbscm_initialize_colors (void) { color_smob_tag = gdbscm_make_smob_type (color_smob_name, sizeof (color_smob)); scm_set_smob_free (color_smob_tag, coscm_free_color_smob); scm_set_smob_print (color_smob_tag, coscm_print_color_smob); gdbscm_define_integer_constants (colorspaces, 1); gdbscm_define_functions (color_functions, 1); colorspace_keyword = scm_from_latin1_keyword ("color-space"); }