--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/file-io.cc	Sun Aug 08 01:13:40 1993 +0000
@@ -0,0 +1,1204 @@
+// file-io.cc                                             -*- C++ -*-
+/*
+
+Copyright (C) 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.
+
+*/
+
+// Written by John C. Campbell <jcc@che.utexas.edu>.
+
+#ifdef __GNUG__
+#pragma implementation
+#endif
+
+#include <DLList.h>
+#include <unistd.h>
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <strstream.h>
+#include <ctype.h>
+
+#include "statdefs.h"
+#include "file-io.h"
+#include "input.h"
+#include "octave-hist.h"
+#include "tree-const.h"
+#include "error.h"
+#include "utils.h"
+#include "pager.h"
+
+// keeps a count of how many files are open and in the file list
+static int file_count = 0;
+
+// keeps a count of args sent to printf or scanf
+static int fmt_arg_count = 0;
+
+class File_info
+{
+ public:
+  File_info (void);
+  File_info (int num, char *nm, FILE *t, char *md);
+  File_info (const File_info& f);
+
+  File_info& operator = (const File_info& f);
+
+  ~File_info (void);
+
+  int number (void) const;
+  char *name (void) const;
+  FILE *fptr (void) const;
+  char *mode (void) const;
+
+ private:
+  int _number;
+  char *_name;
+  FILE *_fptr;
+  char *_mode;
+};
+
+File_info::File_info (void)
+{
+  _number = -1;
+  _name = (char *) NULL;
+  _fptr = (FILE *) NULL;
+  _mode = (char *) NULL;
+}
+
+File_info::File_info (const File_info& f)
+{
+  _number = f._number;
+  _name = strsave (f._name);
+  _fptr = f._fptr;
+  _mode = strsave (f._mode);
+}
+
+File_info&
+File_info::operator = (const File_info& f)
+{
+  _number = f._number;
+  _name = strsave (f._name);
+  _fptr = f._fptr;
+  _mode = strsave (f._mode);
+
+  return *this;
+}
+
+File_info::~File_info (void)
+{
+  delete [] _name;
+  delete [] _mode;
+}
+
+File_info::File_info (int n, char *nm, FILE *t, char *md)
+{
+  _number = n;
+  _name = strsave (nm);
+  _fptr = t;
+  _mode = strsave (md);
+}
+
+int
+File_info::number (void) const
+{
+  return _number;
+}
+
+char *
+File_info::name (void) const
+{
+  return _name;
+}
+
+FILE *
+File_info::fptr (void) const
+{
+  return _fptr;
+}
+
+char *
+File_info::mode (void) const
+{
+  return _mode;
+}
+
+
+// double linked list containing relevant information about open files
+static DLList <File_info> file_list;
+
+void
+initialize_file_io ()
+{
+  File_info _stdin (0, "stdin", stdin, "r");
+  File_info _stdout (1, "stdout", stdout, "w");
+  File_info _stderr (2, "stderr", stderr, "w");
+
+  file_list.append (_stdin);
+  file_list.append (_stdout);
+  file_list.append (_stderr);
+
+  file_count = 3;
+}
+
+Pix
+return_valid_file (tree_constant& arg)
+{
+  if (arg.is_string_type ())
+    {
+      Pix p = file_list.first ();
+      File_info file;
+      for (int i = 0; i < file_count; i++)
+	{
+	  char *file_name = arg.string_value ();
+	  file = file_list (p);
+	  if (strcmp (file.name (), file_name) == 0)
+	    return p;
+	  file_list.next (p);
+	}
+    }
+  else if (arg.is_scalar_type ())
+    {
+      double file_num = arg.double_value ();
+      if ((double) NINT (file_num) != file_num)
+	error ("file number not an integer value");
+      else
+	{
+	  Pix p = file_list.first ();
+	  File_info file;
+	  for (int i = 0; i < file_count; i++)
+	    {
+	      file = file_list (p);
+	      if (file.number () == file_num)
+		return p;
+	      file_list.next (p);
+	    }
+	  error ("no file with that number");
+	}
+      }
+    else
+      error ("inapproriate file specifier");
+
+  return (Pix) NULL;
+}
+
+static Pix 
+fopen_file_for_user (tree_constant& arg, char *mode)
+{
+  char *file_name = arg.string_value ();
+
+  FILE *file_ptr = fopen (file_name, mode);
+  if (file_ptr != (FILE *) NULL)
+    {
+      File_info file (++file_count, file_name, file_ptr, mode);
+      file_list.append (file);
+      
+      Pix p = file_list.first ();
+      File_info file_from_list;
+      
+      for (int i = 0; i < file_count; i++)
+	{
+	  file_from_list = file_list (p);
+	  if (strcmp (file_from_list.name (), file_name) == 0)
+	    return p;
+	  file_list.next (p);
+	}
+    }
+
+  error ("problems automatically opening file for user");
+  return (Pix) NULL;
+}
+
+
+tree_constant *
+fclose_internal (tree_constant *args)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+
+  Pix p = return_valid_file (args[1]);
+
+  if (p == (Pix) NULL)
+    return retval;
+
+  File_info file = file_list (p);
+
+  if (file.number () < 3)
+    {
+      warning ("fclose: can't close stdin, stdout, or stderr!");
+      return retval;
+    }
+
+  int success = fclose (file.fptr ());
+  file_list.del (p);
+  file_count--;
+
+  retval = new tree_constant[2];
+  if (success == 0)
+    retval[0] = tree_constant (1.0); // succeeded
+  else
+    {
+      error ("fclose: error on closing file");
+      retval[0] = tree_constant (0.0); // failed
+    }
+
+  return retval;
+}
+
+tree_constant *
+fflush_internal (tree_constant *args)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+
+  Pix p = return_valid_file (args[1]);
+
+  if (p == (Pix) NULL)
+    return retval;
+
+  File_info file = file_list (p);
+
+  if (strcmp (file.mode (), "r") == 0)
+    {
+      warning ("can't flush an input stream");
+      return retval;
+    }
+
+  int success = 0;
+  if (file.number () == 1)
+    flush_output_to_pager ();
+  else
+    success = fflush (file.fptr ());
+
+  retval = new tree_constant[2];
+  if (success == 0)
+    retval[0] = tree_constant (1.0); // succeeded
+  else
+    {
+      error ("fflush: write error");
+      retval[0] = tree_constant (0.0); // failed
+    }
+
+  return retval;
+}
+
+static int
+valid_mode (char *mode)
+{
+  if (mode != (char *) NULL)
+    {
+      char m = mode[0];
+      if (m == 'r' || m == 'w' || m == 'a')
+	{
+	  m = mode[1];
+	  return (m == '\0' || (m == '+' && mode[2] == '\0'));
+	}
+    }
+  return 0;
+}
+
+tree_constant *
+fgets_internal (tree_constant *args, int nargout)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+
+  Pix p = return_valid_file (args[1]);
+  
+  if (p == (Pix) NULL)
+    {
+      if (args[1].is_string_type ())
+	{
+	  struct stat buffer;
+	  char *name = args[1].string_value ();
+	  if (stat (name, &buffer) == 0
+	      && (buffer.st_mode & S_IFREG) == S_IFREG)
+	    {
+	      p = fopen_file_for_user (args[1], "r");
+	    }
+	  else
+	    {
+	      error ("fgets: file dosen't exist");
+	      return retval;
+	    }
+	}
+      else
+	return retval;
+    }
+  
+  int length = 0;
+
+  if (args[2].is_scalar_type ())
+    {
+      length = (int) args[2].double_value ();
+      if ((double) NINT (length) != length)
+	{
+	  error ("fgets: length not an integer value");
+	  return retval;
+	}
+    }
+
+  char string[length+1];
+  File_info file = file_list (p);
+  char *success = fgets (string, length+1, file.fptr ());
+
+  if (success == (char *) NULL)
+    {
+      retval = new tree_constant[2];
+      retval[0] = tree_constant (-1.0);
+      return retval;
+    }
+
+  if (nargout == 2)
+    {
+      retval = new tree_constant[3];
+      retval[1] = tree_constant ((double) strlen (string));
+    }
+  else
+    retval = new tree_constant[2];
+
+  retval[0] = tree_constant (string);
+
+  return retval;
+}
+
+tree_constant *
+fopen_internal (tree_constant *args)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  Pix p;
+
+  if (! args[1].is_string_type ())
+    {
+      error ("fopen: file name must be a string");
+      return retval;
+    }
+
+  p = return_valid_file (args[1]);
+
+  if (p != (Pix) NULL)
+    {
+      File_info file = file_list (p);
+
+      retval = new tree_constant[2];
+      retval[0] = tree_constant ((double) file.number ());
+
+      return retval;
+    }
+
+  if (! args[2].is_string_type ())
+    {
+      error ("fopen: mode must be a string");
+      return retval;
+    }
+
+  char *name = args[1].string_value ();
+  char *mode = args[2].string_value ();
+
+  if (! valid_mode (mode))
+    {
+      error ("fopen: invalid mode");
+      return retval;
+    }
+
+  struct stat buffer;
+  if (stat (name, &buffer) == 0 && (buffer.st_mode & S_IFDIR) == S_IFDIR)
+    {
+      error ("fopen: can't open directory");
+      return retval;
+    }
+
+  FILE *file_ptr = fopen (name, mode);
+
+  if (file_ptr == (FILE *) NULL)
+    {
+      error ("fopen: file does not exist");
+      return retval;
+    }
+
+  int number = file_count++;
+
+  File_info file (number, name, file_ptr, mode);
+  file_list.append (file);
+
+  retval = new tree_constant[2];
+  retval[0] = tree_constant ((double) number);
+
+  return retval;
+}
+
+tree_constant *
+freport_internal ()
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  Pix p = file_list.first ();
+
+  ostrstream output_buf;
+
+  output_buf << "\n number  mode  name\n\n";
+  for (int i = 0; i < file_count; i++)
+    {
+      File_info file = file_list (p);
+      output_buf.form ("%7d%6s  %s\n", file.number (), file.mode (),
+		       file.name ());
+      file_list.next (p);
+    }
+
+  output_buf << "\n" << ends;
+  maybe_page_output (output_buf);
+
+  return retval;
+}
+
+tree_constant *
+frewind_internal (tree_constant *args)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+
+  Pix p = return_valid_file (args[1]);
+  if (p == (Pix) NULL)
+    p = fopen_file_for_user (args[1], "a+");   
+
+  File_info file = file_list (p);
+  rewind (file.fptr ());
+
+  return retval;
+}
+
+tree_constant *
+fseek_internal (tree_constant *args, int nargin)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+
+  Pix p = return_valid_file (args[1]);
+
+  if (p == (Pix) NULL)
+    p = fopen_file_for_user (args[1], "a+");
+
+  long origin = SEEK_SET;
+  long offset = 0;
+  if (args[2].is_scalar_type ())
+    {
+      offset = (long) args[2].double_value ();
+      if ((double) NINT (offset) != offset)
+	{
+	  error ("fseek: offset not an integer value");
+	  return retval;
+	}
+    }
+
+  if (nargin == 4 && args[3].is_scalar_type ())
+    {
+      origin = (long) args[3].double_value ();
+      if (origin == -1)
+	origin = SEEK_CUR;
+      else if (origin == -2)
+	origin = SEEK_END;
+      else
+	{
+	  if ((double) NINT (origin) != origin)
+	    {
+	      error ("fseek: origin not an integer value");
+	      return retval;
+	    }
+	}
+    }
+
+  File_info file = file_list (p);
+  int success = fseek (file.fptr (), offset, origin);
+  retval = new tree_constant[2];
+
+  if (success == 0)
+    retval[0] = tree_constant (1.0); // succeeded
+  else
+    {
+      error ("fseek: file error");
+      retval[0] = tree_constant (0.0); // failed
+    }
+
+  return retval;
+}
+
+tree_constant *
+ftell_internal (tree_constant *args)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  Pix p = return_valid_file (args[1]);
+
+  if (p == (Pix) NULL)
+    p = fopen_file_for_user (args[1], "a+");
+
+  File_info file = file_list (p);
+  long offset = ftell (file.fptr ());
+  retval = new tree_constant[2];
+  retval[0] = tree_constant ((double) offset);
+
+  if (offset == -1L)
+    error ("ftell: write error");
+
+  return retval;
+}
+
+void
+close_files ()
+{
+  Pix p = file_list.first ();
+
+  for (int i = 0; i < file_count; i++)
+    {
+      File_info file = file_list (p);
+      if (i > 2)   // do not close stdin, stdout, stderr!
+	{
+	  int success = fclose (file.fptr ());
+	  if (success != 0)
+	    error ("closing %s", file.name ());
+	}
+      file_list.del (p);
+    }
+}
+
+static int
+process_printf_format (char *s, tree_constant *args, ostrstream& sb,
+		       char *type, int nargin)
+{
+  ostrstream fmt;
+
+  fmt << "%";  // do_printf() already blew past this one...
+
+  tree_constant_rep::constant_type arg_type;
+
+  int chars_from_fmt_str = 0;
+
+ again:
+  switch (*s)
+    {
+    case '+': case '-': case ' ': case '0': case '#':
+      chars_from_fmt_str++;
+      fmt << *s++;
+      goto again;
+
+    case '\0':
+      goto invalid_format;
+
+    default:
+      break;
+    }
+
+  if (*s == '*')
+    {
+      if (fmt_arg_count >= nargin)
+	{
+	  message (type, "not enough arguments");
+	  return -1;
+	}
+
+      if (args[fmt_arg_count].const_type ()
+	  != tree_constant_rep::scalar_constant)
+	{
+	  message (type, "`*' must be replaced by an integer");
+	  return -1;
+	}
+
+      fmt << (int) (args[fmt_arg_count++].double_value ());
+      s++;
+      chars_from_fmt_str++;
+    }
+  else
+    {
+      while (*s != '\0' && isdigit (*s))
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s++;
+	}
+    }
+
+  if (*s == '\0')
+    goto invalid_format;
+
+  if (*s == '.')
+    {
+      chars_from_fmt_str++;
+      fmt << *s++;
+    }
+
+  if (*s == '*')
+    {
+      if (*(s-1) == '*')
+	goto invalid_format;
+
+      if (fmt_arg_count >= nargin)
+	{
+	  message (type, "not enough arguments");
+	  return -1;
+	}
+
+      if (args[fmt_arg_count].const_type ()
+	  != tree_constant_rep::scalar_constant)
+	{
+	  message (type, "`*' must be replaced by an integer");
+	  return -1;
+	}
+
+      fmt << (int) (args[fmt_arg_count++].double_value ());
+      s++;
+      chars_from_fmt_str++;
+    }
+  else
+    {
+      while (*s != '\0' && isdigit (*s))
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s++;
+	}
+    }
+
+  if (*s == '\0')
+    goto invalid_format;
+
+  if (*s != '\0' && (*s == 'h' || *s == 'l' || *s == 'L'))
+    {
+      chars_from_fmt_str++;
+      fmt << *s++;
+    }
+
+  if (*s == '\0')
+    goto invalid_format;
+
+  if (fmt_arg_count >= nargin)
+    {
+      message (type, "not enough arguments");
+      return -1;
+    }
+
+  arg_type = args[fmt_arg_count].const_type ();
+
+  switch (*s)
+    {
+    case 'd': case 'i': case 'o': case 'u': case 'x': case 'X':
+
+      if (arg_type != tree_constant_rep::scalar_constant)
+	goto invalid_conversion;
+      else
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s << ends;
+	  double d = args[fmt_arg_count++].double_value ();
+	  if ((int) d != d)
+	    goto invalid_conversion;
+	  else
+	    {
+	      char *s = fmt.str ();
+	      sb.form (s, (int) d);
+	      delete [] s;
+	      return chars_from_fmt_str;
+	    }
+	}
+
+    case 'e': case 'E': case 'f': case 'g': case 'G':
+
+      if (arg_type != tree_constant_rep::scalar_constant)
+	goto invalid_conversion;
+      else
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s << ends;
+	  char *s = fmt.str ();
+	  sb.form (s, args[fmt_arg_count++].double_value ());
+	  delete [] s;
+	  return chars_from_fmt_str;
+	}
+
+    case 's':
+
+      if (arg_type != tree_constant_rep::string_constant)
+	goto invalid_conversion;
+      else
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s << ends;
+	  char *s = fmt.str ();
+	  sb.form (s, args[fmt_arg_count++].string_value ());
+	  delete [] s;
+	  return chars_from_fmt_str;
+	}
+
+    case 'c':
+
+      if (arg_type != tree_constant_rep::string_constant)
+	goto invalid_conversion;
+      else
+	{
+	  chars_from_fmt_str++;
+	  fmt << *s << ends;
+	  char *str = args[fmt_arg_count++].string_value ();
+	  if (strlen (str) != 1)
+	    goto invalid_conversion;
+	  else
+	    {
+	      char *s = fmt.str ();
+	      sb.form (s, *str);
+	      delete [] s;
+	      return chars_from_fmt_str;
+	    }
+	}
+
+    default:
+      goto invalid_format;
+   }
+
+ invalid_conversion:
+  message (type, "invalid conversion");
+  return -1;
+
+ invalid_format:
+  message (type, "invalid format");
+  return -1;
+}
+
+
+tree_constant *
+do_printf (char *type, tree_constant *args, int nargin, int nargout)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  fmt_arg_count = 1;
+  char *fmt;
+  File_info file;
+
+  if (strcmp (type, "fprintf") == 0)
+    {
+      Pix p;
+
+      if (args[2].is_string_type ())
+	{
+	  fmt = args[2].string_value ();
+	  fmt_arg_count++;
+	}
+      else
+	{
+	  error ("%s: format must be a string", type);
+	  return retval;
+	}
+
+      if (args[1].is_scalar_type ())
+	{
+	  p = return_valid_file (args[1]);
+	  if (p == (Pix) NULL)
+	    return retval;
+	}
+      else if (args[1].is_string_type ())
+	{
+	  p = return_valid_file (args[1]);
+	  if (p == (Pix) NULL)
+	    p = fopen_file_for_user (args[1], "a+");
+	}
+      else
+	  {
+	    error ("%s: illegal file specifier", type);
+	    return retval;
+	  }
+
+      file = file_list (p);
+      if (file.mode () == "r")
+	{
+	  error ("%s: file is read only", type);
+	  return retval;
+	}
+      fmt = args[2].string_value ();
+      fmt_arg_count++;
+    }
+  else if (args[1].is_string_type ())
+    {
+      fmt = args[1].string_value ();
+      fmt_arg_count++;
+    }
+  else
+    {
+      error ("%s: invalid format string", type);
+      return retval;
+    }
+
+// Scan fmt for % escapes and print out the arguments.
+
+  ostrstream output_buf;
+
+  char *ptr = fmt;
+
+  for (;;)
+    {
+      char c;
+      while ((c = *ptr++) != '\0' && c != '%')
+	output_buf << c;
+
+      if (c == '\0')
+	break;
+
+      if (*ptr == '%')
+	{
+	  ptr++;
+	  output_buf << c;
+	  continue;
+	}
+
+// We must be looking at a format specifier.  Extract it or fail.
+
+
+      int status = process_printf_format (ptr, args, output_buf, type,
+					  nargin);
+
+      if (status < 0)
+	return retval;
+
+      ptr += status;
+    }
+
+  output_buf << ends;
+  if (strcmp (type, "printf") == 0
+      || (strcmp (type, "fprintf") == 0 && file.number () == 1))
+    {
+      maybe_page_output (output_buf);
+    }
+  else if (strcmp (type, "fprintf") == 0)
+    {
+      char *msg = output_buf.str ();
+      int success = fputs (msg, file.fptr ());
+      if (success == EOF)
+	error ("%s: writing to file", type);
+      delete [] msg;
+    }
+  else if (strcmp (type, "sprintf") == 0)
+    {
+      retval = new tree_constant [2];
+      char *msg = output_buf.str ();
+      retval[0] = tree_constant (msg);
+      delete [] msg;
+    }
+
+  return retval;
+}
+
+static int
+process_scanf_format (char *s, tree_constant *args, ostrstream& fmt,
+		      char *type, int nargout, FILE* fptr,
+		      tree_constant *values)
+{
+  fmt << "%";
+
+  tree_constant_rep::constant_type arg_type;
+
+  int chars_from_fmt_str = 0;
+  int store_value = 1;
+  int string_width = -1;
+  int success = 1;
+
+  if (*s == '*')
+    {
+      store_value = 0;
+      s++;
+      chars_from_fmt_str++;
+    }
+
+  if (isdigit (*s))
+    {
+      ostrstream str_number;
+      while (*s != '\0' && isdigit (*s))
+	{
+	  chars_from_fmt_str++;
+	  str_number << *s;
+	  fmt << *s++;
+	}
+      str_number << ends;
+      char *number = str_number.str ();
+      string_width = atoi (number);
+      delete [] number;
+    }
+
+  if (*s == '\0')
+    goto invalid_format;
+
+  if (*s != '\0' && (*s == 'h' || *s == 'l' || *s == 'L'))
+    {
+      chars_from_fmt_str++;
+      s++;
+    }
+
+  if (*s == '\0')
+    goto invalid_format;
+
+  if (fmt_arg_count >= nargout && store_value)
+    {
+      message (type, "not enough arguments");
+      return -1;
+    }
+
+  arg_type = args[fmt_arg_count].const_type ();
+
+  switch (*s)
+    {
+    case 'd': case 'i': case 'o': case 'u': case 'x': case 'X':
+      {
+	chars_from_fmt_str++;
+	fmt << *s << ends;
+	int temp;
+	char *str = fmt.str ();
+	success = fscanf (fptr, str, &temp);
+	delete [] str;
+	if (success > 0 && store_value)
+	  values[fmt_arg_count++] = tree_constant ((double) temp);
+      }
+      break;
+    case 'e': case 'E': case 'f': case 'g': case 'G':
+      {
+	chars_from_fmt_str++;
+	fmt << 'l' << *s << ends;
+	double temp;
+	char *str = fmt.str ();
+	success = fscanf (fptr, str, &temp);
+	delete [] str;
+	if (success > 0 && store_value)
+	  values[fmt_arg_count++] = tree_constant (temp);
+      }
+      break;
+    case 's':
+      {
+	if (string_width < 1)
+	  {
+	    string_width = 0;
+	    long original_position = ftell (fptr);
+	    int c;
+
+	    while ((c = getc (fptr)) != EOF
+		   && (c == ' ' || c == '\n' || c != '\t'))
+	      ; // Don't count leading whitespace.
+
+	    if (c != EOF)
+	      string_width++;
+
+	    for (;;)
+	      {
+		c = getc (fptr);
+		if (c != EOF && c != ' ' && c != '\n' && c != '\t')
+		  string_width++;
+		else
+		  break;
+	      }
+
+	    fseek (fptr, original_position, SEEK_SET);
+	  }
+	chars_from_fmt_str++;
+	char temp[string_width+1];
+	fmt << *s << ends;
+	char *str = fmt.str ();
+	success = fscanf (fptr, str, temp);
+	delete [] str;
+	if (success && store_value)
+	  values[fmt_arg_count++] = tree_constant (temp);
+      }
+      break;
+    case 'c':
+      {
+	if (string_width < 1)
+	  string_width = 1;
+	chars_from_fmt_str++;
+	char temp[string_width+1];
+	memset (temp, '\0', string_width+1);
+	fmt << *s << ends;
+	char *str = fmt.str ();
+	success = fscanf (fptr, str, temp);
+	delete [] str;
+	temp[string_width] = '\0';
+	if (success > 0 && store_value)
+	  values[fmt_arg_count++] = tree_constant (temp);
+      }
+      break;
+    default:
+      goto invalid_format;
+    }
+
+  if (success > 0 || (success == 0 && store_value == 0))
+    return chars_from_fmt_str;
+
+  if (success == 0)
+    message (type, "invalid conversion");
+  else if (success == EOF)
+    {
+      if (strcmp (type, "fscanf") == 0)
+	message (type, "end of file reached before final conversion");
+      else if (strcmp (type, "sscanf") == 0)
+	message (type, "end of string reached before final conversion");
+      else if (strcmp (type, "scanf") == 0)
+	message (type, "end of input reached before final conversion");
+    }
+  else
+    {
+    invalid_format:
+      message (type, "invalid format");
+    }
+
+  return -1;
+}
+
+tree_constant *
+do_scanf (char *type, tree_constant *args, int nargin, int nargout)
+{
+  tree_constant *retval = NULL_TREE_CONST;
+  char *scanf_fmt = (char *) NULL;
+  char *tmp_file = (char *) NULL;
+  int tmp_file_open = 0;
+  FILE *fptr = (FILE *) NULL;
+  File_info file;
+
+  fmt_arg_count = 0;
+
+  if (strcmp (type, "scanf") != 0)
+    {
+      if ( args[2].is_string_type ())
+	scanf_fmt = args[2].string_value ();
+      else
+	{
+	  error ("%s: format must be a string", type);
+	  return retval;
+	}
+    }
+
+  int doing_fscanf = (strcmp (type, "fscanf") == 0);
+
+  if (doing_fscanf)
+    {
+      Pix p;
+      if (args[1].is_scalar_type ()
+	  || args[1].is_string_type ())
+	{
+	  p = return_valid_file (args[1]);
+	  if (p == (Pix) NULL)
+	    return retval;
+	}
+      else
+	{
+	  error ("%s: illegal file specifier", type);
+	  return retval;
+	}
+
+      file = file_list (p);
+
+      if (strcmp (file.mode (), "w") == 0 || strcmp (file.mode (), "a") == 0)
+	{
+	  error ("%s: this file is opened for writing only", type);
+	  return retval;
+	}
+
+      fptr = file.fptr ();
+    }
+
+  if (args[1].is_string_type () || (doing_fscanf && file.number () == 0))
+    {
+      char *string;
+
+      if (strcmp (type, "scanf") == 0)
+	scanf_fmt = args[1].string_value ();
+
+      if (strcmp (type, "scanf") == 0
+	  || (doing_fscanf && file.number () == 0))
+	{
+	  string = gnu_readline ("");
+	  if (string && *string)
+	    maybe_save_history (string);
+	}
+      else
+	string = args[1].string_value ();
+
+      tmp_file = tmpnam ((char *) NULL);
+
+      fptr = fopen (tmp_file, "w+");
+      if (fptr == (FILE *) NULL)
+	{
+	  error ("%s: error opening temporary file", type);
+	  return retval;
+	}
+      tmp_file_open = 1;
+      unlink (tmp_file);
+
+      if (string == (char *) NULL)
+	panic_impossible ();
+
+      int success = fputs (string, fptr);
+      fflush (fptr);
+      rewind (fptr);
+
+      if (success < 0)
+	{
+	  error ("%s: trouble writing temporary file", type);
+	  fclose (fptr);
+	  return retval;
+	}
+    }
+  else if (! doing_fscanf)
+    {
+      error ("%s: first argument must be a string", type);
+      return retval;
+    }
+
+// Scan scanf_fmt for % escapes and assign the arguments.
+
+  retval = new tree_constant[nargout+1];
+
+  char *ptr = scanf_fmt;
+
+  for (;;)
+    {
+      ostrstream fmt;
+      char c;
+      while ((c = *ptr++) != '\0' && c != '%')
+	fmt << c;
+
+      if (c == '\0')
+	break;
+
+      if (*ptr == '%')
+	{
+	  ptr++;
+	  fmt << c;
+	  continue;
+	}
+
+// We must be looking at a format specifier.  Extract it or fail.
+
+      int status = process_scanf_format (ptr, args, fmt, type,
+					 nargout, fptr, retval);
+
+      if (status < 0)
+	{
+	  if (fmt_arg_count == 0)
+	    {
+	      delete [] retval;
+	      retval = NULL_TREE_CONST;
+	    }
+	  break;
+	}
+
+      ptr += status;
+    }
+
+  if (tmp_file_open)
+    fclose (fptr);
+
+  return retval;
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; page-delimiter: "^/\\*" ***
+;;; End: ***
+*/