]>
Commit | Line | Data |
---|---|---|
e698b8c4 DE |
1 | /* GDB commands implemented in Scheme. |
2 | ||
1d506c26 | 3 | Copyright (C) 2008-2024 Free Software Foundation, Inc. |
e698b8c4 DE |
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> | |
e698b8c4 DE |
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 | ||
f99b5177 | 40 | struct command_smob |
e698b8c4 DE |
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; | |
f99b5177 | 88 | }; |
e698b8c4 DE |
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 }, | |
78b13106 | 117 | { "COMPLETE_SYMBOL", symbol_completer }, |
e698b8c4 DE |
118 | { "COMPLETE_EXPRESSION", expression_completer }, |
119 | }; | |
120 | ||
121 | #define N_COMPLETERS (sizeof (cmdscm_completers) \ | |
122 | / sizeof (cmdscm_completers[0])) | |
123 | ||
124 | static int cmdscm_is_valid (command_smob *); | |
125 | \f | |
126 | /* Administrivia for command smobs. */ | |
127 | ||
128 | /* The smob "print" function for <gdb:command>. */ | |
129 | ||
130 | static int | |
131 | cmdscm_print_command_smob (SCM self, SCM port, scm_print_state *pstate) | |
132 | { | |
133 | command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (self); | |
134 | ||
135 | gdbscm_printf (port, "#<%s", command_smob_name); | |
136 | ||
137 | gdbscm_printf (port, " %s", | |
138 | c_smob->name != NULL ? c_smob->name : "{unnamed}"); | |
139 | ||
140 | if (! cmdscm_is_valid (c_smob)) | |
141 | scm_puts (" {invalid}", port); | |
142 | ||
143 | scm_puts (">", port); | |
144 | ||
145 | scm_remember_upto_here_1 (self); | |
146 | ||
147 | /* Non-zero means success. */ | |
148 | return 1; | |
149 | } | |
150 | ||
151 | /* Low level routine to create a <gdb:command> object. | |
152 | It's empty in the sense that a command still needs to be associated | |
153 | with it. */ | |
154 | ||
155 | static SCM | |
156 | cmdscm_make_command_smob (void) | |
157 | { | |
158 | command_smob *c_smob = (command_smob *) | |
159 | scm_gc_malloc (sizeof (command_smob), command_smob_name); | |
160 | SCM c_scm; | |
161 | ||
162 | memset (c_smob, 0, sizeof (*c_smob)); | |
163 | c_smob->cmd_class = no_class; | |
164 | c_smob->invoke = SCM_BOOL_F; | |
165 | c_smob->complete = SCM_BOOL_F; | |
166 | c_scm = scm_new_smob (command_smob_tag, (scm_t_bits) c_smob); | |
167 | c_smob->containing_scm = c_scm; | |
168 | gdbscm_init_gsmob (&c_smob->base); | |
169 | ||
170 | return c_scm; | |
171 | } | |
172 | ||
173 | /* Clear the COMMAND pointer in C_SMOB and unprotect the object from GC. */ | |
174 | ||
175 | static void | |
176 | cmdscm_release_command (command_smob *c_smob) | |
177 | { | |
178 | c_smob->command = NULL; | |
179 | scm_gc_unprotect_object (c_smob->containing_scm); | |
180 | } | |
181 | ||
182 | /* Return non-zero if SCM is a command smob. */ | |
183 | ||
184 | static int | |
185 | cmdscm_is_command (SCM scm) | |
186 | { | |
187 | return SCM_SMOB_PREDICATE (command_smob_tag, scm); | |
188 | } | |
189 | ||
190 | /* (command? scm) -> boolean */ | |
191 | ||
192 | static SCM | |
193 | gdbscm_command_p (SCM scm) | |
194 | { | |
195 | return scm_from_bool (cmdscm_is_command (scm)); | |
196 | } | |
197 | ||
198 | /* Returns the <gdb:command> object in SELF. | |
199 | Throws an exception if SELF is not a <gdb:command> object. */ | |
200 | ||
201 | static SCM | |
202 | cmdscm_get_command_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
203 | { | |
204 | SCM_ASSERT_TYPE (cmdscm_is_command (self), self, arg_pos, func_name, | |
205 | command_smob_name); | |
206 | ||
207 | return self; | |
208 | } | |
209 | ||
210 | /* Returns a pointer to the command smob of SELF. | |
211 | Throws an exception if SELF is not a <gdb:command> object. */ | |
212 | ||
213 | static command_smob * | |
214 | cmdscm_get_command_smob_arg_unsafe (SCM self, int arg_pos, | |
215 | const char *func_name) | |
216 | { | |
217 | SCM c_scm = cmdscm_get_command_arg_unsafe (self, arg_pos, func_name); | |
218 | command_smob *c_smob = (command_smob *) SCM_SMOB_DATA (c_scm); | |
219 | ||
220 | return c_smob; | |
221 | } | |
222 | ||
223 | /* Return non-zero if command C_SMOB is valid. */ | |
224 | ||
225 | static int | |
226 | cmdscm_is_valid (command_smob *c_smob) | |
227 | { | |
228 | return c_smob->command != NULL; | |
229 | } | |
230 | ||
231 | /* Returns a pointer to the command smob of SELF. | |
232 | Throws an exception if SELF is not a valid <gdb:command> object. */ | |
233 | ||
234 | static command_smob * | |
235 | cmdscm_get_valid_command_smob_arg_unsafe (SCM self, int arg_pos, | |
236 | const char *func_name) | |
237 | { | |
238 | command_smob *c_smob | |
239 | = cmdscm_get_command_smob_arg_unsafe (self, arg_pos, func_name); | |
240 | ||
241 | if (!cmdscm_is_valid (c_smob)) | |
242 | { | |
243 | gdbscm_invalid_object_error (func_name, arg_pos, self, | |
244 | _("<gdb:command>")); | |
245 | } | |
246 | ||
247 | return c_smob; | |
248 | } | |
249 | \f | |
250 | /* Scheme functions for GDB commands. */ | |
251 | ||
252 | /* (command-valid? <gdb:command>) -> boolean | |
253 | Returns #t if SELF is still valid. */ | |
254 | ||
255 | static SCM | |
256 | gdbscm_command_valid_p (SCM self) | |
257 | { | |
258 | command_smob *c_smob | |
259 | = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
260 | ||
261 | return scm_from_bool (cmdscm_is_valid (c_smob)); | |
262 | } | |
263 | ||
264 | /* (dont-repeat cmd) -> unspecified | |
265 | Scheme function which wraps dont_repeat. */ | |
266 | ||
267 | static SCM | |
268 | gdbscm_dont_repeat (SCM self) | |
269 | { | |
d5e9a511 TT |
270 | /* We currently don't need anything from SELF, but still verify it. |
271 | Call for side effects. */ | |
272 | cmdscm_get_valid_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
e698b8c4 DE |
273 | |
274 | dont_repeat (); | |
275 | ||
276 | return SCM_UNSPECIFIED; | |
277 | } | |
278 | \f | |
279 | /* The make-command function. */ | |
280 | ||
281 | /* Called if the gdb cmd_list_element is destroyed. */ | |
282 | ||
283 | static void | |
284 | cmdscm_destroyer (struct cmd_list_element *self, void *context) | |
285 | { | |
286 | command_smob *c_smob = (command_smob *) context; | |
287 | ||
288 | cmdscm_release_command (c_smob); | |
e698b8c4 DE |
289 | } |
290 | ||
291 | /* Called by gdb to invoke the command. */ | |
292 | ||
293 | static void | |
5538b03c | 294 | cmdscm_function (const char *args, int from_tty, cmd_list_element *command) |
e698b8c4 | 295 | { |
0f8e2034 | 296 | command_smob *c_smob/*obj*/ = (command_smob *) command->context (); |
e698b8c4 DE |
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. */ | |
316 | if (gdbscm_user_error_p (gdbscm_exception_key (result))) | |
317 | { | |
15bf3002 TT |
318 | gdb::unique_xmalloc_ptr<char> msg |
319 | = gdbscm_exception_message_to_string (result); | |
e698b8c4 | 320 | |
15bf3002 | 321 | error ("%s", msg.get ()); |
e698b8c4 DE |
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 | |
eb3ff9a5 | 351 | cmdscm_add_completion (SCM completion, completion_tracker &tracker) |
e698b8c4 | 352 | { |
e698b8c4 DE |
353 | SCM except_scm; |
354 | ||
355 | if (!scm_is_string (completion)) | |
356 | { | |
357 | /* Inform the user, but otherwise ignore the entire result. */ | |
358 | cmdscm_bad_completion_result (_("Bad text from completer: "), | |
359 | completion); | |
360 | return 0; | |
361 | } | |
362 | ||
eb3ff9a5 | 363 | gdb::unique_xmalloc_ptr<char> item |
c6c6149a TT |
364 | = gdbscm_scm_to_string (completion, NULL, host_charset (), 1, |
365 | &except_scm); | |
e698b8c4 DE |
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 | ||
eb3ff9a5 | 373 | tracker.add_completion (std::move (item)); |
e698b8c4 DE |
374 | |
375 | return 1; | |
376 | } | |
377 | ||
378 | /* Called by gdb for command completion. */ | |
379 | ||
eb3ff9a5 | 380 | static void |
e698b8c4 | 381 | cmdscm_completer (struct cmd_list_element *command, |
eb3ff9a5 | 382 | completion_tracker &tracker, |
e698b8c4 DE |
383 | const char *text, const char *word) |
384 | { | |
0f8e2034 | 385 | command_smob *c_smob/*obj*/ = (command_smob *) command->context (); |
e698b8c4 | 386 | SCM completer_result_scm; |
798a7429 | 387 | SCM text_scm, word_scm; |
e698b8c4 DE |
388 | |
389 | gdb_assert (c_smob != NULL); | |
390 | gdb_assert (gdbscm_is_procedure (c_smob->complete)); | |
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); | |
eb3ff9a5 | 409 | return; |
e698b8c4 DE |
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 | ||
eb3ff9a5 PA |
420 | if (!cmdscm_add_completion (next, tracker)) |
421 | break; | |
e698b8c4 DE |
422 | |
423 | list = scm_cdr (list); | |
424 | } | |
425 | } | |
426 | else if (itscm_is_iterator (completer_result_scm)) | |
427 | { | |
428 | SCM iter = completer_result_scm; | |
429 | SCM next = itscm_safe_call_next_x (iter, NULL); | |
430 | ||
431 | while (gdbscm_is_true (next)) | |
432 | { | |
433 | if (gdbscm_is_exception (next)) | |
434 | { | |
eb3ff9a5 | 435 | /* Inform the user. */ |
e698b8c4 | 436 | gdbscm_print_gdb_exception (SCM_BOOL_F, completer_result_scm); |
eb3ff9a5 | 437 | break; |
e698b8c4 DE |
438 | } |
439 | ||
eb3ff9a5 PA |
440 | if (cmdscm_add_completion (next, tracker)) |
441 | break; | |
e698b8c4 DE |
442 | |
443 | next = itscm_safe_call_next_x (iter, NULL); | |
444 | } | |
445 | } | |
446 | else | |
447 | { | |
448 | /* Inform the user, but otherwise ignore. */ | |
449 | cmdscm_bad_completion_result (_("Bad completer result: "), | |
450 | completer_result_scm); | |
451 | } | |
e698b8c4 DE |
452 | } |
453 | ||
454 | /* Helper for gdbscm_make_command which locates the command list to use and | |
455 | pulls out the command name. | |
456 | ||
457 | NAME is the command name list. The final word in the list is the | |
458 | name of the new command. All earlier words must be existing prefix | |
459 | commands. | |
460 | ||
461 | *BASE_LIST is set to the final prefix command's list of | |
462 | *sub-commands. | |
463 | ||
464 | START_LIST is the list in which the search starts. | |
465 | ||
466 | This function returns the xmalloc()d name of the new command. | |
467 | On error a Scheme exception is thrown. */ | |
468 | ||
469 | char * | |
470 | gdbscm_parse_command_name (const char *name, | |
471 | const char *func_name, int arg_pos, | |
472 | struct cmd_list_element ***base_list, | |
473 | struct cmd_list_element **start_list) | |
474 | { | |
475 | struct cmd_list_element *elt; | |
476 | int len = strlen (name); | |
477 | int i, lastchar; | |
8579fd13 | 478 | char *msg; |
e698b8c4 DE |
479 | |
480 | /* Skip trailing whitespace. */ | |
481 | for (i = len - 1; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i) | |
482 | ; | |
483 | if (i < 0) | |
484 | { | |
485 | gdbscm_out_of_range_error (func_name, arg_pos, | |
486 | gdbscm_scm_from_c_string (name), | |
487 | _("no command name found")); | |
488 | } | |
489 | lastchar = i; | |
490 | ||
491 | /* Find first character of the final word. */ | |
be09caf1 | 492 | for (; i > 0 && valid_cmd_char_p (name[i - 1]); --i) |
e698b8c4 | 493 | ; |
8579fd13 AB |
494 | gdb::unique_xmalloc_ptr<char> result ((char *) xmalloc (lastchar - i + 2)); |
495 | memcpy (result.get (), &name[i], lastchar - i + 1); | |
496 | result.get ()[lastchar - i + 1] = '\0'; | |
e698b8c4 DE |
497 | |
498 | /* Skip whitespace again. */ | |
499 | for (--i; i >= 0 && (name[i] == ' ' || name[i] == '\t'); --i) | |
500 | ; | |
501 | if (i < 0) | |
502 | { | |
503 | *base_list = start_list; | |
8579fd13 | 504 | return result.release (); |
e698b8c4 DE |
505 | } |
506 | ||
8579fd13 AB |
507 | gdb::unique_xmalloc_ptr<char> prefix_text ((char *) xmalloc (i + 2)); |
508 | memcpy (prefix_text.get (), name, i + 1); | |
509 | prefix_text.get ()[i + 1] = '\0'; | |
e698b8c4 | 510 | |
8579fd13 | 511 | const char *prefix_text2 = prefix_text.get (); |
cf00cd6f | 512 | elt = lookup_cmd_1 (&prefix_text2, *start_list, NULL, NULL, 1); |
d81412aa | 513 | if (elt == NULL || elt == CMD_LIST_AMBIGUOUS) |
e698b8c4 | 514 | { |
8579fd13 AB |
515 | msg = xstrprintf (_("could not find command prefix '%s'"), |
516 | prefix_text.get ()).release (); | |
c6486df5 | 517 | scm_dynwind_begin ((scm_t_dynwind_flags) 0); |
e698b8c4 DE |
518 | gdbscm_dynwind_xfree (msg); |
519 | gdbscm_out_of_range_error (func_name, arg_pos, | |
520 | gdbscm_scm_from_c_string (name), msg); | |
521 | } | |
522 | ||
3d0b3564 | 523 | if (elt->is_prefix ()) |
e698b8c4 | 524 | { |
14b42fc4 | 525 | *base_list = elt->subcommands; |
8579fd13 | 526 | return result.release (); |
e698b8c4 DE |
527 | } |
528 | ||
8579fd13 AB |
529 | msg = xstrprintf (_("'%s' is not a prefix command"), |
530 | prefix_text.get ()).release (); | |
c6486df5 | 531 | scm_dynwind_begin ((scm_t_dynwind_flags) 0); |
e698b8c4 DE |
532 | gdbscm_dynwind_xfree (msg); |
533 | gdbscm_out_of_range_error (func_name, arg_pos, | |
534 | gdbscm_scm_from_c_string (name), msg); | |
535 | /* NOTREACHED */ | |
536 | } | |
537 | ||
538 | static const scheme_integer_constant command_classes[] = | |
539 | { | |
540 | /* Note: alias and user are special; pseudo appears to be unused, | |
4f45d445 | 541 | and there is no reason to expose tui, I think. */ |
e698b8c4 DE |
542 | { "COMMAND_NONE", no_class }, |
543 | { "COMMAND_RUNNING", class_run }, | |
544 | { "COMMAND_DATA", class_vars }, | |
545 | { "COMMAND_STACK", class_stack }, | |
546 | { "COMMAND_FILES", class_files }, | |
547 | { "COMMAND_SUPPORT", class_support }, | |
548 | { "COMMAND_STATUS", class_info }, | |
549 | { "COMMAND_BREAKPOINTS", class_breakpoint }, | |
550 | { "COMMAND_TRACEPOINTS", class_trace }, | |
551 | { "COMMAND_OBSCURE", class_obscure }, | |
552 | { "COMMAND_MAINTENANCE", class_maintenance }, | |
553 | { "COMMAND_USER", class_user }, | |
554 | ||
555 | END_INTEGER_CONSTANTS | |
556 | }; | |
557 | ||
558 | /* Return non-zero if command_class is a valid command class. */ | |
559 | ||
560 | int | |
561 | gdbscm_valid_command_class_p (int command_class) | |
562 | { | |
563 | int i; | |
564 | ||
565 | for (i = 0; command_classes[i].name != NULL; ++i) | |
566 | { | |
567 | if (command_classes[i].value == command_class) | |
568 | return 1; | |
569 | } | |
570 | ||
571 | return 0; | |
572 | } | |
573 | ||
574 | /* Return a normalized form of command NAME. | |
575 | That is tabs are replaced with spaces and multiple spaces are replaced | |
576 | with a single space. | |
577 | If WANT_TRAILING_SPACE is non-zero, add one space at the end. This is for | |
578 | prefix commands. | |
579 | but that is the caller's responsibility. | |
580 | Space for the result is allocated on the GC heap. */ | |
581 | ||
06eb1586 DE |
582 | char * |
583 | gdbscm_canonicalize_command_name (const char *name, int want_trailing_space) | |
e698b8c4 DE |
584 | { |
585 | int i, out, seen_word; | |
224c3ddb SM |
586 | char *result |
587 | = (char *) scm_gc_malloc_pointerless (strlen (name) + 2, FUNC_NAME); | |
e698b8c4 DE |
588 | |
589 | i = out = seen_word = 0; | |
590 | while (name[i]) | |
591 | { | |
592 | /* Skip whitespace. */ | |
593 | while (name[i] == ' ' || name[i] == '\t') | |
594 | ++i; | |
595 | /* Copy non-whitespace characters. */ | |
596 | if (name[i]) | |
597 | { | |
598 | if (seen_word) | |
599 | result[out++] = ' '; | |
600 | while (name[i] && name[i] != ' ' && name[i] != '\t') | |
601 | result[out++] = name[i++]; | |
602 | seen_word = 1; | |
603 | } | |
604 | } | |
605 | if (want_trailing_space) | |
606 | result[out++] = ' '; | |
607 | result[out] = '\0'; | |
608 | ||
609 | return result; | |
610 | } | |
611 | ||
612 | /* (make-command name [#:invoke lambda] | |
613 | [#:command-class class] [#:completer-class completer] | |
614 | [#:prefix? <bool>] [#:doc <string>]) -> <gdb:command> | |
615 | ||
616 | NAME is the name of the command. It may consist of multiple words, | |
617 | in which case the final word is the name of the new command, and | |
618 | earlier words must be prefix commands. | |
619 | ||
620 | INVOKE is a procedure of three arguments that performs the command when | |
621 | invoked: (lambda (self arg from-tty) ...). | |
622 | Its result is unspecified. | |
623 | ||
624 | CLASS is the kind of command. It must be one of the COMMAND_* | |
625 | constants defined in the gdb module. If not specified, "no_class" is used. | |
626 | ||
627 | COMPLETER is the kind of completer. It must be either: | |
628 | #f - completion is not supported for this command. | |
629 | One of the COMPLETE_* constants defined in the gdb module. | |
630 | A procedure of three arguments: (lambda (self text word) ...). | |
631 | Its result is one of: | |
dda83cd7 SM |
632 | A list of strings. |
633 | A <gdb:iterator> object that returns the set of possible completions, | |
634 | ending with #f. | |
e698b8c4 DE |
635 | TODO(dje): Once PR 16699 is fixed, add support for returning |
636 | a COMPLETE_* constant. | |
637 | If not specified, then completion is not supported for this command. | |
638 | ||
639 | If PREFIX is #t, then this command is a prefix command. | |
640 | ||
641 | DOC is the doc string for the command. | |
642 | ||
643 | The result is the <gdb:command> Scheme object. | |
644 | The command is not available to be used yet, however. | |
645 | It must still be added to gdb with register-command!. */ | |
646 | ||
647 | static SCM | |
648 | gdbscm_make_command (SCM name_scm, SCM rest) | |
649 | { | |
650 | const SCM keywords[] = { | |
651 | invoke_keyword, command_class_keyword, completer_class_keyword, | |
652 | prefix_p_keyword, doc_keyword, SCM_BOOL_F | |
653 | }; | |
654 | int invoke_arg_pos = -1, command_class_arg_pos = 1; | |
655 | int completer_class_arg_pos = -1, is_prefix_arg_pos = -1; | |
656 | int doc_arg_pos = -1; | |
657 | char *s; | |
658 | char *name; | |
f486487f | 659 | enum command_class command_class = no_class; |
e698b8c4 DE |
660 | SCM completer_class = SCM_BOOL_F; |
661 | int is_prefix = 0; | |
662 | char *doc = NULL; | |
663 | SCM invoke = SCM_BOOL_F; | |
664 | SCM c_scm; | |
665 | command_smob *c_smob; | |
666 | ||
667 | gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#OiOts", | |
668 | name_scm, &name, rest, | |
669 | &invoke_arg_pos, &invoke, | |
670 | &command_class_arg_pos, &command_class, | |
671 | &completer_class_arg_pos, &completer_class, | |
672 | &is_prefix_arg_pos, &is_prefix, | |
673 | &doc_arg_pos, &doc); | |
674 | ||
675 | if (doc == NULL) | |
676 | doc = xstrdup (_("This command is not documented.")); | |
677 | ||
678 | s = name; | |
06eb1586 | 679 | name = gdbscm_canonicalize_command_name (s, is_prefix); |
e698b8c4 DE |
680 | xfree (s); |
681 | s = doc; | |
682 | doc = gdbscm_gc_xstrdup (s); | |
683 | xfree (s); | |
684 | ||
685 | if (is_prefix | |
686 | ? name[0] == ' ' | |
687 | : name[0] == '\0') | |
688 | { | |
689 | gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, name_scm, | |
690 | _("no command name found")); | |
691 | } | |
692 | ||
693 | if (gdbscm_is_true (invoke)) | |
694 | { | |
695 | SCM_ASSERT_TYPE (gdbscm_is_procedure (invoke), invoke, | |
696 | invoke_arg_pos, FUNC_NAME, _("procedure")); | |
697 | } | |
698 | ||
699 | if (!gdbscm_valid_command_class_p (command_class)) | |
700 | { | |
701 | gdbscm_out_of_range_error (FUNC_NAME, command_class_arg_pos, | |
702 | scm_from_int (command_class), | |
703 | _("invalid command class argument")); | |
704 | } | |
705 | ||
706 | SCM_ASSERT_TYPE (gdbscm_is_false (completer_class) | |
707 | || scm_is_integer (completer_class) | |
708 | || gdbscm_is_procedure (completer_class), | |
709 | completer_class, completer_class_arg_pos, FUNC_NAME, | |
710 | _("integer or procedure")); | |
711 | if (scm_is_integer (completer_class) | |
712 | && !scm_is_signed_integer (completer_class, 0, N_COMPLETERS - 1)) | |
713 | { | |
714 | gdbscm_out_of_range_error (FUNC_NAME, completer_class_arg_pos, | |
715 | completer_class, | |
716 | _("invalid completion type argument")); | |
717 | } | |
718 | ||
719 | c_scm = cmdscm_make_command_smob (); | |
720 | c_smob = (command_smob *) SCM_SMOB_DATA (c_scm); | |
721 | c_smob->name = name; | |
722 | c_smob->is_prefix = is_prefix; | |
723 | c_smob->cmd_class = command_class; | |
724 | c_smob->doc = doc; | |
725 | c_smob->invoke = invoke; | |
726 | c_smob->complete = completer_class; | |
727 | ||
728 | return c_scm; | |
729 | } | |
730 | ||
731 | /* (register-command! <gdb:command>) -> unspecified | |
732 | ||
733 | It is an error to register a command more than once. */ | |
734 | ||
735 | static SCM | |
736 | gdbscm_register_command_x (SCM self) | |
737 | { | |
738 | command_smob *c_smob | |
739 | = cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
798a7429 | 740 | char *cmd_name; |
e698b8c4 DE |
741 | struct cmd_list_element **cmd_list; |
742 | struct cmd_list_element *cmd = NULL; | |
e698b8c4 DE |
743 | |
744 | if (cmdscm_is_valid (c_smob)) | |
745 | scm_misc_error (FUNC_NAME, _("command is already registered"), SCM_EOL); | |
746 | ||
747 | cmd_name = gdbscm_parse_command_name (c_smob->name, FUNC_NAME, SCM_ARG1, | |
748 | &cmd_list, &cmdlist); | |
749 | c_smob->cmd_name = gdbscm_gc_xstrdup (cmd_name); | |
750 | xfree (cmd_name); | |
751 | ||
680d7fd5 | 752 | gdbscm_gdb_exception exc {}; |
a70b8144 | 753 | try |
e698b8c4 DE |
754 | { |
755 | if (c_smob->is_prefix) | |
756 | { | |
757 | /* If we have our own "invoke" method, then allow unknown | |
758 | sub-commands. */ | |
759 | int allow_unknown = gdbscm_is_true (c_smob->invoke); | |
760 | ||
761 | cmd = add_prefix_cmd (c_smob->cmd_name, c_smob->cmd_class, | |
762 | NULL, c_smob->doc, &c_smob->sub_list, | |
2f822da5 | 763 | allow_unknown, cmd_list); |
e698b8c4 DE |
764 | } |
765 | else | |
766 | { | |
767 | cmd = add_cmd (c_smob->cmd_name, c_smob->cmd_class, | |
0450cc4c | 768 | c_smob->doc, cmd_list); |
e698b8c4 DE |
769 | } |
770 | } | |
230d2906 | 771 | catch (const gdb_exception &except) |
492d29ea | 772 | { |
680d7fd5 | 773 | exc = unpack (except); |
492d29ea | 774 | } |
680d7fd5 | 775 | GDBSCM_HANDLE_GDB_EXCEPTION (exc); |
e698b8c4 DE |
776 | |
777 | /* Note: At this point the command exists in gdb. | |
778 | So no more errors after this point. */ | |
779 | ||
780 | /* There appears to be no API to set this. */ | |
781 | cmd->func = cmdscm_function; | |
782 | cmd->destroyer = cmdscm_destroyer; | |
783 | ||
784 | c_smob->command = cmd; | |
0f8e2034 | 785 | cmd->set_context (c_smob); |
e698b8c4 DE |
786 | |
787 | if (gdbscm_is_true (c_smob->complete)) | |
788 | { | |
789 | set_cmd_completer (cmd, | |
790 | scm_is_integer (c_smob->complete) | |
791 | ? cmdscm_completers[scm_to_int (c_smob->complete)].completer | |
792 | : cmdscm_completer); | |
793 | } | |
794 | ||
795 | /* The owner of this command is not in GC-controlled memory, so we need | |
796 | to protect it from GC until the command is deleted. */ | |
797 | scm_gc_protect_object (c_smob->containing_scm); | |
798 | ||
799 | return SCM_UNSPECIFIED; | |
800 | } | |
801 | \f | |
802 | /* Initialize the Scheme command support. */ | |
803 | ||
804 | static const scheme_function command_functions[] = | |
805 | { | |
72e02483 | 806 | { "make-command", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_command), |
e698b8c4 DE |
807 | "\ |
808 | Make a GDB command object.\n\ | |
809 | \n\ | |
810 | Arguments: name [#:invoke lambda]\n\ | |
811 | [#:command-class <class>] [#:completer-class <completer>]\n\ | |
812 | [#:prefix? <bool>] [#:doc string]\n\ | |
813 | name: The name of the command. It may consist of multiple words,\n\ | |
814 | in which case the final word is the name of the new command, and\n\ | |
815 | earlier words must be prefix commands.\n\ | |
816 | invoke: A procedure of three arguments to perform the command.\n\ | |
817 | (lambda (self arg from-tty) ...)\n\ | |
818 | Its result is unspecified.\n\ | |
819 | class: The class of the command, one of COMMAND_*.\n\ | |
820 | The default is COMMAND_NONE.\n\ | |
821 | completer: The kind of completer, #f, one of COMPLETE_*, or a procedure\n\ | |
822 | to perform the completion: (lambda (self text word) ...).\n\ | |
823 | prefix?: If true then the command is a prefix command.\n\ | |
824 | doc: The \"doc string\" of the command.\n\ | |
825 | Returns: <gdb:command> object" }, | |
826 | ||
72e02483 | 827 | { "register-command!", 1, 0, 0, as_a_scm_t_subr (gdbscm_register_command_x), |
e698b8c4 DE |
828 | "\ |
829 | Register a <gdb:command> object with GDB." }, | |
830 | ||
72e02483 | 831 | { "command?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_p), |
e698b8c4 DE |
832 | "\ |
833 | Return #t if the object is a <gdb:command> object." }, | |
834 | ||
72e02483 | 835 | { "command-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_command_valid_p), |
e698b8c4 DE |
836 | "\ |
837 | Return #t if the <gdb:command> object is valid." }, | |
838 | ||
72e02483 | 839 | { "dont-repeat", 1, 0, 0, as_a_scm_t_subr (gdbscm_dont_repeat), |
e698b8c4 DE |
840 | "\ |
841 | Prevent command repetition when user enters an empty line.\n\ | |
842 | \n\ | |
843 | Arguments: <gdb:command>\n\ | |
844 | Returns: unspecified" }, | |
845 | ||
846 | END_FUNCTIONS | |
847 | }; | |
848 | ||
849 | /* Initialize the 'commands' code. */ | |
850 | ||
851 | void | |
852 | gdbscm_initialize_commands (void) | |
853 | { | |
854 | int i; | |
855 | ||
856 | command_smob_tag | |
857 | = gdbscm_make_smob_type (command_smob_name, sizeof (command_smob)); | |
858 | scm_set_smob_print (command_smob_tag, cmdscm_print_command_smob); | |
859 | ||
860 | gdbscm_define_integer_constants (command_classes, 1); | |
861 | gdbscm_define_functions (command_functions, 1); | |
862 | ||
863 | for (i = 0; i < N_COMPLETERS; ++i) | |
864 | { | |
865 | scm_c_define (cmdscm_completers[i].name, scm_from_int (i)); | |
866 | scm_c_export (cmdscm_completers[i].name, NULL); | |
867 | } | |
868 | ||
869 | invoke_keyword = scm_from_latin1_keyword ("invoke"); | |
870 | command_class_keyword = scm_from_latin1_keyword ("command-class"); | |
871 | completer_class_keyword = scm_from_latin1_keyword ("completer-class"); | |
872 | prefix_p_keyword = scm_from_latin1_keyword ("prefix?"); | |
873 | doc_keyword = scm_from_latin1_keyword ("doc"); | |
874 | } |