view src/t-builtins.cc @ 184:782234508686

[project @ 1993-10-24 02:34:02 by jwe]
author jwe
date Sun, 24 Oct 1993 02:36:31 +0000
parents 91ec95436dca
children 7a647cf4850c
line wrap: on
line source

// t-builtins.cc                                           -*- C++ -*-
/*

Copyright (C) 1992, 1993 John W. Eaton

This file is part of Octave.

Octave is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.

Octave is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with Octave; see the file COPYING.  If not, write to the Free
Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

*/

/*

The function builtin_cd was adapted from a similar function from GNU
Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free
Software Foundation, Inc.

The function list_in_columns was adapted from a similar function from
GNU ls, print_many_per_line, copyright (C) 1985, 1988, 1990, 1991 Free
Software Foundation, Inc.

*/

#ifdef __GNUG__
#pragma implementation
#endif

#include <sys/types.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <iostream.h>
#include <strstream.h>
#include <fstream.h>
#include <stdio.h>
#include <fcntl.h>
#include <sys/file.h>
#include <sys/stat.h>
#include <time.h>
#include <errno.h>
#include <signal.h>
#include <String.h>

#include "procstream.h"

#include "variables.h"
#include "symtab.h"
#include "error.h"
#include "input.h"
#include "pager.h"
#include "utils.h"
#include "sighandlers.h"
#include "builtins.h"
#include "t-builtins.h"
#include "octave.h"
#include "octave-hist.h"
#include "user-prefs.h"
#include "pr-output.h"
#include "defaults.h"
#include "tree.h"
#include "help.h"

// May need replacement for this on some machines.
extern "C"
{
  extern char *strerror (int);
  char *tilde_expand (char *s); /* From readline's tilde.c */
}

extern "C"
{
#include "info/info.h"
#include "info/dribble.h"
#include "info/terminal.h"

  extern int initialize_info_session ();
  extern int index_entry_exists ();
  extern int do_info_index_search ();
  extern void finish_info_session ();
  extern char *replace_in_documentation ();
}

extern int symbol_out_of_date (symbol_record *s);

// Is this a parametric plot?  Makes a difference for 3D plotting.
extern int parametric_plot;

/*
 * Format a list in neat columns.  Mostly stolen from GNU ls.  This
 * should maybe be in utils.cc.
 */
static ostrstream&
list_in_columns (ostrstream& os, char **list)
{
// Compute the maximum name length.

  int max_name_length = 0;
  int total_names = 0;
  for (char **names = list; *names != (char *) NULL; names++)
    {
      total_names++;
      int name_length = strlen (*names);
      if (name_length > max_name_length)
	max_name_length = name_length;
    }

// Allow at least two spaces between names.

  max_name_length += 2;

// Calculate the maximum number of columns that will fit.

  int line_length = terminal_columns ();
  int cols = line_length / max_name_length;
  if (cols == 0)
    cols = 1;

// Calculate the number of rows that will be in each column except
// possibly  for a short column on the right.

  int rows = total_names / cols + (total_names % cols != 0);

// Recalculate columns based on rows.

  cols = total_names / rows + (total_names % rows != 0);

  names = list;
  int count;
  for (int row = 0; row < rows; row++)
    {
      count = row;
      int pos = 0;

// Print the next row.

      while (1)
	{
	  os << *(names + count);
	  int name_length = strlen (*(names + count));

	  count += rows;
	  if (count >= total_names)
	    break;

	  int spaces_to_pad = max_name_length - name_length;
	  for (int i = 0; i < spaces_to_pad; i++)
	    os << " ";
	  pos += max_name_length;
	}
      os << "\n";
    }

  return os;
}

tree_constant
builtin_casesen (int argc, char **argv)
{
  tree_constant retval;

  if (argc == 1 || (argc > 1 && strcmp (argv[1], "off") == 0))
    warning ("casesen: sorry, Octave is always case sensitive");
  else if (argc > 1 && strcmp (argv[1], "on") == 0)
    ; // ok.
  else
    print_usage ("casesen");

  return retval;
}

/*
 * Change current working directory.
 */
tree_constant
builtin_cd (int argc, char **argv)
{
  tree_constant retval;

  if (argc > 1)
    {
      static char *dirname = (char *) NULL;

      if (dirname)
	free (dirname);

      dirname = tilde_expand (argv[1]);

      if (dirname != (char *) NULL && !change_to_directory (dirname))
	{
	  error ("%s: %s", dirname, strerror (errno));
	  return retval;
	}
    }
  else
    {
      if (!home_directory)
	return retval;

      if (!change_to_directory (home_directory))
	{
          error ("%s: %s", home_directory, strerror (errno));
	  return retval;
	}
    }


  char *directory = get_working_directory ("cd");
  tree_constant *dir = new tree_constant (directory);
  bind_protected_variable ("PWD", dir);

  return retval;
}

