GDB (xrefs)

scm-cmd.c
Go to the documentation of this file.
1 /* GDB commands implemented in Scheme.
2
3 Copyright (C) 2008-2018 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
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
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 command_smob *c_smob
272 = cmdscm_get_valid_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
273
274 dont_repeat ();
275
276 return SCM_UNSPECIFIED;
277 }
278
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 char *msg = gdbscm_exception_message_to_string (result);
320
321 make_cleanup (xfree, msg);
322 error ("%s", msg);
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 && (isalnum (name[i - 1])
496 || name[i - 1] == '-'
497 || name[i - 1] == '_');
498 --i)
499 ;
500 result = (char *) xmalloc (lastchar - i + 2);
501 memcpy (result, &name[i], lastchar - i + 1);
502 result[lastchar - i + 1] = '\0';
503
504 /* Skip whitespace again. */
505 for (--i; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i)
506 ;
507 if (i < 0)
508 {
509 *base_list = start_list;
510 return result;
511 }
512
513 prefix_text = (char *) xmalloc (i + 2);
514 memcpy (prefix_text, name, i + 1);
515 prefix_text[i + 1] = '\0';
516
517 prefix_text2 = prefix_text;
518 elt = lookup_cmd_1 (&prefix_text2, *start_list, NULL, 1);
519 if (elt == NULL || elt == CMD_LIST_AMBIGUOUS)
520 {
521 msg = xstrprintf (_("could not find command prefix '%s'"), prefix_text);
522 xfree (prefix_text);
523 xfree (result);
524 scm_dynwind_begin ((scm_t_dynwind_flags) 0);
525 gdbscm_dynwind_xfree (msg);
526 gdbscm_out_of_range_error (func_name, arg_pos,
527 gdbscm_scm_from_c_string (name), msg);
528 }
529
530 if (elt->prefixlist)
531 {
532 xfree (prefix_text);
533 *base_list = elt->prefixlist;
534 return result;
535 }
536
537 msg = xstrprintf (_("'%s' is not a prefix command"), prefix_text);
538 xfree (prefix_text);
539 xfree (result);
540 scm_dynwind_begin ((scm_t_dynwind_flags) 0);
541 gdbscm_dynwind_xfree (msg);
542 gdbscm_out_of_range_error (func_name, arg_pos,
543 gdbscm_scm_from_c_string (name), msg);
544 /* NOTREACHED */
545 }
546
547 static const scheme_integer_constant command_classes[] =
548 {
549 /* Note: alias and user are special; pseudo appears to be unused,
550 and there is no reason to expose tui, I think. */
551 { "COMMAND_NONE", no_class },
552 { "COMMAND_RUNNING", class_run },
553 { "COMMAND_DATA", class_vars },
554 { "COMMAND_STACK", class_stack },
555 { "COMMAND_FILES", class_files },
556 { "COMMAND_SUPPORT", class_support },
557 { "COMMAND_STATUS", class_info },
558 { "COMMAND_BREAKPOINTS", class_breakpoint },
559 { "COMMAND_TRACEPOINTS", class_trace },
560 { "COMMAND_OBSCURE", class_obscure },
561 { "COMMAND_MAINTENANCE", class_maintenance },
562 { "COMMAND_USER", class_user },
563
564 END_INTEGER_CONSTANTS
565 };
566
567 /* Return non-zero if command_class is a valid command class. */
568
569 int
570 gdbscm_valid_command_class_p (int command_class)
571 {
572 int i;
573
574 for (i = 0; command_classes[i].name != NULL; ++i)
575 {
576 if (command_classes[i].value == command_class)
577 return 1;
578 }
579
580 return 0;
581 }
582
583 /* Return a normalized form of command NAME.
584 That is tabs are replaced with spaces and multiple spaces are replaced
585 with a single space.
586 If WANT_TRAILING_SPACE is non-zero, add one space at the end. This is for
587 prefix commands.
588 but that is the caller's responsibility.
589 Space for the result is allocated on the GC heap. */
590
591 char *
592 gdbscm_canonicalize_command_name (const char *name, int want_trailing_space)
593 {
594 int i, out, seen_word;
595 char *result
596 = (char *) scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME);
597
598 i = out = seen_word = 0;
599 while (name[i])
600 {
601 /* Skip whitespace. */
602 while (name[i] == ' ' || name[i] == '\t')
603 ++i;
604 /* Copy non-whitespace characters. */
605 if (name[i])
606 {
607 if (seen_word)
608 result[out++] = ' ';
609 while (name[i] && name[i] != ' ' && name[i] != '\t')
610 result[out++] = name[i++];
611 seen_word = 1;
612 }
613 }
614 if (want_trailing_space)
615 result[out++] = ' ';
616 result[out] = '\0';
617
618 return result;
619 }
620
621 /* (make-command name [#:invoke lambda]
622 [#:command-class class] [#:completer-class completer]
623 [#:prefix? <bool>] [#:doc <string>]) -> <gdb:command>
624
625 NAME is the name of the command. It may consist of multiple words,
626 in which case the final word is the name of the new command, and
627 earlier words must be prefix commands.
628
629 INVOKE is a procedure of three arguments that performs the command when
630 invoked: (lambda (self arg from-tty) ...).
631 Its result is unspecified.
632
633 CLASS is the kind of command. It must be one of the COMMAND_*
634 constants defined in the gdb module. If not specified, "no_class" is used.
635
636 COMPLETER is the kind of completer. It must be either:
637 #f - completion is not supported for this command.
638 One of the COMPLETE_* constants defined in the gdb module.
639 A procedure of three arguments: (lambda (self text word) ...).
640 Its result is one of:
641 A list of strings.
642 A <gdb:iterator> object that returns the set of possible completions,
643 ending with #f.
644 TODO(dje): Once PR 16699 is fixed, add support for returning
645 a COMPLETE_* constant.
646 If not specified, then completion is not supported for this command.
647
648 If PREFIX is #t, then this command is a prefix command.
649
650 DOC is the doc string for the command.
651
652 The result is the <gdb:command> Scheme object.
653 The command is not available to be used yet, however.
654 It must still be added to gdb with register-command!. */
655
656 static SCM
657 gdbscm_make_command (SCM name_scm, SCM rest)
658 {
659 const SCM keywords[] = {
660 invoke_keyword, command_class_keyword, completer_class_keyword,
661 prefix_p_keyword, doc_keyword, SCM_BOOL_F
662 };
663 int invoke_arg_pos = -1, command_class_arg_pos = 1;
664 int completer_class_arg_pos = -1, is_prefix_arg_pos = -1;
665 int doc_arg_pos = -1;
666 char *s;
667 char *name;
668 enum command_class command_class = no_class;
669 SCM completer_class = SCM_BOOL_F;
670 int is_prefix = 0;
671 char *doc = NULL;
672 SCM invoke = SCM_BOOL_F;
673 SCM c_scm;
674 command_smob *c_smob;
675
676 gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#OiOts",
677 name_scm, &name, rest,
678 &invoke_arg_pos, &invoke,
679 &command_class_arg_pos, &command_class,
680 &completer_class_arg_pos, &completer_class,
681 &is_prefix_arg_pos, &is_prefix,
682 &doc_arg_pos, &doc);
683
684 if (doc == NULL)
685 doc = xstrdup (_("This command is not documented."));
686
687 s = name;
688 name = gdbscm_canonicalize_command_name (s, is_prefix);
689 xfree (s);
690 s = doc;
691 doc = gdbscm_gc_xstrdup (s);
692 xfree (s);
693
694 if (is_prefix
695 ? name[0] == ' '
696 : name[0] == '\0')
697 {
698 gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, name_scm,
699 _("no command name found"));
700 }
701
702 if (gdbscm_is_true (invoke))
703 {
704 SCM_ASSERT_TYPE (gdbscm_is_procedure (invoke), invoke,
705 invoke_arg_pos, FUNC_NAME, _("procedure"));
706 }
707
708 if (!gdbscm_valid_command_class_p (command_class))
709 {
710 gdbscm_out_of_range_error (FUNC_NAME, command_class_arg_pos,
711 scm_from_int (command_class),
712 _("invalid command class argument"));
713 }
714
715 SCM_ASSERT_TYPE (gdbscm_is_false (completer_class)
716 || scm_is_integer (completer_class)
717 || gdbscm_is_procedure (completer_class),
718 completer_class, completer_class_arg_pos, FUNC_NAME,
719 _("integer or procedure"));
720 if (scm_is_integer (completer_class)
721 && !scm_is_signed_integer (completer_class, 0, N_COMPLETERS - 1))
722 {
723 gdbscm_out_of_range_error (FUNC_NAME, completer_class_arg_pos,
724 completer_class,
725 _("invalid completion type argument"));
726 }
727
728 c_scm = cmdscm_make_command_smob ();
729 c_smob = (command_smob *) SCM_SMOB_DATA (c_scm);
730 c_smob->name = name;
731 c_smob->is_prefix = is_prefix;
732 c_smob->cmd_class = command_class;
733 c_smob->doc = doc;
734 c_smob->invoke = invoke;
735 c_smob->complete = completer_class;
736
737 return c_scm;
738 }
739
740 /* (register-command! <gdb:command>) -> unspecified
741
742 It is an error to register a command more than once. */
743
744 static SCM
745 gdbscm_register_command_x (SCM self)
746 {
747 command_smob *c_smob
748 = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
749 char *cmd_name;
750 struct cmd_list_element **cmd_list;
751 struct cmd_list_element *cmd = NULL;
752
753 if (cmdscm_is_valid (c_smob))
754 scm_misc_error (FUNC_NAME, _("command is already registered"), SCM_EOL);
755
756 cmd_name = gdbscm_parse_command_name (c_smob->name, FUNC_NAME, SCM_ARG1,
757 &cmd_list, &cmdlist);
758 c_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
759 xfree (cmd_name);
760
761 TRY
762 {
763 if (c_smob->is_prefix)
764 {
765 /* If we have our own "invoke" method, then allow unknown
766 sub-commands. */
767 int allow_unknown = gdbscm_is_true (c_smob->invoke);
768
769 cmd = add_prefix_cmd (c_smob->cmd_name, c_smob->cmd_class,
770 NULL, c_smob->doc, &c_smob->sub_list,
771 c_smob->name, allow_unknown, cmd_list);
772 }
773 else
774 {
775 cmd = add_cmd (c_smob->cmd_name, c_smob->cmd_class,
776 c_smob->doc, cmd_list);
777 }
778 }
779 CATCH (except, RETURN_MASK_ALL)
780 {
781 GDBSCM_HANDLE_GDB_EXCEPTION (except);
782 }
783 END_CATCH
784
785 /* Note: At this point the command exists in gdb.
786 So no more errors after this point. */
787
788 /* There appears to be no API to set this. */
789 cmd->func = cmdscm_function;
790 cmd->destroyer = cmdscm_destroyer;
791
792 c_smob->command = cmd;
793 set_cmd_context (cmd, c_smob);
794
795 if (gdbscm_is_true (c_smob->complete))
796 {
797 set_cmd_completer (cmd,
798 scm_is_integer (c_smob->complete)
799 ? cmdscm_completers[scm_to_int (c_smob->complete)].completer
800 : cmdscm_completer);
801 }
802
803 /* The owner of this command is not in GC-controlled memory, so we need
804 to protect it from GC until the command is deleted. */
805 scm_gc_protect_object (c_smob->containing_scm);
806
807 return SCM_UNSPECIFIED;
808 }
809
810 /* Initialize the Scheme command support. */
811
812 static const scheme_function command_functions[] =
813 {
814 { "make-command", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_command),
815 "\
816 Make a GDB command object.\n\
817 \n\
818 Arguments: name [#:invoke lambda]\n\
819 [#:command-class <class>] [#:completer-class <completer>]\n\
820 [#:prefix? <bool>] [#:doc string]\n\
821 name: The name of the command. It may consist of multiple words,\n\
822 in which case the final word is the name of the new command, and\n\
823 earlier words must be prefix commands.\n\
824 invoke: A procedure of three arguments to perform the command.\n\
825 (lambda (self arg from-tty) ...)\n\
826 Its result is unspecified.\n\
827 class: The class of the command, one of COMMAND_*.\n\
828 The default is COMMAND_NONE.\n\
829 completer: The kind of completer, #f, one of COMPLETE_*, or a procedure\n\
830 to perform the completion: (lambda (self text word) ...).\n\
831 prefix?: If true then the command is a prefix command.\n\
832 doc: The \"doc string\" of the command.\n\
833 Returns: <gdb:command> object" },
834
835 { "register-command!", 1, 0, 0, as_a_scm_t_subr (gdbscm_register_command_x),
836 "\
837 Register a <gdb:command> object with GDB." },
838
839 { "command?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_p),
840 "\
841 Return #t if the object is a <gdb:command> object." },
842
843 { "command-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_valid_p),
844 "\
845 Return #t if the <gdb:command> object is valid." },
846
847 { "dont-repeat", 1, 0, 0, as_a_scm_t_subr (gdbscm_dont_repeat),
848 "\
849 Prevent command repetition when user enters an empty line.\n\
850 \n\
851 Arguments: <gdb:command>\n\
852 Returns: unspecified" },
853
854 END_FUNCTIONS
855 };
856
857 /* Initialize the 'commands' code. */
858
859 void
860 gdbscm_initialize_commands (void)
861 {
862 int i;
863
864 command_smob_tag
865 = gdbscm_make_smob_type (command_smob_name, sizeof (command_smob));
866 scm_set_smob_print (command_smob_tag, cmdscm_print_command_smob);
867
868 gdbscm_define_integer_constants (command_classes, 1);
869 gdbscm_define_functions (command_functions, 1);
870
871 for (i = 0; i < N_COMPLETERS; ++i)
872 {
873 scm_c_define (cmdscm_completers[i].name, scm_from_int (i));
874 scm_c_export (cmdscm_completers[i].name, NULL);
875 }
876
877 invoke_keyword = scm_from_latin1_keyword ("invoke");
878 command_class_keyword = scm_from_latin1_keyword ("command-class");
879 completer_class_keyword = scm_from_latin1_keyword ("completer-class");
880 prefix_p_keyword = scm_from_latin1_keyword ("prefix?");
881 doc_keyword = scm_from_latin1_keyword ("doc");
882 }
cmdscm_completer::name
const char * name
Definition: scm-cmd.c:106
cmdscm_completer
Definition: scm-cmd.c:103
set_cmd_context
void set_cmd_context(struct cmd_list_element *cmd, void *context)
Definition: cli-decode.c:142
as_a_scm_t_subr
static scm_t_subr as_a_scm_t_subr(SCM(*func)(void))
Definition: guile-internal.h:66
command_smob_name
static const char command_smob_name[]
Definition: scm-cmd.c:90
completer.h
cmdscm_completer
static void cmdscm_completer(struct cmd_list_element *command, completion_tracker &tracker, const char *text, const char *word)
Definition: scm-cmd.c:382
scm_new_smob
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
Definition: guile-internal.h:141
cmdscm_is_valid
static int cmdscm_is_valid(command_smob *)
Definition: scm-cmd.c:226
get_cmd_context
void * get_cmd_context(struct cmd_list_element *cmd)
Definition: cli-decode.c:148
_command_smob::base
gdb_smob base
Definition: scm-cmd.c:43
gdbscm_define_functions
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
cmdscm_function
static void cmdscm_function(struct cmd_list_element *command, const char *args, int from_tty)
Definition: scm-cmd.c:294
RETURN_MASK_ALL
Definition: common-exceptions.h:44
xfree
void xfree(void *)
gdbscm_make_command
static SCM gdbscm_make_command(SCM name_scm, SCM rest)
Definition: scm-cmd.c:657
no_class
Definition: command.h:41
class_support
Definition: command.h:42
cmdscm_print_command_smob
static int cmdscm_print_command_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-cmd.c:131
cmdscm_get_command_smob_arg_unsafe
static command_smob * cmdscm_get_command_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:214
cmd_list_element
Definition: cli-decode.h:46
doc_keyword
static SCM doc_keyword
Definition: scm-cmd.c:100
command_classes
static const scheme_integer_constant command_classes[]
Definition: scm-cmd.c:547
gdbscm_safe_call_3
SCM gdbscm_safe_call_3(SCM proc, SCM arg0, SCM arg1, SCM arg2, excp_matcher_func *ok_excps)
Definition: scm-safe-call.c:293
gdbscm_command_p
static SCM gdbscm_command_p(SCM scm)
Definition: scm-cmd.c:193
cmdscm_destroyer
static void cmdscm_destroyer(struct cmd_list_element *self, void *context)
Definition: scm-cmd.c:284
cmd_list_element::allow_unknown
unsigned int allow_unknown
Definition: cli-decode.h:90
cmdscm_get_valid_command_smob_arg_unsafe
static command_smob * cmdscm_get_valid_command_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:235
charset.h
memset
void * memset(T *s, int c, size_t n)=delete
_command_smob::invoke
SCM invoke
Definition: scm-cmd.c:78
FUNC_NAME
#define FUNC_NAME
Definition: guile-internal.h:153
guile-internal.h
gdbscm_parse_command_name
char * gdbscm_parse_command_name(const char *name, const char *func_name, int arg_pos, struct cmd_list_element ***base_list, struct cmd_list_element **start_list)
Definition: scm-cmd.c:471
add_cmd
struct cmd_list_element * add_cmd(const char *name, enum command_class theclass, const char *doc, struct cmd_list_element **list)
Definition: cli-decode.c:262
class_vars
Definition: command.h:41
cmdscm_bad_completion_result
static void cmdscm_bad_completion_result(const char *msg, SCM completion)
Definition: scm-cmd.c:337
lookup_cmd_1
struct cmd_list_element * lookup_cmd_1(const char **text, struct cmd_list_element *clist, struct cmd_list_element **result_list, int ignore_help_classes)
Definition: cli-decode.c:1385
cmdscm_add_completion
static int cmdscm_add_completion(SCM completion, completion_tracker &tracker)
Definition: scm-cmd.c:352
gdbscm_make_smob_type
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
filename_completer
void filename_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *word)
Definition: completer.c:152
cmdlist
struct cmd_list_element * cmdlist
Definition: cli-cmds.c:79
command_smob_tag
static scm_t_bits command_smob_tag
Definition: scm-cmd.c:93
_
#define _(String)
Definition: gdb_locale.h:35
defs.h
command_class_keyword
static SCM command_class_keyword
Definition: scm-cmd.c:97
END_CATCH
#define END_CATCH
Definition: common-exceptions.h:259
gdbscm_is_exception
int gdbscm_is_exception(SCM scm)
Definition: scm-exception.c:147
class_info
Definition: command.h:42
class_files
Definition: command.h:41
gdbscm_is_true
#define gdbscm_is_true(scm)
Definition: guile-internal.h:134
cli-decode.h
add_prefix_cmd
struct cmd_list_element * add_prefix_cmd(const char *name, enum command_class theclass, cmd_const_cfunc_ftype *fun, const char *doc, struct cmd_list_element **prefixlist, const char *prefixname, int allow_unknown, struct cmd_list_element **list)
Definition: cli-decode.c:367
class_user
Definition: command.h:44
TRY
#define TRY
Definition: common-exceptions.h:246
gdbscm_dynwind_xfree
void gdbscm_dynwind_xfree(void *ptr)
Definition: scm-utils.c:571
gdbscm_scm_from_string
SCM gdbscm_scm_from_string(const char *string, size_t len, const char *charset, int strict)
Definition: scm-string.c:180
_command_smob::name
char * name
Definition: scm-cmd.c:46
name
const char *const name
Definition: aarch64-tdep.c:76
gdbscm_initialize_commands
void gdbscm_initialize_commands(void)
Definition: scm-cmd.c:860
gdbscm_init_gsmob
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
CATCH
#define CATCH(EXCEPTION, MASK)
Definition: common-exceptions.h:254
gdbscm_exception_message_to_string
char * gdbscm_exception_message_to_string(SCM exception)
Definition: scm-exception.c:583
noop_completer
void noop_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *prefix)
Definition: completer.c:143
_command_smob::command
struct cmd_list_element * command
Definition: scm-cmd.c:65
gdb::unique_xmalloc_ptr
std::unique_ptr< T, xfree_deleter< T > > unique_xmalloc_ptr
Definition: gdb_unique_ptr.h:48
pstate
static struct parser_state * pstate
Definition: ada-exp.c:98
_command_smob::cmd_class
enum command_class cmd_class
Definition: scm-cmd.c:57
_command_smob::is_prefix
int is_prefix
Definition: scm-cmd.c:54
gdbscm_scm_from_c_string
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
gdbscm_exception_key
SCM gdbscm_exception_key(SCM excp)
Definition: scm-exception.c:163
set_cmd_completer
void set_cmd_completer(struct cmd_list_element *cmd, completer_ftype *completer)
Definition: cli-decode.c:160
prefix_p_keyword
static SCM prefix_p_keyword
Definition: scm-cmd.c:99
command_smob
struct _command_smob command_smob
gdbscm_is_false
#define gdbscm_is_false(scm)
Definition: guile-internal.h:133
class_trace
Definition: command.h:42
cmd_list_element::destroyer
void(* destroyer)(struct cmd_list_element *self, void *context)
Definition: cli-decode.h:177
gdbscm_user_error_p
excp_matcher_func gdbscm_user_error_p
cmdscm_get_command_arg_unsafe
static SCM cmdscm_get_command_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:202
command_completer
void command_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *word)
Definition: completer.c:1649
make_cleanup
struct cleanup * make_cleanup(make_cleanup_ftype *function, void *arg)
Definition: cleanups.c:116
_command_smob
Definition: scm-cmd.c:40
gdb_smob
Definition: guile-internal.h:241
symbol_completer
void symbol_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *word)
Definition: completer.c:1111
completer_class_keyword
static SCM completer_class_keyword
Definition: scm-cmd.c:98
gdbscm_valid_command_class_p
int gdbscm_valid_command_class_p(int command_class)
Definition: scm-cmd.c:570
_command_smob::containing_scm
SCM containing_scm
Definition: scm-cmd.c:87
scheme_function
Definition: guile-internal.h:91
CMD_LIST_AMBIGUOUS
#define CMD_LIST_AMBIGUOUS
Definition: command.h:228
cmdscm_completers
static const struct cmdscm_completer cmdscm_completers[]
Definition: scm-cmd.c:111
N_COMPLETERS
#define N_COMPLETERS
Definition: scm-cmd.c:121
xstrprintf
char * xstrprintf(const char *format,...)
Definition: common-utils.c:107
class_stack
Definition: command.h:41
completer_ftype
void completer_ftype(struct cmd_list_element *, completion_tracker &tracker, const char *text, const char *word)
Definition: command.h:191
_command_smob::complete
SCM complete
Definition: scm-cmd.c:82
xmalloc
void * xmalloc(YYSIZE_T)
gdbscm_printf
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
gdb_assert
#define gdb_assert(expr)
Definition: gdb_assert.h:32
value
Definition: value.c:169
invoke_keyword
static SCM invoke_keyword
Definition: scm-cmd.c:96
location_completer
void location_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *)
Definition: completer.c:828
command_functions
static const scheme_function command_functions[]
Definition: scm-cmd.c:812
gdbscm_define_integer_constants
void gdbscm_define_integer_constants(const scheme_integer_constant *, int is_public)
Definition: scm-utils.c:63
END_FUNCTIONS
#define END_FUNCTIONS
Definition: guile-internal.h:103
gdbscm_invalid_object_error
void gdbscm_invalid_object_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
Definition: scm-exception.c:325
command_class
command_class
Definition: command.h:36
cmdscm_release_command
static void cmdscm_release_command(command_smob *c_smob)
Definition: scm-cmd.c:176
gdbscm_register_command_x
static SCM gdbscm_register_command_x(SCM self)
Definition: scm-cmd.c:745
gdbscm_print_gdb_exception
void gdbscm_print_gdb_exception(SCM port, SCM exception)
Definition: scm-exception.c:567
expression_completer
void expression_completer(struct cmd_list_element *ignore, completion_tracker &tracker, const char *text, const char *word)
Definition: completer.c:1076
class_breakpoint
Definition: command.h:42
gdbscm_out_of_range_error
void gdbscm_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
Definition: scm-exception.c:349
cmdscm_completer::completer
completer_ftype * completer
Definition: scm-cmd.c:108
gdbscm_command_valid_p
static SCM gdbscm_command_valid_p(SCM self)
Definition: scm-cmd.c:256
completion_tracker::add_completion
void add_completion(gdb::unique_xmalloc_ptr< char > name, completion_match_for_lcd *match_for_lcd=NULL, const char *text=NULL, const char *word=NULL)
Definition: completer.c:1550
gdbscm_parse_function_args
void gdbscm_parse_function_args(const char *function_name, int beginning_arg_pos, const SCM *keywords, const char *format,...)
Definition: scm-utils.c:377
cmd_list_element::func
void(* func)(struct cmd_list_element *c, const char *args, int from_tty)
Definition: cli-decode.h:110
_command_smob::cmd_name
char * cmd_name
Definition: scm-cmd.c:51
GDBSCM_HANDLE_GDB_EXCEPTION
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)
Definition: guile-internal.h:643
itscm_safe_call_next_x
SCM itscm_safe_call_next_x(SCM iter, excp_matcher_func *ok_excps)
Definition: scm-iterator.c:215
class_run
Definition: command.h:41
completion_tracker
Definition: completer.h:310
cmd_list_element::doc
const char * doc
Definition: cli-decode.h:130
cmd_list_element::prefixlist
struct cmd_list_element ** prefixlist
Definition: cli-decode.h:151
gdbscm_dont_repeat
static SCM gdbscm_dont_repeat(SCM self)
Definition: scm-cmd.c:268
gdbscm_canonicalize_command_name
char * gdbscm_canonicalize_command_name(const char *name, int want_trailing_space)
Definition: scm-cmd.c:592
cmdscm_is_command
static int cmdscm_is_command(SCM scm)
Definition: scm-cmd.c:185
itscm_is_iterator
int itscm_is_iterator(SCM scm)
Definition: scm-iterator.c:172
host_charset
const char * host_charset(void)
Definition: charset.c:417
scheme_integer_constant::name
const char * name
Definition: guile-internal.h:109
cmdscm_make_command_smob
static SCM cmdscm_make_command_smob(void)
Definition: scm-cmd.c:156
scheme_integer_constant
Definition: guile-internal.h:107
dont_repeat
void dont_repeat(void)
Definition: top.c:695
class_maintenance
Definition: command.h:43
_command_smob::doc
char * doc
Definition: scm-cmd.c:60
class_obscure
Definition: command.h:43
gdbscm_is_procedure
int gdbscm_is_procedure(SCM proc)
Definition: scm-utils.c:579
gdbcmd.h
_command_smob::sub_list
struct cmd_list_element * sub_list
Definition: scm-cmd.c:73
gdbscm_scm_to_string
SCM char * gdbscm_scm_to_string(SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp)
Definition: scm-string.c:120
error
void error(const char *fmt,...)
Definition: errors.c:38
gdbscm_gc_xstrdup
char * gdbscm_gc_xstrdup(const char *)
Definition: scm-utils.c:587
END_INTEGER_CONSTANTS
#define END_INTEGER_CONSTANTS
Definition: guile-internal.h:113