GDB (xrefs)
scm-cmd.c
Go to the documentation of this file.
1 /* GDB commands implemented in Scheme.
2 
3  Copyright (C) 2008-2015 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. */
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. */
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. */
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. */
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). */
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;
99 static SCM prefix_p_keyword;
100 static SCM doc_keyword;
101 
102 /* Struct representing built-in completion types. */
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", make_symbol_completion_list_fn },
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
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
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
186 {
187  return SCM_SMOB_PREDICATE (command_smob_tag, scm);
188 }
189 
190 /* (command? scm) -> boolean */
191 
192 static 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
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 *
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
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
269 {
270  /* We currently don't need anything from SELF, but still verify it. */
271  command_smob *c_smob
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, char *args, int from_tty)
295 {
296  command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
297  SCM arg_scm, tty_scm, result;
298 
299  gdb_assert (c_smob != NULL);
300 
301  if (args == NULL)
302  args = "";
303  arg_scm = gdbscm_scm_from_string (args, strlen (args), host_charset (), 1);
304  if (gdbscm_is_exception (arg_scm))
305  error (_("Could not convert arguments to Scheme string."));
306 
307  tty_scm = scm_from_bool (from_tty);
308 
309  result = gdbscm_safe_call_3 (c_smob->invoke, c_smob->containing_scm,
310  arg_scm, tty_scm, gdbscm_user_error_p);
311 
312  if (gdbscm_is_exception (result))
313  {
314  /* Don't print the stack if this was an error signalled by the command
315  itself. */
317  {
318  char *msg = gdbscm_exception_message_to_string (result);
319 
320  make_cleanup (xfree, msg);
321  error ("%s", msg);
322  }
323  else
324  {
325  gdbscm_print_gdb_exception (SCM_BOOL_F, result);
326  error (_("Error occurred in Scheme-implemented GDB command."));
327  }
328  }
329 }
330 
331 /* Subroutine of cmdscm_completer to simplify it.
332  Print an error message indicating that COMPLETION is a bad completion
333  result. */
334 
335 static void
336 cmdscm_bad_completion_result (const char *msg, SCM completion)
337 {
338  SCM port = scm_current_error_port ();
339 
340  scm_puts (msg, port);
341  scm_display (completion, port);
342  scm_newline (port);
343 }
344 
345 /* Subroutine of cmdscm_completer to simplify it.
346  Validate COMPLETION and add to RESULT.
347  If an error occurs print an error message.
348  The result is a boolean indicating success. */
349 
350 static int
351 cmdscm_add_completion (SCM completion, VEC (char_ptr) **result)
352 {
353  char *item;
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  item = gdbscm_scm_to_string (completion, NULL, host_charset (), 1,
365  &except_scm);
366  if (item == NULL)
367  {
368  /* Inform the user, but otherwise ignore the entire result. */
369  gdbscm_print_gdb_exception (SCM_BOOL_F, except_scm);
370  return 0;
371  }
372 
373  VEC_safe_push (char_ptr, *result, item);
374 
375  return 1;
376 }
377 
378 /* Called by gdb for command completion. */
379 
380 static VEC (char_ptr) *
381 cmdscm_completer (struct cmd_list_element *command,
382  const char *text, const char *word)
383 {
384  command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
385  SCM completer_result_scm;
386  SCM text_scm, word_scm, result_scm;
387  VEC (char_ptr) *result = NULL;
388 
389  gdb_assert (c_smob != NULL);
391 
392  text_scm = gdbscm_scm_from_string (text, strlen (text), host_charset (),
393  1);
394  if (gdbscm_is_exception (text_scm))
395  error (_("Could not convert \"text\" argument to Scheme string."));
396  word_scm = gdbscm_scm_from_string (word, strlen (word), host_charset (),
397  1);
398  if (gdbscm_is_exception (word_scm))
399  error (_("Could not convert \"word\" argument to Scheme string."));
400 
401  completer_result_scm
402  = gdbscm_safe_call_3 (c_smob->complete, c_smob->containing_scm,
403  text_scm, word_scm, NULL);
404 
405  if (gdbscm_is_exception (completer_result_scm))
406  {
407  /* Inform the user, but otherwise ignore. */
408  gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm);
409  goto done;
410  }
411 
412  if (gdbscm_is_true (scm_list_p (completer_result_scm)))
413  {
414  SCM list = completer_result_scm;
415 
416  while (!scm_is_eq (list, SCM_EOL))
417  {
418  SCM next = scm_car (list);
419 
420  if (!cmdscm_add_completion (next, &result))
421  {
422  VEC_free (char_ptr, result);
423  goto done;
424  }
425 
426  list = scm_cdr (list);
427  }
428  }
429  else if (itscm_is_iterator (completer_result_scm))
430  {
431  SCM iter = completer_result_scm;
432  SCM next = itscm_safe_call_next_x (iter, NULL);
433 
434  while (gdbscm_is_true (next))
435  {
436  if (gdbscm_is_exception (next))
437  {
438  /* Inform the user, but otherwise ignore the entire result. */
439  gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm);
440  VEC_free (char_ptr, result);
441  goto done;
442  }
443 
444  if (!cmdscm_add_completion (next, &result))
445  {
446  VEC_free (char_ptr, result);
447  goto done;
448  }
449 
450  next = itscm_safe_call_next_x (iter, NULL);
451  }
452  }
453  else
454  {
455  /* Inform the user, but otherwise ignore. */
456  cmdscm_bad_completion_result (_("Bad completer result: "),
457  completer_result_scm);
458  }
459 
460  done:
461  return result;
462 }
463 
464 /* Helper for gdbscm_make_command which locates the command list to use and
465  pulls out the command name.
466 
467  NAME is the command name list. The final word in the list is the
468  name of the new command. All earlier words must be existing prefix
469  commands.
470 
471  *BASE_LIST is set to the final prefix command's list of
472  *sub-commands.
473 
474  START_LIST is the list in which the search starts.
475 
476  This function returns the xmalloc()d name of the new command.
477  On error a Scheme exception is thrown. */
478 
479 char *
481  const char *func_name, int arg_pos,
482  struct cmd_list_element ***base_list,
483  struct cmd_list_element **start_list)
484 {
485  struct cmd_list_element *elt;
486  int len = strlen (name);
487  int i, lastchar;
488  char *prefix_text;
489  const char *prefix_text2;
490  char *result, *msg;
491 
492  /* Skip trailing whitespace. */
493  for (i = len - 1; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i)
494  ;
495  if (i < 0)
496  {
497  gdbscm_out_of_range_error (func_name, arg_pos,
499  _("no command name found"));
500  }
501  lastchar = i;
502 
503  /* Find first character of the final word. */
504  for (; i > 0 && (isalnum (name[i - 1])
505  || name[i - 1] == '-'
506  || name[i - 1] == '_');
507  --i)
508  ;
509  result = xmalloc (lastchar - i + 2);
510  memcpy (result, &name[i], lastchar - i + 1);
511  result[lastchar - i + 1] = '\0';
512 
513  /* Skip whitespace again. */
514  for (--i; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i)
515  ;
516  if (i < 0)
517  {
518  *base_list = start_list;
519  return result;
520  }
521 
522  prefix_text = xmalloc (i + 2);
523  memcpy (prefix_text, name, i + 1);
524  prefix_text[i + 1] = '\0';
525 
526  prefix_text2 = prefix_text;
527  elt = lookup_cmd_1 (&prefix_text2, *start_list, NULL, 1);
528  if (elt == NULL || elt == CMD_LIST_AMBIGUOUS)
529  {
530  msg = xstrprintf (_("could not find command prefix '%s'"), prefix_text);
531  xfree (prefix_text);
532  xfree (result);
533  scm_dynwind_begin (0);
534  gdbscm_dynwind_xfree (msg);
535  gdbscm_out_of_range_error (func_name, arg_pos,
536  gdbscm_scm_from_c_string (name), msg);
537  }
538 
539  if (elt->prefixlist)
540  {
541  xfree (prefix_text);
542  *base_list = elt->prefixlist;
543  return result;
544  }
545 
546  msg = xstrprintf (_("'%s' is not a prefix command"), prefix_text);
547  xfree (prefix_text);
548  xfree (result);
549  scm_dynwind_begin (0);
550  gdbscm_dynwind_xfree (msg);
551  gdbscm_out_of_range_error (func_name, arg_pos,
552  gdbscm_scm_from_c_string (name), msg);
553  /* NOTREACHED */
554 }
555 
556 static const scheme_integer_constant command_classes[] =
557 {
558  /* Note: alias and user are special; pseudo appears to be unused,
559  and there is no reason to expose tui, I think. */
560  { "COMMAND_NONE", no_class },
561  { "COMMAND_RUNNING", class_run },
562  { "COMMAND_DATA", class_vars },
563  { "COMMAND_STACK", class_stack },
564  { "COMMAND_FILES", class_files },
565  { "COMMAND_SUPPORT", class_support },
566  { "COMMAND_STATUS", class_info },
567  { "COMMAND_BREAKPOINTS", class_breakpoint },
568  { "COMMAND_TRACEPOINTS", class_trace },
569  { "COMMAND_OBSCURE", class_obscure },
570  { "COMMAND_MAINTENANCE", class_maintenance },
571  { "COMMAND_USER", class_user },
572 
574 };
575 
576 /* Return non-zero if command_class is a valid command class. */
577 
578 int
580 {
581  int i;
582 
583  for (i = 0; command_classes[i].name != NULL; ++i)
584  {
585  if (command_classes[i].value == command_class)
586  return 1;
587  }
588 
589  return 0;
590 }
591 
592 /* Return a normalized form of command NAME.
593  That is tabs are replaced with spaces and multiple spaces are replaced
594  with a single space.
595  If WANT_TRAILING_SPACE is non-zero, add one space at the end. This is for
596  prefix commands.
597  but that is the caller's responsibility.
598  Space for the result is allocated on the GC heap. */
599 
600 char *
601 gdbscm_canonicalize_command_name (const char *name, int want_trailing_space)
602 {
603  int i, out, seen_word;
604  char *result = scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME);
605 
606  i = out = seen_word = 0;
607  while (name[i])
608  {
609  /* Skip whitespace. */
610  while (name[i] == ' ' || name[i] == '\t')
611  ++i;
612  /* Copy non-whitespace characters. */
613  if (name[i])
614  {
615  if (seen_word)
616  result[out++] = ' ';
617  while (name[i] && name[i] != ' ' && name[i] != '\t')
618  result[out++] = name[i++];
619  seen_word = 1;
620  }
621  }
622  if (want_trailing_space)
623  result[out++] = ' ';
624  result[out] = '\0';
625 
626  return result;
627 }
628 
629 /* (make-command name [#:invoke lambda]
630  [#:command-class class] [#:completer-class completer]
631  [#:prefix? <bool>] [#:doc <string>]) -> <gdb:command>
632 
633  NAME is the name of the command. It may consist of multiple words,
634  in which case the final word is the name of the new command, and
635  earlier words must be prefix commands.
636 
637  INVOKE is a procedure of three arguments that performs the command when
638  invoked: (lambda (self arg from-tty) ...).
639  Its result is unspecified.
640 
641  CLASS is the kind of command. It must be one of the COMMAND_*
642  constants defined in the gdb module. If not specified, "no_class" is used.
643 
644  COMPLETER is the kind of completer. It must be either:
645  #f - completion is not supported for this command.
646  One of the COMPLETE_* constants defined in the gdb module.
647  A procedure of three arguments: (lambda (self text word) ...).
648  Its result is one of:
649  A list of strings.
650  A <gdb:iterator> object that returns the set of possible completions,
651  ending with #f.
652  TODO(dje): Once PR 16699 is fixed, add support for returning
653  a COMPLETE_* constant.
654  If not specified, then completion is not supported for this command.
655 
656  If PREFIX is #t, then this command is a prefix command.
657 
658  DOC is the doc string for the command.
659 
660  The result is the <gdb:command> Scheme object.
661  The command is not available to be used yet, however.
662  It must still be added to gdb with register-command!. */
663 
664 static SCM
665 gdbscm_make_command (SCM name_scm, SCM rest)
666 {
667  const SCM keywords[] = {
669  prefix_p_keyword, doc_keyword, SCM_BOOL_F
670  };
671  int invoke_arg_pos = -1, command_class_arg_pos = 1;
672  int completer_class_arg_pos = -1, is_prefix_arg_pos = -1;
673  int doc_arg_pos = -1;
674  char *s;
675  char *name;
676  int command_class = no_class;
677  SCM completer_class = SCM_BOOL_F;
678  int is_prefix = 0;
679  char *doc = NULL;
680  SCM invoke = SCM_BOOL_F;
681  SCM c_scm;
682  command_smob *c_smob;
683 
684  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#OiOts",
685  name_scm, &name, rest,
686  &invoke_arg_pos, &invoke,
687  &command_class_arg_pos, &command_class,
688  &completer_class_arg_pos, &completer_class,
689  &is_prefix_arg_pos, &is_prefix,
690  &doc_arg_pos, &doc);
691 
692  if (doc == NULL)
693  doc = xstrdup (_("This command is not documented."));
694 
695  s = name;
696  name = gdbscm_canonicalize_command_name (s, is_prefix);
697  xfree (s);
698  s = doc;
699  doc = gdbscm_gc_xstrdup (s);
700  xfree (s);
701 
702  if (is_prefix
703  ? name[0] == ' '
704  : name[0] == '\0')
705  {
706  gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, name_scm,
707  _("no command name found"));
708  }
709 
710  if (gdbscm_is_true (invoke))
711  {
712  SCM_ASSERT_TYPE (gdbscm_is_procedure (invoke), invoke,
713  invoke_arg_pos, FUNC_NAME, _("procedure"));
714  }
715 
716  if (!gdbscm_valid_command_class_p (command_class))
717  {
718  gdbscm_out_of_range_error (FUNC_NAME, command_class_arg_pos,
719  scm_from_int (command_class),
720  _("invalid command class argument"));
721  }
722 
723  SCM_ASSERT_TYPE (gdbscm_is_false (completer_class)
724  || scm_is_integer (completer_class)
725  || gdbscm_is_procedure (completer_class),
726  completer_class, completer_class_arg_pos, FUNC_NAME,
727  _("integer or procedure"));
728  if (scm_is_integer (completer_class)
729  && !scm_is_signed_integer (completer_class, 0, N_COMPLETERS - 1))
730  {
731  gdbscm_out_of_range_error (FUNC_NAME, completer_class_arg_pos,
732  completer_class,
733  _("invalid completion type argument"));
734  }
735 
736  c_scm = cmdscm_make_command_smob ();
737  c_smob = (command_smob *) SCM_SMOB_DATA (c_scm);
738  c_smob->name = name;
739  c_smob->is_prefix = is_prefix;
740  c_smob->cmd_class = command_class;
741  c_smob->doc = doc;
742  c_smob->invoke = invoke;
743  c_smob->complete = completer_class;
744 
745  return c_scm;
746 }
747 
748 /* (register-command! <gdb:command>) -> unspecified
749 
750  It is an error to register a command more than once. */
751 
752 static SCM
754 {
755  command_smob *c_smob
756  = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
757  char *cmd_name, *pfx_name;
758  struct cmd_list_element **cmd_list;
759  struct cmd_list_element *cmd = NULL;
760 
761  if (cmdscm_is_valid (c_smob))
762  scm_misc_error (FUNC_NAME, _("command is already registered"), SCM_EOL);
763 
764  cmd_name = gdbscm_parse_command_name (c_smob->name, FUNC_NAME, SCM_ARG1,
765  &cmd_list, &cmdlist);
766  c_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name);
767  xfree (cmd_name);
768 
769  TRY
770  {
771  if (c_smob->is_prefix)
772  {
773  /* If we have our own "invoke" method, then allow unknown
774  sub-commands. */
775  int allow_unknown = gdbscm_is_true (c_smob->invoke);
776 
777  cmd = add_prefix_cmd (c_smob->cmd_name, c_smob->cmd_class,
778  NULL, c_smob->doc, &c_smob->sub_list,
779  c_smob->name, allow_unknown, cmd_list);
780  }
781  else
782  {
783  cmd = add_cmd (c_smob->cmd_name, c_smob->cmd_class,
784  NULL, c_smob->doc, cmd_list);
785  }
786  }
787  CATCH (except, RETURN_MASK_ALL)
788  {
790  }
791  END_CATCH
792 
793  /* Note: At this point the command exists in gdb.
794  So no more errors after this point. */
795 
796  /* There appears to be no API to set this. */
797  cmd->func = cmdscm_function;
799 
800  c_smob->command = cmd;
801  set_cmd_context (cmd, c_smob);
802 
803  if (gdbscm_is_true (c_smob->complete))
804  {
805  set_cmd_completer (cmd,
806  scm_is_integer (c_smob->complete)
807  ? cmdscm_completers[scm_to_int (c_smob->complete)].completer
808  : cmdscm_completer);
809  }
810 
811  /* The owner of this command is not in GC-controlled memory, so we need
812  to protect it from GC until the command is deleted. */
813  scm_gc_protect_object (c_smob->containing_scm);
814 
815  return SCM_UNSPECIFIED;
816 }
817 
818 /* Initialize the Scheme command support. */
819 
820 static const scheme_function command_functions[] =
821 {
822  { "make-command", 1, 0, 1, gdbscm_make_command,
823  "\
824 Make a GDB command object.\n\
825 \n\
826  Arguments: name [#:invoke lambda]\n\
827  [#:command-class <class>] [#:completer-class <completer>]\n\
828  [#:prefix? <bool>] [#:doc string]\n\
829  name: The name of the command. It may consist of multiple words,\n\
830  in which case the final word is the name of the new command, and\n\
831  earlier words must be prefix commands.\n\
832  invoke: A procedure of three arguments to perform the command.\n\
833  (lambda (self arg from-tty) ...)\n\
834  Its result is unspecified.\n\
835  class: The class of the command, one of COMMAND_*.\n\
836  The default is COMMAND_NONE.\n\
837  completer: The kind of completer, #f, one of COMPLETE_*, or a procedure\n\
838  to perform the completion: (lambda (self text word) ...).\n\
839  prefix?: If true then the command is a prefix command.\n\
840  doc: The \"doc string\" of the command.\n\
841  Returns: <gdb:command> object" },
842 
843  { "register-command!", 1, 0, 0, gdbscm_register_command_x,
844  "\
845 Register a <gdb:command> object with GDB." },
846 
847  { "command?", 1, 0, 0, gdbscm_command_p,
848  "\
849 Return #t if the object is a <gdb:command> object." },
850 
851  { "command-valid?", 1, 0, 0, gdbscm_command_valid_p,
852  "\
853 Return #t if the <gdb:command> object is valid." },
854 
855  { "dont-repeat", 1, 0, 0, gdbscm_dont_repeat,
856  "\
857 Prevent command repetition when user enters an empty line.\n\
858 \n\
859  Arguments: <gdb:command>\n\
860  Returns: unspecified" },
861 
863 };
864 
865 /* Initialize the 'commands' code. */
866 
867 void
869 {
870  int i;
871 
872  command_smob_tag
873  = gdbscm_make_smob_type (command_smob_name, sizeof (command_smob));
874  scm_set_smob_print (command_smob_tag, cmdscm_print_command_smob);
875 
876  gdbscm_define_integer_constants (command_classes, 1);
877  gdbscm_define_functions (command_functions, 1);
878 
879  for (i = 0; i < N_COMPLETERS; ++i)
880  {
881  scm_c_define (cmdscm_completers[i].name, scm_from_int (i));
882  scm_c_export (cmdscm_completers[i].name, NULL);
883  }
884 
885  invoke_keyword = scm_from_latin1_keyword ("invoke");
886  command_class_keyword = scm_from_latin1_keyword ("command-class");
887  completer_class_keyword = scm_from_latin1_keyword ("completer-class");
888  prefix_p_keyword = scm_from_latin1_keyword ("prefix?");
889  doc_keyword = scm_from_latin1_keyword ("doc");
890 }
const char * name
Definition: scm-cmd.c:106
void set_cmd_context(struct cmd_list_element *cmd, void *context)
Definition: cli-decode.c:141
struct cmd_list_element * add_prefix_cmd(const char *name, enum command_class theclass, cmd_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:338
static const char command_smob_name[]
Definition: scm-cmd.c:90
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
static int cmdscm_is_valid(command_smob *)
Definition: scm-cmd.c:226
void * get_cmd_context(struct cmd_list_element *cmd)
Definition: cli-decode.c:147
gdb_smob base
Definition: scm-cmd.c:43
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
void xfree(void *)
Definition: common-utils.c:97
static SCM gdbscm_make_command(SCM name_scm, SCM rest)
Definition: scm-cmd.c:665
static int cmdscm_print_command_smob(SCM self, SCM port, scm_print_state *pstate)
Definition: scm-cmd.c:131
static command_smob * cmdscm_get_command_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:214
static SCM doc_keyword
Definition: scm-cmd.c:100
SCM gdbscm_safe_call_3(SCM proc, SCM arg0, SCM arg1, SCM arg2, excp_matcher_func *ok_excps)
static SCM gdbscm_command_p(SCM scm)
Definition: scm-cmd.c:193
static void cmdscm_destroyer(struct cmd_list_element *self, void *context)
Definition: scm-cmd.c:284
unsigned int allow_unknown
Definition: cli-decode.h:91
static command_smob * cmdscm_get_valid_command_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:235
SCM invoke
Definition: scm-cmd.c:78
#define FUNC_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:480
static void cmdscm_bad_completion_result(const char *msg, SCM completion)
Definition: scm-cmd.c:336
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:1332
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
#define VEC_safe_push(T, V, O)
Definition: vec.h:260
struct cmd_list_element * cmdlist
Definition: cli-cmds.c:103
static scm_t_bits command_smob_tag
Definition: scm-cmd.c:93
#define _(String)
Definition: gdb_locale.h:40
char * char_ptr
Definition: gdb_vecs.h:25
static SCM command_class_keyword
Definition: scm-cmd.c:97
#define END_CATCH
int gdbscm_is_exception(SCM scm)
#define gdbscm_is_true(scm)
#define TRY
void gdbscm_dynwind_xfree(void *ptr)
Definition: scm-utils.c:571
SCM gdbscm_scm_from_string(const char *string, size_t len, const char *charset, int strict)
Definition: scm-string.c:180
char * name
Definition: scm-cmd.c:46
const char *const name
Definition: aarch64-tdep.c:68
void gdbscm_initialize_commands(void)
Definition: scm-cmd.c:868
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
#define CATCH(EXCEPTION, MASK)
char * gdbscm_exception_message_to_string(SCM exception)
static void cmdscm_function(struct cmd_list_element *command, char *args, int from_tty)
Definition: scm-cmd.c:294
struct cmd_list_element * command
Definition: scm-cmd.c:65
static struct parser_state * pstate
Definition: ada-exp.c:149
enum command_class cmd_class
Definition: scm-cmd.c:57
int is_prefix
Definition: scm-cmd.c:54
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
SCM gdbscm_exception_key(SCM excp)
void set_cmd_completer(struct cmd_list_element *cmd, completer_ftype *completer)
Definition: cli-decode.c:159
static SCM prefix_p_keyword
Definition: scm-cmd.c:99
struct _command_smob command_smob
#define gdbscm_is_false(scm)
void(* destroyer)(struct cmd_list_element *self, void *context)
Definition: cli-decode.h:191
excp_matcher_func gdbscm_user_error_p
struct cmd_list_element * add_cmd(const char *name, enum command_class theclass, cmd_cfunc_ftype *fun, const char *doc, struct cmd_list_element **list)
Definition: cli-decode.c:192
static SCM cmdscm_get_command_arg_unsafe(SCM self, int arg_pos, const char *func_name)
Definition: scm-cmd.c:202
struct cleanup * make_cleanup(make_cleanup_ftype *function, void *arg)
Definition: cleanups.c:117
const char * word
Definition: symtab.h:1448
static SCM completer_class_keyword
Definition: scm-cmd.c:98
int gdbscm_valid_command_class_p(int command_class)
Definition: scm-cmd.c:579
SCM containing_scm
Definition: scm-cmd.c:87
#define gdb_assert(expr)
Definition: gdb_assert.h:33
static int cmdscm_add_completion(SCM completion, VEC(char_ptr)**result)
Definition: scm-cmd.c:351
#define CMD_LIST_AMBIGUOUS
Definition: command.h:193
#define N_COMPLETERS
Definition: scm-cmd.c:121
char * xstrprintf(const char *format,...)
Definition: common-utils.c:107
static VEC(char_ptr)
Definition: scm-cmd.c:380
SCM complete
Definition: scm-cmd.c:82
void * xmalloc(YYSIZE_T)
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
Definition: value.c:172
static SCM invoke_keyword
Definition: scm-cmd.c:96
void gdbscm_define_integer_constants(const scheme_integer_constant *, int is_public)
Definition: scm-utils.c:63
#define END_FUNCTIONS
void gdbscm_invalid_object_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
command_class
Definition: command.h:33
static void cmdscm_release_command(command_smob *c_smob)
Definition: scm-cmd.c:176
static SCM gdbscm_register_command_x(SCM self)
Definition: scm-cmd.c:753
void gdbscm_print_gdb_exception(SCM port, SCM exception)
void(* func)(struct cmd_list_element *c, char *args, int from_tty)
Definition: cli-decode.h:111
void gdbscm_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error) ATTRIBUTE_NORETURN
completer_ftype * completer
Definition: scm-cmd.c:108
static SCM gdbscm_command_valid_p(SCM self)
Definition: scm-cmd.c:256
#define VEC_free(T, V)
Definition: vec.h:180
void gdbscm_parse_function_args(const char *function_name, int beginning_arg_pos, const SCM *keywords, const char *format,...)
Definition: scm-utils.c:377
char * cmd_name
Definition: scm-cmd.c:51
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)
SCM itscm_safe_call_next_x(SCM iter, excp_matcher_func *ok_excps)
Definition: scm-iterator.c:215
const char * doc
Definition: cli-decode.h:131
struct cmd_list_element ** prefixlist
Definition: cli-decode.h:152
static SCM gdbscm_dont_repeat(SCM self)
Definition: scm-cmd.c:268
char * gdbscm_canonicalize_command_name(const char *name, int want_trailing_space)
Definition: scm-cmd.c:601
static int cmdscm_is_command(SCM scm)
Definition: scm-cmd.c:185
int itscm_is_iterator(SCM scm)
Definition: scm-iterator.c:172
const char * host_charset(void)
Definition: charset.c:399
static SCM cmdscm_make_command_smob(void)
Definition: scm-cmd.c:156
void dont_repeat(void)
Definition: top.c:582
char * doc
Definition: scm-cmd.c:60
int gdbscm_is_procedure(SCM proc)
Definition: scm-utils.c:579
struct cmd_list_element * sub_list
Definition: scm-cmd.c:73
SCM char * gdbscm_scm_to_string(SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp)
Definition: scm-string.c:120
void error(const char *fmt,...)
Definition: errors.c:38
char * gdbscm_gc_xstrdup(const char *)
Definition: scm-utils.c:587
const ULONGEST const LONGEST len
Definition: target.h:309
#define END_INTEGER_CONSTANTS