static int
in_list (char *s, char **list)
{
  while (*list != (char *) NULL)
    {
      if (strcmp (s, *list) == 0)
	return 1;
      list++;
    }

  return 0;
}

/*
 * Wipe out user-defined variables and functions given a list of
 * regular expressions. 
 */
tree_constant
builtin_clear (int argc, char **argv)
{
  tree_constant retval;
  if (argc == 1)
    {
      curr_sym_tab->clear ();
      if (curr_sym_tab == top_level_sym_tab)
	global_sym_tab->clear ();
    }
  else
    {
      int count;
      char **names = curr_sym_tab->list (count);

      int g_count;
      char **g_names = global_sym_tab->list (g_count);

      int num_cleared = 0;
      char **locals_cleared = new char * [count+1];
      locals_cleared[num_cleared] = (char *) NULL;

      while (--argc > 0)
	{
	  argv++;
	  if (*argv != (char *) NULL)
	    {
	      Regex rx (*argv);

	      int i;
	      for (i = 0; i < count; i++)
		{
		  String nm (names[i]);
		  if (nm.matches (rx) && curr_sym_tab->clear (names[i]))
		    {
		      locals_cleared[num_cleared++] = strsave (names[i]);
		      locals_cleared[num_cleared] = (char *) NULL;
		    }
		}

	      if (curr_sym_tab == top_level_sym_tab)
		{
		  for (i = 0; i < g_count; i++)
		    {
		      String nm (g_names[i]);
		      if (nm.matches (rx)
			  && ! in_list (g_names[i], locals_cleared))
			{
			  global_sym_tab->clear (g_names[i]);
			}
		    }
		}
	    }
	}

      int i = 0;
      while (locals_cleared[i] != (char *) NULL)
	delete [] locals_cleared[i++];
      delete [] locals_cleared;

      delete [] names;
      delete [] g_names;

    }
  return retval;
}

/*
 * Associate a cryptic message with a variable name.
 */
tree_constant
builtin_document (int argc, char **argv)
{
  tree_constant retval;
  if (argc == 3)
    {
      symbol_record *sym_rec = curr_sym_tab->lookup (argv[1], 0);
      if (sym_rec == (symbol_record *) NULL)
	{
	  sym_rec = global_sym_tab->lookup (argv[1], 0);
	  if (sym_rec == (symbol_record *) NULL)
	    {
	      error ("document: no such symbol `%s'", argv[1]);
	      return retval;
	    }
	}
      sym_rec->document (argv[2]);
    }
  else
    print_usage ("document");

  return retval;
}

/*
 * Edit commands with your favorite editor.
 */
tree_constant
builtin_edit_history (int argc, char **argv)
{
  tree_constant retval;
  do_edit_history (argc, argv);
  return retval;
}

/*
 * Set output format state.
 */
tree_constant
builtin_format (int argc, char **argv)
{
  tree_constant retval;
  set_format_style (argc, argv);
  return retval;
}

static void
help_syms_list (ostrstream& output_buf, help_list *list,
		const char *desc)
{
  int count = 0;
  char **symbols = names (list, count);
  output_buf << "\n*** " << desc << ":\n\n";
  if (symbols != (char **) NULL && count > 0)
    list_in_columns (output_buf, symbols);
  delete [] symbols;
}

static void
simple_help (void)
{
  ostrstream output_buf;

  help_syms_list (output_buf, operator_help (), "operators");

  help_syms_list (output_buf, keyword_help (), "reserved words");

  help_syms_list (output_buf, builtin_text_functions_help (),
		  "text functions (these names are also reserved)");

  help_syms_list (output_buf, builtin_mapper_functions_help (),
		  "mapper functions");

  help_syms_list (output_buf, builtin_general_functions_help (),
		  "general functions");

  help_syms_list (output_buf, builtin_variables_help (),
		  "builtin variables");
      
// Also need to list variables and currently compiled functions from
// the symbol table, if there are any.

// Also need to search octave_path for script files.

  char **path = pathstring_to_vector (user_pref.loadpath);

  char **ptr = path;
  if (ptr != (char **) NULL)
    {
      while (*ptr != (char *) NULL)
	{
	  int count;
	  char **names = get_m_file_names (count, *ptr, 0);
	  output_buf << "\n*** M-files in "
		     << make_absolute (*ptr, the_current_working_directory)
		     << ":\n\n";
	  if (names != (char **) NULL && count > 0)
	    list_in_columns (output_buf, names);
	  delete [] names;
	  ptr++;
	}
    }

  additional_help_message (output_buf);
  output_buf << ends;
  maybe_page_output (output_buf);
}

