view src/t-builtins.cc @ 195:13c6086c325c

[project @ 1993-11-06 10:12:29 by jwe]
author jwe
date Sat, 06 Nov 1993 10:14:11 +0000
parents 7a647cf4850c
children 1468a5e6a466
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 ();
}

// 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_builtin_variable ("PWD", dir, 1);

  return retval;
}

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

  return 0;
}
#endif

/*
 * Wipe out user-defined variables and functions given a list of
 * regular expressions.
 *
 * It's not likely that this works correctly now.  XXX FIXME XXX
 */
tree_constant
builtin_clear (int argc, char **argv)
{
  tree_constant retval;

// 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 != (char *) NULL)
	    {
	      Regex rx (*argv);

	      int i;
	      for (i = 0; i < lcount; i++)
		{
		  String nm (lvars[i]);
		  if (nm.matches (rx))
		    curr_sym_tab->clear (lvars[i]);
		}

	      int count;
	      for (i = 0; i < gcount; i++)
		{
		  String nm (gvars[i]);
		  if (nm.matches (rx))
		    {
		      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++)
		{
		  String nm (fcns[i]);
		  if (nm.matches (rx))
		    {
		      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;

    }
  return retval;
}

/*
 * Associate a cryptic message with a variable name.
 */
tree_constant
builtin_document (int argc, char **argv)
{
  tree_constant retval;
  if (argc == 3)
    document_symbol (argv[1], 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 (user_pref.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 (user_pref.info_file, (char *)NULL);

  if (! initial_node)
    {
      warning ("can't find info file!\n");
      status = -1;
    }
  else
    {
      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)
    {
      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]));

      delete [] vars;
    }
  else
    {
      while (--argc > 0)
	{
	  argv++;

	  int count;
	  char **lvars = curr_sym_tab->list (count, 0,
					     symbol_def::USER_VARIABLE);
	  Regex rx (*argv);

	  int saved_or_error = 0;
	  int i;
	  for (i = 0; i < count; i++)
	    {
	      String nm (lvars[i]);
	      if (nm.matches (rx)
		  && curr_sym_tab->save (stream, lvars[i]) != 0)
		saved_or_error++;
	    }

	  char **bvars = global_sym_tab->list (count, 0,
					       symbol_def::BUILTIN_VARIABLE);

	  for (i = 0; i < count; i++)
	    {
	      String nm (bvars[i]);
	      if (nm.matches (rx)
		  && global_sym_tab->save (stream, bvars[i]) != 0)
		saved_or_error++;
	    }

	  delete [] lvars;
	  delete [] bvars;

	  if (! saved_or_error)
	    warning ("save: no such variable `%s'", *argv);
	}
    }

  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.
 */
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 == (symbol_record_info *) NULL)
    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 != (symbol_record_info *) NULL && 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 != (char **) NULL && count > 0)
	{
	  output_buf << "\n" << header << "\n\n";
	  list_in_columns (output_buf, symbols);
	  status = 1;
	}
      delete [] symbols;
    }
  return status;
}

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

  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);

  return retval;
}

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