| 1 | /* GDB commands implemented in Scheme. |
| 2 | |
| 3 | Copyright (C) 2008-2019 Free Software Foundation, Inc. |
| 4 | |
| 5 | This file is part of GDB. |
| 6 | |
| 7 | This program is free software; you can redistribute it and/or modify |
| 8 | it under the terms of the GNU General Public License as published by |
| 9 | the Free Software Foundation; either version 3 of the License, or |
| 10 | (at your option) any later version. |
| 11 | |
| 12 | This program is distributed in the hope that it will be useful, |
| 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | GNU General Public License for more details. |
| 16 | |
| 17 | You should have received a copy of the GNU General Public License |
| 18 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ |
| 19 | |
| 20 | /* See README file in this directory for implementation notes, coding |
| 21 | conventions, et.al. */ |
| 22 | |
| 23 | #include "defs.h" |
| 24 | #include <ctype.h> |
| 25 | #include "charset.h" |
| 26 | #include "gdbcmd.h" |
| 27 | #include "cli/cli-decode.h" |
| 28 | #include "completer.h" |
| 29 | #include "guile-internal.h" |
| 30 | |
| 31 | /* The <gdb:command> smob. |
| 32 | |
| 33 | Note: Commands are added to gdb using a two step process: |
| 34 | 1) Call make-command to create a <gdb:command> object. |
| 35 | 2) Call register-command! to add the command to gdb. |
| 36 | It is done this way so that the constructor, make-command, doesn't have |
| 37 | any side-effects. This means that the smob needs to store everything |
| 38 | that was passed to make-command. */ |
| 39 | |
| 40 | typedef struct _command_smob |
| 41 | { |
| 42 | /* This always appears first. */ |
| 43 | gdb_smob base; |
| 44 | |
| 45 | /* The name of the command, as passed to make-command. */ |
| 46 | char *name; |
| 47 | |
| 48 | /* The last word of the command. |
| 49 | This is needed because add_cmd requires us to allocate space |
| 50 | for it. :-( */ |
| 51 | char *cmd_name; |
| 52 | |
| 53 | /* Non-zero if this is a prefix command. */ |
| 54 | int is_prefix; |
| 55 | |
| 56 | /* One of the COMMAND_* constants. */ |
| 57 | enum command_class cmd_class; |
| 58 | |
| 59 | /* The documentation for the command. */ |
| 60 | char *doc; |
| 61 | |
| 62 | /* The corresponding gdb command object. |
| 63 | This is NULL if the command has not been registered yet, or |
| 64 | is no longer registered. */ |
| 65 | struct cmd_list_element *command; |
| 66 | |
| 67 | /* A prefix command requires storage for a list of its sub-commands. |
| 68 | A pointer to this is passed to add_prefix_command, and to add_cmd |
| 69 | for sub-commands of that prefix. |
| 70 | This is NULL if the command has not been registered yet, or |
| 71 | is no longer registered. If this command is not a prefix |
| 72 | command, then this field is unused. */ |
| 73 | struct cmd_list_element *sub_list; |
| 74 | |
| 75 | /* The procedure to call to invoke the command. |
| 76 | (lambda (self arg from-tty) ...). |
| 77 | Its result is unspecified. */ |
| 78 | SCM invoke; |
| 79 | |
| 80 | /* Either #f, one of the COMPLETE_* constants, or a procedure to call to |
| 81 | perform command completion. Called as (lambda (self text word) ...). */ |
| 82 | SCM complete; |
| 83 | |
| 84 | /* The <gdb:command> object we are contained in, needed to protect/unprotect |
| 85 | the object since a reference to it comes from non-gc-managed space |
| 86 | (the command context pointer). */ |
| 87 | SCM containing_scm; |
| 88 | } command_smob; |
| 89 | |
| 90 | static const char command_smob_name[] = "gdb:command"; |
| 91 | |
| 92 | /* The tag Guile knows the objfile smob by. */ |
| 93 | static scm_t_bits command_smob_tag; |
| 94 | |
| 95 | /* Keywords used by make-command. */ |
| 96 | static SCM invoke_keyword; |
| 97 | static SCM command_class_keyword; |
| 98 | static SCM completer_class_keyword; |
| 99 | static SCM prefix_p_keyword; |
| 100 | static SCM doc_keyword; |
| 101 | |
| 102 | /* Struct representing built-in completion types. */ |
| 103 | struct cmdscm_completer |
| 104 | { |
| 105 | /* Scheme symbol name. */ |
| 106 | const char *name; |
| 107 | /* Completion function. */ |
| 108 | completer_ftype *completer; |
| 109 | }; |
| 110 | |
| 111 | static const struct cmdscm_completer cmdscm_completers[] = |
| 112 | { |
| 113 | { "COMPLETE_NONE", noop_completer }, |
| 114 | { "COMPLETE_FILENAME", filename_completer }, |
| 115 | { "COMPLETE_LOCATION", location_completer }, |
| 116 | { "COMPLETE_COMMAND", command_completer }, |
| 117 | { "COMPLETE_SYMBOL", symbol_completer }, |
| 118 | { "COMPLETE_EXPRESSION", expression_completer }, |
| 119 | }; |
| 120 | |
| 121 | #define N_COMPLETERS (sizeof (cmdscm_completers) \ |
| 122 | / sizeof (cmdscm_completers[0])) |
| 123 | |
| 124 | static int cmdscm_is_valid (command_smob *); |
| 125 | \f |
| 126 | /* Administrivia for command smobs. */ |
| 127 | |
| 128 | /* The smob "print" function for <gdb:command>. */ |
| 129 | |
| 130 | static int |
| 131 | cmdscm_print_command_smob (SCM self, SCM port, scm_print_state *pstate) |
| 132 | { |
| 133 | command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (self); |
| 134 | |
| 135 | gdbscm_printf (port, "#<%s", command_smob_name); |
| 136 | |
| 137 | gdbscm_printf (port, " %s", |
| 138 | c_smob->name != NULL ? c_smob->name : "{unnamed}"); |
| 139 | |
| 140 | if (! cmdscm_is_valid (c_smob)) |
| 141 | scm_puts (" {invalid}", port); |
| 142 | |
| 143 | scm_puts (">", port); |
| 144 | |
| 145 | scm_remember_upto_here_1 (self); |
| 146 | |
| 147 | /* Non-zero means success. */ |
| 148 | return 1; |
| 149 | } |
| 150 | |
| 151 | /* Low level routine to create a <gdb:command> object. |
| 152 | It's empty in the sense that a command still needs to be associated |
| 153 | with it. */ |
| 154 | |
| 155 | static SCM |
| 156 | cmdscm_make_command_smob (void) |
| 157 | { |
| 158 | command_smob *c_smob = (command_smob *) |
| 159 | scm_gc_malloc (sizeof (command_smob), command_smob_name); |
| 160 | SCM c_scm; |
| 161 | |
| 162 | memset (c_smob, 0, sizeof (*c_smob)); |
| 163 | c_smob->cmd_class = no_class; |
| 164 | c_smob->invoke = SCM_BOOL_F; |
| 165 | c_smob->complete = SCM_BOOL_F; |
| 166 | c_scm = scm_new_smob (command_smob_tag, (scm_t_bits) c_smob); |
| 167 | c_smob->containing_scm = c_scm; |
| 168 | gdbscm_init_gsmob (&c_smob->base); |
| 169 | |
| 170 | return c_scm; |
| 171 | } |
| 172 | |
| 173 | /* Clear the COMMAND pointer in C_SMOB and unprotect the object from GC. */ |
| 174 | |
| 175 | static void |
| 176 | cmdscm_release_command (command_smob *c_smob) |
| 177 | { |
| 178 | c_smob->command = NULL; |
| 179 | scm_gc_unprotect_object (c_smob->containing_scm); |
| 180 | } |
| 181 | |
| 182 | /* Return non-zero if SCM is a command smob. */ |
| 183 | |
| 184 | static int |
| 185 | cmdscm_is_command (SCM scm) |
| 186 | { |
| 187 | return SCM_SMOB_PREDICATE (command_smob_tag, scm); |
| 188 | } |
| 189 | |
| 190 | /* (command? scm) -> boolean */ |
| 191 | |
| 192 | static SCM |
| 193 | gdbscm_command_p (SCM scm) |
| 194 | { |
| 195 | return scm_from_bool (cmdscm_is_command (scm)); |
| 196 | } |
| 197 | |
| 198 | /* Returns the <gdb:command> object in SELF. |
| 199 | Throws an exception if SELF is not a <gdb:command> object. */ |
| 200 | |
| 201 | static SCM |
| 202 | cmdscm_get_command_arg_unsafe (SCM self, int arg_pos, const char *func_name) |
| 203 | { |
| 204 | SCM_ASSERT_TYPE (cmdscm_is_command (self), self, arg_pos, func_name, |
| 205 | command_smob_name); |
| 206 | |
| 207 | return self; |
| 208 | } |
| 209 | |
| 210 | /* Returns a pointer to the command smob of SELF. |
| 211 | Throws an exception if SELF is not a <gdb:command> object. */ |
| 212 | |
| 213 | static command_smob * |
| 214 | cmdscm_get_command_smob_arg_unsafe (SCM self, int arg_pos, |
| 215 | const char *func_name) |
| 216 | { |
| 217 | SCM c_scm = cmdscm_get_command_arg_unsafe (self, arg_pos, func_name); |
| 218 | command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (c_scm); |
| 219 | |
| 220 | return c_smob; |
| 221 | } |
| 222 | |
| 223 | /* Return non-zero if command C_SMOB is valid. */ |
| 224 | |
| 225 | static int |
| 226 | cmdscm_is_valid (command_smob *c_smob) |
| 227 | { |
| 228 | return c_smob->command != NULL; |
| 229 | } |
| 230 | |
| 231 | /* Returns a pointer to the command smob of SELF. |
| 232 | Throws an exception if SELF is not a valid <gdb:command> object. */ |
| 233 | |
| 234 | static command_smob * |
| 235 | cmdscm_get_valid_command_smob_arg_unsafe (SCM self, int arg_pos, |
| 236 | const char *func_name) |
| 237 | { |
| 238 | command_smob *c_smob |
| 239 | = cmdscm_get_command_smob_arg_unsafe (self, arg_pos, func_name); |
| 240 | |
| 241 | if (!cmdscm_is_valid (c_smob)) |
| 242 | { |
| 243 | gdbscm_invalid_object_error (func_name, arg_pos, self, |
| 244 | _("<gdb:command>")); |
| 245 | } |
| 246 | |
| 247 | return c_smob; |
| 248 | } |
| 249 | \f |
| 250 | /* Scheme functions for GDB commands. */ |
| 251 | |
| 252 | /* (command-valid? <gdb:command>) -> boolean |
| 253 | Returns #t if SELF is still valid. */ |
| 254 | |
| 255 | static SCM |
| 256 | gdbscm_command_valid_p (SCM self) |
| 257 | { |
| 258 | command_smob *c_smob |
| 259 | = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); |
| 260 | |
| 261 | return scm_from_bool (cmdscm_is_valid (c_smob)); |
| 262 | } |
| 263 | |
| 264 | /* (dont-repeat cmd) -> unspecified |
| 265 | Scheme function which wraps dont_repeat. */ |
| 266 | |
| 267 | static SCM |
| 268 | gdbscm_dont_repeat (SCM self) |
| 269 | { |
| 270 | /* We currently don't need anything from SELF, but still verify it. |
| 271 | Call for side effects. */ |
| 272 | cmdscm_get_valid_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); |
| 273 | |
| 274 | dont_repeat (); |
| 275 | |
| 276 | return SCM_UNSPECIFIED; |
| 277 | } |
| 278 | \f |
| 279 | /* The make-command function. */ |
| 280 | |
| 281 | /* Called if the gdb cmd_list_element is destroyed. */ |
| 282 | |
| 283 | static void |
| 284 | cmdscm_destroyer (struct cmd_list_element *self, void *context) |
| 285 | { |
| 286 | command_smob *c_smob = (command_smob *) context; |
| 287 | |
| 288 | cmdscm_release_command (c_smob); |
| 289 | } |
| 290 | |
| 291 | /* Called by gdb to invoke the command. */ |
| 292 | |
| 293 | static void |
| 294 | cmdscm_function (struct cmd_list_element *command, |
| 295 | const char *args, int from_tty) |
| 296 | { |
| 297 | command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command); |
| 298 | SCM arg_scm, tty_scm, result; |
| 299 | |
| 300 | gdb_assert (c_smob != NULL); |
| 301 | |
| 302 | if (args == NULL) |
| 303 | args = ""; |
| 304 | arg_scm = gdbscm_scm_from_string (args, strlen (args), host_charset (), 1); |
| 305 | if (gdbscm_is_exception (arg_scm)) |
| 306 | error (_("Could not convert arguments to Scheme string.")); |
| 307 | |
| 308 | tty_scm = scm_from_bool (from_tty); |
| 309 | |
| 310 | result = gdbscm_safe_call_3 (c_smob->invoke, c_smob->containing_scm, |
| 311 | arg_scm, tty_scm, gdbscm_user_error_p); |
| 312 | |
| 313 | if (gdbscm_is_exception (result)) |
| 314 | { |
| 315 | /* Don't print the stack if this was an error signalled by the command |
| 316 | itself. */ |
| 317 | if (gdbscm_user_error_p (gdbscm_exception_key (result))) |
| 318 | { |
| 319 | gdb::unique_xmalloc_ptr<char> msg |
| 320 | = gdbscm_exception_message_to_string (result); |
| 321 | |
| 322 | error ("%s", msg.get ()); |
| 323 | } |
| 324 | else |
| 325 | { |
| 326 | gdbscm_print_gdb_exception (SCM_BOOL_F, result); |
| 327 | error (_("Error occurred in Scheme-implemented GDB command.")); |
| 328 | } |
| 329 | } |
| 330 | } |
| 331 | |
| 332 | /* Subroutine of cmdscm_completer to simplify it. |
| 333 | Print an error message indicating that COMPLETION is a bad completion |
| 334 | result. */ |
| 335 | |
| 336 | static void |
| 337 | cmdscm_bad_completion_result (const char *msg, SCM completion) |
| 338 | { |
| 339 | SCM port = scm_current_error_port (); |
| 340 | |
| 341 | scm_puts (msg, port); |
| 342 | scm_display (completion, port); |
| 343 | scm_newline (port); |
| 344 | } |
| 345 | |
| 346 | /* Subroutine of cmdscm_completer to simplify it. |
| 347 | Validate COMPLETION and add to RESULT. |
| 348 | If an error occurs print an error message. |
| 349 | The result is a boolean indicating success. */ |
| 350 | |
| 351 | static int |
| 352 | cmdscm_add_completion (SCM completion, completion_tracker &tracker) |
| 353 | { |
| 354 | SCM except_scm; |
| 355 | |
| 356 | if (!scm_is_string (completion)) |
| 357 | { |
| 358 | /* Inform the user, but otherwise ignore the entire result. */ |
| 359 | cmdscm_bad_completion_result (_("Bad text from completer: "), |
| 360 | completion); |
| 361 | return 0; |
| 362 | } |
| 363 | |
| 364 | gdb::unique_xmalloc_ptr<char> item |
| 365 | = gdbscm_scm_to_string (completion, NULL, host_charset (), 1, |
| 366 | &except_scm); |
| 367 | if (item == NULL) |
| 368 | { |
| 369 | /* Inform the user, but otherwise ignore the entire result. */ |
| 370 | gdbscm_print_gdb_exception (SCM_BOOL_F, except_scm); |
| 371 | return 0; |
| 372 | } |
| 373 | |
| 374 | tracker.add_completion (std::move (item)); |
| 375 | |
| 376 | return 1; |
| 377 | } |
| 378 | |
| 379 | /* Called by gdb for command completion. */ |
| 380 | |
| 381 | static void |
| 382 | cmdscm_completer (struct cmd_list_element *command, |
| 383 | completion_tracker &tracker, |
| 384 | const char *text, const char *word) |
| 385 | { |
| 386 | command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command); |
| 387 | SCM completer_result_scm; |
| 388 | SCM text_scm, word_scm; |
| 389 | |
| 390 | gdb_assert (c_smob != NULL); |
| 391 | gdb_assert (gdbscm_is_procedure (c_smob->complete)); |
| 392 | |
| 393 | text_scm = gdbscm_scm_from_string (text, strlen (text), host_charset (), |
| 394 | 1); |
| 395 | if (gdbscm_is_exception (text_scm)) |
| 396 | error (_("Could not convert \"text\" argument to Scheme string.")); |
| 397 | word_scm = gdbscm_scm_from_string (word, strlen (word), host_charset (), |
| 398 | 1); |
| 399 | if (gdbscm_is_exception (word_scm)) |
| 400 | error (_("Could not convert \"word\" argument to Scheme string.")); |
| 401 | |
| 402 | completer_result_scm |
| 403 | = gdbscm_safe_call_3 (c_smob->complete, c_smob->containing_scm, |
| 404 | text_scm, word_scm, NULL); |
| 405 | |
| 406 | if (gdbscm_is_exception (completer_result_scm)) |
| 407 | { |
| 408 | /* Inform the user, but otherwise ignore. */ |
| 409 | gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm); |
| 410 | return; |
| 411 | } |
| 412 | |
| 413 | if (gdbscm_is_true (scm_list_p (completer_result_scm))) |
| 414 | { |
| 415 | SCM list = completer_result_scm; |
| 416 | |
| 417 | while (!scm_is_eq (list, SCM_EOL)) |
| 418 | { |
| 419 | SCM next = scm_car (list); |
| 420 | |
| 421 | if (!cmdscm_add_completion (next, tracker)) |
| 422 | break; |
| 423 | |
| 424 | list = scm_cdr (list); |
| 425 | } |
| 426 | } |
| 427 | else if (itscm_is_iterator (completer_result_scm)) |
| 428 | { |
| 429 | SCM iter = completer_result_scm; |
| 430 | SCM next = itscm_safe_call_next_x (iter, NULL); |
| 431 | |
| 432 | while (gdbscm_is_true (next)) |
| 433 | { |
| 434 | if (gdbscm_is_exception (next)) |
| 435 | { |
| 436 | /* Inform the user. */ |
| 437 | gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm); |
| 438 | break; |
| 439 | } |
| 440 | |
| 441 | if (cmdscm_add_completion (next, tracker)) |
| 442 | break; |
| 443 | |
| 444 | next = itscm_safe_call_next_x (iter, NULL); |
| 445 | } |
| 446 | } |
| 447 | else |
| 448 | { |
| 449 | /* Inform the user, but otherwise ignore. */ |
| 450 | cmdscm_bad_completion_result (_("Bad completer result: "), |
| 451 | completer_result_scm); |
| 452 | } |
| 453 | } |
| 454 | |
| 455 | /* Helper for gdbscm_make_command which locates the command list to use and |
| 456 | pulls out the command name. |
| 457 | |
| 458 | NAME is the command name list. The final word in the list is the |
| 459 | name of the new command. All earlier words must be existing prefix |
| 460 | commands. |
| 461 | |
| 462 | *BASE_LIST is set to the final prefix command's list of |
| 463 | *sub-commands. |
| 464 | |
| 465 | START_LIST is the list in which the search starts. |
| 466 | |
| 467 | This function returns the xmalloc()d name of the new command. |
| 468 | On error a Scheme exception is thrown. */ |
| 469 | |
| 470 | char * |
| 471 | gdbscm_parse_command_name (const char *name, |
| 472 | const char *func_name, int arg_pos, |
| 473 | struct cmd_list_element ***base_list, |
| 474 | struct cmd_list_element **start_list) |
| 475 | { |
| 476 | struct cmd_list_element *elt; |
| 477 | int len = strlen (name); |
| 478 | int i, lastchar; |
| 479 | char *prefix_text; |
| 480 | const char *prefix_text2; |
| 481 | char *result, *msg; |
| 482 | |
| 483 | /* Skip trailing whitespace. */ |
| 484 | for (i = len - 1; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i) |
| 485 | ; |
| 486 | if (i < 0) |
| 487 | { |
| 488 | gdbscm_out_of_range_error (func_name, arg_pos, |
| 489 | gdbscm_scm_from_c_string (name), |
| 490 | _("no command name found")); |
| 491 | } |
| 492 | lastchar = i; |
| 493 | |
| 494 | /* Find first character of the final word. */ |
| 495 | for (; i > 0 && valid_cmd_char_p (name[i - 1]); --i) |
| 496 | ; |
| 497 | result = (char *) xmalloc (lastchar - i + 2); |
| 498 | memcpy (result, &name[i], lastchar - i + 1); |
| 499 | result[lastchar - i + 1] = '\0'; |
| 500 | |
| 501 | /* Skip whitespace again. */ |
| 502 | for (--i; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i) |
| 503 | ; |
| 504 | if (i < 0) |
| 505 | { |
| 506 | *base_list = start_list; |
| 507 | return result; |
| 508 | } |
| 509 | |
| 510 | prefix_text = (char *) xmalloc (i + 2); |
| 511 | memcpy (prefix_text, name, i + 1); |
| 512 | prefix_text[i + 1] = '\0'; |
| 513 | |
| 514 | prefix_text2 = prefix_text; |
| 515 | elt = lookup_cmd_1 (&prefix_text2, *start_list, NULL, 1); |
| 516 | if (elt == NULL || elt == CMD_LIST_AMBIGUOUS) |
| 517 | { |
| 518 | msg = xstrprintf (_("could not find command prefix '%s'"), prefix_text); |
| 519 | xfree (prefix_text); |
| 520 | xfree (result); |
| 521 | scm_dynwind_begin ((scm_t_dynwind_flags) 0); |
| 522 | gdbscm_dynwind_xfree (msg); |
| 523 | gdbscm_out_of_range_error (func_name, arg_pos, |
| 524 | gdbscm_scm_from_c_string (name), msg); |
| 525 | } |
| 526 | |
| 527 | if (elt->prefixlist) |
| 528 | { |
| 529 | xfree (prefix_text); |
| 530 | *base_list = elt->prefixlist; |
| 531 | return result; |
| 532 | } |
| 533 | |
| 534 | msg = xstrprintf (_("'%s' is not a prefix command"), prefix_text); |
| 535 | xfree (prefix_text); |
| 536 | xfree (result); |
| 537 | scm_dynwind_begin ((scm_t_dynwind_flags) 0); |
| 538 | gdbscm_dynwind_xfree (msg); |
| 539 | gdbscm_out_of_range_error (func_name, arg_pos, |
| 540 | gdbscm_scm_from_c_string (name), msg); |
| 541 | /* NOTREACHED */ |
| 542 | } |
| 543 | |
| 544 | static const scheme_integer_constant command_classes[] = |
| 545 | { |
| 546 | /* Note: alias and user are special; pseudo appears to be unused, |
| 547 | and there is no reason to expose tui, I think. */ |
| 548 | { "COMMAND_NONE", no_class }, |
| 549 | { "COMMAND_RUNNING", class_run }, |
| 550 | { "COMMAND_DATA", class_vars }, |
| 551 | { "COMMAND_STACK", class_stack }, |
| 552 | { "COMMAND_FILES", class_files }, |
| 553 | { "COMMAND_SUPPORT", class_support }, |
| 554 | { "COMMAND_STATUS", class_info }, |
| 555 | { "COMMAND_BREAKPOINTS", class_breakpoint }, |
| 556 | { "COMMAND_TRACEPOINTS", class_trace }, |
| 557 | { "COMMAND_OBSCURE", class_obscure }, |
| 558 | { "COMMAND_MAINTENANCE", class_maintenance }, |
| 559 | { "COMMAND_USER", class_user }, |
| 560 | |
| 561 | END_INTEGER_CONSTANTS |
| 562 | }; |
| 563 | |
| 564 | /* Return non-zero if command_class is a valid command class. */ |
| 565 | |
| 566 | int |
| 567 | gdbscm_valid_command_class_p (int command_class) |
| 568 | { |
| 569 | int i; |
| 570 | |
| 571 | for (i = 0; command_classes[i].name != NULL; ++i) |
| 572 | { |
| 573 | if (command_classes[i].value == command_class) |
| 574 | return 1; |
| 575 | } |
| 576 | |
| 577 | return 0; |
| 578 | } |
| 579 | |
| 580 | /* Return a normalized form of command NAME. |
| 581 | That is tabs are replaced with spaces and multiple spaces are replaced |
| 582 | with a single space. |
| 583 | If WANT_TRAILING_SPACE is non-zero, add one space at the end. This is for |
| 584 | prefix commands. |
| 585 | but that is the caller's responsibility. |
| 586 | Space for the result is allocated on the GC heap. */ |
| 587 | |
| 588 | char * |
| 589 | gdbscm_canonicalize_command_name (const char *name, int want_trailing_space) |
| 590 | { |
| 591 | int i, out, seen_word; |
| 592 | char *result |
| 593 | = (char *) scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME); |
| 594 | |
| 595 | i = out = seen_word = 0; |
| 596 | while (name[i]) |
| 597 | { |
| 598 | /* Skip whitespace. */ |
| 599 | while (name[i] == ' ' || name[i] == '\t') |
| 600 | ++i; |
| 601 | /* Copy non-whitespace characters. */ |
| 602 | if (name[i]) |
| 603 | { |
| 604 | if (seen_word) |
| 605 | result[out++] = ' '; |
| 606 | while (name[i] && name[i] != ' ' && name[i] != '\t') |
| 607 | result[out++] = name[i++]; |
| 608 | seen_word = 1; |
| 609 | } |
| 610 | } |
| 611 | if (want_trailing_space) |
| 612 | result[out++] = ' '; |
| 613 | result[out] = '\0'; |
| 614 | |
| 615 | return result; |
| 616 | } |
| 617 | |
| 618 | /* (make-command name [#:invoke lambda] |
| 619 | [#:command-class class] [#:completer-class completer] |
| 620 | [#:prefix? <bool>] [#:doc <string>]) -> <gdb:command> |
| 621 | |
| 622 | NAME is the name of the command. It may consist of multiple words, |
| 623 | in which case the final word is the name of the new command, and |
| 624 | earlier words must be prefix commands. |
| 625 | |
| 626 | INVOKE is a procedure of three arguments that performs the command when |
| 627 | invoked: (lambda (self arg from-tty) ...). |
| 628 | Its result is unspecified. |
| 629 | |
| 630 | CLASS is the kind of command. It must be one of the COMMAND_* |
| 631 | constants defined in the gdb module. If not specified, "no_class" is used. |
| 632 | |
| 633 | COMPLETER is the kind of completer. It must be either: |
| 634 | #f - completion is not supported for this command. |
| 635 | One of the COMPLETE_* constants defined in the gdb module. |
| 636 | A procedure of three arguments: (lambda (self text word) ...). |
| 637 | Its result is one of: |
| 638 | A list of strings. |
| 639 | A <gdb:iterator> object that returns the set of possible completions, |
| 640 | ending with #f. |
| 641 | TODO(dje): Once PR 16699 is fixed, add support for returning |
| 642 | a COMPLETE_* constant. |
| 643 | If not specified, then completion is not supported for this command. |
| 644 | |
| 645 | If PREFIX is #t, then this command is a prefix command. |
| 646 | |
| 647 | DOC is the doc string for the command. |
| 648 | |
| 649 | The result is the <gdb:command> Scheme object. |
| 650 | The command is not available to be used yet, however. |
| 651 | It must still be added to gdb with register-command!. */ |
| 652 | |
| 653 | static SCM |
| 654 | gdbscm_make_command (SCM name_scm, SCM rest) |
| 655 | { |
| 656 | const SCM keywords[] = { |
| 657 | invoke_keyword, command_class_keyword, completer_class_keyword, |
| 658 | prefix_p_keyword, doc_keyword, SCM_BOOL_F |
| 659 | }; |
| 660 | int invoke_arg_pos = -1, command_class_arg_pos = 1; |
| 661 | int completer_class_arg_pos = -1, is_prefix_arg_pos = -1; |
| 662 | int doc_arg_pos = -1; |
| 663 | char *s; |
| 664 | char *name; |
| 665 | enum command_class command_class = no_class; |
| 666 | SCM completer_class = SCM_BOOL_F; |
| 667 | int is_prefix = 0; |
| 668 | char *doc = NULL; |
| 669 | SCM invoke = SCM_BOOL_F; |
| 670 | SCM c_scm; |
| 671 | command_smob *c_smob; |
| 672 | |
| 673 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#OiOts", |
| 674 | name_scm, &name, rest, |
| 675 | &invoke_arg_pos, &invoke, |
| 676 | &command_class_arg_pos, &command_class, |
| 677 | &completer_class_arg_pos, &completer_class, |
| 678 | &is_prefix_arg_pos, &is_prefix, |
| 679 | &doc_arg_pos, &doc); |
| 680 | |
| 681 | if (doc == NULL) |
| 682 | doc = xstrdup (_("This command is not documented.")); |
| 683 | |
| 684 | s = name; |
| 685 | name = gdbscm_canonicalize_command_name (s, is_prefix); |
| 686 | xfree (s); |
| 687 | s = doc; |
| 688 | doc = gdbscm_gc_xstrdup (s); |
| 689 | xfree (s); |
| 690 | |
| 691 | if (is_prefix |
| 692 | ? name[0] == ' ' |
| 693 | : name[0] == '\0') |
| 694 | { |
| 695 | gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, name_scm, |
| 696 | _("no command name found")); |
| 697 | } |
| 698 | |
| 699 | if (gdbscm_is_true (invoke)) |
| 700 | { |
| 701 | SCM_ASSERT_TYPE (gdbscm_is_procedure (invoke), invoke, |
| 702 | invoke_arg_pos, FUNC_NAME, _("procedure")); |
| 703 | } |
| 704 | |
| 705 | if (!gdbscm_valid_command_class_p (command_class)) |
| 706 | { |
| 707 | gdbscm_out_of_range_error (FUNC_NAME, command_class_arg_pos, |
| 708 | scm_from_int (command_class), |
| 709 | _("invalid command class argument")); |
| 710 | } |
| 711 | |
| 712 | SCM_ASSERT_TYPE (gdbscm_is_false (completer_class) |
| 713 | || scm_is_integer (completer_class) |
| 714 | || gdbscm_is_procedure (completer_class), |
| 715 | completer_class, completer_class_arg_pos, FUNC_NAME, |
| 716 | _("integer or procedure")); |
| 717 | if (scm_is_integer (completer_class) |
| 718 | && !scm_is_signed_integer (completer_class, 0, N_COMPLETERS - 1)) |
| 719 | { |
| 720 | gdbscm_out_of_range_error (FUNC_NAME, completer_class_arg_pos, |
| 721 | completer_class, |
| 722 | _("invalid completion type argument")); |
| 723 | } |
| 724 | |
| 725 | c_scm = cmdscm_make_command_smob (); |
| 726 | c_smob = (command_smob *) SCM_SMOB_DATA (c_scm); |
| 727 | c_smob->name = name; |
| 728 | c_smob->is_prefix = is_prefix; |
| 729 | c_smob->cmd_class = command_class; |
| 730 | c_smob->doc = doc; |
| 731 | c_smob->invoke = invoke; |
| 732 | c_smob->complete = completer_class; |
| 733 | |
| 734 | return c_scm; |
| 735 | } |
| 736 | |
| 737 | /* (register-command! <gdb:command>) -> unspecified |
| 738 | |
| 739 | It is an error to register a command more than once. */ |
| 740 | |
| 741 | static SCM |
| 742 | gdbscm_register_command_x (SCM self) |
| 743 | { |
| 744 | command_smob *c_smob |
| 745 | = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); |
| 746 | char *cmd_name; |
| 747 | struct cmd_list_element **cmd_list; |
| 748 | struct cmd_list_element *cmd = NULL; |
| 749 | |
| 750 | if (cmdscm_is_valid (c_smob)) |
| 751 | scm_misc_error (FUNC_NAME, _("command is already registered"), SCM_EOL); |
| 752 | |
| 753 | cmd_name = gdbscm_parse_command_name (c_smob->name, FUNC_NAME, SCM_ARG1, |
| 754 | &cmd_list, &cmdlist); |
| 755 | c_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name); |
| 756 | xfree (cmd_name); |
| 757 | |
| 758 | gdbscm_gdb_exception exc {}; |
| 759 | try |
| 760 | { |
| 761 | if (c_smob->is_prefix) |
| 762 | { |
| 763 | /* If we have our own "invoke" method, then allow unknown |
| 764 | sub-commands. */ |
| 765 | int allow_unknown = gdbscm_is_true (c_smob->invoke); |
| 766 | |
| 767 | cmd = add_prefix_cmd (c_smob->cmd_name, c_smob->cmd_class, |
| 768 | NULL, c_smob->doc, &c_smob->sub_list, |
| 769 | c_smob->name, allow_unknown, cmd_list); |
| 770 | } |
| 771 | else |
| 772 | { |
| 773 | cmd = add_cmd (c_smob->cmd_name, c_smob->cmd_class, |
| 774 | c_smob->doc, cmd_list); |
| 775 | } |
| 776 | } |
| 777 | catch (const gdb_exception &except) |
| 778 | { |
| 779 | exc = unpack (except); |
| 780 | } |
| 781 | GDBSCM_HANDLE_GDB_EXCEPTION (exc); |
| 782 | |
| 783 | /* Note: At this point the command exists in gdb. |
| 784 | So no more errors after this point. */ |
| 785 | |
| 786 | /* There appears to be no API to set this. */ |
| 787 | cmd->func = cmdscm_function; |
| 788 | cmd->destroyer = cmdscm_destroyer; |
| 789 | |
| 790 | c_smob->command = cmd; |
| 791 | set_cmd_context (cmd, c_smob); |
| 792 | |
| 793 | if (gdbscm_is_true (c_smob->complete)) |
| 794 | { |
| 795 | set_cmd_completer (cmd, |
| 796 | scm_is_integer (c_smob->complete) |
| 797 | ? cmdscm_completers[scm_to_int (c_smob->complete)].completer |
| 798 | : cmdscm_completer); |
| 799 | } |
| 800 | |
| 801 | /* The owner of this command is not in GC-controlled memory, so we need |
| 802 | to protect it from GC until the command is deleted. */ |
| 803 | scm_gc_protect_object (c_smob->containing_scm); |
| 804 | |
| 805 | return SCM_UNSPECIFIED; |
| 806 | } |
| 807 | \f |
| 808 | /* Initialize the Scheme command support. */ |
| 809 | |
| 810 | static const scheme_function command_functions[] = |
| 811 | { |
| 812 | { "make-command", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_command), |
| 813 | "\ |
| 814 | Make a GDB command object.\n\ |
| 815 | \n\ |
| 816 | Arguments: name [#:invoke lambda]\n\ |
| 817 | [#:command-class <class>] [#:completer-class <completer>]\n\ |
| 818 | [#:prefix? <bool>] [#:doc string]\n\ |
| 819 | name: The name of the command. It may consist of multiple words,\n\ |
| 820 | in which case the final word is the name of the new command, and\n\ |
| 821 | earlier words must be prefix commands.\n\ |
| 822 | invoke: A procedure of three arguments to perform the command.\n\ |
| 823 | (lambda (self arg from-tty) ...)\n\ |
| 824 | Its result is unspecified.\n\ |
| 825 | class: The class of the command, one of COMMAND_*.\n\ |
| 826 | The default is COMMAND_NONE.\n\ |
| 827 | completer: The kind of completer, #f, one of COMPLETE_*, or a procedure\n\ |
| 828 | to perform the completion: (lambda (self text word) ...).\n\ |
| 829 | prefix?: If true then the command is a prefix command.\n\ |
| 830 | doc: The \"doc string\" of the command.\n\ |
| 831 | Returns: <gdb:command> object" }, |
| 832 | |
| 833 | { "register-command!", 1, 0, 0, as_a_scm_t_subr (gdbscm_register_command_x), |
| 834 | "\ |
| 835 | Register a <gdb:command> object with GDB." }, |
| 836 | |
| 837 | { "command?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_p), |
| 838 | "\ |
| 839 | Return #t if the object is a <gdb:command> object." }, |
| 840 | |
| 841 | { "command-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_valid_p), |
| 842 | "\ |
| 843 | Return #t if the <gdb:command> object is valid." }, |
| 844 | |
| 845 | { "dont-repeat", 1, 0, 0, as_a_scm_t_subr (gdbscm_dont_repeat), |
| 846 | "\ |
| 847 | Prevent command repetition when user enters an empty line.\n\ |
| 848 | \n\ |
| 849 | Arguments: <gdb:command>\n\ |
| 850 | Returns: unspecified" }, |
| 851 | |
| 852 | END_FUNCTIONS |
| 853 | }; |
| 854 | |
| 855 | /* Initialize the 'commands' code. */ |
| 856 | |
| 857 | void |
| 858 | gdbscm_initialize_commands (void) |
| 859 | { |
| 860 | int i; |
| 861 | |
| 862 | command_smob_tag |
| 863 | = gdbscm_make_smob_type (command_smob_name, sizeof (command_smob)); |
| 864 | scm_set_smob_print (command_smob_tag, cmdscm_print_command_smob); |
| 865 | |
| 866 | gdbscm_define_integer_constants (command_classes, 1); |
| 867 | gdbscm_define_functions (command_functions, 1); |
| 868 | |
| 869 | for (i = 0; i < N_COMPLETERS; ++i) |
| 870 | { |
| 871 | scm_c_define (cmdscm_completers[i].name, scm_from_int (i)); |
| 872 | scm_c_export (cmdscm_completers[i].name, NULL); |
| 873 | } |
| 874 | |
| 875 | invoke_keyword = scm_from_latin1_keyword ("invoke"); |
| 876 | command_class_keyword = scm_from_latin1_keyword ("command-class"); |
| 877 | completer_class_keyword = scm_from_latin1_keyword ("completer-class"); |
| 878 | prefix_p_keyword = scm_from_latin1_keyword ("prefix?"); |
| 879 | doc_keyword = scm_from_latin1_keyword ("doc"); |
| 880 | } |