static int
try_info (const char *string, int force = 0)
{
  int status = 0;

  char *directory_name = strsave (DEFAULT_INFO_FILE);
  char *temp = filename_non_directory (directory_name);

  if (temp != directory_name)
    {
      *temp = 0;
      info_add_path (directory_name, INFOPATH_PREPEND);
    }

  delete [] directory_name;

  NODE *initial_node = info_get_node (DEFAULT_INFO_FILE, (char *)NULL);

  if (! initial_node)
    {
      warning ("can't find info file!\n");
      return status;
    }

  initialize_info_session (initial_node, 0);

  if (force || index_entry_exists (windows, string))
    {
      terminal_clear_screen ();

      terminal_prep_terminal ();

      display_update_display (windows);

      info_last_executed_command = (VFunction *)NULL;

      if (! force)
	do_info_index_search (windows, 0, string);

      char *format = replace_in_documentation
	("Type \"\\[quit]\" to quit, \"\\[get-help-window]\" for help.");

      window_message_in_echo_area (format);

      info_read_and_dispatch ();

      terminal_goto_xy (0, screenheight - 1);

      terminal_clear_to_eol ();

      terminal_unprep_terminal ();

      status = 1;
    }

  finish_info_session (initial_node, 0);

  return status;
}

/*
 * Print cryptic yet witty messages.
 */
tree_constant
builtin_help (int argc, char **argv)
{
  tree_constant retval;

  if (argc == 1)
    {
      simple_help ();
    }
  else
    {
      if (argv[1] != (char *) NULL && strcmp (argv[1], "-i") == 0)
	{
	  argc--;
	  argv++;

	  if (argc == 1)
	    {
	      volatile sig_handler *old_sigint_handler;
	      old_sigint_handler = signal (SIGINT, SIG_IGN);

	      try_info ((char *) NULL, 1);

	      signal (SIGINT, old_sigint_handler);
	    }
	  else
	    {
	      while (--argc > 0)
		{
		  argv++;

		  if (*argv == (char *) NULL || **argv == '\0')
		    continue;

		  volatile sig_handler *old_sigint_handler;
		  old_sigint_handler = signal (SIGINT, SIG_IGN);

		  if (! try_info (*argv))
		    {
		      message ("help",
			       "sorry, `%s' is not indexed in the manual",
			       *argv); 
		      sleep (2);
		    }

		  signal (SIGINT, old_sigint_handler);
		}
	    }
	}
      else
	{
	  ostrstream output_buf;

	  char *m_file_name = (char *) NULL;
	  symbol_record *sym_rec;
	  help_list *op_help_list = operator_help ();
	  help_list *kw_help_list = keyword_help ();

	  while (--argc > 0)
	    {
	      argv++;

	      if (*argv == (char *) NULL || **argv == '\0')
		continue;

	      if (help_from_list (output_buf, op_help_list, *argv, 0))
		continue;

	      if (help_from_list (output_buf, kw_help_list, *argv, 0))
		continue;

	      sym_rec = curr_sym_tab->lookup (*argv, 0, 0);
	      if (sym_rec != (symbol_record *) NULL)
		{
		  char *h = sym_rec->help ();
		  if (h != (char *) NULL && *h != '\0')
		    {
		      output_buf << "\n*** " << *argv << ":\n\n"
				 << h << "\n";
		      continue;
		    }
		}

	      sym_rec = global_sym_tab->lookup (*argv, 0, 0);
	      if (sym_rec != (symbol_record *) NULL
		  && ! symbol_out_of_date (sym_rec))
		{
		  char *h = sym_rec->help ();
		  if (h != (char *) NULL && *h != '\0')
		    {
		      output_buf << "\n*** " << *argv << ":\n\n"
				 << h << "\n";
		      continue;
		    }
		}

// Try harder to find M-files that might not be defined yet, or that
// appear to be out of date.  Don\'t execute commands from the file if
// it turns out to be a script file.

	      m_file_name = m_file_in_path (*argv);
	      if (m_file_name != (char *) NULL)
		{
		  sym_rec = global_sym_tab->lookup (*argv, 1, 0);
		  if (sym_rec != (symbol_record *) NULL)
		    {
		      tree_identifier tmp (sym_rec);
		      tmp.parse_m_file (0);
		      char *h = sym_rec->help ();
		      if (h != (char *) NULL && *h != '\0')
			{
			  output_buf << "\n*** " << *argv << ":\n\n"
				     << h << "\n"; 
			  continue;
			}
		    }
		}
	      delete [] m_file_name;

	      output_buf << "\nhelp: sorry, `" << *argv
			 << "' is not documented\n"; 
	    }

	  additional_help_message (output_buf);
	  output_buf << ends;
	  maybe_page_output (output_buf);
	}
    }

  return retval;
}

