octave-nkf: src/variables.cc comparison

comparison src/variables.cc @ 529:7ea224e713cd

[project @ 1994-07-20 18:54:27 by jwe]

author	jwe
date	Wed, 20 Jul 1994 19:19:08 +0000
parents	0f388340e607
children	682393bf54f7

comparison

equal deleted inserted replaced

-:e1e6e33e26f8
+:7ea224e713cd
 #include <sys/types.h>
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
 #endif
 #include <ctype.h>
+#include <float.h>
+#include <string.h>
+#include <fstream.h>
 #include <iostream.h>
 #include <strstream.h>
 #include "statdefs.h"
 #include "tree-const.h"
 #include "variables.h"
+#include "mappers.h"
 #include "user-prefs.h"
+#include "version.h"
 #include "symtab.h"
-#include "builtins.h"
+#include "defaults.h"
-#include "g-builtins.h"
+#include "dirfns.h"
-#include "t-builtins.h"
+#include "pager.h"
+#include "sysdep.h"
+#include "octave.h"
+#include "oct-obj.h"
 #include "error.h"
 #include "utils.h"
 #include "tree.h"
 #include "help.h"
+#include "defun.h"
+extern "C"
+{
+#include <readline/tilde.h>
+#include "fnmatch.h"
+}
 // Symbol table for symbols at the top level.
 symbol_table *top_level_sym_tab;
 // Symbol table for the current scope.
 int ignore = user_pref.ignore_function_time_stamp;
 if (ignore == 2)
 return 0;
