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