# HG changeset patch # User jwe # Date 774729307 0 # Node ID 4a07f0083ab06021c503544143144e1215e9b15f # Parent 2dba380d2d859828bde6258e11fb5565f46bec9d [project @ 1994-07-20 18:33:47 by jwe] Initial revision diff --git a/src/data.cc b/src/data.cc new file mode 100644 --- /dev/null +++ b/src/data.cc @@ -0,0 +1,445 @@ +// data.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993, 1994 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_pwd adapted from a similar function from GNU +Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free +Software Foundation, Inc. + +*/ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "tree-const.h" +#include "user-prefs.h" +#include "utils.h" +#include "error.h" +#include "defun.h" + +#ifndef MIN +#define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif + +DEFUN ("all", Fall, Sall, 2, 1, + "all (X): are all elements of X nonzero?") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("all"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).all (); + + return retval; +} + +DEFUN ("any", Fany, Sany, 2, 1, + "any (X): are any elements of X nonzero?") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("any"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).any (); + + return retval; +} + +DEFUN ("cumprod", Fcumprod, Scumprod, 2, 1, + "cumprod (X): cumulative products") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("cumprod"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).cumprod (); + + return retval; +} + +DEFUN ("cumsum", Fcumsum, Scumsum, 2, 1, + "cumsum (X): cumulative sums") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("cumsum"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).cumsum (); + + return retval; +} + +DEFUN ("diag", Fdiag, Sdiag, 3, 1, + "diag (X [,k]): form/extract diagonals") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2) + retval = args(1).diag (); + else if (nargin == 3) + retval = args(1).diag (args(2)); + else + print_usage ("diag"); + + return retval; +} + +DEFUN ("isstr", Fisstr, Sisstr, 2, 1, + "isstr (X): return 1 if X is a string, 0 otherwise") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("isstr"); + else + { + if (nargin > 0 && args(1).is_defined ()) + retval = args(1).isstr (); + } + + return retval; +} + +DEFUN ("prod", Fprod, Sprod, 2, 1, + "prod (X): products") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("prod"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).prod (); + + return retval; +} + +DEFUN ("setstr", Fsetstr, Ssetstr, 2, 1, + "setstr (V): convert a vector to a string") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2) + retval = args(1).convert_to_str (); + else + print_usage ("setstr"); + + return retval; +} + +DEFUN ("size", Fsize, Ssize, 2, 1, + "[m, n] = size (x): return rows and columns of X") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("size"); + else + { + if (nargin > 0 && args(1).is_defined ()) + { + int nr = args(1).rows (); + int nc = args(1).columns (); + if (nargout == 0 || nargout == 1) + { + Matrix m (1, 2); + m.elem (0, 0) = nr; + m.elem (0, 1) = nc; + retval = m; + } + else if (nargout == 2) + { + retval(1) = (double) nc; + retval(0) = (double) nr; + } + else + print_usage ("size"); + } + } + + return retval; +} + +DEFUN ("sum", Fsum, Ssum, 2, 1, + "sum (X): sum of elements") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("sum"); + else + { + if (nargin > 0 && args(1).is_defined ()) + retval = args(1).sum (); + } + + return retval; +} + +DEFUN ("sumsq", Fsumsq, Ssumsq, 2, 1, + "sumsq (X): sum of squares of elements") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("sumsq"); + else if (nargin > 0 && args(1).is_defined ()) + retval = args(1).sumsq (); + + return retval; +} + +static void +check_dimensions (int& nr, int& nc, const char *warnfor) +{ + if (nr < 0 || nc < 0) + { + if (user_pref.treat_neg_dim_as_zero) + nr = nc = 0; + else + error ("%s: can't create a matrix with negative dimensions", + warnfor); + } +} + +static void +get_dimensions (const tree_constant& a, const char *warn_for, + int& nr, int& nc) +{ + tree_constant tmpa = a.make_numeric (); + + if (tmpa.is_scalar_type ()) + { + double tmp = tmpa.double_value (); + nr = nc = NINT (tmp); + } + else + { + nr = tmpa.rows (); + nc = tmpa.columns (); + + if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) + { + ColumnVector v = tmpa.to_vector (); + + nr = NINT (v.elem (0)); + nc = NINT (v.elem (1)); + } + else + warning ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +static void +get_dimensions (const tree_constant& a, const tree_constant& b, + const char *warn_for, int& nr, int& nc) +{ + tree_constant tmpa = a.make_numeric (); + tree_constant tmpb = b.make_numeric (); + + if (tmpa.is_scalar_type () && tmpb.is_scalar_type ()) + { + nr = NINT (tmpa.double_value ()); + nc = NINT (tmpb.double_value ()); + + check_dimensions (nr, nc, warn_for); // May set error_state. + } + else + error ("%s: expecting two scalar arguments", warn_for); +} + +static tree_constant +fill_matrix (const tree_constant& a, double val, const char *warn_for) +{ + int nr, nc; + get_dimensions (a, warn_for, nr, nc); + + if (error_state) + return tree_constant (); + + Matrix m (nr, nc, val); + + return m; +} + +static tree_constant +fill_matrix (const tree_constant& a, const tree_constant& b, + double val, const char *warn_for) +{ + int nr, nc; + get_dimensions (a, b, warn_for, nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); + + Matrix m (nr, nc, val); + + return m; +} + +DEFUN ("ones", Fones, Sones, 3, 1, + "ones (N), ones (N, M), ones (X): create a matrix of all ones") +{ + Octave_object retval; + + int nargin = args.length (); + + switch (nargin) + { + case 2: + retval = fill_matrix (args(1), 1.0, "ones"); + break; + case 3: + retval = fill_matrix (args(1), args(2), 1.0, "ones"); + break; + default: + print_usage ("ones"); + break; + } + + return retval; +} + +DEFUN ("zeros", Fzeros, Szeros, 3, 1, + "zeros (N), zeros (N, M), zeros (X): create a matrix of all zeros") +{ + Octave_object retval; + + int nargin = args.length (); + + switch (nargin) + { + case 2: + retval = fill_matrix (args(1), 0.0, "zeros"); + break; + case 3: + retval = fill_matrix (args(1), args(2), 0.0, "zeros"); + break; + default: + print_usage ("zeros"); + break; + } + + return retval; +} + +static tree_constant +identity_matrix (const tree_constant& a) +{ + int nr, nc; + get_dimensions (a, "eye", nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); + + Matrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + int n = MIN (nr, nc); + for (int i = 0; i < n; i++) + m.elem (i, i) = 1.0; + } + + return m; +} + +static tree_constant +identity_matrix (const tree_constant& a, const tree_constant& b) +{ + int nr, nc; + get_dimensions (a, b, "eye", nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); + + Matrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + int n = MIN (nr, nc); + for (int i = 0; i < n; i++) + m.elem (i, i) = 1.0; + } + + return m; +} + +DEFUN ("eye", Feye, Seye, 3, 1, + "eye (N), eye (N, M), eye (X): create an identity matrix") +{ + Octave_object retval; + + int nargin = args.length (); + + switch (nargin) + { + case 2: + retval = identity_matrix (args(1)); + break; + case 3: + retval = identity_matrix (args(1), args(2)); + break; + default: + print_usage ("eye"); + break; + } + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff --git a/src/dirfns.cc b/src/dirfns.cc new file mode 100644 --- /dev/null +++ b/src/dirfns.cc @@ -0,0 +1,492 @@ +// dirfns.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993, 1994 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. + +*/ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#ifdef HAVE_UNISTD_H +#include +#endif +#include +#include +#include +#include + +// This mess suggested by the autoconf manual. +// unistd.h defines _POSIX_VERSION on POSIX.1 systems. +#if defined(DIRENT) || defined(_POSIX_VERSION) +#include +#define NLENGTH(dirent) (strlen((dirent)->d_name)) +#else /* not (DIRENT or _POSIX_VERSION) */ +#define dirent direct +#define NLENGTH(dirent) ((dirent)->d_namlen) +#ifdef SYSNDIR +#include +#endif /* SYSNDIR */ +#ifdef SYSDIR +#include +#endif /* SYSDIR */ +#ifdef NDIR +#include +#endif /* NDIR */ +#endif /* not (DIRENT or _POSIX_VERSION) */ + +#include "statdefs.h" +#include "procstream.h" +#include "tree-const.h" +#include "oct-obj.h" +#include "octave.h" +#include "dirfns.h" +#include "pager.h" +#include "error.h" +#include "utils.h" +#include "defun.h" + +extern "C" +{ +#include +extern char *strerror (int); +} + +#ifndef MAXPATHLEN +#define MAXPATHLEN 1024 +#endif + +// Temp storage for a path. +static char tdir[MAXPATHLEN]; + +// Non-zero means follow symbolic links that point to directories just +// as if they are real directories. +static int follow_symbolic_links = 1; + +// Non-zero means that pwd always give verbatim directory, regardless +// of symbolic link following. +static int verbatim_pwd = 1; + +/* + * Remove the last N directories from PATH. Do not PATH blank. + * PATH must contain enough space for MAXPATHLEN characters. + */ +void +pathname_backup (char *path, int n) +{ + register char *p; + + if (! *path) + return; + + p = path + (strlen (path) - 1); + + while (n--) + { + while (*p == '/' && p != path) + p--; + + while (*p != '/' && p != path) + p--; + + *++p = '\0'; + } +} + +/* + * Return a pretty pathname. If the first part of the pathname is the + * same as $HOME, then replace that with `~'. + */ +char * +polite_directory_format (char *name) +{ + int l = home_directory ? strlen (home_directory) : 0; + + if (l > 1 && strncmp (home_directory, name, l) == 0 + && (! name[l] || name[l] == '/')) + { + strcpy (tdir + 1, name + l); + tdir[0] = '~'; + return (tdir); + } + else + return name; +} + +/* + * Return 1 if STRING contains an absolute pathname, else 0. + */ +int +absolute_pathname (const char *string) +{ + if (! string || ! *string) + return 0; + + if (*string == '/') + return 1; + + if (*string++ == '.') + { + if ((! *string) || *string == '/') + return 1; + + if (*string++ == '.') + if (! *string || *string == '/') + return 1; + } + return 0; +} + +/* + * Return 1 if STRING is an absolute program name; it is absolute if + * it contains any slashes. This is used to decide whether or not to + * look up through $PATH. + */ +int +absolute_program (const char *string) +{ + return (strchr (string, '/') != 0); +} + +/* + * Return the `basename' of the pathname in STRING (the stuff after + * the last '/'). If STRING is not a full pathname, simply return it. + */ +char * +base_pathname (char *string) +{ + char *p = strrchr (string, '/'); + + if (! absolute_pathname (string)) + return (string); + + if (p) + return (++p); + else + return (string); +} + +/* + * Turn STRING (a pathname) into an absolute pathname, assuming that + * DOT_PATH contains the symbolic location of '.'. This always + * returns a new string, even if STRING was an absolute pathname to + * begin with. + */ +char * +make_absolute (const char *string, const char *dot_path) +{ + static char current_path[MAXPATHLEN]; + register char *cp; + + if (! dot_path || *string == '/') + return strsave (string); + + strcpy (current_path, dot_path); + + if (! current_path[0]) + strcpy (current_path, "./"); + + cp = current_path + (strlen (current_path) - 1); + + if (*cp++ != '/') + *cp++ = '/'; + + *cp = '\0'; + + while (*string) + { + if (*string == '.') + { + if (! string[1]) + return strsave (current_path); + + if (string[1] == '/') + { + string += 2; + continue; + } + + if (string[1] == '.' && (string[2] == '/' || ! string[2])) + { + string += 2; + + if (*string) + string++; + + pathname_backup (current_path, 1); + cp = current_path + strlen (current_path); + continue; + } + } + + while (*string && *string != '/') + *cp++ = *string++; + + if (*string) + *cp++ = *string++; + + *cp = '\0'; + } + return strsave (current_path); +} + +/* + * Has file `A' been modified after time `T'? + * + * case: + * + * a newer than t returns 1 + * a older than t returns 0 + * stat on a fails returns -1 + */ +int +is_newer (const char *fa, time_t t) +{ + struct stat fa_sb; + register int fa_stat; + register int status = 0; + + fa_stat = stat (fa, &fa_sb); + if (fa_stat != 0) + status = -1; + + if (status != 0) + return status; + + return (fa_sb.st_mtime > t); +} + +/* + * Return a consed string which is the current working directory. + * FOR_WHOM is the name of the caller for error printing. + */ +char * +get_working_directory (const char *for_whom) +{ + if (! follow_symbolic_links) + { + if (the_current_working_directory) + delete [] the_current_working_directory; + + the_current_working_directory = 0; + } + + if (! the_current_working_directory) + { + char *directory; + + the_current_working_directory = new char [MAXPATHLEN]; + directory = getcwd (the_current_working_directory, MAXPATHLEN); + if (! directory) + { + message (for_whom, the_current_working_directory); + delete [] the_current_working_directory; + the_current_working_directory = 0; + return 0; + } + } + + return the_current_working_directory; +} + +/* + * Do the work of changing to the directory NEWDIR. Handle symbolic + * link following, etc. + */ +static int +change_to_directory (const char *newdir) +{ + char *t; + + if (follow_symbolic_links) + { + if (! the_current_working_directory) + get_working_directory ("cd_links"); + + if (the_current_working_directory) + t = make_absolute (newdir, the_current_working_directory); + else + t = strsave (newdir); + + /* Get rid of trailing `/'. */ + { + register int len_t = strlen (t); + if (len_t > 1) + { + --len_t; + if (t[len_t] == '/') + t[len_t] = '\0'; + } + } + + if (chdir (t) < 0) + { + delete [] t; + return 0; + } + + if (the_current_working_directory) + strcpy (the_current_working_directory, t); + + delete [] t; + return 1; + } + else + { + if (chdir (newdir) < 0) + return 0; + else + return 1; + } +} + +DEFUN_TEXT ("cd", Fcd, Scd, 2, 1, + "cd [dir]\n\ +\n\ +change current working directory\n\ +if no arguments are given, the current directory is changed to the\n\ +users home directory") +{ + Octave_object retval; + + DEFINE_ARGV("cd"); + + if (argc > 1) + { + static char *dirname = 0; + + if (dirname) + free (dirname); + + dirname = tilde_expand (argv[1]); + + if (dirname && ! change_to_directory (dirname)) + { + error ("%s: %s", dirname, strerror (errno)); + DELETE_ARGV; + return retval; + } + } + else + { + if (!home_directory) + { + DELETE_ARGV; + return retval; + } + + if (!change_to_directory (home_directory)) + { + error ("%s: %s", home_directory, strerror (errno)); + DELETE_ARGV; + return retval; + } + } + + + char *directory = get_working_directory ("cd"); + tree_constant *dir = new tree_constant (directory); + bind_builtin_variable ("PWD", dir, 1); + + DELETE_ARGV; + + return retval; +} + +DEFALIAS (dir, ls) + +/* + * Get a directory listing. + */ +DEFUN_TEXT ("ls", Fls, Sls, -1, 1, + "ls [options]\n\ +\n\ +print a directory listing") +{ + Octave_object retval; + + DEFINE_ARGV("ls"); + + 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; + + DELETE_ARGV; + + return retval; +} + +DEFUN ("pwd", Fpwd, Spwd, 1, 0, + "pwd (): print current working directory") +{ + Octave_object retval; + char *directory; + + if (verbatim_pwd) + { + char *buffer = new char [MAXPATHLEN]; + directory = getcwd (buffer, MAXPATHLEN); + + if (!directory) + { + warning ("pwd: can't find working directory!"); + delete buffer; + } + } + else + { + directory = get_working_directory ("pwd"); + } + + if (directory) + { + char *s = strconcat (directory, "\n"); + retval = s; + delete [] s; + } + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff --git a/src/dirfns.h b/src/dirfns.h new file mode 100644 --- /dev/null +++ b/src/dirfns.h @@ -0,0 +1,43 @@ +// dirfns.h -*- C++ -*- +/* + +Copyright (C) 1992, 1993, 1994 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. + +*/ + +#if !defined (octave_dirfns_h) +#define octave_dirfns_h 1 + +extern char *polite_directory_format (char *); +extern int absolute_pathname (const char *); +extern int absolute_program (const char *); +extern char *base_pathname (char *); +extern void pathname_backup (char *, int); +extern char *make_absolute (const char *, const char *); +extern int is_newer (const char *, time_t); +extern char *get_working_directory (const char *); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/ diff --git a/src/timefns.cc b/src/timefns.cc new file mode 100644 --- /dev/null +++ b/src/timefns.cc @@ -0,0 +1,81 @@ +// timefns.cc -*- C++ -*- +/* + +Copyright (C) 1992, 1993, 1994 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. + +*/ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include + +#include "dMatrix.h" + +#include "tree-const.h" +#include "oct-obj.h" +#include "defun.h" + +DEFUN ("clock", Fclock, Sclock, 1, 0, + "clock (): return current date and time in vector with elements\n\ +\n\ + [ year, month, day-of-month, hour, minute, second ]") +{ + time_t now; + struct tm *tm; + + time (&now); + tm = localtime (&now); + + Matrix m (1, 6); + m.elem (0, 0) = tm->tm_year + 1900; + m.elem (0, 1) = tm->tm_mon + 1; + m.elem (0, 2) = tm->tm_mday; + m.elem (0, 3) = tm->tm_hour; + m.elem (0, 4) = tm->tm_min; + m.elem (0, 5) = tm->tm_sec; + + return m; +} + +DEFUN ("date", Fdate, Sdate, 1, 0, + "date (): return current date in a string, in the form `18-Jul-94'") +{ + Octave_object retval; + + time_t now; + struct tm *tm; + + time (&now); + tm = localtime (&now); + char date[32]; + int len = strftime (date, 31, "%d-%b-%y", tm); + if (len > 0) + retval = date; + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; page-delimiter: "^/\\*" *** +;;; End: *** +*/