-if (sr != (symbol_record *) NULL)
+if (sr)
 {
 tree_fvc *ans = sr->def ();
-if (ans != (tree_fvc *) NULL)
+if (ans)
 	{
 	  char *ff = ans->fcn_file_name ();
-	  if (! (ff == (char *) NULL
+	  if (ff && ! (ignore && ans->is_system_fcn_file ()))
-		 || (ignore && ans->is_system_fcn_file ())))
 	    {
 	      time_t tp = ans->time_parsed ();
 	      char *fname = fcn_file_in_path (ff);
 	      int status = is_newer (fname, tp);
 	      delete [] fname;
 error ("sorry, can't redefine help for builtin variables");
 }
 else
 {
 symbol_record *sym_rec = curr_sym_tab->lookup (name, 0);
-if (sym_rec == (symbol_record *) NULL)
+if (sym_rec)
-	{
+	sym_rec->document (help);
-	  error ("document: no such symbol `%s'", name);
-	}
 else
-	{
+	error ("document: no such symbol `%s'", name);
-	  sym_rec->document (help);
-	}
 }
 }
 void
-install_builtin_mapper_function (builtin_mapper_functions *mf)
+install_builtin_mapper (builtin_mapper_function *mf)
 {
 symbol_record *sym_rec = global_sym_tab->lookup (mf->name, 1);
 sym_rec->unprotect ();
 Mapper_fcn mfcn;
 sym_rec->make_eternal ();
 sym_rec->protect ();
 }
 void
-install_builtin_text_function (builtin_text_functions *tf)
+install_builtin_function (builtin_function *f)
 {
-symbol_record *sym_rec = global_sym_tab->lookup (tf->name, 1);
+symbol_record *sym_rec = global_sym_tab->lookup (f->name, 1);
 sym_rec->unprotect ();
-tree_builtin *def = new tree_builtin (tf->nargin_max, 1,
+tree_builtin *def = new tree_builtin (f->nargin_max, f->nargout_max,
-					tf->text_fcn, tf->name);
+					f->fcn, f->name);
-sym_rec->define (def);
+sym_rec->define (def, f->is_text_fcn);
-sym_rec->document (tf->help_string);
+sym_rec->document (f->help_string);
 sym_rec->make_eternal ();
 sym_rec->protect ();
 }
 void
-install_builtin_general_function (builtin_general_functions *gf)
+install_builtin_variable (builtin_variable *v)
 {
-symbol_record *sym_rec = global_sym_tab->lookup (gf->name, 1);
+if (v->install_as_function)
-sym_rec->unprotect ();
+install_builtin_variable_as_function (v->name, v->value, v->protect,
+					  v->eternal, v->help_string);
-tree_builtin *def = new tree_builtin (gf->nargin_max,
+else
-					gf->nargout_max,
+bind_builtin_variable (v->name, v->value, v->protect, v->eternal,
-					gf->general_fcn, gf->name);
+			   v->sv_function, v->help_string);
-sym_rec->define (def);
-sym_rec->document (gf->help_string);
-sym_rec->make_eternal ();
-sym_rec->protect ();
-}
-void
-install_builtin_variable (builtin_string_variables *sv)
-{
-tree_constant *val = new tree_constant (sv->value);
-bind_builtin_variable (sv->name, val, 0, 1, sv->sv_function,
-			 sv->help_string);
 }
 void
 install_builtin_variable_as_function (const char *name, tree_constant *val,
-				      int protect = 0, int eternal = 0)
+				      int protect, int eternal,
+				      const char *help)
 {
 symbol_record *sym_rec = global_sym_tab->lookup (name, 1);
 sym_rec->unprotect ();
-char *tmp_help = sym_rec->help ();
+const char *tmp_help = help;
+if (! help)
+tmp_help = sym_rec->help ();
 sym_rec->define_as_fcn (val);
 sym_rec->document (tmp_help);
 * Give a global variable a definition.  This will insert the symbol
 * in the global table if necessary.
 */
 void
 bind_builtin_variable (const char *varname, tree_constant *val,
-		       int protect = 0, int eternal = 0,
+		       int protect, int eternal, sv_Function sv_fcn,
-		       sv_Function sv_fcn = (sv_Function) 0,
+		       const char *help)
-		       const char *help = (char *) 0)
 {
 symbol_record *sr = global_sym_tab->lookup (varname, 1, 0);
 // It is a programming error for a builtin symbol to be missing.
 // Besides, we just inserted it, so it must be there.
-assert (sr != (symbol_record *) NULL);
+assert (sr);
 sr->unprotect ();
 // Must do this before define, since define will call the special
 // variable function only if it knows about it, and it needs to, so
 sr->document (help);
 }
 /*
 * Look for the given name in the global symbol table.  If it refers
-* to a string, return a new copy.  If not, return NULL.
+* to a string, return a new copy.  If not, return 0;
 */
 char *
 builtin_string_variable (const char *name)
 {
 symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
 // It is a prorgramming error to look for builtins that aren't.
-assert (sr != (symbol_record *) NULL);
+assert (sr);
-char *retval = (char *) NULL;
+char *retval = 0;
 tree_fvc *defn = sr->def ();
-if (defn != (tree_fvc *) NULL)
+if (defn)
 {
 tree_constant val = defn->eval (0);
 if (! error_state && val.is_string_type ())
 	{
 	  char *s = val.string_value ();
-	  if (s != (char *) NULL)
+	  if (s)
 	    retval = strsave (s);
 	}
 }
 return retval;
 int status = -1;
 symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
 // It is a prorgramming error to look for builtins that aren't.
-assert (sr != (symbol_record *) NULL);
+assert (sr);
 tree_fvc *defn = sr->def ();
-if (defn != (tree_fvc *) NULL)
+if (defn)
 {
 tree_constant val = defn->eval (0);
 if (! error_state
 	  && val.const_type () == tree_constant_rep::scalar_constant)
 if (sr->is_variable ())
 {
 // Would be nice not to have this cast.  XXX FIXME XXX
 tree_constant *tmp = (tree_constant *) sr->def ();
-if (tmp == NULL_TREE_CONST)
+if (tmp)
+	tmp = new tree_constant (*tmp);
+else
 	tmp = new tree_constant ();
-else
-	tmp = new tree_constant (*tmp);
 gsr->define (tmp);
 }
 else
-{
+sr->clear ();
-sr->clear ();
-}
 // If the global symbol is currently defined as a function, we need to
 // hide it with a variable.
 if (gsr->is_function ())
-gsr->define (NULL_TREE_CONST);
+gsr->define ((tree_constant *) 0);
 sr->alias (gsr, 1);
 sr->mark_as_linked_to_global ();
 }
 void
 link_to_builtin_variable (symbol_record *sr)
 {
 symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
-if (tmp_sym != (symbol_record *) NULL)
+if (tmp_sym && tmp_sym->is_builtin_variable ())
-{
+sr->alias (tmp_sym);
-if (tmp_sym->is_builtin_variable ())
-	{
-	  sr->alias (tmp_sym);
-	}
-}
 }
 /*
 * Make the definition of the symbol record sr be the same as the
 * definition of the builtin variable or function, or user function of
 void
 link_to_builtin_or_function (symbol_record *sr)
 {
 symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0);
-if (tmp_sym != (symbol_record *) NULL)
+if (tmp_sym
-{
+&& (tmp_sym->is_builtin_variable () || tmp_sym->is_function ())
-if ((tmp_sym->is_builtin_variable () || tmp_sym->is_function ())
+&& ! tmp_sym->is_formal_parameter ())
-	  && ! tmp_sym->is_formal_parameter ())
+sr->alias (tmp_sym);
-	{
-	  sr->alias (tmp_sym);
-	}
-}
 }
 /*
 * Force a link to a function in the current symbol table.  This is
 * used just after defining a function to avoid different behavior
 symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0);
 csr->alias (gsr);
 }
 }
-/*
+DEFUN ("is_global", Fis_global, Sis_global, 2, 1,
-* Return 1 if the argument names a globally visible variable.
+"is_global (X): return 1 if the string X names a global variable\n\
-* Otherwise, return 0.
+otherwise, return 0.")
-*/
+{
-int
+Octave_object retval (0.0);
-is_globally_visible (const char *name)
-{
+int nargin = args.length ();
+if (nargin != 2 || ! args(1).is_string_type ())
+{
+print_usage ("is_global");
+return retval;
+}
+char *name = args(1).string_value ();
 symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
-return (sr != (symbol_record *) NULL && sr->is_linked_to_global ());
+retval = (double) (sr && sr->is_linked_to_global ());
+return retval;
 }
 /*
 * Extract a keyword and its value from a file.  Input should look
 * something like:
 char *
 extract_keyword (istream& is, char *keyword)
 {
 ostrstream buf;
-char *retval = (char *) NULL;
+char *retval = 0;
 char c;
 while (is.get (c))
 {
 if (c == '#')
 * Is `s' a valid identifier?
 */
 int
 valid_identifier (char *s)
 {
-if (s == (char *) NULL || ! (isalnum (*s) || *s == '_'))
+if (! s || ! (isalnum (*s) || *s == '_'))
 return 0;
 while (*++s != '\0')
 if (! (isalnum (*s) || *s == '_'))
 return 0;
 return 1;
 }
-/*
+DEFUN ("exist", Fexist, Sexist, 2, 1,
-* See if the identifier is in scope.
+"exist (NAME): check if variable or file exists\n\
-*/
+\n\
-int
+return 0 if NAME is undefined, 1 if it is a variable, or 2 if it is\n\
-identifier_exists (char *name)
+a function.")
 {
+Octave_object retval;
+int nargin = args.length ();
+if (nargin != 2 || ! args(1).is_string_type ())
+{
+print_usage ("exist");
+return retval;
+}
+char *name = args(1).string_value ();
 symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
-if (sr == (symbol_record *) NULL)
+if (! sr)
 sr = global_sym_tab->lookup (name, 0, 0);
-if (sr != (symbol_record *) NULL && sr->is_variable () && sr->is_defined ())
+retval = 0.0;
-return 1;
-else if (sr != (symbol_record *) NULL && sr->is_function ())
+if (sr && sr->is_variable () && sr->is_defined ())
-return 2;
+retval = 1.0;
+else if (sr && sr->is_function ())
+retval = 2.0;
 else
 {
 char *path = fcn_file_in_path (name);
-if (path != (char *) NULL)
+if (path)
 	{
 	  delete [] path;
-	  return 2;
+	  retval = 2.0;
 	}
 else
 	{
 	  struct stat buf;
 	  if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode))
-	    return 2;
+	    retval = 2.0;
 	}
 }
-return 0;
+return retval;
 }
 /*
 * Is this variable a builtin?
 */
 int
 is_builtin_variable (const char *name)
 {
 symbol_record *sr = global_sym_tab->lookup (name, 0, 0);
-return (sr != (symbol_record *) NULL && sr->is_builtin_variable ());
+return (sr && sr->is_builtin_variable ());
 }
 /*
 * Is this tree_constant a valid function?
 */
 tree_fvc *
