home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / src / variables.cc < prev    next >
C/C++ Source or Header  |  1996-09-28  |  42KB  |  1,812 lines
  1. // variables.cc                                              -*- C++ -*-
  2. /*
  3.  
  4. Copyright (C) 1992, 1993, 1994, 1995 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. #ifdef HAVE_CONFIG_H
  25. #include "config.h"
  26. #endif
  27.  
  28. #if 0
  29. #include <ctype.h>
  30. #include <iostream.h>
  31.  
  32. #include "mappers.h"
  33. #endif
  34.  
  35. #include <sys/types.h>
  36. #ifdef HAVE_UNISTD_H
  37. #include <unistd.h>
  38. #endif
  39. #include <float.h>
  40. #include <string.h>
  41. #include <strstream.h>
  42.  
  43. #include "defaults.h"
  44. #include "version.h"
  45. #include "dynamic-ld.h"
  46. #include "octave-hist.h"
  47. #include "unwind-prot.h"
  48. #include "variables.h"
  49. #include "user-prefs.h"
  50. #include "statdefs.h"
  51. #include "tree-base.h"
  52. #include "tree-expr.h"
  53. #include "tree-const.h"
  54. #include "dirfns.h"
  55. #include "oct-obj.h"
  56. #include "sysdep.h"
  57. #include "symtab.h"
  58. #include "octave.h"
  59. #include "pager.h"
  60. #include "error.h"
  61. #include "defun.h"
  62. #include "utils.h"
  63. #include "parse.h"
  64. #include "input.h"
  65. #include "help.h"
  66. #include "lex.h"
  67.  
  68. extern "C"
  69. {
  70. #include <readline/readline.h>
  71.  
  72. #include "fnmatch.h"
  73. }
  74.  
  75. // Symbol table for symbols at the top level.
  76. symbol_table *top_level_sym_tab = 0;
  77.  
  78. // Symbol table for the current scope.
  79. symbol_table *curr_sym_tab = 0;
  80.  
  81. // Symbol table for global symbols.
  82. symbol_table *global_sym_tab = 0;
  83.  
  84. // Initialization.
  85.  
  86. // Create the initial symbol tables and set the current scope at the
  87. // top level.
  88.  
  89. void
  90. initialize_symbol_tables (void)
  91. {
  92.   if (! global_sym_tab)
  93.     global_sym_tab = new symbol_table ();
  94.  
  95.   if (! top_level_sym_tab)
  96.     top_level_sym_tab = new symbol_table ();
  97.  
  98.   curr_sym_tab = top_level_sym_tab;
  99. }
  100.  
  101. // Attributes of variables and functions.
  102.  
  103. // Is this variable a builtin?
  104.  
  105. int
  106. is_builtin_variable (const char *name)
  107. {
  108.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  109.   return (sr && sr->is_builtin_variable ());
  110. }
  111.  
  112. // Is this a text-style function?
  113.  
  114. int
  115. is_text_function_name (const char *s)
  116. {
  117.   symbol_record *sr = global_sym_tab->lookup (s);
  118.   return (sr && sr->is_text_function ());
  119. }
  120.  
  121. // Is this function globally in this scope?
  122.  
  123. int
  124. is_globally_visible (const char *name)
  125. {
  126.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  127.   return (sr && sr->is_linked_to_global ());
  128. }
  129.  
  130. // Is this tree_constant a valid function?
  131.  
  132. tree_fvc *
  133. is_valid_function (const tree_constant& arg, char *warn_for, int warn)
  134. {
  135.   tree_fvc *ans = 0;
  136.  
  137.   char *fcn_name = arg.string_value ();
  138.  
  139.   if (error_state)
  140.     {
  141.       if (warn)
  142.     error ("%s: expecting function name as argument", warn_for);
  143.       return ans;
  144.     }
  145.  
  146.   symbol_record *sr = 0;
  147.   if (fcn_name)
  148.     sr = lookup_by_name (fcn_name);
  149.  
  150.   if (sr)
  151.     ans = sr->def ();
  152.  
  153.   if (! sr || ! ans || ! sr->is_function ())
  154.     {
  155.       if (warn)
  156.     error ("%s: the symbol `%s' is not valid as a function",
  157.            warn_for, fcn_name);
  158.       ans = 0;
  159.     }
  160.  
  161.   return ans;
  162. }
  163.  
  164. // Does this function take the right number of arguments?
  165.  
  166. int
  167. takes_correct_nargs (tree_fvc *fcn, int expected_nargin, char *warn_for,
  168.              int warn)
  169. {
  170.   int nargin = fcn->max_expected_args ();
  171.   int e_nargin = expected_nargin;
  172.   if (nargin != e_nargin)
  173.     {
  174.       if (warn)
  175.     error ("%s: expecting function to take %d argument%s", 
  176.            warn_for, e_nargin, (e_nargin == 1 ? "" : "s"));
  177.       return 0;
  178.     }
  179.   return 1;
  180. }
  181.  
  182. DEFUN ("is_global", Fis_global, Sis_global, 1, 1,
  183.   "is_global (X): return 1 if the string X names a global variable\n\
  184. otherwise, return 0.")
  185. {
  186.   Octave_object retval = 0.0;
  187.  
  188.   int nargin = args.length ();
  189.  
  190.   if (nargin != 1)
  191.     {
  192.       print_usage ("is_global");
  193.       return retval;
  194.     }
  195.  
  196.   char *name = args(0).string_value ();
  197.  
  198.   if (error_state)
  199.     {
  200.       error ("is_global: expecting string argument");
  201.       return retval;
  202.     }
  203.  
  204.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  205.  
  206.   retval = (double) (sr && sr->is_linked_to_global ());
  207.  
  208.   return retval;
  209. }
  210.  
  211. DEFUN ("exist", Fexist, Sexist, 1, 1,
  212.   "exist (NAME): check if variable or file exists\n\
  213. \n\
  214. return 0 if NAME is undefined, 1 if it is a variable, or 2 if it is\n\
  215. a function.") 
  216. {
  217.   Octave_object retval;
  218.  
  219.   int nargin = args.length ();
  220.  
  221.   if (nargin != 1)
  222.     {
  223.       print_usage ("exist");
  224.       return retval;
  225.     }
  226.  
  227.   char *name = args(0).string_value ();
  228.  
  229.   if (error_state)
  230.     {
  231.       error ("exist: expecting string argument");
  232.       return retval;
  233.     }
  234.  
  235.   symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
  236.   if (! sr)
  237.     sr = global_sym_tab->lookup (name, 0, 0);
  238.  
  239.   retval = 0.0;
  240.  
  241.   if (sr && sr->is_variable () && sr->is_defined ())
  242.     retval = 1.0;
  243.   else if (sr && sr->is_function ())
  244.     retval = 2.0;
  245.   else
  246.     {
  247.       char *path = fcn_file_in_path (name);
  248.       if (path)
  249.     {
  250.       delete [] path;
  251.       retval = 2.0;
  252.     }
  253.       else
  254.     {
  255.       struct stat buf;
  256.       if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode))
  257.         retval = 2.0;
  258.     }
  259.     }
  260.  
  261.   return retval;
  262. }
  263.  
  264. // XXX FIXME XXX -- should these really be here?
  265.  
  266. static char *
  267. octave_home (void)
  268. {
  269.   char *oh = getenv ("OCTAVE_HOME");
  270.  
  271.   return (oh ? oh : OCTAVE_PREFIX);
  272. }
  273.  
  274. static char *
  275. subst_octave_home (char *s)
  276. {
  277.   char *home = octave_home ();
  278.   char *prefix = OCTAVE_PREFIX;
  279.  
  280.   char *retval;
  281.  
  282.   if (strcmp (home, prefix) == 0)
  283.     retval = strsave (s);
  284.   else
  285.     {
  286.       int len_home = strlen (home);
  287.       int len_prefix = strlen (prefix);
  288.  
  289.       int count = 0;
  290.       char *ptr = s;
  291.       char *next = 0;
  292.       while ((next = strstr (ptr, prefix)))
  293.     {
  294.       ptr = next + len_prefix;
  295.       count++;
  296.     }
  297.  
  298.       int grow_size = count * (len_home - len_prefix);
  299.  
  300.       int len_s = strlen (s);
  301.  
  302.       int len_retval = len_s + count * grow_size;
  303.  
  304.       retval = new char [len_retval+1];
  305.  
  306.       char *p1 = s;
  307.       char *p2 = p1;
  308.       char *pdest = retval;
  309.  
  310. // Is this really a good way to do this?
  311.  
  312.       while (count >= 0)
  313.     {
  314.       p2 = strstr (p1, prefix);
  315.       
  316.       if (! p2)
  317.         {
  318.           memcpy (pdest, p1, strlen (p1)+1);
  319.           break;
  320.         }
  321.       else if (p1 == p2)
  322.         {
  323.           memcpy (pdest, home, len_home);
  324.           pdest += len_home;
  325.           p1 += len_prefix;
  326.           count--;
  327.         }
  328.       else
  329.         {
  330.           int len = (int) (p2 - p1);
  331.           memcpy (pdest, p1, len);
  332.           pdest += len;
  333.           p1 += len;
  334.         }
  335.  
  336.     }
  337.     }
  338.  
  339.   return retval;
  340. }
  341.  
  342. static char *
  343. octave_info_dir (void)
  344. {
  345.   static char *retval = subst_octave_home (OCTAVE_INFODIR);
  346.   return retval;
  347. }
  348.  
  349. char *
  350. octave_arch_lib_dir (void)
  351. {
  352.   static char *retval = subst_octave_home (OCTAVE_ARCHLIBDIR);
  353.   return retval;
  354. }
  355.  
  356. char *
  357. octave_bin_dir (void)
  358. {
  359.   static char *retval = subst_octave_home (OCTAVE_BINDIR);
  360.   return retval;
  361. }
  362.  
  363. static char *
  364. default_pager (void)
  365. {
  366.   static char *pager_binary = 0;
  367.   delete [] pager_binary;
  368.   char *pgr = getenv ("PAGER");
  369.   if (pgr)
  370.     pager_binary = strsave (pgr);
  371.   else
  372. #ifdef DEFAULT_PAGER
  373.     pager_binary = strsave (DEFAULT_PAGER);
  374. #else
  375.     pager_binary = strsave ("");
  376. #endif
  377.  
  378.   return pager_binary;
  379. }
  380.  
  381. // Always returns a new string.
  382.  
  383. char *
  384. maybe_add_default_load_path (const char *p)
  385. {
  386.   static char *std_path = subst_octave_home (OCTAVE_FCNFILEPATH);
  387.  
  388.   char *pathstring = strsave (p);
  389.  
  390.   if (pathstring[0] == SEPCHAR)
  391.     {
  392.       char *tmp = pathstring;
  393.       pathstring = strconcat (std_path, pathstring);
  394.       delete [] tmp;
  395.     }
  396.  
  397.   int tmp_len = strlen (pathstring);
  398.   if (pathstring[tmp_len-1] == SEPCHAR)
  399.     {
  400.       char *tmp = pathstring;
  401.       pathstring = strconcat (pathstring, std_path);
  402.       delete [] tmp;
  403.     }
  404.  
  405.   return pathstring;
  406. }
  407.  
  408. char *
  409. octave_lib_dir (void)
  410. {
  411.   static char *retval = subst_octave_home (OCTAVE_LIBDIR);
  412.   return retval;
  413. }
  414.  
  415. // Handle OCTAVE_PATH from the environment like TeX handles TEXINPUTS.
  416. // If the path starts with `:', prepend the standard path.  If it ends
  417. // with `:' append the standard path.  If it begins and ends with
  418. // `:', do both (which is useless, but the luser asked for it...).
  419. //
  420. // This function may eventually be called more than once, so be
  421. // careful not to create memory leaks. 
  422.  
  423. char *
  424. default_path (void)
  425. {
  426.   static char *std_path = subst_octave_home (OCTAVE_FCNFILEPATH);
  427.  
  428.   static char *oct_path = getenv ("OCTAVE_PATH");
  429.  
  430.   static char *pathstring = 0;
  431.   delete [] pathstring;
  432.  
  433.   return oct_path ? strsave (oct_path) : strsave (std_path);
  434. }
  435.  
  436. char *
  437. default_info_file (void)
  438. {
  439.   static char *info_file_string = 0;
  440.   delete [] info_file_string;
  441.   char *oct_info_file = getenv ("OCTAVE_INFO_FILE");
  442.   if (oct_info_file)
  443.     info_file_string = strsave (oct_info_file);
  444.   else
  445.     {
  446.       char *infodir = octave_info_dir ();
  447.       info_file_string = strconcat (infodir, "/octave.info");
  448.     }
  449.   return info_file_string;
  450. }
  451.  
  452. char *
  453. default_editor (void)
  454. {
  455.   static char *editor_string = 0;
  456.   delete [] editor_string;
  457.   char *env_editor = getenv ("EDITOR");
  458.   if (env_editor && *env_editor)
  459.     editor_string = strsave (env_editor);
  460.   else
  461.     editor_string = strsave ("vi");
  462.   return editor_string;
  463. }
  464.  
  465. char *
  466. get_site_defaults (void)
  467. {
  468.   static char *startupdir = subst_octave_home (OCTAVE_STARTUPFILEDIR);
  469.   static char *sd = strconcat (startupdir, "/octaverc");
  470.   return sd;
  471. }
  472.  
  473. // Functions for looking up variables and functions.
  474.  
  475. // Is there a corresponding function file that is newer than the
  476. // symbol definition?
  477.  
  478. static int
  479. symbol_out_of_date (symbol_record *sr)
  480. {
  481.   int ignore = user_pref.ignore_function_time_stamp;
  482.  
  483.   if (ignore == 2)
  484.     return 0;
  485.  
  486.   if (sr)
  487.     {
  488.       tree_fvc *ans = sr->def ();
  489.       if (ans)
  490.     {
  491.       char *ff = ans->fcn_file_name ();
  492.       if (ff && ! (ignore && ans->is_system_fcn_file ()))
  493.         {
  494.           time_t tp = ans->time_parsed ();
  495.           char *fname = fcn_file_in_path (ff);
  496.           int status = is_newer (fname, tp);
  497.           delete [] fname;
  498.           if (status > 0)
  499.         return 1;
  500.         }
  501.     }
  502.     }
  503.   return 0;
  504. }
  505.  
  506. static int
  507. looks_like_octave_copyright (char *s)
  508. {
  509.   if (s && strncmp (s, " Copyright (C) ", 15) == 0)
  510.     {
  511.       s = strchr (s, '\n');
  512.       if (s)
  513.     {
  514.       s++;
  515.       s = strchr (s, '\n');
  516.       if (s)
  517.         {
  518.           s++;
  519.           if (strncmp (s, " This file is part of Octave.", 29) == 0)
  520.         return 1;
  521.         }
  522.     }
  523.     }
  524.   return 0;
  525. }
  526.  
  527. static char *
  528. gobble_leading_white_space (FILE *ffile)
  529. {
  530.   ostrstream buf;
  531.  
  532.   int first_comments_seen = 0;
  533.   int have_help_text = 0;
  534.   int in_comment = 0;
  535.   int c;
  536.   while ((c = getc (ffile)) != EOF)
  537.     {
  538.       current_input_column++;
  539.       if (in_comment)
  540.     {
  541.       if (! have_help_text)
  542.         {
  543.           first_comments_seen = 1;
  544.           buf << (char) c;
  545.         }
  546.  
  547.       if (c == '\n')
  548.         {
  549.           input_line_number++;
  550.           current_input_column = 0;
  551.           in_comment = 0;
  552.         }
  553.     }
  554.       else
  555.     {
  556.       switch (c)
  557.         {
  558.         case ' ':
  559.         case '\t':
  560.           if (first_comments_seen)
  561.         have_help_text = 1;
  562.           break;
  563.  
  564.         case '\n':
  565.           if (first_comments_seen)
  566.         have_help_text = 1;
  567.           input_line_number++;
  568.           current_input_column = 0;
  569.           continue;
  570.  
  571.         case '%':
  572.         case '#':
  573.           in_comment = 1;
  574.           break;
  575.  
  576.         default:
  577.           current_input_column--;
  578.           ungetc (c, ffile);
  579.           goto done;
  580.         }
  581.     }
  582.     }
  583.  
  584.  done:
  585.  
  586.   buf << ends;
  587.   char *help_txt = buf.str ();
  588.  
  589.   if (! help_txt || ! *help_txt || looks_like_octave_copyright (help_txt))
  590.     {
  591.       delete help_txt;
  592.       help_txt = 0;
  593.     }
  594.  
  595.   return help_txt;
  596. }
  597.  
  598. static int
  599. is_function_file (FILE *ffile)
  600. {
  601.   int status = 0;
  602.  
  603.   long pos = ftell (ffile);
  604.  
  605.   char buf [10];
  606.   fgets (buf, 10, ffile);
  607.   int len = strlen (buf);
  608.   if (len > 8 && strncmp (buf, "function", 8) == 0
  609.       && ! (isalnum (buf[8]) || buf[8] == '_'))
  610.     status = 1;
  611.  
  612.   fseek (ffile, pos, SEEK_SET);
  613.  
  614.   return status;
  615. }
  616.  
  617. static int
  618. parse_fcn_file (int exec_script, char *ff)
  619. {
  620.   begin_unwind_frame ("parse_fcn_file");
  621.  
  622.   int script_file_executed = 0;
  623.  
  624.   assert (ff);
  625.  
  626. // Open function file and parse.
  627.  
  628.   int old_reading_fcn_file_state = reading_fcn_file;
  629.  
  630.   unwind_protect_ptr (rl_instream);
  631.   unwind_protect_ptr (ff_instream);
  632.  
  633.   unwind_protect_int (using_readline);
  634.   unwind_protect_int (input_line_number);
  635.   unwind_protect_int (current_input_column);
  636.   unwind_protect_int (reading_fcn_file);
  637.  
  638.   using_readline = 0;
  639.   reading_fcn_file = 1;
  640.   input_line_number = 0;
  641.   current_input_column = 1;
  642.  
  643.   FILE *ffile = get_input_from_file (ff, 0);
  644.  
  645.   if (ffile)
  646.     {
  647. // Check to see if this file defines a function or is just a list of
  648. // commands.
  649.  
  650.       char *tmp_help_txt = gobble_leading_white_space (ffile);
  651.  
  652.       if (is_function_file (ffile))
  653.     {
  654.       unwind_protect_int (echo_input);
  655.       unwind_protect_int (saving_history);
  656.       unwind_protect_int (reading_fcn_file);
  657.  
  658.       echo_input = 0;
  659.       saving_history = 0;
  660.       reading_fcn_file = 1;
  661.  
  662.       YY_BUFFER_STATE old_buf = current_buffer ();
  663.       YY_BUFFER_STATE new_buf = create_buffer (ffile);
  664.  
  665.       add_unwind_protect (restore_input_buffer, (void *) old_buf);
  666.       add_unwind_protect (delete_input_buffer, (void *) new_buf);
  667.  
  668.       switch_to_buffer (new_buf);
  669.  
  670.       unwind_protect_ptr (curr_sym_tab);
  671.  
  672.       reset_parser ();
  673.  
  674.       delete [] help_buf;
  675.       help_buf = tmp_help_txt;
  676.  
  677.       int status = yyparse ();
  678.  
  679.       if (status != 0)
  680.         {
  681.           error ("parse error while reading function file %s", ff);
  682.           global_sym_tab->clear (curr_fcn_file_name);
  683.         }
  684.     }
  685.       else if (exec_script)
  686.     {
  687. // The value of `reading_fcn_file' will be restored to the proper value
  688. // when we unwind from this frame.
  689.       reading_fcn_file = old_reading_fcn_file_state;
  690.  
  691.       unwind_protect_int (reading_script_file);
  692.       reading_script_file = 1;
  693.  
  694.       parse_and_execute (ffile, 1);
  695.  
  696.       script_file_executed = 1;
  697.     }
  698.       fclose (ffile);
  699.     }
  700.  
  701.   run_unwind_frame ("parse_fcn_file");
  702.  
  703.   return script_file_executed;
  704. }
  705.  
  706. static int
  707. load_fcn_from_file (symbol_record *sym_rec, int exec_script)
  708. {
  709.   int script_file_executed = 0;
  710.  
  711.   char *nm = sym_rec->name ();
  712.  
  713. // This is needed by yyparse.
  714.  
  715.   curr_fcn_file_name = nm;
  716.  
  717. #ifdef WITH_DLD
  718.  
  719.   if (load_octave_oct_file (nm))
  720.     {
  721.       force_link_to_function (nm);
  722.     }
  723.   else
  724.  
  725. #endif
  726.  
  727.     {
  728.       char *ff = fcn_file_in_path (nm);
  729.  
  730.       if (ff)
  731.     {
  732.       script_file_executed = parse_fcn_file (exec_script, ff);
  733.       delete [] ff;
  734.     }
  735.  
  736.       if (! (error_state || script_file_executed))
  737.     force_link_to_function (nm);
  738.     }
  739.  
  740.   return script_file_executed;
  741. }
  742.  
  743. int
  744. lookup (symbol_record *sym_rec, int exec_script)
  745. {
  746.   int script_file_executed = 0;
  747.  
  748.   if (! sym_rec->is_linked_to_global ())
  749.     {
  750.       if (sym_rec->is_defined ())
  751.     {
  752.       if (sym_rec->is_function () && symbol_out_of_date (sym_rec))
  753.         script_file_executed = load_fcn_from_file (sym_rec, exec_script);
  754.     }
  755.       else if (! sym_rec->is_formal_parameter ())
  756.     {
  757.       link_to_builtin_or_function (sym_rec);
  758.       
  759.       if (! sym_rec->is_defined ())
  760.         script_file_executed = load_fcn_from_file (sym_rec, exec_script);
  761.       else if (sym_rec->is_function () && symbol_out_of_date (sym_rec))
  762.         script_file_executed = load_fcn_from_file (sym_rec, exec_script);
  763.     }
  764.     }
  765.  
  766.   return script_file_executed;
  767. }
  768.  
  769. // Get the symbol record for the given name that is visible in the
  770. // current scope.  Reread any function definitions that appear to be
  771. // out of date.  If a function is available in a file but is not
  772. // currently loaded, this will load it and insert the name in the
  773. // current symbol table.
  774.  
  775. symbol_record *
  776. lookup_by_name (const char *nm, int exec_script)
  777. {
  778.   symbol_record *sym_rec = curr_sym_tab->lookup (nm, 1, 0);
  779.  
  780.   lookup (sym_rec, exec_script);
  781.  
  782.   return sym_rec;
  783. }
  784.  
  785. char *
  786. get_help_from_file (const char *path)
  787. {
  788.   if (path && *path)
  789.     {
  790.       FILE *fptr = fopen (path, "r");
  791.       if (fptr)
  792.     {
  793.       char *help_txt = gobble_leading_white_space (fptr);
  794.       fclose (fptr);
  795.       return help_txt;
  796.     }
  797.     }
  798.   return 0;
  799. }
  800.  
  801. // Variable values.
  802.  
  803. // Look for the given name in the global symbol table.  If it refers
  804. // to a string, return a new copy.  If not, return 0;
  805.  
  806. char *
  807. builtin_string_variable (const char *name)
  808. {
  809.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  810.  
  811. // It is a prorgramming error to look for builtins that aren't.
  812.  
  813.   assert (sr);
  814.  
  815.   char *retval = 0;
  816.  
  817.   tree_fvc *defn = sr->def ();
  818.  
  819.   if (defn)
  820.     {
  821.       tree_constant val = defn->eval (0);
  822.  
  823.       if (! error_state && val.is_string ())
  824.     {
  825.       char *s = val.string_value ();
  826.  
  827.       if (s)
  828.         retval = strsave (s);
  829.     }
  830.     }
  831.  
  832.   return retval;
  833. }
  834.  
  835. // Look for the given name in the global symbol table.  If it refers
  836. // to a real scalar, place the value in d and return 0.  Otherwise,
  837. // return -1. 
  838.  
  839. int
  840. builtin_real_scalar_variable (const char *name, double& d)
  841. {
  842.   int status = -1;
  843.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  844.  
  845. // It is a prorgramming error to look for builtins that aren't.
  846.  
  847.   assert (sr);
  848.  
  849.   tree_fvc *defn = sr->def ();
  850.  
  851.   if (defn)
  852.     {
  853.       tree_constant val = defn->eval (0);
  854.  
  855.       if (! error_state && val.is_scalar_type ())
  856.     {
  857.       d = val.double_value ();
  858.       status = 0;
  859.     }
  860.     }
  861.  
  862.   return status;
  863. }
  864.  
  865. // Look for the given name in the global symbol table.
  866.  
  867. tree_constant
  868. builtin_any_variable (const char *name)
  869. {
  870.   tree_constant retval;
  871.  
  872.   symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
  873.  
  874. // It is a prorgramming error to look for builtins that aren't.
  875.  
  876.   assert (sr);
  877.  
  878.   tree_fvc *defn = sr->def ();
  879.  
  880.   if (defn)
  881.     retval = defn->eval (0);
  882.  
  883.   return retval;
  884. }
  885.  
  886. // Global stuff and links to builtin variables and functions.
  887.  
  888. // Make the definition of the symbol record sr be the same as the
  889. // definition of the global variable of the same name, creating it if
  890. // it doesn't already exist. 
  891.  
  892. void
  893. link_to_global_variable (symbol_record *sr)
  894. {
  895.   if (sr->is_linked_to_global ())
  896.     return;
  897.  
  898.   symbol_record *gsr = global_sym_tab->lookup (sr->name (), 1, 0);
  899.  
  900.   if (sr->is_formal_parameter ())
  901.     {
  902.       error ("can't make function parameter `%s' global", sr->name ());
  903.       return;
  904.     }
  905.  
  906. // There must be a better way to do this.   XXX FIXME XXX
  907.  
  908.   if (sr->is_variable ())
  909.     {
  910. // Would be nice not to have this cast.  XXX FIXME XXX
  911.       tree_constant *tmp = (tree_constant *) sr->def ();
  912.       if (tmp)
  913.     tmp = new tree_constant (*tmp);
  914.       else
  915.     tmp = new tree_constant ();
  916.       gsr->define (tmp);
  917.     }
  918.   else
  919.     sr->clear ();
  920.  
  921. // If the global symbol is currently defined as a function, we need to
  922. // hide it with a variable.
  923.  
  924.   if (gsr->is_function ())
  925.     gsr->define ((tree_constant *) 0);
  926.  
  927.   sr->alias (gsr, 1);
  928.   sr->mark_as_linked_to_global ();
  929. }
  930.  
  931. // Make the definition of the symbol record sr be the same as the
  932. // definition of the builtin variable of the same name.
  933.  
  934. void
  935. link_to_builtin_variable (symbol_record *sr)
  936. {
  937.   symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
  938.  
  939.   if (tmp_sym && tmp_sym->is_builtin_variable ())
  940.     sr->alias (tmp_sym);
  941. }
  942.  
  943. // Make the definition of the symbol record sr be the same as the
  944. // definition of the builtin variable or function, or user function of
  945. // the same name, provided that the name has not been used as a formal
  946. // parameter.
  947.  
  948. void
  949. link_to_builtin_or_function (symbol_record *sr)
  950. {
  951.   symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
  952.  
  953.   if (tmp_sym
  954.       && (tmp_sym->is_builtin_variable () || tmp_sym->is_function ())
  955.       && ! tmp_sym->is_formal_parameter ())
  956.     sr->alias (tmp_sym);
  957. }
  958.  
  959. // Force a link to a function in the current symbol table.  This is
  960. // used just after defining a function to avoid different behavior
  961. // depending on whether or not the function has been evaluated after
  962. // being defined.
  963. //
  964. // Return without doing anything if there isn't a function with the
  965. // given name defined in the global symbol table.
  966.  
  967. void
  968. force_link_to_function (const char *id_name)
  969. {
  970.   symbol_record *gsr = global_sym_tab->lookup (id_name, 1, 0);
  971.   if (gsr->is_function ())
  972.     {
  973.       curr_sym_tab->clear (id_name);
  974.       symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0);
  975.       csr->alias (gsr);
  976.     }
  977. }
  978.  
  979. // Help stuff.  Shouldn't this go in help.cc?
  980.  
  981. // It's not likely that this does the right thing now.  XXX FIXME XXX
  982.  
  983. char **
  984. make_name_list (void)
  985. {
  986.   int key_len = 0;
  987.   int glb_len = 0;
  988.   int top_len = 0;
  989.   int lcl_len = 0;
  990.   int ffl_len = 0;
  991.  
  992.   char **key = 0;
  993.   char **glb = 0;
  994.   char **top = 0;
  995.   char **lcl = 0;
  996.   char **ffl = 0;
  997.  
  998. // Each of these functions returns a new vector of pointers to new
  999. // strings.
  1000.  
  1001.   key = names (keyword_help (), key_len);
  1002.   glb = global_sym_tab->list (glb_len);
  1003.   top = top_level_sym_tab->list (top_len);
  1004.   if (top_level_sym_tab != curr_sym_tab)
  1005.     lcl = curr_sym_tab->list (lcl_len);
  1006.   ffl = get_fcn_file_names (ffl_len, 1);
  1007.  
  1008.   int total_len = key_len + glb_len + top_len + lcl_len + ffl_len;
  1009.  
  1010.   char **list = new char * [total_len+1];
  1011.   
  1012. // Put all the symbols in one big list.  Only copy pointers, not the
  1013. // strings they point to, then only delete the original array of
  1014. // pointers, and not the strings they point to.
  1015.  
  1016.   int j = 0;
  1017.   int i = 0;
  1018.   for (i = 0; i < key_len; i++)
  1019.     list[j++] = key[i];
  1020.  
  1021.   for (i = 0; i < glb_len; i++)
  1022.     list[j++] = glb[i];
  1023.  
  1024.   for (i = 0; i < top_len; i++)
  1025.     list[j++] = top[i];
  1026.  
  1027.   for (i = 0; i < lcl_len; i++)
  1028.     list[j++] = lcl[i];
  1029.  
  1030.   for (i = 0; i < ffl_len; i++)
  1031.     list[j++] = ffl[i];
  1032.  
  1033.   list[j] = 0;
  1034.  
  1035.   delete [] key;
  1036.   delete [] glb;
  1037.   delete [] top;
  1038.   delete [] lcl;
  1039.   delete [] ffl;
  1040.  
  1041.   return list;
  1042. }
  1043.  
  1044. // List variable names.
  1045.  
  1046. static void
  1047. print_symbol_info_line (ostrstream& output_buf, const symbol_record_info& s)
  1048. {
  1049.   output_buf << (s.is_read_only () ? " -" : " w");
  1050.   output_buf << (s.is_eternal () ? "- " : "d ");
  1051. #if 0
  1052.   output_buf << (s.hides_fcn () ? "f" : (s.hides_builtin () ? "F" : "-"));
  1053. #endif
  1054.   output_buf.form ("  %-16s", s.type_as_string ());
  1055.   if (s.is_function ())
  1056.     output_buf << "      -      -";
  1057.   else
  1058.     {
  1059.       output_buf.form ("%7d", s.rows ());
  1060.       output_buf.form ("%7d", s.columns ());
  1061.     }
  1062.   output_buf << "  " << s.name () << "\n";
  1063. }
  1064.  
  1065. static void
  1066. print_long_listing (ostrstream& output_buf, symbol_record_info *s)
  1067. {
  1068.   if (! s)
  1069.     return;
  1070.  
  1071.   symbol_record_info *ptr = s;
  1072.   while (ptr->is_defined ())
  1073.     {
  1074.       print_symbol_info_line (output_buf, *ptr);
  1075.       ptr++;
  1076.     }
  1077. }
  1078.  
  1079. static int
  1080. maybe_list (const char *header, char **argv, int argc,
  1081.         ostrstream& output_buf, int show_verbose, symbol_table
  1082.         *sym_tab, unsigned type, unsigned scope)
  1083. {
  1084.   int count;
  1085.   int status = 0;
  1086.   if (show_verbose)
  1087.     {
  1088.       symbol_record_info *symbols;
  1089.       symbols = sym_tab->long_list (count, argv, argc, 1, type, scope);
  1090.       if (symbols && count > 0)
  1091.     {
  1092.       output_buf << "\n" << header << "\n\n"
  1093.              << "prot  type               rows   cols  name\n"
  1094.              << "====  ====               ====   ====  ====\n";
  1095.  
  1096.       print_long_listing (output_buf, symbols);
  1097.       status = 1;
  1098.     }
  1099.       delete [] symbols;
  1100.     }
  1101.   else
  1102.     {
  1103.       char **symbols = sym_tab->list (count, argv, argc, 1, type, scope);
  1104.       if (symbols && count > 0)
  1105.     {
  1106.       output_buf << "\n" << header << "\n\n";
  1107.       list_in_columns (output_buf, symbols);
  1108.       status = 1;
  1109.     }
  1110.       delete [] symbols;
  1111.     }
  1112.   return status;
  1113. }
  1114.  
  1115. DEFUN_TEXT ("document", Fdocument, Sdocument, -1, 1,
  1116.   "document symbol string ...\n\
  1117. \n\
  1118. Associate a cryptic message with a variable name.")
  1119. {
  1120.   Octave_object retval;
  1121.  
  1122.   DEFINE_ARGV("document");
  1123.  
  1124.   if (argc == 3)
  1125.     {
  1126.       char *name = argv[1];
  1127.       char *help = argv[2];
  1128.  
  1129.       if (is_builtin_variable (name))
  1130.     error ("sorry, can't redefine help for builtin variables");
  1131.       else
  1132.     {
  1133.       symbol_record *sym_rec = curr_sym_tab->lookup (name, 0);
  1134.  
  1135.       if (sym_rec)
  1136.         sym_rec->document (help);
  1137.       else
  1138.         error ("document: no such symbol `%s'", name);
  1139.     }
  1140.     }
  1141.   else
  1142.     print_usage ("document");
  1143.  
  1144.   DELETE_ARGV;
  1145.  
  1146.   return retval;
  1147. }
  1148.  
  1149. // XXX FIXME XXX -- this should take a list of regular expressions
  1150. // naming the variables to look for.
  1151.  
  1152. static Octave_object
  1153. do_who (int argc, char **argv, int nargout)
  1154. {
  1155.   Octave_object retval;
  1156.  
  1157.   int show_builtins = 0;
  1158.   int show_functions = (curr_sym_tab == top_level_sym_tab);
  1159.   int show_variables = 1;
  1160.   int show_verbose = 0;
  1161.  
  1162.   char *my_name = argv[0];
  1163.  
  1164.   if (argc > 1)
  1165.     {
  1166.       show_functions = 0;
  1167.       show_variables = 0;
  1168.     }
  1169.  
  1170.   while (--argc > 0)
  1171.     {
  1172.       argv++;
  1173.  
  1174.       if (strcmp (*argv, "-all") == 0 || strcmp (*argv, "-a") == 0)
  1175.     {
  1176.       show_builtins++;
  1177.       show_functions++;
  1178.       show_variables++;      
  1179.     }
  1180.       else if (strcmp (*argv, "-builtins") == 0 || strcmp (*argv, "-b") == 0)
  1181.     show_builtins++;
  1182.       else if (strcmp (*argv, "-functions") == 0 || strcmp (*argv, "-f") == 0)
  1183.     show_functions++;
  1184.       else if (strcmp (*argv, "-long") == 0 || strcmp (*argv, "-l") == 0)
  1185.     show_verbose++;
  1186.       else if (strcmp (*argv, "-variables") == 0 || strcmp (*argv, "-v") == 0)
  1187.     show_variables++;
  1188.       else if (*argv[0] == '-')
  1189.     warning ("%s: unrecognized option `%s'", my_name, *argv);
  1190.       else
  1191.     break;
  1192.     }
  1193.  
  1194. // If the user specified -l and nothing else, show variables.  If
  1195. // evaluating this at the top level, also show functions.
  1196.  
  1197.   if (show_verbose && ! (show_builtins || show_functions || show_variables))
  1198.     {
  1199.       show_functions = (curr_sym_tab == top_level_sym_tab);
  1200.       show_variables = 1;
  1201.     }
  1202.  
  1203.   ostrstream output_buf;
  1204.   int pad_after = 0;
  1205.  
  1206.   if (show_builtins)
  1207.     {
  1208.       pad_after += maybe_list ("*** built-in variables:", argv, argc,
  1209.                    output_buf, show_verbose, global_sym_tab,
  1210.                    symbol_def::BUILTIN_VARIABLE,
  1211.                    SYMTAB_ALL_SCOPES);
  1212.  
  1213.       pad_after += maybe_list ("*** built-in functions:", argv, argc,
  1214.                    output_buf, show_verbose, global_sym_tab,
  1215.                    symbol_def::BUILTIN_FUNCTION,
  1216.                    SYMTAB_ALL_SCOPES);
  1217.     }
  1218.  
  1219.   if (show_functions)
  1220.     {
  1221.       pad_after += maybe_list ("*** currently compiled functions:",
  1222.                    argv, argc, output_buf, show_verbose,
  1223.                    global_sym_tab, symbol_def::USER_FUNCTION,
  1224.                    SYMTAB_ALL_SCOPES);
  1225.     }
  1226.  
  1227.   if (show_variables)
  1228.     {
  1229.       pad_after += maybe_list ("*** local user variables:", argv, argc,
  1230.                    output_buf, show_verbose, curr_sym_tab,
  1231.                    symbol_def::USER_VARIABLE,
  1232.                    SYMTAB_LOCAL_SCOPE); 
  1233.  
  1234.       pad_after += maybe_list ("*** globally visible user variables:",
  1235.                    argv, argc, output_buf, show_verbose,
  1236.                    curr_sym_tab, symbol_def::USER_VARIABLE,
  1237.                    SYMTAB_GLOBAL_SCOPE);
  1238.     }
  1239.  
  1240.   if (pad_after)
  1241.     output_buf << "\n";
  1242.  
  1243.   output_buf << ends;
  1244.   maybe_page_output (output_buf);
  1245.  
  1246.   return retval;
  1247. }
  1248.  
  1249. DEFUN_TEXT ("who", Fwho, Swho, -1, 1,
  1250.   "who [-all] [-builtins] [-functions] [-long] [-variables]\n\
  1251. \n\
  1252. List currently defined symbol(s).  Options may be shortened to one\n\
  1253. character, but may not be combined.")
  1254. {
  1255.   Octave_object retval;
  1256.  
  1257.   DEFINE_ARGV("who");
  1258.  
  1259.   retval = do_who (argc, argv, nargout);
  1260.  
  1261.   DELETE_ARGV;
  1262.  
  1263.   return retval;
  1264. }
  1265.  
  1266. DEFUN_TEXT ("whos", Fwhos, Swhos, -1, 1,
  1267.   "whos [-all] [-builtins] [-functions] [-long] [-variables]\n\
  1268. \n\
  1269. List currently defined symbol(s).  Options may be shortened to one\n\
  1270. character, but may not be combined.")
  1271. {
  1272.   Octave_object retval;
  1273.  
  1274.   int nargin = args.length ();
  1275.  
  1276.   Octave_object tmp_args;
  1277.   for (int i = nargin; i > 0; i--)
  1278.     tmp_args(i) = args(i-1);
  1279.   tmp_args(0) = "-long";
  1280.  
  1281.   int argc = tmp_args.length () + 1;
  1282.   char **argv = make_argv (tmp_args, "whos");
  1283.  
  1284.   if (error_state)
  1285.     return retval;
  1286.  
  1287.   retval = do_who (argc, argv, nargout);
  1288.  
  1289.   while (--argc >= 0)
  1290.     delete [] argv[argc];
  1291.   delete [] argv;
  1292.  
  1293.   return retval;
  1294. }
  1295.  
  1296. // Install variables and functions in the symbol tables.
  1297.  
  1298. void
  1299. install_builtin_mapper (builtin_mapper_function *mf)
  1300. {
  1301.   symbol_record *sym_rec = global_sym_tab->lookup (mf->name, 1);
  1302.   sym_rec->unprotect ();
  1303.  
  1304.   Mapper_fcn mfcn;
  1305.   mfcn.name = strsave (mf->name);
  1306.   mfcn.can_return_complex_for_real_arg = mf->can_return_complex_for_real_arg;
  1307.   mfcn.lower_limit = mf->lower_limit;
  1308.   mfcn.upper_limit = mf->upper_limit;
  1309.   mfcn.d_d_mapper = mf->d_d_mapper;
  1310.   mfcn.d_c_mapper = mf->d_c_mapper;
  1311.   mfcn.c_c_mapper = mf->c_c_mapper;
  1312.  
  1313.   tree_builtin *def = new tree_builtin (1, 1, mfcn, mf->name);
  1314.  
  1315.   sym_rec->define (def);
  1316.  
  1317.   sym_rec->document (mf->help_string);
  1318.   sym_rec->make_eternal ();
  1319.   sym_rec->protect ();
  1320. }
  1321.  
  1322. void
  1323. install_builtin_function (builtin_function *f)
  1324. {
  1325.   symbol_record *sym_rec = global_sym_tab->lookup (f->name, 1);
  1326.   sym_rec->unprotect ();
  1327.  
  1328.   tree_builtin *def = new tree_builtin (f->nargin_max, f->nargout_max,
  1329.                     f->fcn, f->name);
  1330.  
  1331.   sym_rec->define (def, f->is_text_fcn);
  1332.  
  1333.   sym_rec->document (f->help_string);
  1334.   sym_rec->make_eternal ();
  1335.   sym_rec->protect ();
  1336. }
  1337.  
  1338. void
  1339. install_builtin_variable (builtin_variable *v)
  1340. {
  1341.   if (v->install_as_function)
  1342.     install_builtin_variable_as_function (v->name, v->value, v->protect,
  1343.                       v->eternal, v->help_string);
  1344.   else
  1345.     bind_builtin_variable (v->name, v->value, v->protect, v->eternal,
  1346.                v->sv_function, v->help_string);
  1347. }
  1348.  
  1349. void
  1350. install_builtin_variable_as_function (const char *name, tree_constant *val,
  1351.                       int protect, int eternal,
  1352.                       const char *help)
  1353. {
  1354.   symbol_record *sym_rec = global_sym_tab->lookup (name, 1);
  1355.   sym_rec->unprotect ();
  1356.  
  1357.   const char *tmp_help = help;
  1358.   if (! help)
  1359.     tmp_help = sym_rec->help ();
  1360.  
  1361.   sym_rec->define_as_fcn (val);
  1362.  
  1363.   sym_rec->document (tmp_help);
  1364.  
  1365.   if (protect)
  1366.     sym_rec->protect ();
  1367.  
  1368.   if (eternal)
  1369.     sym_rec->make_eternal ();
  1370. }
  1371.  
  1372. void
  1373. alias_builtin (const char *alias, const char *name)
  1374. {
  1375.   symbol_record *sr_name = global_sym_tab->lookup (name, 0, 0);
  1376.   if (! sr_name)
  1377.     panic ("can't alias to undefined name!");
  1378.  
  1379.   symbol_record *sr_alias = global_sym_tab->lookup (alias, 1, 0);
  1380.  
  1381.   if (sr_alias)
  1382.     sr_alias->alias (sr_name);
  1383.   else
  1384.     panic ("can't find symbol record for builtin function `%s'", alias);
  1385. }
  1386.  
  1387. // Defining variables.
  1388.  
  1389. void
  1390. bind_nargin_and_nargout (symbol_table *sym_tab, int nargin, int nargout)
  1391. {
  1392.   tree_constant *tmp;
  1393.   symbol_record *sr;
  1394.  
  1395.   sr = sym_tab->lookup ("nargin", 1, 0);
  1396.   sr->unprotect ();
  1397.   tmp = new tree_constant (nargin);
  1398.   sr->define (tmp);
  1399.  
  1400.   sr = sym_tab->lookup ("nargout", 1, 0);
  1401.   sr->unprotect ();
  1402.   tmp = new tree_constant (nargout);
  1403.   sr->define (tmp);
  1404. }
  1405.  
  1406. // Give a global variable a definition.  This will insert the symbol
  1407. // in the global table if necessary.
  1408.  
  1409. // How is this different than install_builtin_variable?  Are both
  1410. // functions needed?
  1411.  
  1412. void
  1413. bind_builtin_variable (const char *varname, tree_constant *val,
  1414.                int protect, int eternal, sv_Function sv_fcn,
  1415.                const char *help)
  1416. {
  1417.   symbol_record *sr = global_sym_tab->lookup (varname, 1, 0);
  1418.  
  1419. // It is a programming error for a builtin symbol to be missing.
  1420. // Besides, we just inserted it, so it must be there.
  1421.  
  1422.   assert (sr);
  1423.  
  1424.   sr->unprotect ();
  1425.  
  1426. // Must do this before define, since define will call the special
  1427. // variable function only if it knows about it, and it needs to, so
  1428. // that user prefs can be properly initialized.
  1429.  
  1430.   if (sv_fcn)
  1431.     sr->set_sv_function (sv_fcn);
  1432.  
  1433.   sr->define_builtin_var (val);
  1434.  
  1435.   if (protect)
  1436.     sr->protect ();
  1437.  
  1438.   if (eternal)
  1439.     sr->make_eternal ();
  1440.  
  1441.   if (help)
  1442.     sr->document (help);    
  1443. }
  1444.  
  1445. void
  1446. install_builtin_variables (void)
  1447. {
  1448. // XXX FIXME XX -- these should probably be moved to where they
  1449. // logically belong instead of being all grouped here.
  1450.  
  1451.   DEFVAR ("EDITOR", SBV_EDITOR, editor, 0, 0, 1, sv_editor,
  1452.     "name of the editor to be invoked by the edit_history command");
  1453.  
  1454.   DEFVAR ("I", SBV_I, Complex (0.0, 1.0), 0, 1, 1, 0,
  1455.     "sqrt (-1)");
  1456.  
  1457.   DEFVAR ("Inf", SBV_Inf, octave_Inf, 0, 1, 1, 0,
  1458.     "infinity");
  1459.  
  1460.   DEFVAR ("INFO_FILE", SBV_INFO_FILE, info_file, 0, 0, 1, sv_info_file,
  1461.     "name of the Octave info file");
  1462.  
  1463.   DEFVAR ("J", SBV_J, Complex (0.0, 1.0), 0, 1, 1, 0,
  1464.     "sqrt (-1)");
  1465.  
  1466.   #if defined (HAVE_ISNAN)
  1467.   DEFVAR ("NaN", SBV_NaN, octave_NaN, 0, 1, 1, 0,
  1468.     "not a number");
  1469.   #endif
  1470.  
  1471.   DEFVAR ("LOADPATH", SBV_LOADPATH, load_path, 0, 0, 1, sv_loadpath,
  1472.     "colon separated list of directories to search for scripts");
  1473.  
  1474.   DEFVAR ("IMAGEPATH", SBV_IMAGEPATH, OCTAVE_IMAGEPATH, 0, 0, 1,
  1475.       sv_imagepath,
  1476.     "colon separated list of directories to search for image files");
  1477.  
  1478.   DEFVAR ("OCTAVE_VERSION", SBV_version, version_string, 0, 1, 1, 0,
  1479.     "Octave version");
  1480.  
  1481.   DEFVAR ("PAGER", SBV_PAGER, default_pager (), 0, 0, 1, sv_pager_binary,
  1482.     "path to pager binary");
  1483.  
  1484.   DEFVAR ("PS1", SBV_PS1, "\\s:\\#> ", 0, 0, 1, sv_ps1,
  1485.     "primary prompt string");
  1486.  
  1487.   DEFVAR ("PS2", SBV_PS2, "> ", 0, 0, 1, sv_ps2,
  1488.     "secondary prompt string");
  1489.  
  1490.   DEFVAR ("PS4", SBV_PS4, "+ ", 0, 0, 1, sv_ps4,
  1491.     "string printed before echoed input (enabled by --echo-input)");
  1492.  
  1493.   DEFVAR ("PWD", SBV_PWD, get_working_directory ("initialize_globals"),
  1494.       0, 1, 1, sv_pwd,
  1495.     "current working directory");
  1496.  
  1497.   DEFVAR ("SEEK_SET", SBV_SEEK_SET, 0.0, 0, 1, 1, 0,
  1498.     "used with fseek to position file relative to the beginning");
  1499.  
  1500.   DEFVAR ("SEEK_CUR", SBV_SEEK_CUR, 1.0, 0, 1, 1, 0,
  1501.     "used with fseek to position file relative to the current position");
  1502.  
  1503.   DEFVAR ("SEEK_END", SBV_SEEK_END, 2.0, 0, 1, 1, 0,
  1504.     "used with fseek to position file relative to the end");
  1505.  
  1506.   DEFVAR ("ans", SBV_ans, , 0, 0, 1, 0,
  1507.     "");
  1508.  
  1509.   DEFVAR ("automatic_replot", SBV_automatic_replot, "false",
  1510.       0, 0, 1, automatic_replot,
  1511.     "if true, auto-insert a replot command when a plot changes");
  1512.  
  1513.   DEFVAR ("default_return_value", SBV_default_return_value, Matrix (),
  1514.       0, 0, 1, 0,
  1515.     "the default for value for unitialized variables returned from\n\
  1516. functions.  Only used if the variable initialize_return_values is\n\
  1517. set to \"true\".");
  1518.  
  1519.   DEFVAR ("default_save_format", SBV_default_save_format, "ascii",
  1520.       0, 0, 1, sv_default_save_format,
  1521.     "default format for files created with save, may be one of\n\
  1522. \"binary\", \"text\", or \"mat-binary\""); 
  1523.  
  1524.   DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0,
  1525.       1, do_fortran_indexing,
  1526.     "allow single indices for matrices");
  1527.  
  1528.   DEFVAR ("empty_list_elements_ok", SBV_empty_list_elements_ok, "warn",
  1529.       0, 0, 1, empty_list_elements_ok,
  1530.     "ignore the empty element in expressions like `a = [[], 1]'");
  1531.  
  1532.   DEFVAR ("eps", SBV_eps, DBL_EPSILON, 0, 1, 1, 0,
  1533.     "machine precision");
  1534.  
  1535.   DEFVAR ("gnuplot_binary", SBV_gnuplot_binary, "gnuplot", 0, 0, 1,
  1536.       sv_gnuplot_binary,
  1537.     "path to gnuplot binary");
  1538.  
  1539.   DEFVAR ("i", SBV_i, Complex (0.0, 1.0), 1, 1, 1, 0,
  1540.     "sqrt (-1)");
  1541.  
  1542.   DEFVAR ("ignore_function_time_stamp", SBV_ignore_function_time_stamp,
  1543.       "system", 0, 0, 1,
  1544.       ignore_function_time_stamp,
  1545.     "don't check to see if function files have changed since they were\n\
  1546.   last compiled.  Possible values are \"system\" and \"all\"");
  1547.  
  1548.   DEFVAR ("implicit_str_to_num_ok", SBV_implicit_str_to_num_ok, "false",
  1549.       0, 0, 1, implicit_str_to_num_ok,
  1550.     "allow implicit string to number conversion");
  1551.  
  1552.   DEFVAR ("inf", SBV_inf, octave_Inf, 0, 1, 1, 0,
  1553.     "infinity");
  1554.  
  1555.   DEFVAR ("define_all_return_values", SBV_define_all_return_values,
  1556.       "false", 0, 0, 1, define_all_return_values,
  1557.     "control whether values returned from functions should have a\n\
  1558. value even if one has not been explicitly assigned.  See also\n\
  1559. default_return_value"); 
  1560.  
  1561.   DEFVAR ("j", SBV_j, Complex (0.0, 1.0), 1, 1, 1, 0,
  1562.     "sqrt (-1)");
  1563.  
  1564.   #if defined (HAVE_ISNAN)
  1565.   DEFVAR ("nan", SBV_nan, octave_NaN, 0, 1, 1, 0,
  1566.     "not a number");
  1567.   #endif
  1568.  
  1569.   DEFVAR ("ok_to_lose_imaginary_part", SBV_ok_to_lose_imaginary_part,
  1570.       "warn", 0, 0, 1, ok_to_lose_imaginary_part,
  1571.     "silently convert from complex to real by dropping imaginary part");
  1572.  
  1573.   DEFVAR ("output_max_field_width", SBV_output_max_field_width, 10.0, 0,
  1574.       0, 1, set_output_max_field_width,
  1575.     "maximum width of an output field for numeric output");
  1576.  
  1577.   DEFVAR ("output_precision", SBV_output_precision, 5.0, 0, 0, 1,
  1578.       set_output_precision,
  1579.     "number of significant figures to display for numeric output");
  1580.  
  1581.   DEFVAR ("page_screen_output", SBV_page_screen_output, "true", 0, 0, 1,
  1582.       page_screen_output,
  1583.     "if possible, send output intended for the screen through the pager");
  1584.  
  1585.   DEFVAR ("pi", SBV_pi, 4.0 * atan (1.0), 0, 1, 1, 0,
  1586.     "ratio of the circumference of a circle to its diameter");
  1587.  
  1588.   DEFVAR ("prefer_column_vectors", SBV_prefer_column_vectors, "true", 0,
  1589.       0, 1, prefer_column_vectors,
  1590.     "prefer column/row vectors");
  1591.  
  1592.   DEFVAR ("prefer_zero_one_indexing", SBV_prefer_zero_one_indexing,
  1593.       "false", 0, 0, 1, prefer_zero_one_indexing,
  1594.     "when there is a conflict, prefer zero-one style indexing");
  1595.  
  1596.   DEFVAR ("print_answer_id_name", SBV_print_answer_id_name, "true", 0,
  1597.       0, 1, print_answer_id_name,
  1598.     "set output style to print `var_name = ...'");
  1599.  
  1600.   DEFVAR ("print_empty_dimensions", SBV_print_empty_dimensions, "true",
  1601.       0, 0, 1, print_empty_dimensions,
  1602.     "also print dimensions of empty matrices");
  1603.  
  1604.   DEFVAR ("propagate_empty_matrices", SBV_propagate_empty_matrices,
  1605.       "true", 0, 0, 1, propagate_empty_matrices,
  1606.     "operations on empty matrices return an empty matrix, not an error");
  1607.  
  1608. #if 0
  1609.   DEFVAR ("read_only_constants", SBV_read_only_constants, "true", 0,
  1610.         0, 1, read_only_constants,
  1611.     "allow built-in constants to be modified");
  1612. #endif
  1613.  
  1614.   DEFVAR ("realmax", SBV_realmax, DBL_MAX, 1, 1, 1, 0,
  1615.     "realmax (): return largest representable floating point number");
  1616.  
  1617.   DEFVAR ("realmin", SBV_realmin, DBL_MIN, 1, 1, 1, 0,
  1618.     "realmin (): return smallest representable floating point number");
  1619.  
  1620.   DEFVAR ("resize_on_range_error", SBV_resize_on_range_error, "true", 0,
  1621.       0, 1, resize_on_range_error,
  1622.     "enlarge matrices on assignment");
  1623.  
  1624.   DEFVAR ("return_last_computed_value", SBV_return_last_computed_value,
  1625.       "false", 0, 0, 1,
  1626.       return_last_computed_value,
  1627.     "if a function does not return any values explicitly, return the\n\
  1628.   last computed value");
  1629.  
  1630.   DEFVAR ("save_precision", SBV_save_precision, 17.0, 0, 0, 1,
  1631.       set_save_precision,
  1632.     "number of significant figures kept by the ASCII save command");
  1633.  
  1634.   DEFVAR ("silent_functions", SBV_silent_functions, "false", 0, 0, 1,
  1635.       silent_functions,
  1636.     "suppress printing results in called functions");
  1637.  
  1638.   DEFVAR ("split_long_rows", SBV_split_long_rows, "true", 0, 0, 1,
  1639.       split_long_rows,
  1640.     "split long matrix rows instead of wrapping");
  1641.  
  1642.   DEFVAR ("suppress_verbose_help_message",
  1643.       SBV_suppress_verbose_help_message, "false", 0, 0, 1,
  1644.       suppress_verbose_help_message,
  1645.     "suppress printing of message pointing to additional help in the\n\
  1646. help and usage functions");
  1647.  
  1648.   DEFVAR ("stdin", SBV_stdin, 0.0, 0, 1, 1, 0,
  1649.     "file number of the standard input stream");
  1650.  
  1651.   DEFVAR ("stdout", SBV_stdout, 1.0, 0, 1, 1, 0,
  1652.     "file number of the standard output stream");
  1653.  
  1654.   DEFVAR ("stderr", SBV_stderr, 2.0, 0, 1, 1, 0,
  1655.     "file number of the standard error stream");
  1656.  
  1657.   DEFVAR ("treat_neg_dim_as_zero", SBV_treat_neg_dim_as_zero, "false",
  1658.       0, 0, 1, treat_neg_dim_as_zero,
  1659.     "convert negative dimensions to zero");
  1660.  
  1661.   DEFVAR ("warn_assign_as_truth_value", SBV_warn_assign_as_truth_value,
  1662.       "true", 0, 0, 1,
  1663.       warn_assign_as_truth_value,
  1664.     "produce warning for assignments used as truth values");
  1665.  
  1666.   DEFVAR ("warn_comma_in_global_decl", SBV_warn_comma_in_global_decl,
  1667.       "true", 0, 0, 1, warn_comma_in_global_decl,
  1668.     "produce warning for commas in global declarations");
  1669.  
  1670.   DEFVAR ("warn_divide_by_zero", SBV_warn_divide_by_zero, "true", 0, 0,
  1671.       1, warn_divide_by_zero,
  1672.     "on IEEE machines, allow divide by zero errors to be suppressed");
  1673.  
  1674.   DEFVAR ("warn_function_name_clash", SBV_warn_function_name_clash,
  1675.       "true", 0, 0, 1, warn_function_name_clash,
  1676.     "produce warning if function name conflicts with file name");
  1677.  
  1678.   DEFVAR ("whitespace_in_literal_matrix", SBV_whitespace_in_literal_matrix, "",
  1679.       0, 0, 1, whitespace_in_literal_matrix,
  1680.     "control auto-insertion of commas and semicolons in literal matrices");
  1681.  
  1682. }
  1683.  
  1684. // Deleting names from the symbol tables.
  1685.  
  1686. DEFUN_TEXT ("clear", Fclear, Sclear, -1, 1,
  1687.   "clear [-x] [name ...]\n\
  1688. \n\
  1689. Clear symbol(s) matching a list of globbing patterns.\n\
  1690. \n\
  1691. If no arguments are given, clear all user-defined variables and
  1692. functions.\n\
  1693. \n\
  1694. With -x, exclude the named variables")
  1695. {
  1696.   Octave_object retval;
  1697.  
  1698.   DEFINE_ARGV("clear");
  1699.  
  1700.   argc--;
  1701.   argv++;
  1702.  
  1703. // Always clear the local table, but don't clear currently compiled
  1704. // functions unless we are at the top level.  (Allowing that to happen
  1705. // inside functions would result in pretty odd behavior...)
  1706.  
  1707.   int clear_user_functions = (curr_sym_tab == top_level_sym_tab);
  1708.  
  1709.   if (argc == 0)
  1710.     {
  1711.       curr_sym_tab->clear ();
  1712.       global_sym_tab->clear (clear_user_functions);
  1713.     }
  1714.   else
  1715.     {
  1716.       int exclusive = 0;
  1717.  
  1718.       if (argc > 0)
  1719.     {
  1720.       if (strcmp (*argv, "-x") == 0)
  1721.         {
  1722.           exclusive = 1;
  1723.           argv++;
  1724.           argc--;
  1725.         }
  1726.     }
  1727.  
  1728.       int lcount = 0;
  1729.       int gcount = 0;
  1730.       int fcount = 0;
  1731.  
  1732.       char **lvars = 0;
  1733.       char **gvars = 0;
  1734.       char **fcns = 0;
  1735.  
  1736.       if (argc > 0)
  1737.     {
  1738.       lvars = curr_sym_tab->list (lcount, 0, 0, 0,
  1739.                       symbol_def::USER_VARIABLE,
  1740.                       SYMTAB_LOCAL_SCOPE);
  1741.  
  1742.       gvars = curr_sym_tab->list (gcount, 0, 0, 0,
  1743.                       symbol_def::USER_VARIABLE,
  1744.                       SYMTAB_GLOBAL_SCOPE);
  1745.  
  1746.       fcns = global_sym_tab->list (fcount, 0, 0, 0,
  1747.                        symbol_def::USER_FUNCTION,
  1748.                        SYMTAB_ALL_SCOPES);
  1749.     }
  1750.  
  1751.       while (argc > 0)
  1752.     {
  1753.       char *pat = *argv;
  1754.  
  1755.       if (pat)
  1756.         {
  1757.           int i;
  1758.           for (i = 0; i < lcount; i++)
  1759.         {
  1760.           char *nm = lvars[i];
  1761.           int match = (fnmatch (pat, nm, __FNM_FLAGS) == 0);
  1762.           if ((exclusive && ! match) || (! exclusive && match))
  1763.             curr_sym_tab->clear (nm);
  1764.         }
  1765.  
  1766.           int count;
  1767.           for (i = 0; i < gcount; i++)
  1768.         {
  1769.           char *nm = gvars[i];
  1770.           int match = (fnmatch (pat, nm, __FNM_FLAGS) == 0);
  1771.           if ((exclusive && ! match) || (! exclusive && match))
  1772.             {
  1773.               count = curr_sym_tab->clear (nm);
  1774.               if (count > 0)
  1775.             global_sym_tab->clear (nm, clear_user_functions);
  1776.             }
  1777.         }
  1778.  
  1779.           for (i = 0; i < fcount; i++)
  1780.         {
  1781.           char *nm = fcns[i];
  1782.           int match = (fnmatch (pat, nm, __FNM_FLAGS) == 0);
  1783.           if ((exclusive && ! match) || (! exclusive && match))
  1784.             {
  1785.               count = curr_sym_tab->clear (nm);
  1786.               global_sym_tab->clear (nm, clear_user_functions);
  1787.             }
  1788.         }
  1789.         }
  1790.  
  1791.       argc--;
  1792.       argv++;
  1793.     }
  1794.  
  1795.       delete [] lvars;
  1796.       delete [] gvars;
  1797.       delete [] fcns;
  1798.  
  1799.     }
  1800.  
  1801.   DELETE_ARGV;
  1802.  
  1803.   return retval;
  1804. }
  1805.  
  1806. /*
  1807. ;;; Local Variables: ***
  1808. ;;; mode: C++ ***
  1809. ;;; page-delimiter: "^/\\*" ***
  1810. ;;; End: ***
  1811. */
  1812.