|
1
|
1 // t-builtins.cc -*- C++ -*- |
|
|
2 /* |
|
|
3 |
|
|
4 Copyright (C) 1992, 1993 John W. Eaton |
|
|
5 |
|
|
6 This file is part of Octave. |
|
|
7 |
|
|
8 Octave is free software; you can redistribute it and/or modify it |
|
|
9 under the terms of the GNU General Public License as published by the |
|
|
10 Free Software Foundation; either version 2, or (at your option) any |
|
|
11 later version. |
|
|
12 |
|
|
13 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
|
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
|
16 for more details. |
|
|
17 |
|
|
18 You should have received a copy of the GNU General Public License |
|
|
19 along with Octave; see the file COPYING. If not, write to the Free |
|
|
20 Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
21 |
|
|
22 */ |
|
|
23 |
|
|
24 /* |
|
|
25 |
|
|
26 The function builtin_cd was adapted from a similar function from GNU |
|
|
27 Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free |
|
|
28 Software Foundation, Inc. |
|
|
29 |
|
|
30 The function list_in_columns was adapted from a similar function from |
|
|
31 GNU ls, print_many_per_line, copyright (C) 1985, 1988, 1990, 1991 Free |
|
|
32 Software Foundation, Inc. |
|
|
33 |
|
|
34 */ |
|
|
35 |
|
|
36 #ifdef __GNUG__ |
|
|
37 #pragma implementation |
|
|
38 #endif |
|
|
39 |
|
|
40 #include <sys/types.h> |
|
|
41 #ifdef HAVE_UNISTD_H |
|
|
42 #include <unistd.h> |
|
|
43 #endif |
|
|
44 #include <iostream.h> |
|
|
45 #include <strstream.h> |
|
|
46 #include <fstream.h> |
|
|
47 #include <stdio.h> |
|
|
48 #include <fcntl.h> |
|
|
49 #include <sys/file.h> |
|
|
50 #include <sys/stat.h> |
|
|
51 #include <time.h> |
|
|
52 #include <errno.h> |
|
|
53 |
|
|
54 #include "procstream.h" |
|
|
55 |
|
|
56 #include "variables.h" |
|
|
57 #include "symtab.h" |
|
|
58 #include "error.h" |
|
|
59 #include "input.h" |
|
|
60 #include "pager.h" |
|
|
61 #include "utils.h" |
|
|
62 #include "builtins.h" |
|
|
63 #include "t-builtins.h" |
|
|
64 #include "octave.h" |
|
|
65 #include "octave-hist.h" |
|
|
66 #include "user-prefs.h" |
|
|
67 #include "pr-output.h" |
|
|
68 #include "tree.h" |
|
|
69 #include "help.h" |
|
|
70 |
|
|
71 // May need replacement for this on some machines. |
|
|
72 extern "C" |
|
|
73 { |
|
|
74 extern char *strerror (int); |
|
|
75 char *tilde_expand (char *s); /* From readline's tilde.c */ |
|
|
76 } |
|
|
77 |
|
|
78 extern int symbol_out_of_date (symbol_record *s); |
|
|
79 |
|
|
80 // Is this a parametric plot? Makes a difference for 3D plotting. |
|
|
81 extern int parametric_plot; |
|
|
82 |
|
|
83 /* |
|
|
84 * Format a list in neat columns. Mostly stolen from GNU ls. This |
|
|
85 * should maybe be in utils.cc. |
|
|
86 */ |
|
|
87 static ostrstream& |
|
|
88 list_in_columns (ostrstream& os, char **list) |
|
|
89 { |
|
|
90 // Compute the maximum name length. |
|
|
91 |
|
|
92 int max_name_length = 0; |
|
|
93 int total_names = 0; |
|
|
94 for (char **names = list; *names != (char *) NULL; names++) |
|
|
95 { |
|
|
96 total_names++; |
|
|
97 int name_length = strlen (*names); |
|
|
98 if (name_length > max_name_length) |
|
|
99 max_name_length = name_length; |
|
|
100 } |
|
|
101 |
|
|
102 // Allow at least two spaces between names. |
|
|
103 |
|
|
104 max_name_length += 2; |
|
|
105 |
|
|
106 // Calculate the maximum number of columns that will fit. |
|
|
107 |
|
|
108 int line_length = terminal_columns (); |
|
|
109 int cols = line_length / max_name_length; |
|
|
110 if (cols == 0) |
|
|
111 cols = 1; |
|
|
112 |
|
|
113 // Calculate the number of rows that will be in each column except |
|
|
114 // possibly for a short column on the right. |
|
|
115 |
|
|
116 int rows = total_names / cols + (total_names % cols != 0); |
|
|
117 |
|
|
118 // Recalculate columns based on rows. |
|
|
119 |
|
|
120 cols = total_names / rows + (total_names % rows != 0); |
|
|
121 |
|
|
122 names = list; |
|
|
123 int count; |
|
|
124 for (int row = 0; row < rows; row++) |
|
|
125 { |
|
|
126 count = row; |
|
|
127 int pos = 0; |
|
|
128 |
|
|
129 // Print the next row. |
|
|
130 |
|
|
131 while (1) |
|
|
132 { |
|
|
133 os << *(names + count); |
|
|
134 int name_length = strlen (*(names + count)); |
|
|
135 |
|
|
136 count += rows; |
|
|
137 if (count >= total_names) |
|
|
138 break; |
|
|
139 |
|
|
140 int spaces_to_pad = max_name_length - name_length; |
|
|
141 for (int i = 0; i < spaces_to_pad; i++) |
|
|
142 os << " "; |
|
|
143 pos += max_name_length; |
|
|
144 } |
|
|
145 os << "\n"; |
|
|
146 } |
|
|
147 |
|
|
148 return os; |
|
|
149 } |
|
|
150 |
|
|
151 tree_constant |
|
|
152 builtin_casesen (int argc, char **argv) |
|
|
153 { |
|
|
154 tree_constant retval; |
|
|
155 |
|
|
156 if (argc == 1 || (argc > 1 && strcmp (argv[1], "off") == 0)) |
|
|
157 message ("casesen", "sorry, octave is always case sensitive"); |
|
|
158 else if (argc > 1 && strcmp (argv[1], "on") == 0) |
|
|
159 ; // ok. |
|
|
160 else |
|
|
161 usage ("casesen [on|off]"); |
|
|
162 |
|
|
163 return retval; |
|
|
164 } |
|
|
165 |
|
|
166 /* |
|
|
167 * Change current working directory. |
|
|
168 */ |
|
|
169 tree_constant |
|
|
170 builtin_cd (int argc, char **argv) |
|
|
171 { |
|
|
172 tree_constant retval; |
|
|
173 |
|
|
174 if (argc > 1) |
|
|
175 { |
|
|
176 static char *dirname = (char *) NULL; |
|
|
177 |
|
|
178 if (dirname) |
|
|
179 free (dirname); |
|
|
180 |
|
|
181 dirname = tilde_expand (argv[1]); |
|
|
182 |
|
|
183 if (dirname != (char *) NULL && !change_to_directory (dirname)) |
|
|
184 { |
|
|
185 error ("%s: %s", dirname, strerror (errno)); |
|
|
186 return retval; |
|
|
187 } |
|
|
188 } |
|
|
189 else |
|
|
190 { |
|
|
191 if (!home_directory) |
|
|
192 return retval; |
|
|
193 |
|
|
194 if (!change_to_directory (home_directory)) |
|
|
195 { |
|
|
196 error ("%s: %s", home_directory, strerror (errno)); |
|
|
197 return retval; |
|
|
198 } |
|
|
199 } |
|
|
200 |
|
|
201 |
|
|
202 char *directory = get_working_directory ("cd"); |
|
|
203 tree_constant *dir = new tree_constant (directory); |
|
|
204 bind_protected_variable ("PWD", dir); |
|
|
205 |
|
|
206 return retval; |
|
|
207 } |
|
|
208 |
|
|
209 /* |
|
|
210 * Wipe out user-defined variables and functions. |
|
|
211 */ |
|
|
212 tree_constant |
|
|
213 builtin_clear (int argc, char **argv) |
|
|
214 { |
|
|
215 tree_constant retval; |
|
|
216 if (argc == 1) |
|
|
217 { |
|
|
218 curr_sym_tab->clear (); |
|
|
219 global_sym_tab->clear (); |
|
|
220 } |
|
|
221 else |
|
|
222 { |
|
|
223 while (--argc > 0) |
|
|
224 { |
|
|
225 argv++; |
|
|
226 if (*argv != (char *) NULL && ! curr_sym_tab->clear (*argv)) |
|
|
227 global_sym_tab->clear (*argv); |
|
|
228 } |
|
|
229 } |
|
|
230 return retval; |
|
|
231 } |
|
|
232 |
|
|
233 /* |
|
|
234 * Associate a cryptic message with a variable name. |
|
|
235 */ |
|
|
236 tree_constant |
|
|
237 builtin_document (int argc, char **argv) |
|
|
238 { |
|
|
239 tree_constant retval; |
|
|
240 if (argc == 3) |
|
|
241 { |
|
|
242 symbol_record *sym_rec = curr_sym_tab->lookup (argv[1], 0); |
|
|
243 if (sym_rec == (symbol_record *) NULL) |
|
|
244 { |
|
|
245 sym_rec = global_sym_tab->lookup (argv[1], 0); |
|
|
246 if (sym_rec == (symbol_record *) NULL) |
|
|
247 { |
|
|
248 error ("document: no such symbol `%s'", argv[1]); |
|
|
249 return retval; |
|
|
250 } |
|
|
251 } |
|
|
252 sym_rec->document (argv[2]); |
|
|
253 } |
|
|
254 else |
|
|
255 usage ("document symbol string ..."); |
|
|
256 |
|
|
257 return retval; |
|
|
258 } |
|
|
259 |
|
|
260 /* |
|
|
261 * Edit commands with your favorite editor. |
|
|
262 */ |
|
|
263 tree_constant |
|
|
264 builtin_edit_history (int argc, char **argv) |
|
|
265 { |
|
|
266 tree_constant retval; |
|
|
267 do_edit_history (argc, argv); |
|
|
268 return retval; |
|
|
269 } |
|
|
270 |
|
|
271 /* |
|
|
272 * Set output format state. |
|
|
273 */ |
|
|
274 tree_constant |
|
|
275 builtin_format (int argc, char **argv) |
|
|
276 { |
|
|
277 tree_constant retval; |
|
|
278 set_format_style (argc, argv); |
|
|
279 return retval; |
|
|
280 } |
|
|
281 |
|
|
282 /* |
|
|
283 * Print cryptic yet witty messages. |
|
|
284 */ |
|
|
285 tree_constant |
|
|
286 builtin_help (int argc, char **argv) |
|
|
287 { |
|
|
288 tree_constant retval; |
|
|
289 |
|
|
290 ostrstream output_buf; |
|
|
291 if (argc == 1) |
|
|
292 { |
|
|
293 char **symbols; |
|
|
294 int count = 0; |
|
|
295 |
|
|
296 symbols = names (operator_help (), count); |
|
|
297 output_buf << "\n*** operators:\n\n"; |
|
|
298 if (symbols != (char **) NULL && count > 0) |
|
|
299 list_in_columns (output_buf, symbols); |
|
|
300 delete [] symbols; |
|
|
301 |
|
|
302 symbols = names (keyword_help (), count); |
|
|
303 output_buf << "\n*** reserved words:\n\n"; |
|
|
304 if (symbols != (char **) NULL && count > 0) |
|
|
305 list_in_columns (output_buf, symbols); |
|
|
306 delete [] symbols; |
|
|
307 |
|
|
308 symbols = names (builtin_text_functions_help (), count); |
|
|
309 output_buf |
|
|
310 << "\n*** text functions (these names are also reserved):\n\n"; |
|
|
311 if (symbols != (char **) NULL && count > 0) |
|
|
312 list_in_columns (output_buf, symbols); |
|
|
313 delete [] symbols; |
|
|
314 |
|
|
315 symbols = names (builtin_mapper_functions_help (), count); |
|
|
316 output_buf << "\n*** mapper functions:\n\n"; |
|
|
317 if (symbols != (char **) NULL && count > 0) |
|
|
318 list_in_columns (output_buf, symbols); |
|
|
319 delete [] symbols; |
|
|
320 |
|
|
321 symbols = names (builtin_general_functions_help (), count); |
|
|
322 output_buf << "\n*** general functions:\n\n"; |
|
|
323 if (symbols != (char **) NULL && count > 0) |
|
|
324 list_in_columns (output_buf, symbols); |
|
|
325 delete [] symbols; |
|
|
326 |
|
|
327 symbols = names (builtin_variables_help (), count); |
|
|
328 output_buf << "\n*** builtin variables:\n\n"; |
|
|
329 if (symbols != (char **) NULL && count > 0) |
|
|
330 list_in_columns (output_buf, symbols); |
|
|
331 delete [] symbols; |
|
|
332 |
|
|
333 // Also need to list variables and currently compiled functions from |
|
|
334 // the symbol table, if there are any. |
|
|
335 |
|
|
336 // Also need to search octave_path for script files. |
|
|
337 |
|
|
338 char **path = pathstring_to_vector (user_pref.loadpath); |
|
|
339 |
|
|
340 char **ptr = path; |
|
|
341 if (ptr != (char **) NULL) |
|
|
342 { |
|
|
343 while (*ptr != (char *) NULL) |
|
|
344 { |
|
|
345 int count; |
|
|
346 char **names = get_m_file_names (count, *ptr, 0); |
|
|
347 output_buf << "\n*** M-files in " |
|
|
348 << make_absolute (*ptr, the_current_working_directory) |
|
|
349 << ":\n\n"; |
|
|
350 if (names != (char **) NULL && count > 0) |
|
|
351 list_in_columns (output_buf, names); |
|
|
352 delete [] names; |
|
|
353 ptr++; |
|
|
354 } |
|
|
355 } |
|
|
356 } |
|
|
357 else |
|
|
358 { |
|
|
359 symbol_record *sym_rec; |
|
|
360 help_list *op_help_list = operator_help (); |
|
|
361 help_list *kw_help_list = keyword_help (); |
|
|
362 for (int i = 1; i < argc; i++) |
|
|
363 { |
|
|
364 if (argv[i] == (char *) NULL || argv[i][0] == '\0') |
|
|
365 continue; |
|
|
366 |
|
|
367 int j = 0; |
|
|
368 char *name; |
|
|
369 while ((name = op_help_list[j].name) != (char *) NULL) |
|
|
370 { |
|
|
371 if (strcmp (name, argv[i]) == 0) |
|
|
372 { |
|
|
373 output_buf << "\n" << op_help_list[j].help << "\n"; |
|
|
374 goto next; |
|
|
375 } |
|
|
376 j++; |
|
|
377 } |
|
|
378 |
|
|
379 j = 0; |
|
|
380 while ((name = kw_help_list[j].name) != (char *) NULL) |
|
|
381 { |
|
|
382 if (strcmp (name, argv[i]) == 0) |
|
|
383 { |
|
|
384 output_buf << "\n" << kw_help_list[j].help << "\n"; |
|
|
385 goto next; |
|
|
386 } |
|
|
387 j++; |
|
|
388 } |
|
|
389 |
|
|
390 sym_rec = curr_sym_tab->lookup (argv[i], 0, 0); |
|
|
391 if (sym_rec != (symbol_record *) NULL) |
|
|
392 { |
|
|
393 char *h = sym_rec->help (); |
|
|
394 if (h != (char *) NULL && *h != '\0') |
|
|
395 { |
|
|
396 output_buf << "\n" << h << "\n"; |
|
|
397 goto next; |
|
|
398 } |
|
|
399 } |
|
|
400 |
|
|
401 sym_rec = global_sym_tab->lookup (argv[i], 0, 0); |
|
|
402 if (sym_rec != (symbol_record *) NULL |
|
|
403 && ! symbol_out_of_date (sym_rec)) |
|
|
404 { |
|
|
405 char *h = sym_rec->help (); |
|
|
406 if (h != (char *) NULL && *h != '\0') |
|
|
407 { |
|
|
408 output_buf << "\n" << h << "\n"; |
|
|
409 goto next; |
|
|
410 } |
|
|
411 } |
|
|
412 |
|
|
413 // Try harder to find M-files that might not be defined yet, or that |
|
|
414 // appear to be out of date. Don\'t execute commands from the file if |
|
|
415 // it turns out to be a script file. |
|
|
416 |
|
|
417 sym_rec = global_sym_tab->lookup (argv[i], 1, 0); |
|
|
418 if (sym_rec != (symbol_record *) NULL) |
|
|
419 { |
|
|
420 tree_identifier tmp (sym_rec); |
|
|
421 tmp.parse_m_file (0); |
|
|
422 char *h = sym_rec->help (); |
|
|
423 if (h != (char *) NULL && *h != '\0') |
|
|
424 { |
|
|
425 output_buf << "\n" << h << "\n"; |
|
|
426 goto next; |
|
|
427 } |
|
|
428 } |
|
|
429 else |
|
|
430 global_sym_tab->clear (argv[i]); |
|
|
431 |
|
|
432 output_buf << "Sorry, `" << argv[i] << "' is not documented\n"; |
|
|
433 |
|
|
434 next: |
|
|
435 continue; |
|
|
436 } |
|
|
437 } |
|
|
438 |
|
|
439 output_buf << ends; |
|
|
440 maybe_page_output (output_buf); |
|
|
441 |
|
|
442 return retval; |
|
|
443 } |
|
|
444 |
|
|
445 /* |
|
|
446 * Display, save, or load history. |
|
|
447 */ |
|
|
448 tree_constant |
|
|
449 builtin_history (int argc, char **argv) |
|
|
450 { |
|
|
451 tree_constant retval; |
|
|
452 |
|
|
453 do_history (argc, argv); |
|
|
454 |
|
|
455 return retval; |
|
|
456 } |
|
|
457 |
|
|
458 static int |
|
|
459 load_variable (char *nm, int force, istream& is) |
|
|
460 { |
|
|
461 symbol_record *gsr = global_sym_tab->lookup (nm, 0, 0); |
|
|
462 symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0); |
|
|
463 |
|
|
464 if (! force |
|
|
465 && ((gsr != (symbol_record *) NULL && gsr->is_variable ()) |
|
|
466 || lsr != (symbol_record *) NULL)) |
|
|
467 { |
|
|
468 message ("load", |
|
|
469 "variable name `%s' exists -- use `load -force' to overwrite", nm); |
|
|
470 return -1; |
|
|
471 } |
|
|
472 |
|
|
473 // We found it. Read data for this entry, and if that succeeds, |
|
|
474 // insert it into symbol table. |
|
|
475 |
|
|
476 tree_constant tc; |
|
|
477 int global = tc.load (is); |
|
|
478 if (tc.const_type () != tree_constant_rep::unknown_constant) |
|
|
479 { |
|
|
480 symbol_record *sr; |
|
|
481 if (global) |
|
|
482 { |
|
|
483 if (lsr != (symbol_record *) NULL) |
|
|
484 { |
|
|
485 warning ("load: replacing local symbol `%s' with global\ |
|
|
486 value from file", nm); |
|
|
487 curr_sym_tab->clear (nm); |
|
|
488 } |
|
|
489 sr = global_sym_tab->lookup (nm, 1, 0); |
|
|
490 } |
|
|
491 else |
|
|
492 { |
|
|
493 if (gsr != (symbol_record *) NULL) |
|
|
494 { |
|
|
495 warning ("loading `%s' as a global variable", nm); |
|
|
496 sr = gsr; |
|
|
497 } |
|
|
498 else |
|
|
499 sr = curr_sym_tab->lookup (nm, 1, 0); |
|
|
500 } |
|
|
501 |
|
|
502 if (sr != (symbol_record *) NULL) |
|
|
503 { |
|
|
504 tree_constant *tmp_tc = new tree_constant (tc); |
|
|
505 sr->define (tmp_tc); |
|
|
506 return 1; |
|
|
507 } |
|
|
508 else |
|
|
509 error ("load: unable to load variable `%s'", nm); |
|
|
510 } |
|
|
511 |
|
|
512 return 0; |
|
|
513 } |
|
|
514 |
|
|
515 /* |
|
|
516 * Read variables from an input stream. |
|
|
517 * |
|
|
518 * BUGS: |
|
|
519 * |
|
|
520 * -- This function is not terribly robust. |
|
|
521 * -- Symbols are only inserted into the current symbol table. |
|
|
522 */ |
|
|
523 tree_constant |
|
|
524 builtin_load (int argc, char **argv) |
|
|
525 { |
|
|
526 tree_constant retval; |
|
|
527 |
|
|
528 argc--; |
|
|
529 argv++; |
|
|
530 |
|
|
531 int force = 0; |
|
|
532 if (argc > 0 && strcmp (*argv, "-force") == 0) |
|
|
533 { |
|
|
534 force++; |
|
|
535 argc--; |
|
|
536 argv++; |
|
|
537 } |
|
|
538 |
|
|
539 if (argc < 1) |
|
|
540 { |
|
|
541 message ("load", "you must specify a single file to read"); |
|
|
542 return retval; |
|
|
543 } |
|
|
544 |
|
|
545 static istream stream; |
|
|
546 static ifstream file; |
|
|
547 if (strcmp (*argv, "-") == 0) |
|
|
548 { |
|
|
549 stream = cin; |
|
|
550 } |
|
|
551 else |
|
|
552 { |
|
|
553 char *fname = tilde_expand (*argv); |
|
|
554 file.open (fname); |
|
|
555 if (! file) |
|
|
556 { |
|
|
557 error ("load: couldn't open input file `%s'", *argv); |
|
|
558 return retval; |
|
|
559 } |
|
|
560 stream = file; |
|
|
561 } |
|
|
562 |
|
|
563 char nm [128]; // XXX FIXME XXX |
|
|
564 int count = 0; |
|
|
565 for (;;) |
|
|
566 { |
|
|
567 // Read name for this entry or break on EOF. |
|
|
568 if (extract_keyword (stream, "name", nm) == 0 || nm == (char *) NULL) |
|
|
569 { |
|
|
570 if (count == 0) |
|
|
571 message ("load", |
|
|
572 "no name keywords found. Are you sure this is an octave data file?"); |
|
|
573 break; |
|
|
574 } |
|
|
575 |
|
|
576 if (*nm == '\0') |
|
|
577 continue; |
|
|
578 |
|
|
579 if (! valid_identifier (nm)) |
|
|
580 { |
|
|
581 message ("load", "skipping bogus identifier `%s'", nm); |
|
|
582 continue; |
|
|
583 } |
|
|
584 |
|
|
585 if (load_variable (nm, force, stream)) |
|
|
586 count++; |
|
|
587 } |
|
|
588 |
|
|
589 if (file); |
|
|
590 file.close (); |
|
|
591 |
|
|
592 return retval; |
|
|
593 } |
|
|
594 |
|
|
595 /* |
|
|
596 * Get a directory listing. |
|
|
597 */ |
|
|
598 tree_constant |
|
|
599 builtin_ls (int argc, char **argv) |
|
|
600 { |
|
|
601 tree_constant retval; |
|
|
602 |
|
|
603 ostrstream ls_buf; |
|
|
604 |
|
|
605 ls_buf << "ls -C "; |
|
|
606 for (int i = 1; i < argc; i++) |
|
|
607 ls_buf << tilde_expand (argv[i]) << " "; |
|
|
608 |
|
|
609 ls_buf << ends; |
|
|
610 |
|
|
611 char *ls_command = ls_buf.str (); |
|
|
612 |
|
|
613 iprocstream cmd (ls_command); |
|
|
614 |
|
|
615 char ch; |
|
|
616 ostrstream output_buf; |
|
|
617 while (cmd.get (ch)) |
|
|
618 output_buf.put (ch); |
|
|
619 |
|
|
620 output_buf << ends; |
|
|
621 |
|
|
622 maybe_page_output (output_buf); |
|
|
623 |
|
|
624 delete [] ls_command; |
|
|
625 |
|
|
626 return retval; |
|
|
627 } |
|
|
628 |
|
|
629 /* |
|
62
|
630 * Run previous commands from the history list. |
|
|
631 */ |
|
|
632 tree_constant |
|
|
633 builtin_run_history (int argc, char **argv) |
|
|
634 { |
|
|
635 tree_constant retval; |
|
|
636 do_run_history (argc, argv); |
|
|
637 return retval; |
|
|
638 } |
|
|
639 |
|
|
640 /* |
|
1
|
641 * Write variables to an output stream. |
|
|
642 */ |
|
|
643 tree_constant |
|
|
644 builtin_save (int argc, char **argv) |
|
|
645 { |
|
|
646 tree_constant retval; |
|
|
647 |
|
|
648 if (argc < 2) |
|
|
649 { |
|
|
650 usage ("save file -- save all variables in named file\n\ |
|
|
651 save file var ... -- saved named variables"); |
|
|
652 return retval; |
|
|
653 } |
|
|
654 |
|
|
655 argc--; |
|
|
656 argv++; |
|
|
657 |
|
|
658 static ostream stream; |
|
|
659 static ofstream file; |
|
|
660 if (strcmp (*argv, "-") == 0) |
|
|
661 { |
|
|
662 // XXX FIXME XXX -- things intended for the screen should end up in a |
|
|
663 // tree_constant (string)? |
|
|
664 stream = cout; |
|
|
665 } |
|
|
666 else |
|
|
667 { |
|
|
668 char *fname = tilde_expand (*argv); |
|
|
669 file.open (fname); |
|
|
670 if (! file) |
|
|
671 { |
|
|
672 error ("save: couldn't open output file `%s'", *argv); |
|
|
673 return retval; |
|
|
674 } |
|
|
675 stream = file; |
|
|
676 } |
|
|
677 |
|
|
678 if (argc == 1) |
|
|
679 { |
|
|
680 curr_sym_tab->save (stream); |
|
|
681 global_sym_tab->save (stream, 1); |
|
|
682 } |
|
|
683 else |
|
|
684 { |
|
|
685 while (--argc > 0) |
|
|
686 { |
|
|
687 argv++; |
|
|
688 if (! curr_sym_tab->save (stream, *argv)) |
|
|
689 if (! global_sym_tab->save (stream, *argv, 1)) |
|
|
690 { |
|
|
691 message ("save", "no such variable `%s'", *argv); |
|
|
692 continue; |
|
|
693 } |
|
|
694 } |
|
|
695 } |
|
|
696 |
|
|
697 if (file); |
|
|
698 file.close (); |
|
|
699 |
|
|
700 return retval; |
|
|
701 } |
|
|
702 |
|
|
703 /* |
|
|
704 * Set plotting options. |
|
|
705 */ |
|
|
706 tree_constant |
|
|
707 builtin_set (int argc, char **argv) |
|
|
708 { |
|
|
709 tree_constant retval; |
|
|
710 |
|
|
711 ostrstream plot_buf; |
|
|
712 |
|
|
713 if (argc > 1) |
|
|
714 { |
|
|
715 if (almost_match ("parametric", argv[1], 3)) |
|
|
716 parametric_plot = 1; |
|
|
717 else if (almost_match ("noparametric", argv[1], 5)) |
|
|
718 parametric_plot = 0; |
|
|
719 } |
|
|
720 |
|
|
721 for (int i = 0; i < argc; i++) |
|
|
722 plot_buf << argv[i] << " "; |
|
|
723 |
|
|
724 plot_buf << "\n" << ends; |
|
|
725 |
|
|
726 char *plot_command = plot_buf.str (); |
|
|
727 send_to_plot_stream (plot_command); |
|
|
728 |
|
|
729 delete [] plot_command; |
|
|
730 |
|
|
731 return retval; |
|
|
732 } |
|
|
733 |
|
|
734 /* |
|
|
735 * Set plotting options. |
|
|
736 */ |
|
|
737 tree_constant |
|
|
738 builtin_show (int argc, char **argv) |
|
|
739 { |
|
|
740 tree_constant retval; |
|
|
741 |
|
|
742 ostrstream plot_buf; |
|
|
743 |
|
|
744 for (int i = 0; i < argc; i++) |
|
|
745 plot_buf << argv[i] << " "; |
|
|
746 |
|
|
747 plot_buf << "\n" << ends; |
|
|
748 |
|
|
749 char *plot_command = plot_buf.str (); |
|
|
750 send_to_plot_stream (plot_command); |
|
|
751 |
|
|
752 delete [] plot_command; |
|
|
753 |
|
|
754 return retval; |
|
|
755 } |
|
|
756 |
|
|
757 /* |
|
|
758 * List variable names. |
|
|
759 */ |
|
|
760 tree_constant |
|
|
761 builtin_who (int argc, char **argv) |
|
|
762 { |
|
|
763 tree_constant retval; |
|
|
764 int show_global = 0; |
|
|
765 int show_local = 1; |
|
|
766 int show_top = 0; |
|
|
767 int show_fcns = 0; |
|
|
768 |
|
|
769 if (argc > 1) |
|
|
770 show_local = 0; |
|
|
771 |
|
|
772 for (int i = 1; i < argc; i++) |
|
|
773 { |
|
|
774 argv++; |
|
|
775 if (strcmp (*argv, "-all") == 0) |
|
|
776 { |
|
|
777 show_global++; |
|
|
778 show_local++; |
|
|
779 show_top++; |
|
|
780 show_fcns++; |
|
|
781 } |
|
|
782 else if (strcmp (*argv, "-global") == 0) |
|
|
783 show_global++; |
|
|
784 else if (strcmp (*argv, "-local") == 0) |
|
|
785 show_local++; |
|
|
786 else if (strcmp (*argv, "-top") == 0) |
|
|
787 show_top++; |
|
|
788 else if (strcmp (*argv, "-fcn") == 0 |
|
|
789 || strcmp (*argv, "-fcns") == 0 |
|
|
790 || strcmp (*argv, "-functions") == 0) |
|
|
791 show_fcns++; |
|
|
792 else |
|
|
793 { |
|
|
794 message ("who", "unrecognized option `%s'", *argv); |
|
|
795 if (argc == 2) |
|
|
796 show_local = 1; |
|
|
797 } |
|
|
798 } |
|
|
799 |
|
|
800 ostrstream output_buf; |
|
|
801 int pad_after = 0; |
|
|
802 if (show_global) |
|
|
803 { |
|
|
804 int count = 0; |
|
|
805 char **symbols = global_sym_tab->sorted_var_list (count); |
|
|
806 if (symbols != (char **) NULL && count > 0) |
|
|
807 { |
|
|
808 output_buf << "\n*** global symbols:\n\n"; |
|
|
809 list_in_columns (output_buf, symbols); |
|
|
810 delete [] symbols; |
|
|
811 pad_after++; |
|
|
812 } |
|
|
813 } |
|
|
814 |
|
|
815 if (show_top) |
|
|
816 { |
|
|
817 int count = 0; |
|
|
818 char **symbols = top_level_sym_tab->sorted_var_list (count); |
|
|
819 if (symbols != (char **) NULL && count > 0) |
|
|
820 { |
|
|
821 output_buf << "\n*** top level symbols:\n\n"; |
|
|
822 list_in_columns (output_buf, symbols); |
|
|
823 delete [] symbols; |
|
|
824 pad_after++; |
|
|
825 } |
|
|
826 } |
|
|
827 |
|
|
828 if (show_local) |
|
|
829 { |
|
|
830 if (show_top && curr_sym_tab == top_level_sym_tab) |
|
|
831 output_buf << |
|
|
832 "\ncurrent (local) symbol table == top level symbol table\n"; |
|
|
833 else |
|
|
834 { |
|
|
835 int count = 0; |
|
|
836 char **symbols = curr_sym_tab->sorted_var_list (count); |
|
|
837 if (symbols != (char **) NULL && count > 0) |
|
|
838 { |
|
|
839 output_buf << "\n*** local symbols:\n\n"; |
|
|
840 list_in_columns (output_buf, symbols); |
|
|
841 delete [] symbols; |
|
|
842 pad_after++; |
|
|
843 } |
|
|
844 } |
|
|
845 } |
|
|
846 |
|
|
847 if (show_fcns) |
|
|
848 { |
|
|
849 int count = 0; |
|
|
850 char **symbols = global_sym_tab->sorted_fcn_list (count); |
|
|
851 if (symbols != (char **) NULL && count > 0) |
|
|
852 { |
|
|
853 output_buf << "\n*** functions builtin or currently compiled:\n\n"; |
|
|
854 list_in_columns (output_buf, symbols); |
|
|
855 delete [] symbols; |
|
|
856 pad_after++; |
|
|
857 } |
|
|
858 } |
|
|
859 |
|
|
860 if (pad_after) |
|
|
861 output_buf << "\n"; |
|
|
862 |
|
|
863 output_buf << ends; |
|
|
864 maybe_page_output (output_buf); |
|
|
865 |
|
|
866 return retval; |
|
|
867 } |
|
|
868 |
|
|
869 /* |
|
|
870 ;;; Local Variables: *** |
|
|
871 ;;; mode: C++ *** |
|
|
872 ;;; page-delimiter: "^/\\*" *** |
|
|
873 ;;; End: *** |
|
|
874 */ |