-is_valid_function (tree_constant& arg, char *warn_for, int warn = 0)
+is_valid_function (const tree_constant& arg, char *warn_for, int warn)
 {
-tree_fvc *ans = (tree_fvc *) NULL;
+tree_fvc *ans = 0;
 if (! arg.is_string_type ())
 {
 if (warn)
 	error ("%s: expecting function name as argument", warn_for);
 }
 char *fcn_name = arg.string_value ();
 symbol_record *sr = global_sym_tab->lookup (fcn_name, 0, 0);
-if (sr == (symbol_record *) NULL)
+if (sr && symbol_out_of_date (sr))
+{
+tree_identifier tmp (sr);
+tmp.parse_fcn_file (0);
+}
+else
 {
 sr = global_sym_tab->lookup (fcn_name, 1, 0);
 tree_identifier tmp (sr);
 tmp.parse_fcn_file (0);
 }
-else if (symbol_out_of_date (sr))
-{
-tree_identifier tmp (sr);
-tmp.parse_fcn_file (0);
-}
 ans = sr->def ();
-if (ans == (tree_fvc *) NULL || ! sr->is_function ())
+if (! ans || ! sr->is_function ())
 {
 if (warn)
 	error ("%s: the symbol `%s' is not valid as a function",
 	       warn_for, fcn_name);
-ans = (tree_fvc *) NULL;
+ans = 0;
 }
 return ans;
 }
 /*
 * Does this function take the right number of arguments?
 */
 int
 takes_correct_nargs (tree_fvc *fcn, int expected_nargin, char *warn_for,
-		     int warn = 0)
+		     int warn)
 {
 int nargin = fcn->max_expected_args () - 1;
 int e_nargin = expected_nargin - 1;
 if (nargin != e_nargin)
 {
 if (warn)
 	error ("%s: expecting function to take %d argument%c",
-	       warn_for, e_nargin, s_plural (e_nargin));
+	       warn_for, e_nargin, (e_nargin == 1 ? "" : "s"));
 return 0;
 }
 return 1;
 }
 int glb_len = 0;
 int top_len = 0;
 int lcl_len = 0;
 int ffl_len = 0;
-char **key = (char **) NULL;
+char **key = 0;
-char **glb = (char **) NULL;
+char **glb = 0;
-char **top = (char **) NULL;
+char **top = 0;
-char **lcl = (char **) NULL;
+char **lcl = 0;
-char **ffl = (char **) NULL;
+char **ffl = 0;
 // Each of these functions returns a new vector of pointers to new
 // strings.
 key = names (keyword_help (), key_len);
 list[j++] = lcl[i];
 for (i = 0; i < ffl_len; i++)
 list[j++] = ffl[i];
-list[j] = (char *) NULL;
+list[j] = 0;
 delete [] key;
 delete [] glb;
 delete [] top;
 delete [] lcl;
 delete [] ffl;
 return list;