/*
 * Display, save, or load history.
 */
tree_constant
builtin_history (int argc, char **argv)
{
  tree_constant retval;

  do_history (argc, argv);

  return retval;
}

static int
load_variable (char *nm, int force, istream& is)
{
  symbol_record *gsr = global_sym_tab->lookup (nm, 0, 0);
  symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0);

  if (! force
      && ((gsr != (symbol_record *) NULL && gsr->is_variable ())
	  || lsr != (symbol_record *) NULL))
    {
      warning ("load: variable name `%s' exists.  Use `load -force'\
 to overwrite", nm);
      return -1;
    }

// We found it.  Read data for this entry, and if that succeeds,
// insert it into symbol table.

  tree_constant tc;
  int global = tc.load (is);
  if (tc.const_type () != tree_constant_rep::unknown_constant)
    {
      symbol_record *sr;
      if (global)
	{
	  if (lsr != (symbol_record *) NULL)
	    {
	      warning ("load: replacing local symbol `%s' with global\
 value from file", nm);
	      curr_sym_tab->clear (nm);
	    }
	  sr = global_sym_tab->lookup (nm, 1, 0);
	}
      else
	{
	  if (gsr != (symbol_record *) NULL)
	    {
	      warning ("loading `%s' as a global variable", nm);
	      sr = gsr;
	    }
	  else
	    sr = curr_sym_tab->lookup (nm, 1, 0);
	}

      if (sr != (symbol_record *) NULL)
	{
	  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;
}

/*
 * Read variables from an input stream.
 *
 * BUGS:
 *
 *  -- This function is not terribly robust.
 */
tree_constant
builtin_load (int argc, char **argv)
{
  tree_constant retval;

  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");
      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);
	  return retval;
	}
      stream = file;
    }

  char nm [128]; // XXX FIXME XXX
  int count = 0;
  for (;;)
    {
// Read name for this entry or break on EOF.
      if (extract_keyword (stream, "name", nm) == 0 || nm == (char *) NULL)
	{
	  if (count == 0)
	    error ("load: no name keywords found in file.\
  Are you sure this is an octave data file?");
	  break;
	}

      if (*nm == '\0')
	continue;

      if (! valid_identifier (nm))
	{
	  warning ("load: skipping bogus identifier `%s'");
	  continue;
	}

      if (load_variable (nm, force, stream))
	count++;
    }

  if (file);
    file.close ();

  return retval;
}

/*
 * Get a directory listing.
 */
tree_constant
builtin_ls (int argc, char **argv)
{
  tree_constant retval;

  ostrstream ls_buf;

  ls_buf << "ls -C ";
  for (int i = 1; i < argc; i++)
    ls_buf << tilde_expand (argv[i]) << " ";

  ls_buf << ends;

  char *ls_command = ls_buf.str ();

  iprocstream cmd (ls_command);

  char ch;
  ostrstream output_buf;
  while (cmd.get (ch))
    output_buf.put (ch);

  output_buf << ends;

  maybe_page_output (output_buf);
  
  delete [] ls_command;

  return retval;
}

/*
 * Run previous commands from the history list.
 */
tree_constant
builtin_run_history (int argc, char **argv)
{
  tree_constant retval;
  do_run_history (argc, argv);
  return retval;
}

/*
 * Write variables to an output stream.
 */
tree_constant
builtin_save (int argc, char **argv)
{
  tree_constant retval;

  if (argc < 2)
    {
      print_usage ("save");
      return retval;
    }

  argc--;
  argv++;

  static ostream stream;
  static ofstream file;
  if (strcmp (*argv, "-") == 0)
    {
// XXX FIXME XXX -- things intended for the screen should end up in a
// tree_constant (string)?
      stream = cout;
    }
  else
    {
      char *fname = tilde_expand (*argv);
      file.open (fname);
      if (! file)
	{
	  error ("save: couldn't open output file `%s'", *argv);
	  return retval;
	}
      stream = file;
    }

  if (argc == 1)
    {
      curr_sym_tab->save (stream);
      global_sym_tab->save (stream, 1);
    }
  else
    {
      while (--argc > 0)
	{
	  argv++;
	  if (! curr_sym_tab->save (stream, *argv))
	    if (! global_sym_tab->save (stream, *argv, 1))
	      {
		warning ("save: no such variable `%s'", *argv);
		continue;
	      }
	}
    }

  if (file);
    file.close ();

  return retval;
}