+}
+int
+is_text_function_name (const char *s)
+{
+symbol_record *sr = global_sym_tab->lookup (s);
+return (sr && sr->is_text_function ());
+}
+/*
+* Help stuff.
+*/
+help_list *
+builtin_mapper_functions_help (void)
+{
+#if 0
+int count = 0;
+builtin_mapper_functions *mfptr;
+mfptr = mapper_functions;
+while (mfptr->name)
+{
+count++;
+mfptr++;
+}
+if (count == 0)
+return 0;
+help_list *hl = new help_list [count+1];
+int i = 0;
+mfptr = mapper_functions;
+while (mfptr->name)
+{
+hl[i].name = mfptr->name;
+hl[i].help = mfptr->help_string;
+i++;
+mfptr++;
+}
+hl[count].name = 0;
+hl[count].help = 0;
+return hl;
+#endif
+return 0;
+}
+help_list *
+builtin_general_functions_help (void)
+{
+#if 0
+int count = 0;
+builtin_general_functions *gfptr;
+gfptr = general_functions;
+while (gfptr->name)
+{
+count++;
+gfptr++;
+}
+if (count == 0)
+return 0;
+help_list *hl = new help_list [count+1];
+int i = 0;
+gfptr = general_functions;
+while (gfptr->name)
+{
+hl[i].name = gfptr->name;
+hl[i].help = gfptr->help_string;
+i++;
+gfptr++;
+}
+hl[count].name = 0;
+hl[count].help = 0;
+return hl;
+#endif
+return 0;
+}
+help_list *
+builtin_text_functions_help (void)
+{
+#if 0
+int count = 0;
+builtin_text_functions *tfptr;
+tfptr = text_functions;
+while (tfptr->name)
+{
+count++;
+tfptr++;
+}
+if (count == 0)
+return 0;
+help_list *hl = new help_list [count+1];
+int i = 0;
+tfptr = text_functions;
+while (tfptr->name)
+{
+hl[i].name = tfptr->name;
+hl[i].help = tfptr->help_string;
+i++;
+tfptr++;
+}
+hl[count].name = 0;
+hl[count].help = 0;
+return hl;
+#endif
+return 0;
+}
+help_list *
+builtin_variables_help (void)
+{
+#if 0
+int count = 0;
+builtin_string_variables *svptr;
+svptr = string_variables;
+while (svptr->name)
+{
+count++;
+svptr++;
+}
+if (count == 0)
+return 0;
+help_list *hl = new help_list [count+1];
+int i = 0;
+svptr = string_variables;
+while (svptr->name)
+{
+hl[i].name = svptr->name;
+hl[i].help = svptr->help_string;
+i++;
+svptr++;
+}
+hl[count].name = 0;
+hl[count].help = 0;
+return hl;
+#endif
+return 0;
+}
+int
+help_from_list (ostrstream& output_buf, const help_list *list,
+		const char *string, int usage)
+{
+char *name;
+while ((name = list->name) != 0)
+{
+if (strcmp (name, string) == 0)
+	{
+	  if (usage)
+	    output_buf << "\nusage: ";
+	  else
+	    {
+	      output_buf << "\n*** " << string << ":\n\n";
+	    }
+	  output_buf << list->help << "\n";
+	  return 1;
+	}
+list++;
+}
+return 0;
+}
+void
+additional_help_message (ostrstream& output_buf)
+{
+output_buf
+<< "\n"
+<< "Additional help for builtin functions, operators, and variables\n"
+<< "is available in the on-line version of the manual.\n"
+<< "\n"
+<< "Use the command `help -i <topic>' to search the manual index.\n";
+}
+void
+print_usage (const char *string, int just_usage)
+{
+ostrstream output_buf;
+help_list *gf_help_list = builtin_general_functions_help ();
+help_list *tf_help_list = builtin_text_functions_help ();
+help_list *mf_help_list = builtin_mapper_functions_help ();
+if (help_from_list (output_buf, gf_help_list, string, 1)
+|| help_from_list (output_buf, tf_help_list, string, 1)
+|| help_from_list (output_buf, mf_help_list, string, 1))
+{
+if (! just_usage)
+	additional_help_message (output_buf);
+output_buf << ends;
+maybe_page_output (output_buf);
+}
+}
+void
+install_builtin_variables (void)
+{
+// XXX FIXME XX -- these should probably be moved to where they
+// logically belong instead of being all grouped here.
+DEFVAR ("EDITOR", SBV_EDITOR, editor, 0, 0, 1, sv_editor,
+"name of the editor to be invoked by the edit_history command");
+DEFVAR ("I", SBV_I, Complex (0.0, 1.0), 0, 1, 1, 0,
+"sqrt (-1)");
+DEFVAR ("Inf", SBV_Inf, octave_Inf, 0, 1, 1, 0,
+"infinity");
+DEFVAR ("INFO_FILE", SBV_INFO_FILE, info_file, 0, 0, 1, sv_info_file,
+"name of the Octave info file");
+DEFVAR ("J", SBV_J, Complex (0.0, 1.0), 0, 1, 1, 0,
+"sqrt (-1)");
+#if defined (HAVE_ISNAN)
+DEFVAR ("NaN", SBV_NaN, octave_NaN, 0, 1, 1, 0,
+"not a number");
+#endif
+DEFVAR ("LOADPATH", SBV_LOADPATH, load_path, 0, 0, 1, sv_loadpath,
+"colon separated list of directories to search for scripts");
+DEFVAR ("PAGER", SBV_PAGER, default_pager (), 0, 0, 1, sv_pager_binary,
+"path to pager binary");
+DEFVAR ("PS1", SBV_PS1, "\\s:\\#> ", 0, 0, 1, sv_ps1,
+"primary prompt string");
+DEFVAR ("PS2", SBV_PS2, "> ", 0, 0, 1, sv_ps2,
+"secondary prompt string");
+DEFVAR ("PWD", SBV_PWD, get_working_directory ("initialize_globals"),
+	  0, 1, 1, sv_pwd,
+"current working directory");
+DEFVAR ("SEEK_SET", SBV_SEEK_SET, 0.0, 0, 1, 1, 0,
+"used with fseek to position file relative to the beginning");
+DEFVAR ("SEEK_CUR", SBV_SEEK_CUR, 1.0, 0, 1, 1, 0,
+"used with fseek to position file relative to the current position");
+DEFVAR ("SEEK_END", SBV_SEEK_END, 2.0, 0, 1, 1, 0,
+"used with fseek to position file relative to the end");
+DEFVAR ("ans", SBV_ans, , 0, 0, 1, 0,
+"");
+DEFVAR ("commas_in_literal_matrix", SBV_commas_in_literal_matrix, "",
+	  0, 0, 1, commas_in_literal_matrix,
+"control auto-insertion of commas in literal matrices");
+DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0,
+	  1, do_fortran_indexing,
+"allow single indices for matrices");
+DEFVAR ("empty_list_elements_ok", SBV_empty_list_elements_ok, "warn",
+	  0, 0, 1, empty_list_elements_ok,
+"ignore the empty element in expressions like `a = [[], 1]'");
+DEFVAR ("eps", SBV_eps, DBL_EPSILON, 0, 1, 1, 0,
+"machine precision");
+DEFVAR ("gnuplot_binary", SBV_gnuplot_binary, "gnuplot", 0, 0, 1,
+	  sv_gnuplot_binary,
+"path to gnuplot binary");
+DEFVAR ("i", SBV_i, Complex (0.0, 1.0), 1, 1, 1, 0,
+"sqrt (-1)");
+DEFVAR ("ignore_function_time_stamp", SBV_ignore_function_time_stamp,
+	  "system", 0, 0, 1,
+	  ignore_function_time_stamp,
+"don't check to see if function files have changed since they were\n\
+last compiled.  Possible values are \"system\" and \"all\"");
+DEFVAR ("implicit_str_to_num_ok", SBV_implicit_str_to_num_ok, "false",
+	  0, 0, 1, implicit_str_to_num_ok,
+"allow implicit string to number conversion");
+DEFVAR ("inf", SBV_inf, octave_Inf, 0, 1, 1, 0,
+"infinity");
+DEFVAR ("j", SBV_j, Complex (0.0, 1.0), 1, 1, 1, 0,
+"sqrt (-1)");
+#if defined (HAVE_ISNAN)
+DEFVAR ("nan", SBV_nan, octave_NaN, 0, 1, 1, 0,
+"not a number");
+#endif
+DEFVAR ("ok_to_lose_imaginary_part", SBV_ok_to_lose_imaginary_part,
+	  "warn", 0, 0, 1, ok_to_lose_imaginary_part,
+"silently convert from complex to real by dropping imaginary part");
+DEFVAR ("output_max_field_width", SBV_output_max_field_width, 10.0, 0,
+	  0, 1, set_output_max_field_width,
+"maximum width of an output field for numeric output");
+DEFVAR ("output_precision", SBV_output_precision, 5.0, 0, 0, 1,
+	  set_output_precision,
+"number of significant figures to display for numeric output");
+DEFVAR ("page_screen_output", SBV_page_screen_output, "true", 0, 0, 1,
+	  page_screen_output,
+"if possible, send output intended for the screen through the pager");
+DEFVAR ("pi", SBV_pi, 4.0 * atan (1.0), 0, 1, 1, 0,
+"ratio of the circumference of a circle to its diameter");
+DEFVAR ("prefer_column_vectors", SBV_prefer_column_vectors, "true", 0,
+	  0, 1, prefer_column_vectors,
+"prefer column/row vectors");
+DEFVAR ("prefer_zero_one_indexing", SBV_prefer_zero_one_indexing,
+	  "false", 0, 0, 1, prefer_zero_one_indexing,
+"when there is a conflict, prefer zero-one style indexing");
+DEFVAR ("print_answer_id_name", SBV_print_answer_id_name, "true", 0,
+	  0, 1, print_answer_id_name,
+"set output style to print `var_name = ...'");
+DEFVAR ("print_empty_dimensions", SBV_print_empty_dimensions, "true",
+	  0, 0, 1, print_empty_dimensions,
+"also print dimensions of empty matrices");
+DEFVAR ("propagate_empty_matrices", SBV_propagate_empty_matrices,
+	  "true", 0, 0, 1, propagate_empty_matrices,
+"operations on empty matrices return an empty matrix, not an error");
+DEFVAR ("resize_on_range_error", SBV_resize_on_range_error, "true", 0,
+	  0, 1, resize_on_range_error,
+"enlarge matrices on assignment");
+DEFVAR ("return_last_computed_value", SBV_return_last_computed_value,
+	  "false", 0, 0, 1,
+	  return_last_computed_value,
+"if a function does not return any values explicitly, return the\n\
+last computed value");
+DEFVAR ("save_precision", SBV_save_precision, 17.0, 0, 0, 1,
+	  set_save_precision,
+"number of significant figures kept by the ASCII save command");
+DEFVAR ("silent_functions", SBV_silent_functions, "false", 0, 0, 1,
+	  silent_functions,
+"suppress printing results in called functions");
+DEFVAR ("split_long_rows", SBV_split_long_rows, "true", 0, 0, 1,
+	  split_long_rows,
+"split long matrix rows instead of wrapping");
+DEFVAR ("stdin", SBV_stdin, 0.0, 0, 1, 1, 0,
+"file number of the standard input stream");
+DEFVAR ("stdout", SBV_stdout, 1.0, 0, 1, 1, 0,
+"file number of the standard output stream");
+DEFVAR ("stderr", SBV_stderr, 2.0, 0, 1, 1, 0,
+"file number of the standard error stream");
+DEFVAR ("treat_neg_dim_as_zero", SBV_treat_neg_dim_as_zero, "false",
+	  0, 0, 1, treat_neg_dim_as_zero,
+"convert negative dimensions to zero");
+DEFVAR ("warn_assign_as_truth_value", SBV_warn_assign_as_truth_value,
+	  "true", 0, 0, 1,
+	  warn_assign_as_truth_value,
+"produce warning for assignments used as truth values");
+DEFVAR ("warn_comma_in_global_decl", SBV_warn_comma_in_global_decl,
+	  "true", 0, 0, 1, warn_comma_in_global_decl,
+"produce warning for commas in global declarations");
+DEFVAR ("warn_divide_by_zero", SBV_warn_divide_by_zero, "true", 0, 0,
+	  1, warn_divide_by_zero,
+"on IEEE machines, allow divide by zero errors to be suppressed");
+}
+/*
+* List variable names.
+*/
+static void
+print_symbol_info_line (ostrstream& output_buf, const symbol_record_info& s)
+{
+output_buf << (s.is_read_only () ? " -" : " w");
+output_buf << (s.is_eternal () ? "- " : "d ");
+#if 0
+output_buf << (s.hides_fcn () ? "f" : (s.hides_builtin () ? "F" : "-"));
+#endif
+output_buf.form ("  %-16s", s.type_as_string ());
+if (s.is_function ())
+output_buf << "      -      -";
+else
+{
+output_buf.form ("%7d", s.rows ());
+output_buf.form ("%7d", s.columns ());
+}
+output_buf << "  " << s.name () << "\n";
+}
+static void
+print_long_listing (ostrstream& output_buf, symbol_record_info *s)
+{
+if (! s)
+return;
+symbol_record_info *ptr = s;
+while (ptr->is_defined ())
+{
+print_symbol_info_line (output_buf, *ptr);
+ptr++;
+}
+}
+static int
+maybe_list (const char *header, ostrstream& output_buf,
+	    int show_verbose, symbol_table *sym_tab, unsigned type,
+	    unsigned scope)
+{
+int count;
+int status = 0;
+if (show_verbose)
+{
+symbol_record_info *symbols;
+symbols = sym_tab->long_list (count, 1, type, scope);
+if (symbols && count > 0)
+	{
+	  output_buf << "\n" << header << "\n\n"
+		     << "prot  type               rows   cols  name\n"
+		     << "====  ====               ====   ====  ====\n";
+	  print_long_listing (output_buf, symbols);
+	  status = 1;
+	}
+delete [] symbols;
+}
+else
+{
+char **symbols = sym_tab->list (count, 1, type, scope);
+if (symbols && count > 0)
+	{
+	  output_buf << "\n" << header << "\n\n";
+	  list_in_columns (output_buf, symbols);
+	  status = 1;
+	}
+delete [] symbols;
+}
+return status;
+}
+DEFUN_TEXT ("clear", Fclear, Sclear, -1, 1,
+"clear [name ...]\n\
+\n\
+clear symbol(s) matching a list of globbing patterns\n\
+if no arguments are given, clear all user-defined variables and functions")
+{
+Octave_object retval;
+DEFINE_ARGV("clear");
+// Always clear the local table, but don't clear currently compiled
+// functions unless we are at the top level.  (Allowing that to happen
+// inside functions would result in pretty odd behavior...)
+int clear_user_functions = (curr_sym_tab == top_level_sym_tab);
+if (argc == 1)
+{
+curr_sym_tab->clear ();
+global_sym_tab->clear (clear_user_functions);
+}
+else
+{
+int lcount;
+char **lvars = curr_sym_tab->list (lcount, 0,
+					 symbol_def::USER_VARIABLE,
+					 SYMTAB_LOCAL_SCOPE);
+int gcount;
+char **gvars = curr_sym_tab->list (gcount, 0,
+					 symbol_def::USER_VARIABLE,
+					 SYMTAB_GLOBAL_SCOPE);
+int fcount;
+char **fcns = curr_sym_tab->list (fcount, 0,
+					symbol_def::USER_FUNCTION,
+					SYMTAB_ALL_SCOPES);
+while (--argc > 0)
+	{
+	  argv++;
+	  if (*argv)
+	    {
+	      int i;
+	      for (i = 0; i < lcount; i++)
+		{
+		  if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0)
+		    curr_sym_tab->clear (lvars[i]);
+		}
+	      int count;
+	      for (i = 0; i < gcount; i++)
+		{
+		  if (fnmatch (*argv, gvars[i], __FNM_FLAGS) == 0)
+		    {
+		      count = curr_sym_tab->clear (gvars[i]);
+		      if (count > 0)
+			global_sym_tab->clear (gvars[i], clear_user_functions);
+		    }
+		}
+	      for (i = 0; i < fcount; i++)
+		{
+		  if (fnmatch (*argv, fcns[i], __FNM_FLAGS) == 0)
+		    {
+		      count = curr_sym_tab->clear (fcns[i]);
+		      if (count > 0)
+			global_sym_tab->clear (fcns[i], clear_user_functions);
+		    }
+		}
+	    }
+	}
+delete [] lvars;
+delete [] gvars;
+delete [] fcns;
+}
+DELETE_ARGV;
+return retval;
+}
+DEFUN_TEXT ("document", Fdocument, Sdocument, -1, 1,
+"document symbol string ...\n\
+\n\
+Associate a cryptic message with a variable name.")
+{
+Octave_object retval;
+DEFINE_ARGV("document");
+if (argc == 3)
+document_symbol (argv[1], argv[2]);
+else
+print_usage ("document");
+DELETE_ARGV;
+return retval;
+}
+static int
+load_variable (char *nm, int force, istream& is)
+{
+// Is there already a symbol by this name?  If so, what is it?
+symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0);
+int is_undefined = 1;
+int is_variable = 0;
+int is_function = 0;
+int is_global = 0;
+if (lsr)
+{
+is_undefined = ! lsr->is_defined ();
+is_variable = lsr->is_variable ();
+is_function = lsr->is_function ();
+is_global = lsr->is_linked_to_global ();
+}
+// Try to read data for this name.
+tree_constant tc;
+int global = tc.load (is);
+if (tc.const_type () == tree_constant_rep::unknown_constant)
+{
+error ("load: unable to load variable `%s'", nm);
+return 0;
+}
+symbol_record *sr = 0;
+if (global)
+{
+if (is_global || is_undefined)
+	{
+	  if (force || is_undefined)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      link_to_global_variable (lsr);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: global variable name `%s' exists.", nm);
+	      warning ("use `load -force' to overwrite");
+	    }
+	}
+else if (is_function)
+	{
+	  if (force)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      link_to_global_variable (lsr);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: `%s' is currently a function in this scope", nm);
+	      warning ("`load -force' will load variable and hide function");
+	    }
+	}
+else if (is_variable)
+	{
+	  if (force)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      link_to_global_variable (lsr);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: local variable name `%s' exists.", nm);
+	      warning ("use `load -force' to overwrite");
+	    }
+	}
+else
+	panic_impossible ();
+}
+else
+{
+if (is_global)
+	{
+	  if (force || is_undefined)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      link_to_global_variable (lsr);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: global variable name `%s' exists.", nm);
+	      warning ("use `load -force' to overwrite");
+	    }
+	}
+else if (is_function)
+	{
+	  if (force)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      link_to_global_variable (lsr);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: `%s' is currently a function in this scope", nm);
+	      warning ("`load -force' will load variable and hide function");
+	    }
+	}
+else if (is_variable || is_undefined)
+	{
+	  if (force || is_undefined)
+	    {
+	      lsr = curr_sym_tab->lookup (nm, 1, 0);
+	      sr = lsr;
+	    }
+	  else
+	    {
+	      warning ("load: local variable name `%s' exists.", nm);
+	      warning ("use `load -force' to overwrite");
+	    }
+	}
+else
+	panic_impossible ();
+}
+if (sr)
+{
+tree_constant *tmp_tc = new tree_constant (tc);
+sr->define (tmp_tc);
+return 1;
+}
+else
+error ("load: unable to load variable `%s'", nm);
+return 0;
+}
+DEFUN_TEXT ("load", Fload, Sload, -1, 1,
+"load [-force] file\n
+\n\
+load variables from a file")
+{
+Octave_object retval;
+DEFINE_ARGV("load");
+argc--;
+argv++;
+int force = 0;
+if (argc > 0 && strcmp (*argv, "-force") == 0)
+{
+force++;
+argc--;
+argv++;
+}
+if (argc < 1)
+{
+error ("load: you must specify a single file to read");
+DELETE_ARGV;
+return retval;
+}
+static istream stream;
+static ifstream file;
+if (strcmp (*argv, "-") == 0)
+{
+stream = cin;
+}
+else
+{
+char *fname = tilde_expand (*argv);
+file.open (fname);
+if (! file)
+	{
+	  error ("load: couldn't open input file `%s'", *argv);
+	  DELETE_ARGV;
+	  return retval;
+	}
+stream = file;
+}
+int count = 0;
+char *nm = 0;
+for (;;)
+{
+// Read name for this entry or break on EOF.
+delete [] nm;
+nm = extract_keyword (stream, "name");
+if (nm)
+	count++;
+else
+	{
+	  if (count == 0)
+	    {
+	      error ("load: no name keywords found in file `%s'", *argv);
+	      error ("Are you sure this is an octave data file?");
+	    }
+	  break;
+	}
+if (! *nm)
+	continue;
+if (! valid_identifier (nm))
+	{
+	  warning ("load: skipping bogus identifier `%s'");
+	  continue;
+	}
+load_variable (nm, force, stream);
+if (error_state)
+	{
+	  error ("reading file %s", *argv);
+	  break;
+	}
+}
+if (file);
+file.close ();
+DELETE_ARGV;
+return retval;
+}
+/*
+* Return nonzero if PATTERN has any special globbing chars in it.
+*/
+static int
+glob_pattern_p (char *pattern)
+{
+char *p = pattern;
+char c;
+int open = 0;
+while ((c = *p++) != '\0')
+{
+switch (c)
+	{
+	case '?':
+	case '*':
+	  return 1;
+	case '[':	// Only accept an open brace if there is a close
+	  open++;	// brace to match it.  Bracket expressions must be
+	  continue;	// complete, according to Posix.2
+	case ']':
+	  if (open)
+	    return 1;
+	  continue;
+	case '\\':
+	  if (*p++ == '\0')
+	    return 0;
+	default:
+	  continue;
+	}
+}
+return 0;
+}
+DEFUN_TEXT ("save", Fsave, Ssave, -1, 1,
+"save file [var ...]\n\
+\n\
+save variables in a file")
+{
+Octave_object retval;
+#if 0
+DEFINE_ARGV("save");
+if (argc < 2)
+{
+print_usage ("save");
+DELETE_ARGV;
+return retval;
+}
+argc--;
+argv++;
+static ostream stream;
+static ofstream file;
+if (strcmp (*argv, "-") == 0)
+{
+// XXX FIXME XXX -- should things intended for the screen end up in a
+// tree_constant (string)?
+stream = cout;
+}
+else if (argc == 1 && glob_pattern_p (*argv)) // Guard against things
+{						// like `save a*',
+print_usage ("save");			// which are probably
+DELETE_ARGV;				// mistakes...
+return retval;
+}
+else
+{
+char *fname = tilde_expand (*argv);
+file.open (fname);
+if (! file)
+	{
+	  error ("save: couldn't open output file `%s'", *argv);
+	  DELETE_ARGV;
+	  return retval;
+	}
+stream = file;
+}
+int prec = user_pref.save_precision;
+if (argc == 1)
+{
+int count;
+char **vars = curr_sym_tab->list (count, 0,
+					symbol_def::USER_VARIABLE,
+					SYMTAB_ALL_SCOPES);
+for (int i = 0; i < count; i++)
+	curr_sym_tab->save (stream, vars[i],
+			    is_globally_visible (vars[i]), prec);
+delete [] vars;
+}
+else
+{
+while (--argc > 0)
+	{
+	  argv++;
+	  int count;
+	  char **lvars = curr_sym_tab->list (count, 0,
+					     symbol_def::USER_VARIABLE);
+	  int saved_or_error = 0;
+	  int i;
+	  for (i = 0; i < count; i++)
+	    {
+	      if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0
+		  && curr_sym_tab->save (stream, lvars[i],
+					 is_globally_visible (lvars[i]),
+					 prec) != 0)
+		saved_or_error++;
+	    }
+	  char **bvars = global_sym_tab->list (count, 0,
+					       symbol_def::BUILTIN_VARIABLE);
+	  for (i = 0; i < count; i++)
+	    {
+	      if (fnmatch (*argv, bvars[i], __FNM_FLAGS) == 0
+		  && global_sym_tab->save (stream, bvars[i], 0, prec) != 0)
+		saved_or_error++;
+	    }
+	  delete [] lvars;
+	  delete [] bvars;
+	  if (! saved_or_error)
+	    warning ("save: no such variable `%s'", *argv);
+	}
+}
+if (file);
+file.close ();
+DELETE_ARGV;
+#endif
+return retval;
+}
+DEFUN_TEXT ("who", Fwho, Swho, -1, 1,
+"who [-all] [-builtins] [-functions] [-long] [-variables]\n\
+\n\
+List currently defined symbol(s).  Options may be shortened to one\n\
+character, but may not be combined.")
+{
+Octave_object retval;
+DEFINE_ARGV("who");
+int show_builtins = 0;
+int show_functions = (curr_sym_tab == top_level_sym_tab);
+int show_variables = 1;
+int show_verbose = 0;
+if (argc > 1)
+{
+show_functions = 0;
+show_variables = 0;
+}
+for (int i = 1; i < argc; i++)
+{
+argv++;
+if (strcmp (*argv, "-all") == 0 || strcmp (*argv, "-a") == 0)
+	{
+	  show_builtins++;
+	  show_functions++;
+	  show_variables++;
+	}
+else if (strcmp (*argv, "-builtins") == 0
+	       || strcmp (*argv, "-b") == 0)
+	show_builtins++;
+else if (strcmp (*argv, "-functions") == 0
+	       || strcmp (*argv, "-f") == 0)
+	show_functions++;
+else if (strcmp (*argv, "-long") == 0
+	       || strcmp (*argv, "-l") == 0)
+	  show_verbose++;
+else if (strcmp (*argv, "-variables") == 0
+	       || strcmp (*argv, "-v") == 0)
+	show_variables++;
+else
+	warning ("who: unrecognized option `%s'", *argv);
+}
+// If the user specified -l and nothing else, show variables.  If
+// evaluating this at the top level, also show functions.
+if (show_verbose && ! (show_builtins || show_functions || show_variables))
+{
+show_functions = (curr_sym_tab == top_level_sym_tab);
+show_variables = 1;
+}
+ostrstream output_buf;
+int pad_after = 0;
+if (show_builtins)
+{
+pad_after += maybe_list ("*** built-in variables:",
+			       output_buf, show_verbose, global_sym_tab,
+			       symbol_def::BUILTIN_VARIABLE,
+			       SYMTAB_ALL_SCOPES);
+pad_after += maybe_list ("*** built-in functions:",
+			       output_buf, show_verbose, global_sym_tab,
+			       symbol_def::BUILTIN_FUNCTION,
+			       SYMTAB_ALL_SCOPES);
+}
+if (show_functions)
+{
+pad_after += maybe_list ("*** currently compiled functions:",
+			       output_buf, show_verbose, global_sym_tab,
+			       symbol_def::USER_FUNCTION,
+			       SYMTAB_ALL_SCOPES);
+}
+if (show_variables)
+{
+pad_after += maybe_list ("*** local user variables:",
+			       output_buf, show_verbose, curr_sym_tab,
+			       symbol_def::USER_VARIABLE,
+			       SYMTAB_LOCAL_SCOPE);
+pad_after += maybe_list ("*** globally visible user variables:",
+			       output_buf, show_verbose, curr_sym_tab,
+			       symbol_def::USER_VARIABLE,
+			       SYMTAB_GLOBAL_SCOPE);
+}
+if (pad_after)
+output_buf << "\n";
+output_buf << ends;
+maybe_page_output (output_buf);
+DELETE_ARGV;
+return retval;
+}
+// XXX FIXME XXX -- should these really be here?
+char *
+octave_home (void)
+{
+#ifdef RUN_IN_PLACE
+static char *home = OCTAVE_HOME;
+return home;
+#else
+static char *home = 0;
+delete [] home;
+char *oh = getenv ("OCTAVE_HOME");
+if (oh)
+home = strsave (oh);
+else
+home = strsave (OCTAVE_HOME);
+return home;
+#endif
+}
+char *
+octave_lib_dir (void)
+{
+#ifdef RUN_IN_PLACE
+static char *ol = OCTAVE_LIB_DIR;
+return ol;
+#else
+static char *ol = 0;
+delete [] ol;
+char *oh = octave_home ();
+char *tmp = strconcat (oh, "/lib/octave/");
+ol = strconcat (tmp, version_string);
+delete [] tmp;
+return ol;
+#endif
+}
+char *
+octave_info_dir (void)
+{
+#ifdef RUN_IN_PLACE
+static char *oi = OCTAVE_INFO_DIR;
+return oi;
+#else
+static char *oi = 0;
+delete [] oi;
+char *oh = octave_home ();
+oi = strconcat (oh, "/info/");
+return oi;
+#endif
+}
+/*
+* Handle OCTAVE_PATH from the environment like TeX handles TEXINPUTS.
+* If the path starts with `:', prepend the standard path.  If it ends
+* with `:' append the standard path.  If it begins and ends with
+* `:', do both (which is useless, but the luser asked for it...).
+*
+* This function may eventually be called more than once, so be
+* careful not to create memory leaks.
+*/
+char *
+default_path (void)
+{
+static char *pathstring = 0;
+delete [] pathstring;
+static char *std_path = 0;
+delete [] std_path;
+char *libdir = octave_lib_dir ();
+std_path = strconcat (".:", libdir);
+char *oct_path = getenv ("OCTAVE_PATH");
+if (oct_path)
+{
+pathstring = strsave (oct_path);
+if (pathstring[0] == ':')
+	{
+	  char *tmp = pathstring;
+	  pathstring = strconcat (std_path, pathstring);
+	  delete [] tmp;
+	}
+int tmp_len = strlen (pathstring);
+if (pathstring[tmp_len-1] == ':')
+	{
+	  char *tmp = pathstring;
+	  pathstring = strconcat (pathstring, std_path);
+	  delete [] tmp;
+	}
+}
+else
+pathstring = strsave (std_path);
+return pathstring;
+}
+char *
+default_info_file (void)
+{
+static char *info_file_string = 0;
+delete [] info_file_string;
+char *oct_info_file = getenv ("OCTAVE_INFO_FILE");
+if (oct_info_file)
+info_file_string = strsave (oct_info_file);
+else
+{
+char *infodir = octave_info_dir ();
+info_file_string = strconcat (infodir, "/octave.info");
+}
+return info_file_string;
+}
+char *
+default_editor (void)
+{
+static char *editor_string = 0;
+delete [] editor_string;
+char *env_editor = getenv ("EDITOR");
+if (env_editor && *env_editor)
+editor_string = strsave (env_editor);
+else
+editor_string = strsave ("vi");
+return editor_string;
+}
+char *
+get_site_defaults (void)
+{
+static char *sd = 0;
+delete [] sd;
+char *libdir = octave_lib_dir ();
+sd = strconcat (libdir, "/octaverc");
+return sd;
+}
+char *
+default_pager (void)
+{
+static char *pager_binary = 0;
+delete [] pager_binary;
+char *pgr = getenv ("PAGER");
+if (pgr)
+pager_binary = strsave (pgr);
+else
+#ifdef DEFAULT_PAGER
+pager_binary = strsave (DEFAULT_PAGER);
+#else
+pager_binary = strsave ("");
+#endif
+return pager_binary;
 }
 /*
 ;;; Local Variables: ***
 ;;; mode: C++ ***

Mercurial > hg > octave-nkf

comparison src/variables.cc @ 529:7ea224e713cd