/*
 * Set plotting options.
 */
tree_constant
builtin_set (int argc, char **argv)
{
  tree_constant retval;

  ostrstream plot_buf;

  if (argc > 1)
    {
      if (almost_match ("parametric", argv[1], 3))
	parametric_plot = 1;
      else if (almost_match ("noparametric", argv[1], 5))
	parametric_plot = 0;
    }

  for (int i = 0; i < argc; i++)
    plot_buf << argv[i] << " ";

  plot_buf << "\n" << ends;

  char *plot_command = plot_buf.str ();
  send_to_plot_stream (plot_command);

  delete [] plot_command;

  return retval;
}

/*
 * Set plotting options.
 */
tree_constant
builtin_show (int argc, char **argv)
{
  tree_constant retval;

  ostrstream plot_buf;

  for (int i = 0; i < argc; i++)
    plot_buf << argv[i] << " ";

  plot_buf << "\n" << ends;

  char *plot_command = plot_buf.str ();
  send_to_plot_stream (plot_command);

  delete [] plot_command;

  return retval;
}

/*
 * List variable names.
 */
tree_constant
builtin_who (int argc, char **argv)
{
  tree_constant retval;
  int show_global = 0;
  int show_local = 1;
  int show_top = 0;
  int show_fcns = 0;

  if (argc > 1)
    show_local = 0;

  for (int i = 1; i < argc; i++)
    {
      argv++;
      if (strcmp (*argv, "-all") == 0)
	{
	  show_global++;	  
	  show_local++;
	  show_top++;
	  show_fcns++;
	}
      else if (strcmp (*argv, "-global") == 0)
	show_global++;
      else if (strcmp (*argv, "-local") == 0)
	show_local++;
      else if (strcmp (*argv, "-top") == 0)
	show_top++;
      else if (strcmp (*argv, "-fcn") == 0
	       || strcmp (*argv, "-fcns") == 0
	       || strcmp (*argv, "-functions") == 0)
	show_fcns++;
      else
	{
	  warning ("who: unrecognized option `%s'", *argv);
	  if (argc == 2)
	    show_local = 1;
	}
    }

  ostrstream output_buf;
  int pad_after = 0;
  if (show_global)
    {
      int count = 0;
      char **symbols = global_sym_tab->sorted_var_list (count);
      if (symbols != (char **) NULL && count > 0)
	{
	  output_buf << "\n*** global symbols:\n\n";
	  list_in_columns (output_buf, symbols);
	  delete [] symbols;
	  pad_after++;
	}
    }

  if (show_top)
    {
      int count = 0;
      char **symbols = top_level_sym_tab->sorted_var_list (count);
      if (symbols != (char **) NULL && count > 0)
	{
	  output_buf << "\n*** top level symbols:\n\n";
	  list_in_columns (output_buf, symbols);
	  delete [] symbols;
	  pad_after++;
	}
    }

  if (show_local)
    {
      if (show_top && curr_sym_tab == top_level_sym_tab)
	output_buf <<
	  "\ncurrent (local) symbol table == top level symbol table\n";
      else
	{
	  int count = 0;
	  char **symbols = curr_sym_tab->sorted_var_list (count);
	  if (symbols != (char **) NULL && count > 0)
	    {
	      output_buf << "\n*** local symbols:\n\n";
	      list_in_columns (output_buf, symbols);
	      delete [] symbols;
	      pad_after++;
	    }
	}
    }

  if (show_fcns)
    {
      int count = 0;
      char **symbols = global_sym_tab->sorted_fcn_list (count);
      if (symbols != (char **) NULL && count > 0)
	{
	  output_buf << "\n*** functions builtin or currently compiled:\n\n";
	  list_in_columns (output_buf, symbols);
	  delete [] symbols;
	  pad_after++;
	}
    }

  if (pad_after)
    output_buf << "\n";

  output_buf << ends;
  maybe_page_output (output_buf);

  return retval;
}

/*
;;; Local Variables: ***
;;; mode: C++ ***
;;; page-delimiter: "^/\\*" ***
;;; End: ***
*/