# HG changeset patch # User John W. Eaton # Date 1344018944 14400 # Node ID 959953dba5193fbb3aab9eaace497e8ec57b57b0 # Parent 069c552587a0812cadb2bfd728b692023c7407d0# Parent 6c5b6c0ab528f716289afe1bc049cacf6edbcee3 maint: periodic merge of default to classdef diff -r 069c552587a0 -r 959953dba519 .hgsubstate --- a/.hgsubstate Tue Jul 31 09:54:19 2012 -0400 +++ b/.hgsubstate Fri Aug 03 14:35:44 2012 -0400 @@ -1,1 +1,1 @@ -33f823397dbb0edb57503f2f6dad2362456bc6a9 gnulib +0e3af50c9e20938bd1cea0182bf749ce61cb6782 gnulib diff -r 069c552587a0 -r 959953dba519 autogen.sh --- a/autogen.sh Tue Jul 31 09:54:19 2012 -0400 +++ b/autogen.sh Fri Aug 03 14:35:44 2012 -0400 @@ -30,9 +30,9 @@ (cd doc/interpreter; ./config-images.sh) -echo "generating src/DLD-FUNCTIONS/module.mk..." +echo "generating src/dldfcn/module.mk..." -(cd src/DLD-FUNCTIONS; ./config-module.sh) +(cd src/dldfcn; ./config-module.sh) echo "bootstrapping..." diff -r 069c552587a0 -r 959953dba519 configure.ac --- a/configure.ac Tue Jul 31 09:54:19 2012 -0400 +++ b/configure.ac Fri Aug 03 14:35:44 2012 -0400 @@ -44,7 +44,7 @@ AC_REVISION($Revision: 1.603 $) AC_PREREQ([2.62]) AC_CONFIG_SRCDIR([src/octave.cc]) -AC_CONFIG_HEADER([config.h]) +AC_CONFIG_HEADERS([config.h]) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) @@ -52,9 +52,11 @@ OCTAVE_HOST_TYPE -AC_DEFINE(OCTAVE_SOURCE, 1, [Define if this is Octave.]) +AC_DEFINE(OCTAVE_SOURCE, 1, [Define to 1 if this is Octave.]) -dnl FIXME -- we should probably only generate this file if it is missing. +dnl FIXME: Can this MSVC test be moved down to the section on finding a +dnl a C compiler which already has an MSVC exception test? +dnl FIXME: We should probably only generate this file if it is missing. ### Produce unistd.h for MSVC target, this simplifies changes in ### Octave source tree and avoid problems with lex-generated code. case "$canonical_host_type" in @@ -72,24 +74,8 @@ AC_USE_SYSTEM_EXTENSIONS -### Check for MSVC -have_msvc=no -case "$canonical_host_type" in - *-*-msdosmsvc) - have_msvc=yes - ;; - *-*-mingw*) - AC_MSG_CHECKING([for MSVC compiler]) - AC_PREPROC_IFELSE([AC_LANG_SOURCE([ -#ifndef _MSC_VER -#error "Not MSVC compiler" -#endif -])], have_msvc=yes, have_msvc=no) - AC_MSG_RESULT([$have_msvc]) - ;; -esac +### Path separator. -### Path separator. sepchar=: AC_ARG_WITH(sepchar, [AS_HELP_STRING([--with-sepchar=], @@ -113,7 +99,7 @@ AC_DEFINE_UNQUOTED(SEPCHAR, ['$sepchar'], [Define this to be the path separator for your system, as a character constant.]) AC_DEFINE_UNQUOTED(SEPCHAR_STR, ["$sepchar"], [Define this to the path separator, as a string.]) -### some defaults +### Set default file locations OCTAVE_SET_DEFAULT(man1dir, '$(mandir)/man1') OCTAVE_SET_DEFAULT(man1ext, '.1') @@ -155,9 +141,9 @@ config_opts=$ac_configure_args AC_SUBST(config_opts) -### Make it possible to have Octave's array and matrix classes do bounds -### checking on element references. This slows some operations down a -### bit, so it is turned off by default. +### Enable bounds checking on element references within Octave's array and +### matrix classes. This slows down some operations a bit, so it is turned off +### by default. BOUNDS_CHECKING=false AC_ARG_ENABLE(bounds-check, @@ -165,29 +151,37 @@ [bounds checking for indexing in internal array classes (default is no)])], [if test "$enableval" = yes; then BOUNDS_CHECKING=true; fi], []) if $BOUNDS_CHECKING; then - AC_DEFINE(BOUNDS_CHECKING, 1, [Define to use internal bounds checking.]) + AC_DEFINE(BOUNDS_CHECKING, 1, [Define to 1 to use internal bounds checking.]) fi +### Use Octave's built-in memory allocator rather than straightforward malloc. +### Disabled by default. + USE_OCTAVE_ALLOCATOR=false AC_ARG_ENABLE(octave-allocator, [AS_HELP_STRING([--enable-octave-allocator], [use the obsolete octave_allocator class for many of Octave's objects (mostly octave_value types). You probably do NOT want to enable this feature. (default is no)])], [if test "$enableval" = yes; then USE_OCTAVE_ALLOCATOR=true; fi], []) if $USE_OCTAVE_ALLOCATOR; then - AC_DEFINE(USE_OCTAVE_ALLOCATOR, 1, [Define to use octave_allocator class.]) + AC_DEFINE(USE_OCTAVE_ALLOCATOR, 1, [Define to 1 to use octave_allocator class.]) fi +### Use atomic operations for internal reference counting. This is required +### for thread-safe behavior but incurs a significant slowdown, and is thus +### disabled by default. + USE_ATOMIC_REFCOUNT=false AC_ARG_ENABLE(atomic-refcount, [AS_HELP_STRING([--enable-atomic-refcount], - [use atomic operations for internal reference counting. This is required for thread-safe behavior. (default is no)])], + [use atomic operations for internal reference counting. This is required for thread-safe behavior. (default is no)])], [if test "$enableval" = yes; then USE_ATOMIC_REFCOUNT=true; fi], []) if $USE_ATOMIC_REFCOUNT; then - AC_DEFINE(USE_ATOMIC_REFCOUNT, 1, [Define to use atomic operations for reference counting.]) + AC_DEFINE(USE_ATOMIC_REFCOUNT, 1, [Define to 1 to use atomic operations for reference counting.]) fi -### Make it possible to disable running Make in the doc directory. -### Useful for building on systems without TeX, for example. +### Disable running Make in the doc directory. +### This is useful, for example, when building Octave on systems without TeX. + DOCDIR=doc AC_ARG_ENABLE(docs, [AS_HELP_STRING([--enable-docs], [build documentation (default is yes)])], @@ -215,23 +209,23 @@ OCTAVE_IDX_TYPE=int elif test $ac_cv_sizeof_long -eq 8; then OCTAVE_IDX_TYPE=long - AC_DEFINE(IDX_TYPE_LONG, 1, [Define to 1 if octave index type is long]) + AC_DEFINE(IDX_TYPE_LONG, 1, [Define to 1 if octave index type is long.]) else warn_64_bit="no suitable type found for octave_idx_type so disabling 64-bit features" OCTAVE_CONFIGURE_WARNING([warn_64_bit]) USE_64_BIT_IDX_T=false fi else - warn_64_bit="pointers are not 64-bits wide so disabling 64-bit features" + warn_64_bit="pointers are not 64-bits wide; disabling 64-bit features" OCTAVE_CONFIGURE_WARNING([warn_64_bit]) USE_64_BIT_IDX_T=false fi fi AC_SUBST(OCTAVE_IDX_TYPE) AC_DEFINE_UNQUOTED(OCTAVE_IDX_TYPE, $OCTAVE_IDX_TYPE, - [Define to the type of octave_idx_type (64 or 32 bit signed integer)]) + [Define to the type of octave_idx_type (64 or 32 bit signed integer).]) if $USE_64_BIT_IDX_T; then - AC_DEFINE(USE_64_BIT_IDX_T, 1, [Define if using 64-bit integers for array dimensions and indexing]) + AC_DEFINE(USE_64_BIT_IDX_T, 1, [Define to 1 if using 64-bit integers for array dimensions and indexing.]) fi AC_SUBST(USE_64_BIT_IDX_T) @@ -240,14 +234,14 @@ ### GNU libc, just disable them for all platforms. AC_MSG_NOTICE([defining __NO_MATH_INLINES avoids buggy GNU libc exp function]) -AC_DEFINE(__NO_MATH_INLINES, 1, [Define if your version of GNU libc has buggy inline assembly code for math functions like exp.]) +AC_DEFINE(__NO_MATH_INLINES, 1, [Define to 1 if your version of GNU libc has buggy inline assembly code for math functions like exp.]) -### See which C++ compiler to use (we expect to find g++). +### Determine which C++ compiler to use (we expect to find g++). AC_PROG_CXX AC_PROG_CXXCPP -### Do special things for g++. +### Check version number when using g++. gxx_version=`$CXX -v 2>&1 | grep "^.*g.. version" | \ sed -e 's/^.*g.. version *//' -e 's/cygnus-//' -e 's/egcs-//' -e 's/ .*//'` @@ -269,18 +263,35 @@ OCTAVE_CXX_ISO_COMPLIANT_LIBRARY OCTAVE_CXX_BROKEN_REINTERPRET_CAST -### See which C compiler to use (we expect to find gcc). +### Determine which C compiler to use (we expect to find gcc). AC_PROG_CC AC_PROG_CPP AC_PROG_GCC_TRADITIONAL -### gnulib +## Check for MSVC +have_msvc=no +case "$canonical_host_type" in + *-*-msdosmsvc) + have_msvc=yes + ;; + *-*-mingw*) + AC_MSG_CHECKING([for MSVC compiler]) + AC_PREPROC_IFELSE([AC_LANG_SOURCE([ +#ifndef _MSC_VER +#error "Not MSVC compiler" +#endif +])], have_msvc=yes, have_msvc=no) + AC_MSG_RESULT([$have_msvc]) + ;; +esac + +### gnulib initialization gl_EARLY gl_INIT -### Do special things for gcc. +### Check version number when using gcc. gcc_version=`$CC -v 2>&1 | grep "^.*gcc version" | \ sed -e 's/^.*g.. version *//' -e 's/cygnus-//' -e 's/egcs-//'` @@ -297,9 +308,9 @@ fi AC_SUBST(CC_VERSION) -### The flag to create dependency varies depending on the compier. +### Determine the compiler flag necessary to create dependencies -# Assume GCC. +## Assume GCC. INCLUDE_DEPS=true DEPEND_FLAGS="-M" DEPEND_EXTRA_SED_PATTERN="" @@ -327,40 +338,14 @@ AC_SUBST(DEPEND_FLAGS) AC_SUBST(DEPEND_EXTRA_SED_PATTERN) +### Check for pthread library + AX_PTHREAD -### Include pthread libs and flags here in case other tests need them. -### They seem to be required for the OpenGL tests on Debian systems. +## Include pthread libs and flags here in case other tests need them. +## They seem to be required for the OpenGL tests on Debian systems. LIBS="$PTHREAD_LIBS $LIBS" CFLAGS="$CFLAGS $PTHREAD_CFLAGS" -AC_PATH_X -if test "$have_x" = "yes"; then - AC_DEFINE(HAVE_X_WINDOWS, 1, [Define if you have X11]) - - if test "$x_includes" != "NONE"; then - X11_INCFLAGS="$x_includes" - fi - AC_SUBST(X11_INCFLAGS) - - if test -z $x_libraries; then - AC_CHECK_LIB(X11, XrmInitialize, [X11_LIBS=-lX11], [X11_LIBS=]) - elif test $x_libraries != "NONE"; then - AC_CHECK_LIB(X11, XrmInitialize, - [X11_LIBS="-L$x_libraries -lX11"], [X11_LIBS=], "-L$x_libraries") - fi - AC_SUBST(X11_LIBS) -fi - -### On MacOSX system the Carbon framework is used to determine ScreenSize -OCTAVE_HAVE_FRAMEWORK(Carbon, [#include ], [CGMainDisplayID ()], - [have_framework_carbon="yes"], [have_framework_carbon="no"]) -if test $have_framework_carbon = "yes"; then - AC_DEFINE(HAVE_FRAMEWORK_CARBON, 1, [Define if framework CARBON is available.]) - CARBON_LIBS="-Wl,-framework -Wl,Carbon" - AC_MSG_NOTICE([adding -Wl,-framework -Wl,Carbon to CARBON_LIBS]) - AC_SUBST(CARBON_LIBS) -fi - ### When compiling math for x87, problems may arise in some code comparing ### floating-point intermediate results. ### Generally, it helps to store the result in a local volatile variable, @@ -376,12 +361,14 @@ ac_float_truncate=) AC_DEFINE_UNQUOTED(FLOAT_TRUNCATE, $ac_float_truncate, - [Define to volatile if you need truncating intermediate FP results]) + [Define to volatile if you need to truncate intermediate FP results.]) + +### Determine extra CFLAGS that may be necessary for Octave. -### On Intel systems with gcc, we may need to compile with -mieee-fp -### and -ffloat-store to get full support for IEEE floating point. -### -### On Alpha/OSF systems, we need -mieee. +## On Intel systems with gcc, we may need to compile with -mieee-fp +## and -ffloat-store to get full support for IEEE floating point. +## +## On Alpha/OSF systems, we need -mieee. ieee_fp_flag= case "$canonical_host_type" in @@ -394,10 +381,10 @@ XTRA_CFLAGS="$XTRA_CFLAGS -mieee-fp" AC_MSG_NOTICE([adding -mieee-fp to XTRA_CFLAGS])]) -### OCTAVE_CC_FLAG(-ffloat-store, [ -### float_store_flag=-ffloat-store -### XTRA_CFLAGS="$XTRA_CFLAGS -ffloat-store" -### AC_MSG_RESULT([adding -ffloat-store to XTRA_CFLAGS])]) +## OCTAVE_CC_FLAG(-ffloat-store, [ +## float_store_flag=-ffloat-store +## XTRA_CFLAGS="$XTRA_CFLAGS -ffloat-store" +## AC_MSG_RESULT([adding -ffloat-store to XTRA_CFLAGS])]) fi if test "$GXX" = yes; then OCTAVE_CXX_FLAG(-mieee-fp, [ @@ -405,10 +392,10 @@ XTRA_CXXFLAGS="$XTRA_CXXFLAGS -mieee-fp" AC_MSG_NOTICE([adding -mieee-fp to XTRA_CXXFLAGS])]) -### OCTAVE_CXX_FLAG(-ffloat-store, [ -### float_store_flag=-ffloat-store -### XTRA_CXXFLAGS="$XTRA_CXXFLAGS -ffloat-store" -### AC_MSG_RESULT([adding -ffloat-store to XTRA_CXXFLAGS])]) +## OCTAVE_CXX_FLAG(-ffloat-store, [ +## float_store_flag=-ffloat-store +## XTRA_CXXFLAGS="$XTRA_CXXFLAGS -ffloat-store" +## AC_MSG_RESULT([adding -ffloat-store to XTRA_CXXFLAGS])]) fi ;; alpha*-*-*) @@ -444,8 +431,12 @@ ;; esac -## Test whether the compiler supports OpenMP. Experimental so disable by -## default. Enable it with the flag --enable-openmp +AC_SUBST(XTRA_CFLAGS) +AC_SUBST(XTRA_CXXFLAGS) + +### Test whether the compiler supports OpenMP. This is experimental so disable +### it by default. Enable it with the flag --enable-openmp. + USE_OPENMP=false AC_ARG_ENABLE(openmp, [AS_HELP_STRING([--enable-openmp], @@ -457,21 +448,15 @@ OCTAVE_CHECK_OPENMP(-fopenmp) ;; *-*-msdosmsvc) - ## FIXME is this the right flag for MSVC? + ## FIXME: is this the right flag for MSVC? OCTAVE_CHECK_OPENMP(-openmp) ;; ## Add other compilers supporting OpenMP here esac fi -AC_SUBST(XTRA_CFLAGS) -AC_SUBST(XTRA_CXXFLAGS) - -## Avoid #define of min/max from windows.h header -if test "$have_msvc" = "yes"; then - AC_DEFINE(NOMINMAX, 1, [Define if you want to avoid min/max macro definition in Windows headers]) -fi - +dnl FIXME: This is OS-specific tests. Can this be moved further down in +dnl configure.ac to reside with other similar tests? ### Use -static if compiling on Alpha OSF/1 1.3 systems. case "$canonical_host_type" in @@ -502,15 +487,18 @@ BUILD_CXX='$(CXX)' BUILD_CXXFLAGS='$(CXXFLAGS)' BUILD_LDFLAGS='$(LDFLAGS)' - case "$canonical_host_type" in - sparc-sun-solaris2*) - if test "$GCC" != yes; then - ## The Sun C++ compiler never seems to complete compiling - ## gendoc.cc unless we reduce the optimization level... - BUILD_CXXFLAGS="-g -O1" - fi - ;; - esac + ## 2012/07/31: Commented out special build requirements + ## for Sun compiler now that gendoc.cc is no longer part of build. + ################################################################## + #case "$canonical_host_type" in + # sparc-sun-solaris2*) + # if test "$GCC" != yes; then + # ## The Sun C++ compiler never seems to complete compiling + # ## gendoc.cc unless we reduce the optimization level... + # ## BUILD_CXXFLAGS="-g -O1" + # fi + # ;; + #esac BUILD_EXEEXT='$(EXEEXT)' fi @@ -536,6 +524,8 @@ ;; esac +### Determine the Fortran compiler and how to invoke it + ## Default FFLAGS is -O. if test "x$FFLAGS" = x; then FFLAGS="-O" @@ -590,13 +580,13 @@ AC_SUBST(F77_APPEND_EXTRA_UNDERSCORE) if test -z "$F77"; then - AC_MSG_ERROR([in order to build octave, you must have a compatible Fortran compiler or wrapper script for f2c that functions as a Fortran compiler installed and in your path. See the file INSTALL for more information.]) + AC_MSG_ERROR([in order to build Octave, you must have a compatible Fortran compiler or wrapper script for f2c that functions as a Fortran compiler installed and in your path. See the file INSTALL for more information.]) fi OCTAVE_CHECK_FORTRAN_HAVE_ISNAN F77_ISNAN_MACRO= if test "x$octave_cv_fortran_have_isnan" = xno; then - AC_MSG_NOTICE([substituting ISNAN(X) with X.NE.X in fortran sources]) + AC_MSG_NOTICE([substituting ISNAN(X) with X.NE.X in Fortran sources]) F77_ISNAN_MACRO="s|ISNAN(\(@<:@^)@:>@*\))|(\1.NE.\1)|" fi AC_SUBST(F77_ISNAN_MACRO) @@ -631,7 +621,7 @@ OCTAVE_CHECK_FORTRAN_INTEGER_SIZE fi if test "x$octave_cv_fortran_integer_size" = xno; then - AC_MSG_ERROR([in order to build octave with 64-bit indexing support your Fortran compiler must have an option for setting the default integer size to 8 bytes. See the file INSTALL for more information.]) + AC_MSG_ERROR([in order to build Octave with 64-bit indexing support your Fortran compiler must have an option for setting the default integer size to 8 bytes. See the file INSTALL for more information.]) fi else AC_MSG_ERROR([your Fortran compiler must have an option to make integers the same size as octave_idx_type ($OCTAVE_IDX_TYPE). See the file INSTALL for more information.]) @@ -648,15 +638,15 @@ AC_SUBST(F77_FLOAT_STORE_FLAG) ]) +### Check that C compiler and libraries support IEEE754 data format. OCTAVE_IEEE754_DATA_FORMAT +### Check C++ library for various capabilities. OCTAVE_CXX_BITWISE_OP_TEMPLATES OCTAVE_CXX_COMPLEX_SETTERS OCTAVE_CXX_COMPLEX_REFERENCE_ACCESSORS -OCTAVE_CARBON_CGDISPLAYBITSPERPIXEL - -### Check for the QHull library +### Check for the Qhull library OCTAVE_CHECK_LIBRARY(qhull, QHull, [Qhull library not found -- this will result in loss of functionality of some geometry functions.], @@ -664,10 +654,10 @@ [warn_qhull= OCTAVE_CHECK_QHULL_VERSION OCTAVE_CHECK_QHULL_OK([TEXINFO_QHULL="@set HAVE_QHULL" - AC_DEFINE(HAVE_QHULL, 1, [Define if QHull is available.])], [ - warn_qhull="Qhull library found, but seems not to work properly -- this will result in loss of functionality of some geometry functions. Please try recompiling the library with -fno-strict-aliasing."])]) + AC_DEFINE(HAVE_QHULL, 1, [Define to 1 if Qhull is available.])], [ + warn_qhull="Qhull library found, but does not seem to work properly -- this will result in loss of functionality of some geometry functions. Please try recompiling the library with -fno-strict-aliasing."])]) -### Check for pcre regex library. +### Check for PCRE regex library. REGEX_LIBS= @@ -715,26 +705,25 @@ [ZLIB library not found. Octave will not be able to save or load compressed data files or HDF5 files.], [zlib.h], [gzclearerr]) -### Check for the llvm library -dnl +### Check for the LLVM library dnl -dnl llvm is odd and has its own pkg-config like script. We should probably check -dnl for existance and +dnl LLVM is odd and has its own pkg-config like script. We should probably +dnl check for existence and ???. dnl save_CPPFLAGS="$CPPFLAGS" save_CXXFLAGS="$CXXFLAGS" save_LIBS="$LIBS" save_LDFLAGS="$LDFLAGS" -warn_llvm="LLVM library fails tests. JIT compilation will be disabled." +warn_llvm="LLVM library fails tests. JIT compilation will be disabled." AC_ARG_VAR(LLVM_CONFIG, [path to llvm-config utility]) AC_ARG_ENABLE([jit-debug], - AS_HELP_STRING([--enable-jit-debug], [Enable debug printing of jit IRs])) + AS_HELP_STRING([--enable-jit-debug], [Enable debug printing of JIT IRs])) AS_IF([test "x$enable_jit_debug" = "xyes"], [ - AC_DEFINE(OCTAVE_JIT_DEBUG, 1, [Define for jit debug printing]) + AC_DEFINE(OCTAVE_JIT_DEBUG, 1, [Define to 1 for JIT debug printing.]) ]) LLVM_CXXFLAGS= @@ -743,7 +732,7 @@ LLVM_LIBS= if test "x$ac_cv_env_LLVM_CONFIG_set" = "xset"; then - # We use -isystem if avaiable because we do not want to see warnings in llvm + ## We use -isystem if available because we do not want to see warnings in LLVM LLVM_INCLUDE_FLAG=-I OCTAVE_CC_FLAG(-isystem ., [ LLVM_INCLUDE_FLAG=-isystem @@ -756,8 +745,8 @@ LLVM_CXXFLAGS= dnl - dnl We define some extra flags that llvm requires in order to include headers. - dnl Idealy we should get these from llvm-config, but llvm-config isn't very + dnl We define some extra flags that LLVM requires in order to include headers. + dnl Ideally we should get these from llvm-config, but llvm-config isn't very dnl helpful. dnl CPPFLAGS="-D__STDC_CONSTANT_MACROS -D__STDC_LIMIT_MACROS $LLVM_CPPFLAGS $CPPFLAGS" @@ -782,11 +771,11 @@ AC_LANG_POP(C++) else - warn_llvm="LLVM_CONFIG not set. JIT compilation will be disabled." + warn_llvm="LLVM_CONFIG not set. JIT compilation will be disabled." fi if test -z "$warn_llvm"; then - AC_DEFINE(HAVE_LLVM, 1, [Define if LLVM is available]) + AC_DEFINE(HAVE_LLVM, 1, [Define to 1 if LLVM is available.]) else LLVM_CXXFLAGS= LLVM_CPPFLAGS= @@ -817,7 +806,7 @@ [warn_hdf5= OCTAVE_HDF5_HAS_ENFORCED_16_API TEXINFO_HDF5="@set HAVE_HDF5" - AC_DEFINE(HAVE_HDF5, 1, [Define if HDF5 is available and newer than version 1.6.]) + AC_DEFINE(HAVE_HDF5, 1, [Define to 1 if HDF5 is available and newer than version 1.6.]) if test "$have_msvc" = "yes"; then OCTAVE_HDF5_DLL fi @@ -825,14 +814,9 @@ CPPFLAGS="$save_CPPFLAGS" LIBS="$save_LIBS" - -# Subdirectory of libcruft to build if fftw is not found: +### Check for FFTW library. Default to Fortran FFTPACK if it is not available. -FFT_DIR="fftpack" -AC_SUBST(FFT_DIR) - -# Checks for FFTW header and library. - +## Check for FFTW header and library. OCTAVE_CHECK_LIBRARY(fftw3, FFTW3, [FFTW3 library not found. The slower FFTPACK library will be used instead.], [fftw3.h], [fftw_plan_dft_1d]) @@ -844,7 +828,11 @@ AM_CONDITIONAL([AMCOND_HAVE_FFTW], [test -n "$FFTW3_LIBS" && test -n "$FFTW3F_LIBS"]) -# Checks for GLPK header and library. +## Subdirectory of libcruft to build if FFTW is not found: +FFT_DIR="fftpack" +AC_SUBST(FFT_DIR) + +### Check for GLPK library and header. save_CPPFLAGS="$CPPFLAGS" CPPFLAGS="$Z_CPPFLAGS $CPPFLAGS" @@ -856,7 +844,7 @@ LIBS="$save_LIBS" CPPFLAGS="$save_CPPFLAGS" -# Checks for CURL header and library. +### Checks for cURL header and library. save_CPPFLAGS="$CPPFLAGS" CPPFLAGS="$Z_CPPFLAGS $CPPFLAGS" @@ -868,7 +856,7 @@ LIBS="$save_LIBS" CPPFLAGS="$save_CPPFLAGS" -### Graphics/ImageMagick++ +### Check for either of Graphics/ImageMagick++ libraries AC_ARG_WITH([magick], [AS_HELP_STRING([--with-magick=LIB], @@ -918,7 +906,7 @@ ]) if test -z "$warn_magick"; then - AC_DEFINE(HAVE_MAGICK, 1, [Define if Graphics/ImageMagick++ is available.]) + AC_DEFINE(HAVE_MAGICK, 1, [Define to 1 if Graphics/ImageMagick++ is available.]) else MAGICK_CPPFLAGS= MAGICK_LDFLAGS= @@ -928,9 +916,37 @@ AC_SUBST(MAGICK_LDFLAGS) AC_SUBST(MAGICK_LIBS) -# --------------------------------------------------------------------- +### Check for X11 libraries + +AC_PATH_X +if test "$have_x" = "yes"; then + AC_DEFINE(HAVE_X_WINDOWS, 1, [Define to 1 if you have X11.]) + + if test "$x_includes" != "NONE"; then + X11_INCFLAGS="$x_includes" + fi + AC_SUBST(X11_INCFLAGS) -## libraries needed for native graphics renderer + if test -z $x_libraries; then + AC_CHECK_LIB(X11, XrmInitialize, [X11_LIBS=-lX11], [X11_LIBS=]) + elif test $x_libraries != "NONE"; then + AC_CHECK_LIB(X11, XrmInitialize, + [X11_LIBS="-L$x_libraries -lX11"], [X11_LIBS=], "-L$x_libraries") + fi + AC_SUBST(X11_LIBS) +fi + +### Check for the Carbon framework on MacOSX systems +OCTAVE_HAVE_FRAMEWORK(Carbon, [#include ], [CGMainDisplayID ()], + [have_framework_carbon="yes"], [have_framework_carbon="no"]) +if test $have_framework_carbon = "yes"; then + AC_DEFINE(HAVE_FRAMEWORK_CARBON, 1, [Define to 1 if framework CARBON is available.]) + CARBON_LIBS="-Wl,-framework -Wl,Carbon" + AC_MSG_NOTICE([adding -Wl,-framework -Wl,Carbon to CARBON_LIBS]) + AC_SUBST(CARBON_LIBS) +fi + +### Check for list of libraries needed for native graphics renderer. warn_freetype="" native_graphics=true @@ -947,6 +963,7 @@ fi], [check_opengl=true]) +## Check for OpenGL library if $check_opengl; then OCTAVE_OPENGL fi @@ -956,18 +973,18 @@ if test -z "$OPENGL_LIBS"; then if $check_opengl; then - warn_fltk_opengl="OpenGL libs (GL and GLU) not found. Native graphics will be disabled." + warn_fltk_opengl="OpenGL libs (GL and GLU) not found. Native graphics will be disabled." OCTAVE_CONFIGURE_WARNING([warn_fltk_opengl]) native_graphics=false fi fi if test -n "$OPENGL_LIBS"; then - AC_DEFINE(HAVE_OPENGL, 1, [Define if OpenGL is available]) + AC_DEFINE(HAVE_OPENGL, 1, [Define to 1 if OpenGL is available.]) - ## freetype 2 + ## Check for FreeType 2 library - AC_CHECK_FT2([9.0.3], [AC_DEFINE(HAVE_FREETYPE, 1, [Define to 1 if you have Freetype library.]) + AC_CHECK_FT2([9.0.3], [AC_DEFINE(HAVE_FREETYPE, 1, [Define to 1 if you have FreeType library.]) XTRA_CXXFLAGS="$XTRA_CXXFLAGS $FT2_CFLAGS"], [warn_freetype="FreeType library not found. Native graphics will be disabled."]) @@ -976,7 +993,7 @@ native_graphics=false fi - ## fontconfig library + ## Check for fontconfig library warn_fontconfig="" if test -z "$warn_freetype"; then @@ -984,7 +1001,7 @@ have_fontconfig=yes OPENGL_LIBS="$FONTCONFIG_LIBS $OPENGL_LIBS" XTRA_CXXFLAGS="$XTRA_CXXFLAGS $FONTCONFIG_CFLAGS" - AC_DEFINE(HAVE_FONTCONFIG, 1, [Define to 1 if fontconfig is present])], [ + AC_DEFINE(HAVE_FONTCONFIG, 1, [Define to 1 if fontconfig is present.])], [ have_fontconfig=no warn_fontconfig="Fontconfig library not found. Native graphics will be disabled."]) fi @@ -994,7 +1011,7 @@ native_graphics=false fi - ## fltk (www.fltk.org) + ## Check for FLTK (www.fltk.org) library AC_ARG_WITH([fltk-prefix], [ AS_HELP_STRING([--with-fltk-prefix=PFX], @@ -1050,7 +1067,7 @@ AC_MSG_RESULT([no]) warn_fltk_opengl="FLTK does not have OpenGL support. Native graphics will be disabled." ],[ - AC_DEFINE(HAVE_FLTK, 1, [Define if FLTK is available]) + AC_DEFINE(HAVE_FLTK, 1, [Define to 1 if FLTK is available.]) AC_MSG_RESULT([yes]) ]) @@ -1068,7 +1085,7 @@ AC_SUBST(GRAPHICS_CFLAGS) AC_SUBST(GRAPHICS_LIBS) -# ---------------------------------------------------------------------- +### Start determination of shared vs. static libraries OCTAVE_PROG_AR @@ -1099,7 +1116,7 @@ fi AC_SUBST(XTRA_CRUFT_SH_LDFLAGS) -### Checks for BLAS and LAPACK libraries: +### Check for BLAS and LAPACK libraries: ## Need to adjust FFLAGS to include correct integer size. save_FFLAGS="$FFLAGS" @@ -1163,7 +1180,7 @@ else ## wrapper in libcruft, remove from BLAS_LIBS BLAS_LIBS="`echo $BLAS_LIBS | sed -e 's/blaswrap.[[^ ]]* //g'`" - AC_DEFINE(USE_BLASWRAP, [1], [Define this if BLAS functions need to be wrapped (potentially needed for 64-bit OSX only).]) + AC_DEFINE(USE_BLASWRAP, 1, [Define to 1 if BLAS functions need to be wrapped (potentially needed for 64-bit OSX only).]) fi ;; esac @@ -1172,20 +1189,20 @@ if test "x$ax_blas_f77_func_ok" = "xno"; then if $USE_64_BIT_IDX_T && test "$ax_blas_integer_size_ok" = "no" ; then ## Attempt to be more informative. - AC_MSG_ERROR([BLAS doesn't seem to support 64-bit integers. This is incompatible with --enable-64.]) + AC_MSG_ERROR([BLAS doesn't seem to support 64-bit integers. This is incompatible with --enable-64.]) else AC_MSG_ERROR([A BLAS library was detected but found incompatible with your Fortran 77 compiler settings.]) fi fi if test x$ax_blas_ok = xno || test x$ax_lapack_ok = xno; then - AC_MSG_ERROR([You are required to have BLAS and LAPACK libraries]) + AC_MSG_ERROR([BLAS and LAPACK libraries are required]) fi ### Check for the qrupdate library + ## No need to adjust FFLAGS because only link is attempted. ## Must supply proper LIBS, however. - save_LIBS="$LIBS" LIBS="$LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" OCTAVE_CHECK_LIBRARY(qrupdate, qrupdate, @@ -1203,13 +1220,13 @@ [octave_qrupdate_luu=yes]) AC_MSG_RESULT([$octave_qrupdate_luu]) if test "$octave_qrupdate_luu" = yes; then - AC_DEFINE(HAVE_QRUPDATE_LUU, [1], [Define if qrupdate supports LU updates]) + AC_DEFINE(HAVE_QRUPDATE_LUU, 1, [Define to 1 if qrupdate supports LU updates.]) fi AC_LANG_POP([Fortran 77]) fi LIBS="$save_LIBS" -# Check for AMD library +### Check for AMD library OCTAVE_CHECK_LIBRARY(amd, AMD, [AMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1217,7 +1234,7 @@ [amd_postorder], [], [don't use AMD library, disable some sparse matrix functionality]) -# Check for CAMD library +### Check for CAMD library OCTAVE_CHECK_LIBRARY(camd, CAMD, [CAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1225,7 +1242,7 @@ [camd_postorder], [], [don't use CAMD library, disable some sparse matrix functionality]) -# Check for COLAMD library +### Check for COLAMD library OCTAVE_CHECK_LIBRARY(colamd, COLAMD, [COLAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1233,7 +1250,7 @@ [colamd], [], [don't use COLAMD library, disable some sparse matrix functionality]) -# Check for CCOLAMD library +### Check for CCOLAMD library OCTAVE_CHECK_LIBRARY(ccolamd, CCOLAMD, [CCOLAMD library not found. This will result in some lack of functionality for sparse matrices.], @@ -1241,8 +1258,8 @@ [ccolamd], [], [don't use CCOLAMD library, disable some sparse matrix functionality]) -# Check for CHOLMOD library. If your cholmod library requires cblas, -# then you will need to configure with --with-cholmod="-lcholmod -lcblas". +### Check for CHOLMOD library. If your cholmod library requires cblas, +### then you will need to configure with --with-cholmod="-lcholmod -lcblas". save_LIBS="$LIBS" LIBS="$COLAMD_LDFLAGS $COLAMD_LIBS $AMD_LDFLAGS $AMD_LIBS $LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" @@ -1253,7 +1270,7 @@ [], [don't use CHOLMOD library, disable some sparse matrix functionality]) LIBS="$save_LIBS" -# Check for CXSparse library +### Check for CXSparse library OCTAVE_CHECK_LIBRARY(cxsparse, CXSparse, [CXSparse library not found. This will result in some lack of functionality for sparse matrices.], @@ -1261,7 +1278,7 @@ [cs_di_sqr], [C++], [don't use CXSparse library, disable some sparse matrix functionality]) -# Check for UMFPACK library. +### Check for UMFPACK library. save_LIBS="$LIBS" save_CPPFLAGS="$CPPFLAGS" @@ -1298,6 +1315,8 @@ LIBS="$save_LIBS" fi +### Check for ARPACK library. + save_LIBS="$LIBS" LIBS="$LAPACK_LIBS $BLAS_LIBS $FLIBS $LIBS" OCTAVE_CHECK_LIBRARY(arpack, ARPACK, @@ -1307,10 +1326,14 @@ [Fortran 77], [don't use the ARPACK library, disable eigs function], [warn_arpack= OCTAVE_CHECK_ARPACK_OK([ - AC_DEFINE(HAVE_ARPACK, 1, [Define if ARPACK is available.])], [ - warn_arpack="ARPACK library found, but seems not to work properly -- disabling eigs function"])]) + AC_DEFINE(HAVE_ARPACK, 1, [Define to 1 if ARPACK is available.])], [ + warn_arpack="ARPACK library found, but does not seem to work properly -- disabling eigs function"])]) LIBS="$save_LIBS" +### Check for readline library. + +OCTAVE_ENABLE_READLINE + ### Enable dynamic linking. --enable-shared implies this, so ### --enable-dl is only need if you are only building static libraries ### and want to try dynamic linking too (works on some systems, for @@ -1714,8 +1737,8 @@ AC_MSG_CHECKING([whether unordered_map requires tr1 namespace]) unordered_map_requires_tr1_namespace=no if test "$ac_cv_header_unordered_map" = "yes"; then - ### Have , but still have to check whether - ### tr1 namespace is required (like MSVC, for instance). + ## Have , but still have to check whether + ## tr1 namespace is required (like MSVC, for instance). AC_COMPILE_IFELSE([ AC_LANG_PROGRAM([ #include @@ -1726,7 +1749,7 @@ unordered_map_requires_tr1_namespace=yes fi if test "$unordered_map_requires_tr1_namespace" = "yes"; then - AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Defines whether unordered_map requires the use of tr1 namespace.]) + AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Define to 1 if unordered_map requires the use of tr1 namespace.]) fi AC_MSG_RESULT([$unordered_map_requires_tr1_namespace]) AC_LANG_POP(C++) @@ -1746,6 +1769,11 @@ AC_MSG_WARN([I couldn't find termios.h, termio.h, or sgtty.h!]) fi +### For MSVC compilers, avoid #define of min/max from windows.h header +if test "$have_msvc" = "yes"; then + AC_DEFINE(NOMINMAX, 1, [Define to 1 if you want to avoid min/max macro definition in Windows headers.]) +fi + ### Checks for functions and variables. AC_CHECK_FUNCS(basename canonicalize_file_name \ @@ -1795,7 +1823,7 @@ )], [AC_MSG_RESULT(yes) HAVE_MKSTEMPS=yes - AC_DEFINE(HAVE_MKSTEMPS, 1, [Define if mkstemps is available in libiberty.]) + AC_DEFINE(HAVE_MKSTEMPS, 1, [Define to 1 if mkstemps is available in libiberty.]) ], [AC_MSG_RESULT(no) HAVE_MKSTEMPS=no @@ -1815,21 +1843,24 @@ #error "Wrong version" #endif]], [])], AC_MSG_RESULT([none]), [ - AC_DEFINE(_WIN32_WINNT, 0x0403, [Define to 0x0403 to access InitializeCriticalSectionAndSpinCount]) + AC_DEFINE(_WIN32_WINNT, 0x0403, [Define to 0x0403 to access InitializeCriticalSectionAndSpinCount.]) AC_MSG_RESULT([0x0403])]) AC_MSG_CHECKING([whether _USE_MATH_DEFINES needs to be defined]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[int x = M_LN2;]])], AC_MSG_RESULT([no]), [ - AC_DEFINE(_USE_MATH_DEFINES, 1, [Define if your system needs it to define math constants like M_LN2]) + AC_DEFINE(_USE_MATH_DEFINES, 1, [Define to 1 if your system needs to define math constants like M_LN2.]) AC_MSG_RESULT([yes])]) ;; esac +## Check for CGDisplayBitsPerPixel function on Mac OSX systems with Carbon +OCTAVE_CARBON_CGDISPLAYBITSPERPIXEL + ### Dynamic linking is now enabled only if we are building shared ### libs and some API for dynamic linking is detected. -## FIXME -- a lot of the following duplicates the functionality of +## FIXME: A lot of the following duplicates the functionality of ## code generated by the dlopen option for LT_INIT. LD_CXX='$(CXX)' @@ -1846,23 +1877,23 @@ dlopen) dlopen_api=true DL_API_MSG="(dlopen)" - AC_DEFINE(HAVE_DLOPEN_API, 1, [Define if your system has dlopen, dlsym, dlerror, and dlclose for dynamic linking]) + AC_DEFINE(HAVE_DLOPEN_API, 1, [Define to 1 if your system has dlopen, dlsym, dlerror, and dlclose for dynamic linking.]) OCTAVE_CXX_FLAG(-rdynamic, [RDYNAMIC_FLAG=-rdynamic]) ;; shl_load) shl_load_api=true DL_API_MSG="(shl_load)" - AC_DEFINE(HAVE_SHL_LOAD_API, 1, [Define if your system has shl_load and shl_findsym for dynamic linking]) + AC_DEFINE(HAVE_SHL_LOAD_API, 1, [Define to 1 if your system has shl_load and shl_findsym for dynamic linking.]) ;; LoadLibrary) loadlibrary_api=true DL_API_MSG="(LoadLibrary)" - AC_DEFINE(HAVE_LOADLIBRARY_API, 1, [Define if your system has LoadLibrary for dynamic linking]) + AC_DEFINE(HAVE_LOADLIBRARY_API, 1, [Define to 1 if your system has LoadLibrary for dynamic linking.]) ;; dyld) dyld_api=true DL_API_MSG="(dyld)" - AC_DEFINE(HAVE_DYLD_API, 1, [Define if your system has dyld for dynamic linking]) + AC_DEFINE(HAVE_DYLD_API, 1, [Define to 1 if your system has dyld for dynamic linking.]) ;; esac @@ -1878,7 +1909,7 @@ fi if $ENABLE_DYNAMIC_LINKING; then - AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) + AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define to 1 if using dynamic linking.]) fi AM_CONDITIONAL([AMCOND_ENABLE_DYNAMIC_LINKING], @@ -1959,14 +1990,13 @@ fi AC_SUBST(TERM_LIBS) -OCTAVE_ENABLE_READLINE - +### Return type of matherr() AC_MSG_CHECKING([for struct exception in math.h]) AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct exception *x; x->type; x->name;]])], [AC_MSG_RESULT(yes) AC_DEFINE(EXCEPTION_IN_MATH, 1, - [Define if your math.h declares struct exception for matherr().])], + [Define to 1 if your math.h declares struct exception for matherr().])], [AC_MSG_RESULT(no)]) ### Signal stuff. @@ -1979,17 +2009,17 @@ #endif ]) -### A system dependent kluge or two. +### A system dependent kludge or two. AC_CHECK_FUNCS(getrusage) case "$canonical_host_type" in *-*-cygwin*) - AC_DEFINE(RUSAGE_TIMES_ONLY, 1, [Define if your struct rusage only has time information.]) + AC_DEFINE(RUSAGE_TIMES_ONLY, 1, [Define to 1 if your struct rusage only has time information.]) ;; esac -### Checks for other programs used for building, testing, installing, -### and running Octave. +### Checks for other programs used in building, testing, installing, and +### running Octave. AC_PROG_AWK OCTAVE_PROG_FIND @@ -2159,7 +2189,7 @@ #define OCTAVE_HAVE_POSIX_FILESYSTEM 1 #endif -/* Define if we expect to have , Sleep, etc. */ +/* Define to 1 if we expect to have , Sleep, etc. */ #if defined (__WIN32__) && ! defined (__CYGWIN__) #define OCTAVE_USE_WINDOWS_API 1 #endif @@ -2189,7 +2219,7 @@ /* To be able to use long doubles for 64-bit mixed arithmetics, we need them at least 80 bits wide and we need roundl declared in math.h. - FIXME -- maybe substitute this by a more precise check in the future. */ + FIXME: Maybe substitute this by a more precise check in the future? */ #if (SIZEOF_LONG_DOUBLE >= 10) && defined (HAVE_ROUNDL) #define OCTAVE_INT_USE_LONG_DOUBLE #endif @@ -2197,7 +2227,7 @@ #define OCTAVE_EMPTY_CPP_ARG /* Octave is currently unable to use FFTW unless both float - and double versions are both available. */ + and double versions are available. */ #if defined (HAVE_FFTW3) && defined (HAVE_FFTW3F) #define HAVE_FFTW #endif @@ -2252,7 +2282,7 @@ #include -/* Tag indicating octave config.h has been included */ +/* Tag indicating Octave config.h has been included */ #define OCTAVE_CONFIG_INCLUDED 1 ]) @@ -2337,16 +2367,16 @@ GLPK libraries: $GLPK_LIBS graphics CFLAGS: $GRAPHICS_CFLAGS graphics libraries: $GRAPHICS_LIBS - Magick++ CPPFLAGS: $MAGICK_CPPFLAGS - Magick++ LDFLAGS: $MAGICK_LDFLAGS - Magick++ libraries: $MAGICK_LIBS - LLVM CPPFLAGS: $LLVM_CPPFLAGS - LLVM LDFLAGS: $LLVM_LDFLAGS - LLVM libraries: $LLVM_LIBS HDF5 CPPFLAGS: $HDF5_CPPFLAGS HDF5 LDFLAGS: $HDF5_LDFLAGS HDF5 libraries: $HDF5_LIBS LAPACK libraries: $LAPACK_LIBS + LLVM CPPFLAGS: $LLVM_CPPFLAGS + LLVM LDFLAGS: $LLVM_LDFLAGS + LLVM libraries: $LLVM_LIBS + Magick++ CPPFLAGS: $MAGICK_CPPFLAGS + Magick++ LDFLAGS: $MAGICK_LDFLAGS + Magick++ libraries: $MAGICK_LIBS OPENGL libraries: $OPENGL_LIBS PTHREAD flags: $PTHREAD_CFLAGS PTHREAD libraries: $PTHREAD_LIBS @@ -2413,7 +2443,7 @@ AC_MSG_WARN([Are you sure that is what you want to do?]) AC_MSG_WARN([]) AC_MSG_WARN([This option enables experimental SMP multithreding]) - AC_MSG_WARN([code that has had very little testing. There is no]) + AC_MSG_WARN([code that has had very little testing. There is no]) AC_MSG_WARN([certainity that the results returned by Octave with]) AC_MSG_WARN([this option enabled will be correct.]) AC_MSG_WARN([]) @@ -2460,9 +2490,9 @@ if $USE_ATOMIC_REFCOUNT; then AC_MSG_WARN([]) AC_MSG_WARN([Using atomic reference counting.]) - AC_MSG_WARN([This feature allows to access octave data safely from]) - AC_MSG_WARN([another thread, for instance from a GUI. However this]) - AC_MSG_WARN([results in a small performance penalty in the octave]) + AC_MSG_WARN([This feature allows access to Octave data safely from]) + AC_MSG_WARN([another thread, for instance from a GUI. However this]) + AC_MSG_WARN([results in a small performance penalty in the Octave]) AC_MSG_WARN([interpreter.]) AC_MSG_WARN([]) if $USE_OCTAVE_ALLOCATOR; then diff -r 069c552587a0 -r 959953dba519 liboctave/lo-specfun.cc --- a/liboctave/lo-specfun.cc Tue Jul 31 09:54:19 2012 -0400 +++ b/liboctave/lo-specfun.cc Fri Aug 03 14:35:44 2012 -0400 @@ -2137,15 +2137,6 @@ } static void -gripe_betainc_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, - octave_idx_type c3) -{ - (*current_liboctave_error_handler) - ("betainc: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", - r1, c1, r2, c2, r3, c3); -} - -static void gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2, const dim_vector& d3) { @@ -2159,15 +2150,6 @@ } static void -gripe_betaincinv_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, - octave_idx_type c3) -{ - (*current_liboctave_error_handler) - ("betaincinv: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", - r1, c1, r2, c2, r3, c3); -} - -static void gripe_betaincinv_nonconformant (const dim_vector& d1, const dim_vector& d2, const dim_vector& d3) { diff -r 069c552587a0 -r 959953dba519 m4/acinclude.m4 --- a/m4/acinclude.m4 Tue Jul 31 09:54:19 2012 -0400 +++ b/m4/acinclude.m4 Fri Aug 03 14:35:44 2012 -0400 @@ -85,7 +85,7 @@ [[operator delete((void *)0, (void *)0);]])], octave_cv_placement_delete=yes, octave_cv_placement_delete=no)]) if test $octave_cv_placement_delete = yes; then -AC_DEFINE(HAVE_PLACEMENT_DELETE,1,[Define if C++ supports operator delete(void *, void *)]) +AC_DEFINE(HAVE_PLACEMENT_DELETE,1,[Define to 1 if C++ supports operator delete(void *, void *).]) fi AC_LANG_POP(C++) ]) @@ -100,7 +100,7 @@ [[void test(char *); int length(); char x[length()]; test(x);]])], octave_cv_dynamic_auto_arrays=yes, octave_cv_dynamic_auto_arrays=no)]) if test $octave_cv_dynamic_auto_arrays = yes; then -AC_DEFINE(HAVE_DYNAMIC_AUTO_ARRAYS,1,[Define if C++ supports dynamic auto arrays]) +AC_DEFINE(HAVE_DYNAMIC_AUTO_ARRAYS,1,[Define to 1 if C++ supports dynamic auto arrays.]) fi AC_LANG_POP(C++) ]) @@ -120,7 +120,7 @@ int z3 = std::bit_xor() (x, y);]])], octave_cv_cxx_bitwise_op_templates=yes, octave_cv_cxx_bitwise_op_templates=no)]) if test $octave_cv_cxx_bitwise_op_templates = yes; then -AC_DEFINE(HAVE_CXX_BITWISE_OP_TEMPLATES,1,[Define if C++ library has templated bitwise operators]) +AC_DEFINE(HAVE_CXX_BITWISE_OP_TEMPLATES,1,[Define to 1 if C++ library has templated bitwise operators.]) fi AC_LANG_POP(C++) ]) @@ -137,7 +137,7 @@ [[std::complex x; x.real (1.0); x.imag (2.0);]])], octave_cv_cxx_complex_setters=yes, octave_cv_cxx_complex_setters=no)]) if test $octave_cv_cxx_complex_setters = yes; then -AC_DEFINE(HAVE_CXX_COMPLEX_SETTERS,1,[Define if C++ complex class has void real (T) and void imag (T) methods]) +AC_DEFINE(HAVE_CXX_COMPLEX_SETTERS,1,[Define to 1 if C++ complex class has void real (T) and void imag (T) methods.]) fi AC_LANG_POP(C++) ]) @@ -153,7 +153,7 @@ [[std::complex x; x.real () = 1.0; x.imag () = 1.0;]])], octave_cv_cxx_complex_reference_accessors=yes, octave_cv_cxx_complex_reference_accessors=no)]) if test $octave_cv_cxx_complex_reference_accessors = yes; then -AC_DEFINE(HAVE_CXX_COMPLEX_REFERENCE_ACCESSORS,1,[Define if C++ complex class has T& real (void) and T& imag (void) methods]) +AC_DEFINE(HAVE_CXX_COMPLEX_REFERENCE_ACCESSORS,1,[Define to 1 if C++ complex class has T& real (void) and T& imag (void) methods.]) fi AC_LANG_POP(C++) ]) @@ -172,7 +172,7 @@ ]])], octave_cv_carbon_cgdisplaybitsperpixel=yes, octave_cv_carbon_cgdisplaybitsperpixel=no)]) if test $octave_cv_carbon_cgdisplaybitsperpixel = yes; then -AC_DEFINE(HAVE_CARBON_CGDISPLAYBITSPERPIXEL,1,[Define if Carbon Framework has CGDisplayBitsPerPixel]) +AC_DEFINE(HAVE_CARBON_CGDISPLAYBITSPERPIXEL,1,[Define to 1 if Carbon Framework has CGDisplayBitsPerPixel.]) fi AC_LANG_POP(C++) ]) @@ -275,7 +275,7 @@ ]) AC_MSG_RESULT([$octave_cv_cxx_new_friend_template_decl]) if test $octave_cv_cxx_new_friend_template_decl = yes; then - AC_DEFINE(CXX_NEW_FRIEND_TEMPLATE_DECL,1,[Define if your compiler supports `<>' stuff for template friends.]) + AC_DEFINE(CXX_NEW_FRIEND_TEMPLATE_DECL,1,[Define to 1 if your compiler supports `<>' stuff for template friends.]) fi ]) dnl @@ -528,7 +528,7 @@ m4_ifblank([$8], [ warn_$1= AC_DEFINE([HAVE_]m4_toupper([$1]), 1, - [Define if $2 is available.]) + [Define to 1 if $2 is available.]) [TEXINFO_]m4_toupper([$1])="@set [HAVE_]m4_toupper([$1])"], [$8]) fi LIBS="$octave_check_library_save_LIBS" @@ -761,7 +761,7 @@ ]) AC_MSG_RESULT([$octave_cv_cxx_iso_compliant_library]) if test $octave_cv_cxx_iso_compliant_library = yes; then - AC_DEFINE(CXX_ISO_COMPLIANT_LIBRARY, 1, [Define if your C++ runtime library is ISO compliant.]) + AC_DEFINE(CXX_ISO_COMPLIANT_LIBRARY, 1, [Define to 1 if your C++ runtime library is ISO compliant.]) fi ]) dnl @@ -783,7 +783,7 @@ LIBS="$TERM_LIBS" AC_CHECK_LIB(readline, rl_set_keyboard_input_timeout, [ READLINE_LIBS="-lreadline" - AC_DEFINE(USE_READLINE, 1, [Define to use the readline library.]) + AC_DEFINE(USE_READLINE, 1, [Define to 1 to use the readline library.]) ], [ AC_MSG_WARN([I need GNU Readline 4.2 or later]) AC_MSG_ERROR([this is fatal unless you specify --disable-readline]) @@ -810,7 +810,7 @@ octave_cv_cxx_broken_reinterpret_cast=no, octave_cv_cxx_broken_reinterpret_cast=yes)]) if test $octave_cv_cxx_broken_reinterpret_cast = yes ; then - AC_DEFINE(CXX_BROKEN_REINTERPRET_CAST, 1, [Define if C++ reinterpret_cast fails for function pointers.]) + AC_DEFINE(CXX_BROKEN_REINTERPRET_CAST, 1, [Define to 1 if C++ reinterpret_cast fails for function pointers.]) fi AC_LANG_POP(C++)]) dnl @@ -938,7 +938,7 @@ AC_MSG_RESULT([$octave_cv_ieee754_data_format]) fi if test "$octave_cv_ieee754_data_format" = yes; then - AC_DEFINE(HAVE_IEEE754_DATA_FORMAT, 1, [Define if your system uses IEEE 754 data format.]) + AC_DEFINE(HAVE_IEEE754_DATA_FORMAT, 1, [Define to 1 if your system uses IEEE 754 data format.]) else ## If the format is unknown, then you will probably not have a ## useful system, so we will abort here. Anyone wishing to @@ -1001,7 +1001,7 @@ AC_MSG_RESULT([$octave_cv_umfpack_seperate_split]) fi if test "$octave_cv_umfpack_seperate_split" = yes; then - AC_DEFINE(UMFPACK_SEPARATE_SPLIT, 1, [Define if the UMFPACK Complex solver allow matrix and RHS to be split independently]) + AC_DEFINE(UMFPACK_SEPARATE_SPLIT, 1, [Define to 1 if the UMFPACK Complex solver allow matrix and RHS to be split independently.]) fi ]) dnl @@ -1023,7 +1023,7 @@ CFLAGS="$save_CFLAGS" LIBS="$save_LIBS"])]) if test "$octave_cv_hdf5_dll" = yes; then - AC_DEFINE(_HDF5USEDLL_, 1, [Define if using HDF5 dll (Win32)]) + AC_DEFINE(_HDF5USEDLL_, 1, [Define to 1 if using HDF5 dll (Win32).]) fi]) dnl dnl Check whether HDF5 library has version 1.6 API functions. @@ -1038,11 +1038,11 @@ octave_cv_hdf5_has_enforced_16_api=yes], [ octave_cv_hdf5_has_enforced_16_api=no])]) if test "$octave_cv_hdf5_has_enforced_16_api" != "yes"; then - AC_DEFINE(HAVE_HDF5_18, 1, [Define if >=HDF5-1.8 is available.]) + AC_DEFINE(HAVE_HDF5_18, 1, [Define to 1 if >=HDF5-1.8 is available.]) fi ]) dnl -dnl Check for the QHull version. +dnl Check for the Qhull version. dnl AC_DEFUN([OCTAVE_CHECK_QHULL_VERSION], [AC_CACHE_CHECK([for qh_version in $QHULL_LIBS], @@ -1081,11 +1081,11 @@ ]])], [octave_cv_lib_qhull_version=yes], [octave_cv_lib_qhull_version=no])]) if test "$octave_cv_lib_qhull_version" = no; then AC_DEFINE(NEED_QHULL_VERSION, 1, - [Define if the QHull library needs a qh_version variable defined.]) + [Define to 1 if the Qhull library needs a qh_version variable defined.]) fi ]) dnl -dnl Check whether QHull works (does not crash) +dnl Check whether Qhull works (does not crash) dnl AC_DEFUN([OCTAVE_CHECK_QHULL_OK], [AC_CACHE_CHECK([whether the qhull library works], @@ -1291,10 +1291,10 @@ dnl dnl Check for OpenGL. If found, define OPENGL_LIBS dnl -dnl FIXME -- the following tests should probably check for the +dnl FIXME: The following tests should probably check for the dnl libraries separately. dnl -dnl FIXME -- should we allow a way to specify a directory for OpenGL +dnl FIXME: Should we allow a way to specify a directory for OpenGL dnl libraries and header files? dnl AC_DEFUN([OCTAVE_OPENGL], [ @@ -1307,7 +1307,7 @@ [have_framework_opengl="yes"], [have_framework_opengl="no"]) if test $have_framework_opengl = "yes"; then - AC_DEFINE(HAVE_FRAMEWORK_OPENGL, 1, [Define if framework OPENGL is available.]) + AC_DEFINE(HAVE_FRAMEWORK_OPENGL, 1, [Define to 1 if framework OPENGL is available.]) OPENGL_LIBS="-Wl,-framework -Wl,OpenGL" AC_MSG_NOTICE([adding -Wl,-framework -Wl,OpenGL to OPENGL_LIBS]) OCTAVE_GLUTESSCALLBACK_THREEDOTS @@ -1382,7 +1382,7 @@ AC_LANG_POP(C++) if test $octave_cv_glutesscallback_threedots = "yes"; then AC_DEFINE(HAVE_GLUTESSCALLBACK_THREEDOTS, 1, - [Define if gluTessCallback is called with (...)]) + [Define to 1 if gluTessCallback is called with (...).]) fi ]) dnl @@ -1408,7 +1408,7 @@ ]])],octave_cv_openmp=yes, octave_cv_openmmp=no, octave_cv_openmp=no)]) AC_MSG_RESULT($octave_cv_openmp) if test "$octave_cv_openmp" = yes; then - AC_DEFINE(HAVE_OPENMP,1,[Define if compiler supports OpenMP]) + AC_DEFINE(HAVE_OPENMP,1,[Define to 1 if compiler supports OpenMP.]) CXXFLAGS="$CXXFLAGS $1" else CFLAGS="$XCFLAGS" @@ -1627,7 +1627,7 @@ take_func(std::$1); ]])], [AC_MSG_RESULT([yes]) - AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1),1,[Define if provides $1])], + AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1),1,[Define to 1 if provides $1.])], [AC_MSG_RESULT([no])]) AC_MSG_CHECKING([for std::$1 (float variant) in ]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ @@ -1640,13 +1640,13 @@ take_func(std::$1); ]])], [AC_MSG_RESULT([yes]) - AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1)F,1,[Define if provides float variant of $1])], + AC_DEFINE(HAVE_CMATH_[]AS_TR_CPP($1)F,1,[Define to 1 if provides float variant of $1.])], [AC_MSG_RESULT([no])]) AC_LANG_POP(C++) ]) dnl Check whether fast signed integer arithmetics using bit tricks -dnl can be used in oct-inttypes.h. Defines HAVE_FAST_INT_OPS if +dnl can be used in oct-inttypes.h. Defines HAVE_FAST_INT_OPS if dnl the following conditions hold: dnl 1. Signed numbers are represented by twos complement dnl (see ) @@ -1711,7 +1711,7 @@ AC_LANG_POP(C++)]) if test $octave_cv_fast_int_ops = yes; then AC_DEFINE(HAVE_FAST_INT_OPS, 1, - [Define if signed integers use two's complement]) + [Define to 1 if signed integers use two's complement.]) fi ]) dnl @@ -1719,7 +1719,7 @@ dnl "-framework $1" for the given prologue $2 and the given body $3 of dnl a source file. Arguments 2 and 3 optionally can also be empty. dnl Add options (lower case letters $1) "--with-framework-$1" and -dnl "--without-framework-$1". If this test is successful then perform +dnl "--without-framework-$1". If this test is successful then perform dnl $4, otherwise do $5. dnl dnl OCTAVE_HAVE_FRAMEWORK diff -r 069c552587a0 -r 959953dba519 scripts/image/image.m --- a/scripts/image/image.m Tue Jul 31 09:54:19 2012 -0400 +++ b/scripts/image/image.m Fri Aug 03 14:35:44 2012 -0400 @@ -72,6 +72,11 @@ firstnonnumeric = 4; endif + if (iscomplex (img)) + warning ("image: only showing real part of complex image"); + img = real (img); + endif + oldax = gca (); unwind_protect axes (ax); @@ -241,3 +246,6 @@ %! hold off; %! title ("line, image, line, image, line"); +## Test input validation +%!error image (1+i) +%!error image ([]) diff -r 069c552587a0 -r 959953dba519 scripts/pkg/pkg.m --- a/scripts/pkg/pkg.m Tue Jul 31 09:54:19 2012 -0400 +++ b/scripts/pkg/pkg.m Fri Aug 03 14:35:44 2012 -0400 @@ -428,7 +428,7 @@ endif warning ("creating the directory %s\n", prefix); endif - local_packages = prefix = canonicalize_filename (prefix); + local_packages = prefix = canonicalize_file_name (prefix); user_prefix = true; if (length (files) >= 2 && ischar (files{2})) archprefix = files{2}; diff -r 069c552587a0 -r 959953dba519 scripts/plot/gtext.m --- a/scripts/plot/gtext.m Tue Jul 31 09:54:19 2012 -0400 +++ b/scripts/plot/gtext.m Fri Aug 03 14:35:44 2012 -0400 @@ -18,16 +18,24 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gtext (@var{s}) +## @deftypefnx {Function File} {} gtext (@{@var{s1}, @var{s2}, @dots{}@}) ## @deftypefnx {Function File} {} gtext (@{@var{s1}; @var{s2}; @dots{}@}) ## @deftypefnx {Function File} {} gtext (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {@var{h} =} gtext (@dots{}) ## Place text on the current figure using the mouse. The text is defined -## by the string @var{s}. If @var{s} is a cell array, each element of the cell -## array is written to a separate line. Additional arguments are passed to -## the underlying text object as properties. +## by the string @var{s}. If @var{s} is a cell string organized as a row +## vector then each string of the cell array is written to a separate line. +## If @var{s} is organized as a column vector then one string element of the +## cell array is placed for every mouse click. Additional inputs besides a +## string or cellstr are passed to the underlying text object as Property-value +## pairs. +## +## The optional return value @var{h} is a graphics handle to the created +## text object. ## @seealso{ginput, text} ## @end deftypefn -function gtext (s, varargin) +function h = gtext (s, varargin) if (nargin < 1) print_usage (); @@ -37,9 +45,21 @@ error ("gtext: S must be a string or cell array of strings"); endif + htmp = -1; if (! isempty (s)) - [x, y] = ginput (1); - text (x, y, s, varargin{:}); + if (ischar (s) || isrow (s)) + [x, y] = ginput (1); + htmp = text (x, y, s, varargin{:}); + else + for i = 1:numel (s) + [x, y] = ginput (1); + htmp = text (x, y, s{i}, varargin{:}); + endfor + endif + endif + + if (nargout > 0) + h = htmp; endif endfunction diff -r 069c552587a0 -r 959953dba519 scripts/polynomial/splinefit.m --- a/scripts/polynomial/splinefit.m Tue Jul 31 09:54:19 2012 -0400 +++ b/scripts/polynomial/splinefit.m Fri Aug 03 14:35:44 2012 -0400 @@ -221,19 +221,19 @@ pp = __splinefit__ (x, y, breaks, args{:}); endfunction + %!shared xb, yb, x %! xb = 0:2:10; -%! yb = randn (size (xb)); +%! yb = 2*rand (size (xb)) - 1; %! x = 0:0.1:10; %!test %! y = interp1 (xb, yb, x, "linear"); -%! assert (ppval (splinefit (x, y, xb, "order", 1), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb, "order", 1), x), y, 15 * eps ()); %!test %! y = interp1 (xb, yb, x, "spline"); -%! assert (ppval (splinefit (x, y, xb, "order", 3), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb, "order", 3), x), y, 15 * eps ()); %!test %! y = interp1 (xb, yb, x, "spline"); -%! assert (ppval (splinefit (x, y, xb), x), y, 10 * eps ()); +%! assert (ppval (splinefit (x, y, xb), x), y, 15 * eps ()); - diff -r 069c552587a0 -r 959953dba519 scripts/testfun/demo.m --- a/scripts/testfun/demo.m Tue Jul 31 09:54:19 2012 -0400 +++ b/scripts/testfun/demo.m Fri Aug 03 14:35:44 2012 -0400 @@ -123,19 +123,11 @@ ## Process each demo without failing try block = code(idx(doidx(i)):idx(doidx(i)+1)-1); - ## FIXME: need to check for embedded test functions, which cause - ## segfaults, until issues with subfunctions in functions are resolved. - embed_func = regexp (block, '^\s*function ', 'once', 'lineanchors'); - if (isempty (embed_func)) - ## Use an environment without variables - eval (cstrcat ("function __demo__ ()\n", block, "\nendfunction")); - ## Display the code that will be executed before executing it - printf ("%s example %d:%s\n\n", name, doidx(i), block); - __demo__; - else - error (["Functions embedded in %!demo blocks are not allowed.\n", ... - "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); - endif + ## Use an environment without variables + eval (cstrcat ("function __demo__ ()\n", block, "\nendfunction")); + ## Display the code that will be executed before executing it + printf ("%s example %d:%s\n\n", name, doidx(i), block); + __demo__; catch ## Let the programmer know which demo failed. printf ("%s example %d: failed\n%s\n", name, doidx(i), lasterr ()); diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__delaunayn__.cc --- a/src/DLD-FUNCTIONS/__delaunayn__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -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 3 of the License, 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, see -. - -*/ - -/* - 16. July 2000 - Kai Habel: first release - - 25. September 2002 - Changes by Rafael Laboissiere - - * Added Qbb option to normalize the input and avoid crashes in Octave. - * delaunayn accepts now a second (optional) argument that must be a string - containing extra options to the qhull command. - * Fixed doc string. The dimension of the result matrix is [m, dim+1], and - not [n, dim-1]. - - 6. June 2006: Changes by Alexander Barth - - * triangulate non-simplicial facets - * allow options to be specified as cell array of strings - * change the default options (for compatibility with matlab) -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "__delaunayn__.oct 2007-08-21"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (__delaunayn__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ -@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ -Undocumented internal function.\n\ -@end deftypefn") - -{ - octave_value_list retval; - -#if defined (HAVE_QHULL) - - retval(0) = 0.0; - - int nargin = args.length (); - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - - Matrix p (args(0).matrix_value ()); - const octave_idx_type dim = p.columns (); - const octave_idx_type n = p.rows (); - - // Default options - std::string options; - if (dim <= 3) - options = "Qt Qbb Qc Qz"; - else - options = "Qt Qbb Qc Qx"; - - if (nargin == 2) - { - if (args(1).is_string ()) - options = args(1).string_value (); - else if (args(1).is_empty ()) - ; // Use default options - else if (args(1).is_cellstr ()) - { - options = ""; - Array tmp = args(1).cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += tmp(i) + " "; - } - else - { - error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); - return retval; - } - } - - if (n > dim + 1) - { - p = p.transpose (); - double *pt_array = p.fortran_vec (); - boolT ismalloc = false; - - // Qhull flags argument is not const char* - OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length ()); - - sprintf (flags, "qhull d %s", options.c_str ()); - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("__delaunayn__: unable to create temporary file for output"); - return retval; - } - - int exitcode = qh_new_qhull (dim, n, pt_array, - ismalloc, flags, outfile, errfile); - if (! exitcode) - { - // triangulate non-simplicial facets - qh_triangulate (); - - facetT *facet; - vertexT *vertex, **vertexp; - octave_idx_type nf = 0, i = 0; - - FORALLfacets - { - if (! facet->upperdelaunay) - nf++; - - // Double check. Non-simplicial facets will cause segfault below - if (! facet->simplicial) - { - error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); - exitcode = 1; - break; - } - } - - if (! exitcode) - { - Matrix simpl (nf, dim+1); - - FORALLfacets - { - if (! facet->upperdelaunay) - { - octave_idx_type j = 0; - - FOREACHvertex_ (facet->vertices) - { - simpl(i, j++) = 1 + qh_pointid(vertex->point); - } - i++; - } - } - - retval(0) = simpl; - } - } - else - error ("__delaunayn__: qhull failed"); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); - } - else if (n == dim + 1) - { - // one should check if nx points span a simplex - // I will look at this later. - RowVector vec (n); - for (octave_idx_type i = 0; i < n; i++) - vec(i) = i + 1.0; - - retval(0) = vec; - } - -#else - error ("__delaunayn__: not available in this version of Octave"); -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__dsearchn__.cc --- a/src/DLD-FUNCTIONS/__dsearchn__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,115 +0,0 @@ -/* - -Copyright (C) 2007-2012 David Bateman - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-math.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" - -DEFUN_DLD (__dsearchn__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{idx}, @var{d}] =} dsearch (@var{x}, @var{xi})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 2) - { - print_usage (); - return retval; - } - - Matrix x = args(0).matrix_value ().transpose (); - Matrix xi = args(1).matrix_value ().transpose (); - - if (! error_state) - { - if (x.rows () != xi.rows () || x.columns () < 1) - error ("__dsearch__: number of rows of X and XI must match"); - else - { - octave_idx_type n = x.rows (); - octave_idx_type nx = x.columns (); - octave_idx_type nxi = xi.columns (); - - ColumnVector idx (nxi); - double *pidx = idx.fortran_vec (); - ColumnVector dist (nxi); - double *pdist = dist.fortran_vec (); - -#define DIST(dd, y, yi, m) \ - dd = 0.; \ - for (octave_idx_type k = 0; k < m; k++) \ - { \ - double yd = y[k] - yi[k]; \ - dd += yd * yd; \ - } \ - dd = sqrt (dd); - - const double *pxi = xi.fortran_vec (); - for (octave_idx_type i = 0; i < nxi; i++) - { - double d0; - const double *px = x.fortran_vec (); - DIST(d0, px, pxi, n); - *pidx = 1.; - for (octave_idx_type j = 1; j < nx; j++) - { - px += n; - double d; - DIST (d, px, pxi, n); - if (d < d0) - { - d0 = d; - *pidx = static_cast(j + 1); - } - OCTAVE_QUIT; - } - - *pdist++ = d0; - pidx++; - pxi += n; - } - - retval(1) = dist; - retval(0) = idx; - } - } - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__fltk_uigetfile__.cc --- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 2010-2012 Kai Habel - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#if defined (HAVE_FLTK) - -#ifdef WIN32 -#define WIN32_LEAN_AND_MEAN -#endif - -#include -#include - -// FLTK headers may include X11/X.h which defines Complex, and that -// conflicts with Octave's Complex typedef. We don't need the X11 -// Complex definition in this file, so remove it before including Octave -// headers which may require Octave's Complex typedef. -#undef Complex - -#include "defun-dld.h" -#include "file-ops.h" - -DEFUN_DLD (__fltk_uigetfile__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __fltk_uigetfile__ (@dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - // Expected argument list: - // - // args(0) ... FileFilter in fltk format - // args(1) ... Title - // args(2) ... Default Filename - // args(3) ... PostionValue [x,y] - // args(4) ... SelectValue "on"/"off"/"dir"/"create" - - octave_value_list retval (3, octave_value (0)); - - std::string file_filter = args(0).string_value (); - std::string title = args(1).string_value (); - std::string default_name = args(2).string_value (); - Matrix pos = args(3).matrix_value (); - - int multi_type = Fl_File_Chooser::SINGLE; - std::string flabel = "Filename:"; - - std::string multi = args(4).string_value (); - if (multi == "on") - multi_type = Fl_File_Chooser::MULTI; - else if (multi == "dir") - { - multi_type = Fl_File_Chooser::DIRECTORY; - flabel = "Directory:"; - } - else if (multi == "create") - multi_type = Fl_File_Chooser::CREATE; - - Fl_File_Chooser::filename_label = flabel.c_str (); - - Fl_File_Chooser fc (default_name.c_str (), file_filter.c_str (), - multi_type, title.c_str ()); - - fc.preview (0); - - if (multi_type == Fl_File_Chooser::CREATE) - fc.ok_label ("Save"); - - fc.show (); - - while (fc.shown ()) - Fl::wait (); - - if (fc.value ()) - { - int file_count = fc.count (); - std::string fname; - - //fltk uses forward slash even for windows - std::string sep = "/"; - std::size_t idx; - - if (file_count == 1 && multi_type != Fl_File_Chooser::DIRECTORY) - { - fname = fc.value (); - idx = fname.find_last_of (sep); - retval(0) = fname.substr (idx + 1); - } - else - { - Cell file_cell = Cell (file_count, 1); - for (octave_idx_type n = 1; n <= file_count; n++) - { - fname = fc.value (n); - idx = fname.find_last_of (sep); - file_cell(n - 1) = fname.substr (idx + 1); - } - retval(0) = file_cell; - } - - if (multi_type == Fl_File_Chooser::DIRECTORY) - retval(0) = std::string (fc.value ()); - else - { - retval(1) = std::string (fc.directory ()) + sep; - retval(2) = fc.filter_value () + 1; - } - } - - fc.hide (); - Fl::flush (); - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#endif diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__glpk__.cc --- a/src/DLD-FUNCTIONS/__glpk__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,861 +0,0 @@ -/* - -Copyright (C) 2005-2012 Nicolo' Giorgetti - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-ieee.h" - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "pager.h" - -#if defined (HAVE_GLPK) - -extern "C" -{ -#if defined (HAVE_GLPK_GLPK_H) -#include -#else -#include -#endif - -#if 0 -#ifdef GLPK_PRE_4_14 - -#ifndef _GLPLIB_H -#include -#endif -#ifndef lib_set_fault_hook -#define lib_set_fault_hook lib_fault_hook -#endif -#ifndef lib_set_print_hook -#define lib_set_print_hook lib_print_hook -#endif - -#else - -void _glp_lib_print_hook (int (*func)(void *info, char *buf), void *info); -void _glp_lib_fault_hook (int (*func)(void *info, char *buf), void *info); - -#endif -#endif -} - -#define NIntP 17 -#define NRealP 10 - -int lpxIntParam[NIntP] = { - 0, - 1, - 0, - 1, - 0, - -1, - 0, - 200, - 1, - 2, - 0, - 1, - 0, - 0, - 2, - 2, - 1 -}; - -int IParam[NIntP] = { - LPX_K_MSGLEV, - LPX_K_SCALE, - LPX_K_DUAL, - LPX_K_PRICE, - LPX_K_ROUND, - LPX_K_ITLIM, - LPX_K_ITCNT, - LPX_K_OUTFRQ, - LPX_K_MPSINFO, - LPX_K_MPSOBJ, - LPX_K_MPSORIG, - LPX_K_MPSWIDE, - LPX_K_MPSFREE, - LPX_K_MPSSKIP, - LPX_K_BRANCH, - LPX_K_BTRACK, - LPX_K_PRESOL -}; - - -double lpxRealParam[NRealP] = { - 0.07, - 1e-7, - 1e-7, - 1e-9, - -DBL_MAX, - DBL_MAX, - -1.0, - 0.0, - 1e-6, - 1e-7 -}; - -int RParam[NRealP] = { - LPX_K_RELAX, - LPX_K_TOLBND, - LPX_K_TOLDJ, - LPX_K_TOLPIV, - LPX_K_OBJLL, - LPX_K_OBJUL, - LPX_K_TMLIM, - LPX_K_OUTDLY, - LPX_K_TOLINT, - LPX_K_TOLOBJ -}; - -static jmp_buf mark; //-- Address for long jump to jump to - -#if 0 -int -glpk_fault_hook (void * /* info */, char *msg) -{ - error ("CRITICAL ERROR in GLPK: %s", msg); - longjmp (mark, -1); -} - -int -glpk_print_hook (void * /* info */, char *msg) -{ - message (0, "%s", msg); - return 1; -} -#endif - -int -glpk (int sense, int n, int m, double *c, int nz, int *rn, int *cn, - double *a, double *b, char *ctype, int *freeLB, double *lb, - int *freeUB, double *ub, int *vartype, int isMIP, int lpsolver, - int save_pb, double *xmin, double *fmin, double *status, - double *lambda, double *redcosts, double *time, double *mem) -{ - int errnum; - int typx = 0; - int method; - - clock_t t_start = clock (); - -#if 0 -#ifdef GLPK_PRE_4_14 - lib_set_fault_hook (0, glpk_fault_hook); -#else - _glp_lib_fault_hook (glpk_fault_hook, 0); -#endif - - if (lpxIntParam[0] > 1) -#ifdef GLPK_PRE_4_14 - lib_set_print_hook (0, glpk_print_hook); -#else - _glp_lib_print_hook (glpk_print_hook, 0); -#endif -#endif - - LPX *lp = lpx_create_prob (); - - - //-- Set the sense of optimization - if (sense == 1) - lpx_set_obj_dir (lp, LPX_MIN); - else - lpx_set_obj_dir (lp, LPX_MAX); - - //-- If the problem has integer structural variables switch to MIP - if (isMIP) - lpx_set_class (lp, LPX_MIP); - - lpx_add_cols (lp, n); - for (int i = 0; i < n; i++) - { - //-- Define type of the structural variables - if (! freeLB[i] && ! freeUB[i]) - { - if (lb[i] != ub[i]) - lpx_set_col_bnds (lp, i+1, LPX_DB, lb[i], ub[i]); - else - lpx_set_col_bnds (lp, i+1, LPX_FX, lb[i], ub[i]); - } - else - { - if (! freeLB[i] && freeUB[i]) - lpx_set_col_bnds (lp, i+1, LPX_LO, lb[i], ub[i]); - else - { - if (freeLB[i] && ! freeUB[i]) - lpx_set_col_bnds (lp, i+1, LPX_UP, lb[i], ub[i]); - else - lpx_set_col_bnds (lp, i+1, LPX_FR, lb[i], ub[i]); - } - } - - // -- Set the objective coefficient of the corresponding - // -- structural variable. No constant term is assumed. - lpx_set_obj_coef(lp,i+1,c[i]); - - if (isMIP) - lpx_set_col_kind (lp, i+1, vartype[i]); - } - - lpx_add_rows (lp, m); - - for (int i = 0; i < m; i++) - { - /* If the i-th row has no lower bound (types F,U), the - corrispondent parameter will be ignored. - If the i-th row has no upper bound (types F,L), the corrispondent - parameter will be ignored. - If the i-th row is of S type, the i-th LB is used, but - the i-th UB is ignored. - */ - - switch (ctype[i]) - { - case 'F': - typx = LPX_FR; - break; - - case 'U': - typx = LPX_UP; - break; - - case 'L': - typx = LPX_LO; - break; - - case 'S': - typx = LPX_FX; - break; - - case 'D': - typx = LPX_DB; - break; - } - - lpx_set_row_bnds (lp, i+1, typx, b[i], b[i]); - - } - - lpx_load_matrix (lp, nz, rn, cn, a); - - if (save_pb) - { - static char tmp[] = "outpb.lp"; - if (lpx_write_cpxlp (lp, tmp) != 0) - { - error ("__glpk__: unable to write problem"); - longjmp (mark, -1); - } - } - - //-- scale the problem data (if required) - //-- if (scale && (!presol || method == 1)) lpx_scale_prob (lp); - //-- LPX_K_SCALE=IParam[1] LPX_K_PRESOL=IParam[16] - if (lpxIntParam[1] && (! lpxIntParam[16] || lpsolver != 1)) - lpx_scale_prob (lp); - - //-- build advanced initial basis (if required) - if (lpsolver == 1 && ! lpxIntParam[16]) - lpx_adv_basis (lp); - - for (int i = 0; i < NIntP; i++) - lpx_set_int_parm (lp, IParam[i], lpxIntParam[i]); - - for (int i = 0; i < NRealP; i++) - lpx_set_real_parm (lp, RParam[i], lpxRealParam[i]); - - if (lpsolver == 1) - method = 'S'; - else - method = 'T'; - - switch (method) - { - case 'S': - { - if (isMIP) - { - method = 'I'; - errnum = lpx_simplex (lp); - errnum = lpx_integer (lp); - } - else - errnum = lpx_simplex (lp); - } - break; - - case 'T': - errnum = lpx_interior (lp); - break; - - default: - break; -#if 0 -#ifdef GLPK_PRE_4_14 - insist (method != method); -#else - static char tmp[] = "method != method"; - glpk_fault_hook (0, tmp); -#endif -#endif - } - - /* errnum assumes the following results: - errnum = 0 <=> No errors - errnum = 1 <=> Iteration limit exceeded. - errnum = 2 <=> Numerical problems with basis matrix. - */ - if (errnum == LPX_E_OK) - { - if (isMIP) - { - *status = lpx_mip_status (lp); - *fmin = lpx_mip_obj_val (lp); - } - else - { - if (lpsolver == 1) - { - *status = lpx_get_status (lp); - *fmin = lpx_get_obj_val (lp); - } - else - { - *status = lpx_ipt_status (lp); - *fmin = lpx_ipt_obj_val (lp); - } - } - - if (isMIP) - { - for (int i = 0; i < n; i++) - xmin[i] = lpx_mip_col_val (lp, i+1); - } - else - { - /* Primal values */ - for (int i = 0; i < n; i++) - { - if (lpsolver == 1) - xmin[i] = lpx_get_col_prim (lp, i+1); - else - xmin[i] = lpx_ipt_col_prim (lp, i+1); - } - - /* Dual values */ - for (int i = 0; i < m; i++) - { - if (lpsolver == 1) - lambda[i] = lpx_get_row_dual (lp, i+1); - else - lambda[i] = lpx_ipt_row_dual (lp, i+1); - } - - /* Reduced costs */ - for (int i = 0; i < lpx_get_num_cols (lp); i++) - { - if (lpsolver == 1) - redcosts[i] = lpx_get_col_dual (lp, i+1); - else - redcosts[i] = lpx_ipt_col_dual (lp, i+1); - } - } - - *time = (clock () - t_start) / CLOCKS_PER_SEC; - -#ifdef GLPK_PRE_4_14 - *mem = (lib_env_ptr () -> mem_tpeak); -#else - *mem = 0; -#endif - - lpx_delete_prob (lp); - return 0; - } - - lpx_delete_prob (lp); - - *status = errnum; - - return errnum; -} - -#endif - -#define OCTAVE_GLPK_GET_REAL_PARAM(NAME, IDX) \ - do \ - { \ - octave_value tmp = PARAM.getfield (NAME); \ - \ - if (tmp.is_defined ()) \ - { \ - if (! tmp.is_empty ()) \ - { \ - lpxRealParam[IDX] = tmp.scalar_value (); \ - \ - if (error_state) \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - else \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - } \ - while (0) - -#define OCTAVE_GLPK_GET_INT_PARAM(NAME, VAL) \ - do \ - { \ - octave_value tmp = PARAM.getfield (NAME); \ - \ - if (tmp.is_defined ()) \ - { \ - if (! tmp.is_empty ()) \ - { \ - VAL = tmp.int_value (); \ - \ - if (error_state) \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - else \ - { \ - error ("glpk: invalid value in PARAM." NAME); \ - return retval; \ - } \ - } \ - } \ - while (0) - -DEFUN_DLD (__glpk__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{values}] =} __glpk__ (@var{args})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - // The list of values to return. See the declaration in oct-obj.h - octave_value_list retval; - -#if defined (HAVE_GLPK) - - int nrhs = args.length (); - - if (nrhs != 9) - { - print_usage (); - return retval; - } - - //-- 1nd Input. A column array containing the objective function - //-- coefficients. - volatile int mrowsc = args(0).rows (); - - Matrix C (args(0).matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of C"); - return retval; - } - - double *c = C.fortran_vec (); - Array rn; - Array cn; - ColumnVector a; - volatile int mrowsA; - volatile int nz = 0; - - //-- 2nd Input. A matrix containing the constraints coefficients. - // If matrix A is NOT a sparse matrix - if (args(1).is_sparse_type ()) - { - SparseMatrix A = args(1).sparse_matrix_value (); // get the sparse matrix - - if (error_state) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - mrowsA = A.rows (); - octave_idx_type Anc = A.cols (); - octave_idx_type Anz = A.nnz (); - rn.resize (dim_vector (Anz+1, 1)); - cn.resize (dim_vector (Anz+1, 1)); - a.resize (Anz+1, 0.0); - - if (Anc != mrowsc) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - for (octave_idx_type j = 0; j < Anc; j++) - for (octave_idx_type i = A.cidx (j); i < A.cidx (j+1); i++) - { - nz++; - rn(nz) = A.ridx (i) + 1; - cn(nz) = j + 1; - a(nz) = A.data(i); - } - } - else - { - Matrix A (args(1).matrix_value ()); // get the matrix - - if (error_state) - { - error ("__glpk__: invalid value of A"); - return retval; - } - - mrowsA = A.rows (); - rn.resize (dim_vector (mrowsA*mrowsc+1, 1)); - cn.resize (dim_vector (mrowsA*mrowsc+1, 1)); - a.resize (mrowsA*mrowsc+1, 0.0); - - for (int i = 0; i < mrowsA; i++) - { - for (int j = 0; j < mrowsc; j++) - { - if (A(i,j) != 0) - { - nz++; - rn(nz) = i + 1; - cn(nz) = j + 1; - a(nz) = A(i,j); - } - } - } - - } - - //-- 3rd Input. A column array containing the right-hand side value - // for each constraint in the constraint matrix. - Matrix B (args(2).matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of B"); - return retval; - } - - double *b = B.fortran_vec (); - - //-- 4th Input. An array of length mrowsc containing the lower - //-- bound on each of the variables. - Matrix LB (args(3).matrix_value ()); - - if (error_state || LB.length () < mrowsc) - { - error ("__glpk__: invalid value of LB"); - return retval; - } - - double *lb = LB.fortran_vec (); - - //-- LB argument, default: Free - Array freeLB (dim_vector (mrowsc, 1)); - for (int i = 0; i < mrowsc; i++) - { - if (xisinf (lb[i])) - { - freeLB(i) = 1; - lb[i] = -octave_Inf; - } - else - freeLB(i) = 0; - } - - //-- 5th Input. An array of at least length numcols containing the upper - //-- bound on each of the variables. - Matrix UB (args(4).matrix_value ()); - - if (error_state || UB.length () < mrowsc) - { - error ("__glpk__: invalid value of UB"); - return retval; - } - - double *ub = UB.fortran_vec (); - - Array freeUB (dim_vector (mrowsc, 1)); - for (int i = 0; i < mrowsc; i++) - { - if (xisinf (ub[i])) - { - freeUB(i) = 1; - ub[i] = octave_Inf; - } - else - freeUB(i) = 0; - } - - //-- 6th Input. A column array containing the sense of each constraint - //-- in the constraint matrix. - charMatrix CTYPE (args(5).char_matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of CTYPE"); - return retval; - } - - char *ctype = CTYPE.fortran_vec (); - - //-- 7th Input. A column array containing the types of the variables. - charMatrix VTYPE (args(6).char_matrix_value ()); - - if (error_state) - { - error ("__glpk__: invalid value of VARTYPE"); - return retval; - } - - Array vartype (dim_vector (mrowsc, 1)); - volatile int isMIP = 0; - for (int i = 0; i < mrowsc ; i++) - { - if (VTYPE(i,0) == 'I') - { - isMIP = 1; - vartype(i) = LPX_IV; - } - else - vartype(i) = LPX_CV; - } - - //-- 8th Input. Sense of optimization. - volatile int sense; - double SENSE = args(7).scalar_value (); - - if (error_state) - { - error ("__glpk__: invalid value of SENSE"); - return retval; - } - - if (SENSE >= 0) - sense = 1; - else - sense = -1; - - //-- 9th Input. A structure containing the control parameters. - octave_scalar_map PARAM = args(8).scalar_map_value (); - - if (error_state) - { - error ("__glpk__: invalid value of PARAM"); - return retval; - } - - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - //-- Integer parameters - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - //-- Level of messages output by the solver - OCTAVE_GLPK_GET_INT_PARAM ("msglev", lpxIntParam[0]); - if (lpxIntParam[0] < 0 || lpxIntParam[0] > 3) - { - error ("__glpk__: PARAM.msglev must be 0 (no output [default]) or 1 (error messages only) or 2 (normal output) or 3 (full output)"); - return retval; - } - - //-- scaling option - OCTAVE_GLPK_GET_INT_PARAM ("scale", lpxIntParam[1]); - if (lpxIntParam[1] < 0 || lpxIntParam[1] > 2) - { - error ("__glpk__: PARAM.scale must be 0 (no scaling) or 1 (equilibration scaling [default]) or 2 (geometric mean scaling)"); - return retval; - } - - //-- Dual dimplex option - OCTAVE_GLPK_GET_INT_PARAM ("dual", lpxIntParam[2]); - if (lpxIntParam[2] < 0 || lpxIntParam[2] > 1) - { - error ("__glpk__: PARAM.dual must be 0 (do NOT use dual simplex [default]) or 1 (use dual simplex)"); - return retval; - } - - //-- Pricing option - OCTAVE_GLPK_GET_INT_PARAM ("price", lpxIntParam[3]); - if (lpxIntParam[3] < 0 || lpxIntParam[3] > 1) - { - error ("__glpk__: PARAM.price must be 0 (textbook pricing) or 1 (steepest edge pricing [default])"); - return retval; - } - - //-- Solution rounding option - OCTAVE_GLPK_GET_INT_PARAM ("round", lpxIntParam[4]); - if (lpxIntParam[4] < 0 || lpxIntParam[4] > 1) - { - error ("__glpk__: PARAM.round must be 0 (report all primal and dual values [default]) or 1 (replace tiny primal and dual values by exact zero)"); - return retval; - } - - //-- Simplex iterations limit - OCTAVE_GLPK_GET_INT_PARAM ("itlim", lpxIntParam[5]); - - //-- Simplex iterations count - OCTAVE_GLPK_GET_INT_PARAM ("itcnt", lpxIntParam[6]); - - //-- Output frequency, in iterations - OCTAVE_GLPK_GET_INT_PARAM ("outfrq", lpxIntParam[7]); - - //-- Branching heuristic option - OCTAVE_GLPK_GET_INT_PARAM ("branch", lpxIntParam[14]); - if (lpxIntParam[14] < 0 || lpxIntParam[14] > 2) - { - error ("__glpk__: PARAM.branch must be (MIP only) 0 (branch on first variable) or 1 (branch on last variable) or 2 (branch using a heuristic by Driebeck and Tomlin [default]"); - return retval; - } - - //-- Backtracking heuristic option - OCTAVE_GLPK_GET_INT_PARAM ("btrack", lpxIntParam[15]); - if (lpxIntParam[15] < 0 || lpxIntParam[15] > 2) - { - error ("__glpk__: PARAM.btrack must be (MIP only) 0 (depth first search) or 1 (breadth first search) or 2 (backtrack using the best projection heuristic [default]"); - return retval; - } - - //-- Presolver option - OCTAVE_GLPK_GET_INT_PARAM ("presol", lpxIntParam[16]); - if (lpxIntParam[16] < 0 || lpxIntParam[16] > 1) - { - error ("__glpk__: PARAM.presol must be 0 (do NOT use LP presolver) or 1 (use LP presolver [default])"); - return retval; - } - - //-- LPsolver option - volatile int lpsolver = 1; - OCTAVE_GLPK_GET_INT_PARAM ("lpsolver", lpsolver); - if (lpsolver < 1 || lpsolver > 2) - { - error ("__glpk__: PARAM.lpsolver must be 1 (simplex method) or 2 (interior point method)"); - return retval; - } - - //-- Save option - volatile int save_pb = 0; - OCTAVE_GLPK_GET_INT_PARAM ("save", save_pb); - save_pb = save_pb != 0; - - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - //-- Real parameters - //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - - //-- Ratio test option - OCTAVE_GLPK_GET_REAL_PARAM ("relax", 0); - - //-- Relative tolerance used to check if the current basic solution - //-- is primal feasible - OCTAVE_GLPK_GET_REAL_PARAM ("tolbnd", 1); - - //-- Absolute tolerance used to check if the current basic solution - //-- is dual feasible - OCTAVE_GLPK_GET_REAL_PARAM ("toldj", 2); - - //-- Relative tolerance used to choose eligible pivotal elements of - //-- the simplex table in the ratio test - OCTAVE_GLPK_GET_REAL_PARAM ("tolpiv", 3); - - OCTAVE_GLPK_GET_REAL_PARAM ("objll", 4); - - OCTAVE_GLPK_GET_REAL_PARAM ("objul", 5); - - OCTAVE_GLPK_GET_REAL_PARAM ("tmlim", 6); - - OCTAVE_GLPK_GET_REAL_PARAM ("outdly", 7); - - OCTAVE_GLPK_GET_REAL_PARAM ("tolint", 8); - - OCTAVE_GLPK_GET_REAL_PARAM ("tolobj", 9); - - //-- Assign pointers to the output parameters - ColumnVector xmin (mrowsc, octave_NA); - double fmin = octave_NA; - double status; - ColumnVector lambda (mrowsA, octave_NA); - ColumnVector redcosts (mrowsc, octave_NA); - double time; - double mem; - - int jmpret = setjmp (mark); - - if (jmpret == 0) - glpk (sense, mrowsc, mrowsA, c, nz, rn.fortran_vec (), - cn.fortran_vec (), a.fortran_vec (), b, ctype, - freeLB.fortran_vec (), lb, freeUB.fortran_vec (), ub, - vartype.fortran_vec (), isMIP, lpsolver, save_pb, - xmin.fortran_vec (), &fmin, &status, lambda.fortran_vec (), - redcosts.fortran_vec (), &time, &mem); - - octave_scalar_map extra; - - if (! isMIP) - { - extra.assign ("lambda", lambda); - extra.assign ("redcosts", redcosts); - } - - extra.assign ("time", time); - extra.assign ("mem", mem); - - retval(3) = extra; - retval(2) = status; - retval(1) = fmin; - retval(0) = xmin; - -#else - - gripe_not_supported ("glpk"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__init_fltk__.cc --- a/src/DLD-FUNCTIONS/__init_fltk__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2129 +0,0 @@ -/* - -Copyright (C) 2007-2012 Shai Ayal - -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 3 of the License, 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, see -. - -*/ - -/* - -To initialize: - - graphics_toolkit ("fltk"); - plot (randn (1e3, 1)); - -*/ - -// PKG_ADD: register_graphics_toolkit ("fltk"); - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" - -#if defined (HAVE_FLTK) - -#include -#include -#include -#include - -#ifdef WIN32 -#define WIN32_LEAN_AND_MEAN -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -// FLTK headers may include X11/X.h which defines Complex, and that -// conflicts with Octave's Complex typedef. We don't need the X11 -// Complex definition in this file, so remove it before including Octave -// headers which may require Octave's Complex typedef. -#undef Complex - -#include "cmd-edit.h" -#include "lo-ieee.h" - -#include "file-ops.h" -#include "gl-render.h" -#include "gl2ps-renderer.h" -#include "graphics.h" -#include "parse.h" -#include "sysdep.h" -#include "toplev.h" -#include "variables.h" - -#define FLTK_GRAPHICS_TOOLKIT_NAME "fltk" - -// Give FLTK no more than 0.01 sec to do its stuff. -static double fltk_maxtime = 1e-2; - -const char* help_text = "\ -Keyboard Shortcuts\n\ -a - autoscale\n\ -p - pan/zoom\n\ -r - rotate\n\ -g - toggle grid\n\ -\n\ -Mouse\n\ -left drag - pan\n\ -mouse wheel - zoom\n\ -right drag - rectangle zoom\n\ -left double click - autoscale\n\ -"; - -class OpenGL_fltk : public Fl_Gl_Window -{ -public: - OpenGL_fltk (int xx, int yy, int ww, int hh, double num) - : Fl_Gl_Window (xx, yy, ww, hh, 0), number (num), renderer (), - in_zoom (false), zoom_box (), print_mode (false) - { - // Ask for double buffering and a depth buffer. - mode (FL_DEPTH | FL_DOUBLE); - } - - ~OpenGL_fltk (void) { } - - void zoom (bool z) - { - in_zoom = z; - if (! in_zoom) - hide_overlay (); - } - - bool zoom (void) { return in_zoom; } - void set_zoom_box (const Matrix& zb) { zoom_box = zb; } - - void print (const std::string& cmd, const std::string& term) - { - print_mode = true; - print_cmd = cmd; - print_term = term; - } - - void resize (int xx, int yy, int ww, int hh) - { - Fl_Gl_Window::resize (xx, yy, ww, hh); - setup_viewport (ww, hh); - redraw (); - } - - bool renumber (double new_number) - { - bool retval = false; - - if (number != new_number) - { - number = new_number; - retval = true; - } - - return retval; - } - -private: - double number; - opengl_renderer renderer; - bool in_zoom; - // (x1,y1,x2,y2) - Matrix zoom_box; - - bool print_mode; - std::string print_cmd; - std::string print_term; - - void setup_viewport (int ww, int hh) - { - glMatrixMode (GL_PROJECTION); - glLoadIdentity (); - glViewport (0, 0, ww, hh); - } - - void draw (void) - { - if (! valid ()) - { - valid (1); - setup_viewport (w (), h ()); - } - - if (print_mode) - { - FILE *fp = octave_popen (print_cmd.c_str (), "w"); - glps_renderer rend (fp, print_term); - - rend.draw (gh_manager::get_object (number)); - - octave_pclose (fp); - print_mode = false; - } - else - { - renderer.draw (gh_manager::get_object (number)); - - if (zoom ()) - overlay (); - } - } - - void zoom_box_vertex (void) - { - glVertex2d (zoom_box(0), h () - zoom_box(1)); - glVertex2d (zoom_box(0), h () - zoom_box(3)); - glVertex2d (zoom_box(2), h () - zoom_box(3)); - glVertex2d (zoom_box(2), h () - zoom_box(1)); - glVertex2d (zoom_box(0), h () - zoom_box(1)); - } - - void overlay (void) - { - glPushMatrix (); - - glMatrixMode (GL_MODELVIEW); - glLoadIdentity (); - - glMatrixMode (GL_PROJECTION); - glLoadIdentity (); - gluOrtho2D (0.0, w (), 0.0, h ()); - - glPushAttrib (GL_DEPTH_BUFFER_BIT | GL_CURRENT_BIT); - glDisable (GL_DEPTH_TEST); - - glBegin (GL_POLYGON); - glColor4f (0.45, 0.62, 0.81, 0.1); - zoom_box_vertex (); - glEnd (); - - glBegin (GL_LINE_STRIP); - glLineWidth (1.5); - glColor4f (0.45, 0.62, 0.81, 0.9); - zoom_box_vertex (); - glEnd (); - - glPopAttrib (); - glPopMatrix (); - } - - int handle (int event) - { - int retval = Fl_Gl_Window::handle (event); - - switch (event) - { - case FL_ENTER: - window ()->cursor (FL_CURSOR_CROSS); - return 1; - - case FL_LEAVE: - window ()->cursor (FL_CURSOR_DEFAULT); - return 1; - } - - return retval; - } -}; - -// Parameter controlling how fast we zoom when using the scrool wheel. -static double wheel_zoom_speed = 0.05; -// Parameter controlling the GUI mode. -static enum { pan_zoom, rotate_zoom, none } gui_mode; - -void script_cb (Fl_Widget*, void* data) - { - static_cast (data)->execute_callback (); - } - - -class fltk_uimenu -{ -public: - fltk_uimenu (int xx, int yy, int ww, int hh) - { - menubar = new - Fl_Menu_Bar (xx, yy, ww, hh); - } - - int items_to_show (void) - { - //returns the number of visible menu items - int len = menubar->size (); - int n = 0; - for (int t = 0; t < len; t++ ) - { - const Fl_Menu_Item *m = static_cast (&(menubar->menu ()[t])); - if ((m->label () != NULL) && m->visible ()) - n++; - } - - return n; - } - - void show (void) - { - menubar->show (); - } - - void hide (void) - { - menubar->hide (); - } - - bool is_visible (void) - { - return menubar->visible (); - } - - int find_index_by_name (const std::string& findname) - { - // This function is derived from Greg Ercolano's function - // int GetIndexByName(...), see: - // http://seriss.com/people/erco/fltk/#Menu_ChangeLabel - // He agreed via PM that it can be included in octave using GPLv3 - // Kai Habel (14.10.2010) - - std::string menupath; - for (int t = 0; t < menubar->size (); t++ ) - { - Fl_Menu_Item *m = const_cast (&(menubar->menu ()[t])); - if (m->submenu ()) - { - // item has submenu - if (!menupath.empty ()) - menupath += "/"; - menupath += m->label (); - - if (menupath.compare (findname) == 0 ) - return (t); - } - else - { - // End of submenu? Pop back one level. - if (m->label () == NULL) - { - std::size_t idx = menupath.find_last_of ("/"); - if (idx != std::string::npos) - menupath.erase (idx); - else - menupath.clear (); - continue; - } - // Menu item? - std::string itempath = menupath; - if (!itempath.empty ()) - itempath += "/"; - itempath += m->label (); - - if (itempath.compare (findname) == 0) - return (t); - } - } - return (-1); - } - - Matrix find_uimenu_children (uimenu::properties& uimenup) const - { - Matrix uimenu_childs = uimenup.get_all_children (); - Matrix retval = do_find_uimenu_children (uimenu_childs); - return retval; - } - - Matrix find_uimenu_children (figure::properties& figp) const - { - Matrix uimenu_childs = figp.get_all_children (); - Matrix retval = do_find_uimenu_children (uimenu_childs); - return retval; - } - - Matrix do_find_uimenu_children (Matrix uimenu_childs) const - { - octave_idx_type k = 0; - - - Matrix pos = Matrix (uimenu_childs.numel (), 1); - - for (octave_idx_type ii = 0; ii < uimenu_childs.numel (); ii++) - { - graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); - - if (kidgo.valid_object () && kidgo.isa ("uimenu")) - { - uimenu_childs(k) = uimenu_childs(ii); - pos(k++) = - dynamic_cast (kidgo.get_properties ()).get_position (); - } - } - - uimenu_childs.resize (k, 1); - pos.resize (k, 1); - Matrix retval = Matrix (k, 1); - // Don't know if this is the best method to sort. - // Can we avoid the for loop? - Array sidx = pos.sort_rows_idx (DESCENDING); - for (octave_idx_type ii = 0; ii < k; ii++) - retval(ii) = uimenu_childs (sidx(ii)); - - return retval; - } - - void delete_entry (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - int idx = find_index_by_name (fltk_label.c_str ()); - - if (idx >= 0) - menubar->remove (idx); - } - - void update_accelerator (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - std::string acc = uimenup.get_accelerator (); - if (acc.length () > 0) - { - int key = FL_CTRL + acc[0]; - item->shortcut (key); - } - } - } - } - - void update_callback (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (!uimenup.get_callback ().is_empty ()) - item->callback (static_cast (script_cb), - static_cast (&uimenup)); - else - item->callback (NULL, static_cast (0)); - } - } - } - - void update_enable (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (uimenup.is_enable ()) - item->activate (); - else - item->deactivate (); - } - } - } - - void update_foregroundcolor (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - Matrix rgb = uimenup.get_foregroundcolor_rgb (); - - uchar r = static_cast (gnulib::floor (rgb (0) * 255)); - uchar g = static_cast (gnulib::floor (rgb (1) * 255)); - uchar b = static_cast (gnulib::floor (rgb (2) * 255)); - - item->labelcolor (fl_rgb_color (r, g, b)); - } - } - } - - void update_seperator (const uimenu::properties& uimenup) - { - // Matlab places the separator before the current - // menu entry, while fltk places it after. So we need to find - // the previous item in this menu/submenu. (Kai) - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - int itemflags = 0, idx; - int curr_idx = find_index_by_name (fltk_label.c_str ()); - - for (idx = curr_idx - 1; idx >= 0; idx--) - { - Fl_Menu_Item* item = const_cast (&menubar->menu () [idx]); - itemflags = item->flags; - if (item->label () != NULL) - break; - } - - if (idx >= 0 && idx < menubar->size ()) - { - if (uimenup.is_separator ()) - { - if (idx >= 0 && !(itemflags & FL_SUBMENU)) - menubar->mode (idx, itemflags | FL_MENU_DIVIDER); - } - else - menubar->mode (idx, itemflags & (~FL_MENU_DIVIDER)); - } - } - } - - void update_visible (uimenu::properties& uimenup) - { - std::string fltk_label = uimenup.get_fltk_label (); - if (!fltk_label.empty ()) - { - Fl_Menu_Item* item - = const_cast (menubar->find_item (fltk_label.c_str ())); - if (item != NULL) - { - if (uimenup.is_visible ()) - item->show (); - else - item->hide (); - } - } - } - - void add_entry (uimenu::properties& uimenup) - { - - std::string fltk_label = uimenup.get_fltk_label (); - - if (!fltk_label.empty ()) - { - bool item_added = false; - do - { - const Fl_Menu_Item* item - = menubar->find_item (fltk_label.c_str ()); - - if (item == NULL) - { - Matrix uimenu_ch = find_uimenu_children (uimenup); - int len = uimenu_ch.numel (); - int flags = 0; - if (len > 0) - flags = FL_SUBMENU; - if (len == 0 && uimenup.is_checked ()) - flags += FL_MENU_TOGGLE + FL_MENU_VALUE; - menubar->add (fltk_label.c_str (), 0, 0, 0, flags); - item_added = true; - } - else - { - //avoid duplicate menulabels - std::size_t idx1 = fltk_label.find_last_of ("("); - std::size_t idx2 = fltk_label.find_last_of (")"); - int len = idx2 - idx1; - int val = 1; - if (len > 0) - { - std::string valstr = fltk_label.substr (idx1 + 1, len - 1); - fltk_label.erase (idx1, len + 1); - val = atoi (valstr.c_str ()); - if (val > 0 && val < 99) - val++; - } - std::ostringstream valstream; - valstream << val; - fltk_label += "(" + valstream.str () + ")"; - } - } - while (!item_added); - uimenup.set_fltk_label (fltk_label); - } - } - - void add_to_menu (uimenu::properties& uimenup) - { - Matrix kids = find_uimenu_children (uimenup); - int len = kids.length (); - std::string fltk_label = uimenup.get_fltk_label (); - - add_entry (uimenup); - update_foregroundcolor (uimenup); - update_callback (uimenup); - update_accelerator (uimenup); - update_enable (uimenup); - update_visible (uimenup); - update_seperator (uimenup); - - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - if (kgo.valid_object ()) - { - uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); - add_to_menu (kprop); - } - } - } - - void add_to_menu (figure::properties& figp) - { - Matrix kids = find_uimenu_children (figp); - int len = kids.length (); - menubar->clear (); - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - - if (kgo.valid_object ()) - { - uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); - add_to_menu (kprop); - } - } - } - - template - void remove_from_menu (T_prop& prop) - { - Matrix kids; - std::string type = prop.get_type (); - kids = find_uimenu_children (prop); - int len = kids.length (); - - for (octave_idx_type ii = 0; ii < len; ii++) - { - graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); - - if (kgo.valid_object ()) - { - uimenu::properties kprop = dynamic_cast (kgo.get_properties ()); - remove_from_menu (kprop); - } - } - - if (type.compare ("uimenu") == 0) - delete_entry (dynamic_cast (prop)); - else if (type.compare ("figure") == 0) - menubar->clear (); - } - - ~fltk_uimenu (void) - { - delete menubar; - } - -private: - - // No copying! - - fltk_uimenu (const fltk_uimenu&); - - fltk_uimenu operator = (const fltk_uimenu&); - - Fl_Menu_Bar* menubar; -}; - -class plot_window : public Fl_Window -{ - friend class fltk_uimenu; -public: - plot_window (int xx, int yy, int ww, int hh, figure::properties& xfp) - : Fl_Window (xx, yy, ww, hh, "octave"), window_label (), shift (0), - ndim (2), fp (xfp), canvas (0), autoscale (0), togglegrid (0), - panzoom (0), rotate (0), help (0), status (0), - ax_obj (), pos_x (0), pos_y (0) - { - callback (window_close, static_cast (this)); - size_range (4*status_h, 2*status_h); - - // FIXME: The function below is only available in FLTK >= 1.3 - // At some point support for FLTK 1.1 will be dropped in Octave. - // At that point this function should be uncommented. - // The current solution is to call xclass() before show() for each window. - // Set WM_CLASS which allows window managers to properly group related - // windows. Otherwise, the class is just "FLTK" - //default_xclass ("Octave"); - - begin (); - { - - canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); - - uimenu = new fltk_uimenu (0, 0, ww, menu_h); - uimenu->hide (); - - bottom = new Fl_Box (0, hh - status_h, ww, status_h); - bottom->box (FL_FLAT_BOX); - - ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - - autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); - autoscale->callback (button_callback, static_cast (this)); - autoscale->tooltip ("Autoscale"); - - togglegrid = new Fl_Button (status_h, hh - status_h, status_h, - status_h, "G"); - togglegrid->callback (button_callback, static_cast (this)); - togglegrid->tooltip ("Toggle Grid"); - - panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, - status_h, "P"); - panzoom->callback (button_callback, static_cast (this)); - panzoom->tooltip ("Mouse Pan/Zoom"); - - rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, - status_h, "R"); - rotate->callback (button_callback, static_cast (this)); - rotate->tooltip ("Mouse Rotate"); - - if (ndim == 2) - rotate->deactivate (); - - help = new Fl_Button (4 * status_h, hh - status_h, status_h, - status_h, "?"); - help->callback (button_callback, static_cast (this)); - help->tooltip ("Help"); - - status = new Fl_Output (5 * status_h, hh - status_h, - ww > 2*status_h ? ww - status_h : 0, - status_h, ""); - - status->textcolor (FL_BLACK); - status->color (FL_GRAY); - status->textfont (FL_COURIER); - status->textsize (10); - status->box (FL_ENGRAVED_BOX); - - // This allows us to have a valid OpenGL context right away. - canvas->mode (FL_DEPTH | FL_DOUBLE ); - if (fp.is_visible ()) - { - // FIXME: This code should be removed when Octave drops support - // for FLTK 1.1. Search for default_xclass in this file to find - // code that should be uncommented to take its place. - // - // Set WM_CLASS which allows window managers to properly group - // related windows. Otherwise, the class is just "FLTK" - xclass ("Octave"); - show (); - if (fp.get_currentaxes ().ok ()) - show_canvas (); - else - hide_canvas (); - } - } - end (); - - status->show (); - autoscale->show (); - togglegrid->show (); - panzoom->show (); - rotate->show (); - - set_name (); - resizable (canvas); - gui_mode = (ndim == 3 ? rotate_zoom : pan_zoom); - uimenu->add_to_menu (fp); - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); - } - - ~plot_window (void) - { - canvas->hide (); - status->hide (); - uimenu->hide (); - this->hide (); - } - - double number (void) { return fp.get___myhandle__ ().value (); } - - void renumber (double new_number) - { - if (canvas) - { - if (canvas->renumber (new_number)) - mark_modified (); - } - else - error ("unable to renumber figure"); - } - - void print (const std::string& cmd, const std::string& term) - { - canvas->print (cmd, term); - - // Print immediately so the output file will exist when the drawnow - // command is done. - mark_modified (); - Fl::wait (fltk_maxtime); - } - - void show_menubar (void) - { - if (!uimenu->is_visible ()) - { - canvas->resize (canvas->x (), - canvas->y () + menu_h, - canvas->w (), - canvas->h () - menu_h); - uimenu->show (); - mark_modified (); - } - } - - void hide_menubar (void) - { - if (uimenu->is_visible ()) - { - canvas->resize (canvas->x (), - canvas->y () - menu_h, - canvas->w (), - canvas->h () + menu_h); - uimenu->hide (); - mark_modified (); - } - } - - void uimenu_update (const graphics_handle& gh, int id) - { - graphics_object uimenu_obj = gh_manager::get_object (gh); - - if (uimenu_obj.valid_object () && uimenu_obj.isa ("uimenu")) - { - uimenu::properties& uimenup = - dynamic_cast (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_fltk_label (); - graphics_object fig = uimenu_obj.get_ancestor ("figure"); - figure::properties& figp = - dynamic_cast (fig.get_properties ()); - - switch (id) - { - case base_properties::ID_BEINGDELETED: - uimenu->remove_from_menu (uimenup); - break; - - case base_properties::ID_VISIBLE: - uimenu->update_visible (uimenup); - break; - - case uimenu::properties::ID_ACCELERATOR: - uimenu->update_accelerator (uimenup); - break; - - case uimenu::properties::ID_CALLBACK: - uimenu->update_callback (uimenup); - break; - - case uimenu::properties::ID_CHECKED: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_ENABLE: - uimenu->update_enable (uimenup); - break; - - case uimenu::properties::ID_FOREGROUNDCOLOR: - uimenu->update_foregroundcolor (uimenup); - break; - - case uimenu::properties::ID_LABEL: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_POSITION: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - - case uimenu::properties::ID_SEPARATOR: - uimenu->update_seperator (uimenup); - break; - } - - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); - - mark_modified (); - } - } - - void show_canvas (void) - { - if (fp.is_visible ()) - { - canvas->show (); - canvas->make_current (); - } - } - - void hide_canvas (void) - { - canvas->hide (); - } - - void mark_modified (void) - { - damage (FL_DAMAGE_ALL); - canvas->damage (FL_DAMAGE_ALL); - ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - - if (ndim == 3) - rotate->activate (); - else if (ndim == 2 && gui_mode == rotate_zoom) - { - rotate->deactivate (); - gui_mode = pan_zoom; - } - } - - void set_name (void) - { - window_label = fp.get_title (); - label (window_label.c_str ()); - } - -private: - - // No copying! - - plot_window (const plot_window&); - - plot_window& operator = (const plot_window&); - - // window name -- this must exists for the duration of the window's - // life - std::string window_label; - - // Mod keys status - int shift; - - // Number of dimensions, 2 or 3. - int ndim; - - // Figure properties. - figure::properties& fp; - - // Status area height. - static const int status_h = 20; - - // Menu height - static const int menu_h = 20; - - // Window callback. - static void window_close (Fl_Widget*, void* data) - { - octave_value_list args; - args(0) = static_cast (data)->number (); - feval ("close", args); - } - - // Button callbacks. - static void button_callback (Fl_Widget* ww, void* data) - { - static_cast (data)->button_press (ww, data); - } - - void button_press (Fl_Widget* widg, void*) - { - if (widg == autoscale) - axis_auto (); - - if (widg == togglegrid) - toggle_grid (); - - if (widg == panzoom) - gui_mode = pan_zoom; - - if (widg == rotate && ndim == 3) - gui_mode = rotate_zoom; - - if (widg == help) - fl_message ("%s", help_text); - } - - fltk_uimenu* uimenu; - OpenGL_fltk* canvas; - Fl_Box* bottom; - Fl_Button* autoscale; - Fl_Button* togglegrid; - Fl_Button* panzoom; - Fl_Button* rotate; - Fl_Button* help; - Fl_Output* status; - graphics_object ax_obj; - int pos_x; - int pos_y; - - void axis_auto (void) - { - octave_value_list args; - args(0) = fp.get_currentaxes ().as_octave_value (); - args(1) = "auto"; - feval ("axis", args); - mark_modified (); - } - - void toggle_grid (void) - { - octave_value_list args; - if (fp.get_currentaxes ().ok ()) - args(0) = fp.get_currentaxes ().as_octave_value (); - - feval ("grid", args); - mark_modified (); - } - - void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, - double& yy) const - { - pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); - } - - void pixel2pos (graphics_object ax, int px, int py, double& xx, - double& yy) const - { - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - ColumnVector pp = ap.pixel2coord (px, py); - xx = pp(0); - yy = pp(1); - } - } - - graphics_handle pixel2axes_or_ca (int px, int py ) - { - Matrix kids = fp.get_children (); - int len = kids.length (); - - for (int k = 0; k < len; k++) - { - graphics_handle hnd = gh_manager::lookup (kids(k)); - - if (hnd.ok ()) - { - graphics_object kid = gh_manager::get_object (hnd); - - if (kid.valid_object () && kid.isa ("axes")) - { - Matrix bb = kid.get_properties ().get_boundingbox (true); - - if (bb(0) <= px && px < (bb(0)+bb(2)) - && bb(1) <= py && py < (bb(1)+bb(3))) - { - return hnd; - } - } - } - } - return fp.get_currentaxes (); - } - - void pixel2status (const graphics_handle& ax, int px0, int py0, - int px1 = -1, int py1 = -1) - { - pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); - } - - void pixel2status (graphics_object ax, int px0, int py0, - int px1 = -1, int py1 = -1) - { - double x0, y0, x1, y1; - std::stringstream cbuf; - cbuf.precision (4); - cbuf.width (6); - pixel2pos (ax, px0, py0, x0, y0); - cbuf << "[" << x0 << ", " << y0 << "]"; - if (px1 >= 0) - { - pixel2pos (ax, px1, py1, x1, y1); - cbuf << " -> ["<< x1 << ", " << y1 << "]"; - } - - status->value (cbuf.str ().c_str ()); - status->redraw (); - } - - void view2status (graphics_object ax) - { - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - std::stringstream cbuf; - cbuf.precision (4); - cbuf.width (6); - Matrix v (1,2,0); - v = ap.get ("view").matrix_value (); - cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; - - status->value (cbuf.str ().c_str ()); - status->redraw (); - } - } - - void set_currentpoint (int px, int py) - { - if (!fp.is_beingdeleted ()) - { - Matrix pos (1,2,0); - pos(0) = px; - pos(1) = h () - status_h - menu_h - py; - fp.set_currentpoint (pos); - } - } - - void set_axes_currentpoint (graphics_object ax, int px, int py) - { - if (ax.valid_object ()) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - - double xx, yy; - pixel2pos (ax, px, py, xx, yy); - - Matrix pos (2,3,0); - pos(0,0) = xx; - pos(1,0) = yy; - pos(0,1) = xx; - pos(1,1) = yy; - - ap.set_currentpoint (pos); - } - } - - int key2shift (int key) - { - if (key == FL_Shift_L || key == FL_Shift_R) - return FL_SHIFT; - - if (key == FL_Control_L || key == FL_Control_R) - return FL_CTRL; - - if (key == FL_Alt_L || key == FL_Alt_R) - return FL_ALT; - - if (key == FL_Meta_L || key == FL_Meta_R) - return FL_META; - - return 0; - } - - int key2ascii (int key) - { - if (key < 256) return key; - if (key == FL_Tab) return '\t'; - if (key == FL_Enter) return 0x0a; - if (key == FL_BackSpace) return 0x08; - if (key == FL_Escape) return 0x1b; - - return 0; - } - - Cell modifier2cell () - { - string_vector mod; - - if (shift & FL_SHIFT) - mod.append (std::string ("shift")); - if (shift & FL_CTRL) - mod.append (std::string ("control")); - if (shift & FL_ALT || shift & FL_META) - mod.append (std::string ("alt")); - - return Cell (mod); - } - - void resize (int xx,int yy,int ww,int hh) - { - Fl_Window::resize (xx, yy, ww, hh); - - Matrix pos (1,4,0); - pos(0) = xx; - pos(1) = yy; - pos(2) = ww; - pos(3) = hh - status_h - menu_h; - - fp.set_boundingbox (pos, true); - } - - void draw (void) - { - Matrix pos = fp.get_boundingbox (true); - Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); - - return Fl_Window::draw (); - } - - int handle (int event) - { - graphics_handle gh; - - graphics_object fig = gh_manager::get_object (fp.get___myhandle__ ()); - int retval = Fl_Window::handle (event); - - // We only handle events which are in the canvas area. - if (!Fl::event_inside (canvas)) - return retval; - - if (!fp.is_beingdeleted ()) - { - switch (event) - { - case FL_KEYDOWN: - { - int key = Fl::event_key (); - - shift |= key2shift (key); - int key_a = key2ascii (key); - if (key_a && fp.get_keypressfcn ().is_defined ()) - { - Octave_map evt; - evt.assign ("Character", octave_value (key_a)); - evt.assign ("Key", octave_value (std::tolower (key_a))); - evt.assign ("Modifier", octave_value (modifier2cell ())); - fp.execute_keypressfcn (evt); - } - switch (key) - { - case 'a': - case 'A': - axis_auto (); - break; - - case 'g': - case 'G': - toggle_grid (); - break; - - case 'p': - case 'P': - gui_mode = pan_zoom; - break; - - case 'r': - case 'R': - gui_mode = rotate_zoom; - break; - } - } - break; - - case FL_KEYUP: - { - int key = Fl::event_key (); - - shift &= (~key2shift (key)); - int key_a = key2ascii (key); - if (key_a && fp.get_keyreleasefcn ().is_defined ()) - { - Octave_map evt; - evt.assign ("Character", octave_value (key_a)); - evt.assign ("Key", octave_value (std::tolower (key_a))); - evt.assign ("Modifier", octave_value (modifier2cell ())); - fp.execute_keyreleasefcn (evt); - } - } - break; - - case FL_MOVE: - pixel2status (pixel2axes_or_ca (Fl::event_x (), Fl::event_y ()), - Fl::event_x (), Fl::event_y ()); - break; - - case FL_PUSH: - pos_x = Fl::event_x (); - pos_y = Fl::event_y (); - - set_currentpoint (Fl::event_x (), Fl::event_y ()); - - gh = pixel2axes_or_ca (pos_x, pos_y); - - if (gh.ok ()) - { - ax_obj = gh_manager::get_object (gh); - set_axes_currentpoint (ax_obj, pos_x, pos_y); - } - - fp.execute_windowbuttondownfcn (); - - if (Fl::event_button () == 1 || Fl::event_button () == 3) - return 1; - - break; - - case FL_DRAG: - if (fp.get_windowbuttonmotionfcn ().is_defined ()) - { - set_currentpoint (Fl::event_x (), Fl::event_y ()); - fp.execute_windowbuttonmotionfcn (); - } - - if (Fl::event_button () == 1) - { - if (ax_obj && ax_obj.isa ("axes")) - { - if (gui_mode == pan_zoom) - pixel2status (ax_obj, pos_x, pos_y, - Fl::event_x (), Fl::event_y ()); - else - view2status (ax_obj); - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - - double x0, y0, x1, y1; - Matrix pos = fp.get_boundingbox (true); - pixel2pos (ax_obj, pos_x, pos_y, x0, y0); - pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), x1, y1); - - if (gui_mode == pan_zoom) - ap.translate_view (x0, x1, y0, y1); - else if (gui_mode == rotate_zoom) - { - double daz, del; - daz = (Fl::event_x () - pos_x) / pos(2) * 360; - del = (Fl::event_y () - pos_y) / pos(3) * 360; - ap.rotate_view (del, daz); - } - - pos_x = Fl::event_x (); - pos_y = Fl::event_y (); - mark_modified (); - } - return 1; - } - else if (Fl::event_button () == 3) - { - pixel2status (ax_obj, pos_x, pos_y, - Fl::event_x (), Fl::event_y ()); - Matrix zoom_box (1,4,0); - zoom_box (0) = pos_x; - zoom_box (1) = pos_y; - zoom_box (2) = Fl::event_x (); - zoom_box (3) = Fl::event_y (); - canvas->set_zoom_box (zoom_box); - canvas->zoom (true); - canvas->redraw (); - } - - break; - - case FL_MOUSEWHEEL: - { - graphics_object ax = - gh_manager::get_object (pixel2axes_or_ca (Fl::event_x (), - Fl::event_y ())); - if (ax && ax.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax.get_properties ()); - - // Determine if we're zooming in or out. - const double factor = - (Fl::event_dy () > 0) ? 1.0 + wheel_zoom_speed : 1.0 - wheel_zoom_speed; - - // Get the point we're zooming about. - double x1, y1; - pixel2pos (ax, Fl::event_x (), Fl::event_y (), x1, y1); - - ap.zoom_about_point (x1, y1, factor, false); - mark_modified (); - } - } - return 1; - - case FL_RELEASE: - if (fp.get_windowbuttonupfcn ().is_defined ()) - { - set_currentpoint (Fl::event_x (), Fl::event_y ()); - fp.execute_windowbuttonupfcn (); - } - - if (Fl::event_button () == 1) - { - if ( Fl::event_clicks () == 1) - { - if (ax_obj && ax_obj.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - ap.set_xlimmode ("auto"); - ap.set_ylimmode ("auto"); - ap.set_zlimmode ("auto"); - mark_modified (); - } - } - } - if (Fl::event_button () == 3) - { - // End of drag -- zoom. - if (canvas->zoom ()) - { - canvas->zoom (false); - double x0,y0,x1,y1; - if (ax_obj && ax_obj.isa ("axes")) - { - axes::properties& ap = - dynamic_cast (ax_obj.get_properties ()); - pixel2pos (ax_obj, pos_x, pos_y, x0, y0); - int pos_x1 = Fl::event_x (); - int pos_y1 = Fl::event_y (); - pixel2pos (ax_obj, pos_x1, pos_y1, x1, y1); - Matrix xl (1,2,0); - Matrix yl (1,2,0); - int dx = abs (pos_x - pos_x1); - int dy = abs (pos_y - pos_y1); - // Smallest zoom box must be 4 pixels square - if ((dx > 4) && (dy > 4)) - { - if (x0 < x1) - { - xl(0) = x0; - xl(1) = x1; - } - else - { - xl(0) = x1; - xl(1) = x0; - } - if (y0 < y1) - { - yl(0) = y0; - yl(1) = y1; - } - else - { - yl(0) = y1; - yl(1) = y0; - } - ap.zoom (xl, yl); - } - mark_modified (); - } - } - } - break; - } - } - - return retval; - } -}; - -class figure_manager -{ -public: - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - instance = new figure_manager (); - - if (! instance) - { - ::error ("unable to create figure_manager object!"); - - retval = false; - } - - return retval; - } - - ~figure_manager (void) - { - close_all (); - } - - static void close_all (void) - { - if (instance_ok ()) - instance->do_close_all (); - } - - static void new_window (figure::properties& fp) - { - if (instance_ok ()) - instance->do_new_window (fp); - } - - static void delete_window (int idx) - { - if (instance_ok ()) - instance->do_delete_window (idx); - } - - static void delete_window (const std::string& idx_str) - { - delete_window (str2idx (idx_str)); - } - - static void renumber_figure (const std::string& idx_str, double new_number) - { - if (instance_ok ()) - instance->do_renumber_figure (str2idx (idx_str), new_number); - } - - static void toggle_window_visibility (int idx, bool is_visible) - { - if (instance_ok ()) - instance->do_toggle_window_visibility (idx, is_visible); - } - - static void toggle_window_visibility (const std::string& idx_str, - bool is_visible) - { - toggle_window_visibility (str2idx (idx_str), is_visible); - } - - static void mark_modified (int idx) - { - if (instance_ok ()) - instance->do_mark_modified (idx); - } - - static void mark_modified (const graphics_handle& gh) - { - mark_modified (hnd2idx (gh)); - } - - static void set_name (int idx) - { - if (instance_ok ()) - instance->do_set_name (idx); - } - - static void set_name (const std::string& idx_str) - { - set_name (str2idx (idx_str)); - } - - static Matrix get_size (int idx) - { - return instance_ok () ? instance->do_get_size (idx) : Matrix (); - } - - static Matrix get_size (const graphics_handle& gh) - { - return get_size (hnd2idx (gh)); - } - - static void print (const graphics_handle& gh, const std::string& cmd, - const std::string& term) - { - if (instance_ok ()) - instance->do_print (hnd2idx (gh), cmd, term); - } - - static void uimenu_update (const graphics_handle& figh, - const graphics_handle& uimenuh, int id) - { - if (instance_ok ()) - instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); - } - - static void update_canvas (const graphics_handle& gh, - const graphics_handle& ca) - { - if (instance_ok ()) - instance->do_update_canvas (hnd2idx (gh), ca); - } - - static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) - { - if (instance_ok ()) - instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); - } - - static void toggle_menubar_visibility (const std::string& fig_idx_str, - bool menubar_is_figure) - { - toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); - } - -private: - - static figure_manager *instance; - - figure_manager (void) { } - - // No copying! - figure_manager (const figure_manager&); - figure_manager& operator = (const figure_manager&); - - // Singelton -- hide all of the above. - - static int curr_index; - typedef std::map window_map; - typedef window_map::iterator wm_iterator;; - window_map windows; - - static std::string fltk_idx_header; - - void do_close_all (void) - { - wm_iterator win; - for (win = windows.begin (); win != windows.end (); win++) - delete win->second; - windows.clear (); - } - - void do_new_window (figure::properties& fp) - { - int idx = figprops2idx (fp); - - if (idx >= 0 && windows.find (idx) == windows.end ()) - { - Matrix pos = fp.get_boundingbox (true); - - int x = pos(0); - int y = pos(1); - int w = pos(2); - int h = pos(3); - - idx2figprops (curr_index, fp); - - windows[curr_index++] = new plot_window (x, y, w, h, fp); - } - } - - void do_delete_window (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - delete win->second; - windows.erase (win); - } - } - - void do_renumber_figure (int idx, double new_number) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->renumber (new_number); - } - - void do_toggle_window_visibility (int idx, bool is_visible) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - if (is_visible) - win->second->show (); - else - win->second->hide (); - - win->second->redraw (); - } - } - - void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) - { - wm_iterator win = windows.find (fig_idx); - - if (win != windows.end ()) - { - if (menubar_is_figure) - win->second->show_menubar (); - else - win->second->hide_menubar (); - - win->second->redraw (); - } - } - - void do_mark_modified (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->mark_modified (); - } - - void do_set_name (int idx) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->set_name (); - } - - Matrix do_get_size (int idx) - { - Matrix sz (1, 2, 0.0); - - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - sz(0) = win->second->w (); - sz(1) = win->second->h (); - } - - return sz; - } - - void do_print (int idx, const std::string& cmd, const std::string& term) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->print (cmd, term); - } - - void do_uimenu_update (int idx, const graphics_handle& gh, int id) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - win->second->uimenu_update (gh, id); - } - - void do_update_canvas (int idx, const graphics_handle& ca) - { - wm_iterator win = windows.find (idx); - - if (win != windows.end ()) - { - if (ca.ok ()) - win->second->show_canvas (); - else - win->second->hide_canvas (); - } - } - - static int str2idx (const caseless_str& clstr) - { - int ind; - if (clstr.find (fltk_idx_header,0) == 0) - { - std::istringstream istr (clstr.substr (fltk_idx_header.size ())); - if (istr >> ind) - return ind; - } - error ("figure_manager: could not recognize fltk index"); - return -1; - } - - void idx2figprops (int idx, figure::properties& fp) - { - std::ostringstream ind_str; - ind_str << fltk_idx_header << idx; - fp.set___plot_stream__ (ind_str.str ()); - } - - static int figprops2idx (const figure::properties& fp) - { - if (fp.get___graphics_toolkit__ () == FLTK_GRAPHICS_TOOLKIT_NAME) - { - octave_value ps = fp.get___plot_stream__ (); - if (ps.is_string ()) - return str2idx (ps.string_value ()); - else - return 0; - } - error ("figure_manager: figure is not fltk"); - return -1; - } - - static int hnd2idx (double h) - { - graphics_object fobj = gh_manager::get_object (h); - if (fobj && fobj.isa ("figure")) - { - figure::properties& fp = - dynamic_cast (fobj.get_properties ()); - return figprops2idx (fp); - } - error ("figure_manager: H (= %g) is not a figure", h); - return -1; - } - - static int hnd2idx (const graphics_handle& fh) - { - return hnd2idx (fh.value ()); - } -}; - -figure_manager *figure_manager::instance = 0; - -std::string figure_manager::fltk_idx_header="fltk index="; -int figure_manager::curr_index = 1; - -static bool toolkit_loaded = false; - -static int -__fltk_redraw__ (void) -{ - if (toolkit_loaded) - { - // We scan all figures and add those which use FLTK. - graphics_object obj = gh_manager::get_object (0); - if (obj && obj.isa ("root")) - { - base_properties& props = obj.get_properties (); - Matrix children = props.get_all_children (); - - for (octave_idx_type n = 0; n < children.numel (); n++) - { - graphics_object fobj = gh_manager::get_object (children (n)); - if (fobj && fobj.isa ("figure")) - { - figure::properties& fp = - dynamic_cast (fobj.get_properties ()); - if (fp.get___graphics_toolkit__ () - == FLTK_GRAPHICS_TOOLKIT_NAME) - figure_manager::new_window (fp); - } - } - } - - // it seems that we have to call Fl::check twice to get everything drawn - Fl::check (); - Fl::check (); - } - - return 0; -} - -class fltk_graphics_toolkit : public base_graphics_toolkit -{ -public: - fltk_graphics_toolkit (void) - : base_graphics_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME) { } - - ~fltk_graphics_toolkit (void) { } - - bool is_valid (void) const { return true; } - - bool initialize (const graphics_object& go) - { return go.isa ("figure"); } - - void finalize (const graphics_object& go) - { - if (go.isa ("figure")) - { - octave_value ov = go.get (caseless_str ("__plot_stream__")); - - if (! ov.is_empty ()) - figure_manager::delete_window (ov.string_value ()); - } - } - - void uimenu_set_fltk_label (graphics_object uimenu_obj) - { - if (uimenu_obj.valid_object ()) - { - uimenu::properties& uimenup = - dynamic_cast (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_label (); - graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); - if (go.isa ("uimenu")) - fltk_label = dynamic_cast (go.get_properties ()).get_fltk_label () - + "/" - + fltk_label; - else if (go.isa ("figure")) - ; - else - error ("unexpected parent object\n"); - - uimenup.set_fltk_label (fltk_label); - } - } - - void update (const graphics_object& go, int id) - { - if (go.isa ("figure")) - { - octave_value ov = go.get (caseless_str ("__plot_stream__")); - - if (! ov.is_empty ()) - { - const figure::properties& fp = - dynamic_cast (go.get_properties ()); - - switch (id) - { - case base_properties::ID_VISIBLE: - figure_manager::toggle_window_visibility - (ov.string_value (), fp.is_visible ()); - break; - - case figure::properties::ID_MENUBAR: - figure_manager::toggle_menubar_visibility - (ov.string_value (), fp.menubar_is ("figure")); - break; - - case figure::properties::ID_CURRENTAXES: - figure_manager::update_canvas - (go.get_handle (), fp.get_currentaxes ()); - break; - - case figure::properties::ID_NAME: - case figure::properties::ID_NUMBERTITLE: - figure_manager::set_name (ov.string_value ()); - break; - - case figure::properties::ID_INTEGERHANDLE: - { - std::string tmp = ov.string_value (); - graphics_handle gh = fp.get___myhandle__ (); - figure_manager::renumber_figure (tmp, gh.value ()); - figure_manager::set_name (tmp); - } - break; - } - } - } - else if (go.isa ("uimenu")) - { - if (id == uimenu::properties::ID_LABEL) - uimenu_set_fltk_label (go); - - graphics_object fig = go.get_ancestor ("figure"); - figure_manager::uimenu_update (fig.get_handle (), go.get_handle (), id); - } - } - - void redraw_figure (const graphics_object& go) const - { - figure_manager::mark_modified (go.get_handle ()); - - __fltk_redraw__ (); - } - - void print_figure (const graphics_object& go, - const std::string& term, - const std::string& file_cmd, bool /*mono*/, - const std::string& /*debug_file*/) const - { - figure_manager::print (go.get_handle (), file_cmd, term); - redraw_figure (go); - } - - Matrix get_canvas_size (const graphics_handle& fh) const - { - return figure_manager::get_size (fh); - } - - double get_screen_resolution (void) const - { - // FLTK doesn't give this info. - return 72.0; - } - - Matrix get_screen_size (void) const - { - Matrix sz (1, 2, 0.0); - sz(0) = Fl::w (); - sz(1) = Fl::h (); - return sz; - } - - void close (void) - { - if (toolkit_loaded) - { - munlock ("__init_fltk__"); - - figure_manager::close_all (); - gtk_manager::unload_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); - toolkit_loaded = false; - - octave_value_list args; - args(0) = "__fltk_redraw__"; - feval ("remove_input_event_hook", args, 0); - - // FIXME ??? - Fl::wait (fltk_maxtime); - } - } -}; - -// Initialize the fltk graphics toolkit. - -DEFUN_DLD (__init_fltk__, , , "") -{ - if (! toolkit_loaded) - { - mlock (); - - graphics_toolkit tk (new fltk_graphics_toolkit ()); - gtk_manager::load_toolkit (tk); - toolkit_loaded = true; - - octave_value_list args; - args(0) = "__fltk_redraw__"; - feval ("add_input_event_hook", args, 0); - } - - octave_value retval; - return retval; -} - -DEFUN_DLD (__fltk_redraw__, , , "") -{ - __fltk_redraw__ (); - - return octave_value (); -} - -DEFUN_DLD (__fltk_maxtime__, args, ,"") -{ - octave_value retval = fltk_maxtime; - - if (args.length () == 1) - { - if (args(0).is_real_scalar ()) - fltk_maxtime = args(0).double_value (); - else - error ("argument must be a real scalar"); - } - - return retval; -} - -#endif - -// FIXME -- This function should be abstracted and made potentially -// available to all graphics toolkits. This suggests putting it in -// graphics.cc as is done for drawnow() and having the master -// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same -// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), -// just changing function names and docstrings. - -DEFUN_DLD (mouse_wheel_zoom, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{speed} =} mouse_wheel_zoom ()\n\ -@deftypefnx {Built-in Function} {} mouse_wheel_zoom (@var{speed})\n\ -Query or set the mouse wheel zoom factor.\n\ -\n\ -This function is currently implemented only for the FLTK graphics toolkit.\n\ -@seealso{gui_mode}\n\ -@end deftypefn") -{ -#if defined (HAVE_FLTK) - octave_value retval = wheel_zoom_speed; - - if (args.length () == 1) - { - if (args(0).is_real_scalar ()) - wheel_zoom_speed = args(0).double_value (); - else - error ("mouse_wheel_zoom: SPEED must be a real scalar"); - } - - return retval; -#else - error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); - return octave_value (); -#endif -} - -DEFUN_DLD (gui_mode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{mode} =} gui_mode ()\n\ -@deftypefnx {Built-in Function} {} gui_mode (@var{mode})\n\ -Query or set the GUI mode for the current graphics toolkit.\n\ -The @var{mode} argument can be one of the following strings:\n\ -\n\ -@table @asis\n\ -@item '2d'\n\ -Allows panning and zooming of current axes.\n\ -\n\ -@item '3d'\n\ -Allows rotating and zooming of current axes.\n\ -\n\ -@item 'none'\n\ -Mouse inputs have no effect.\n\ -@end table\n\ -\n\ -This function is currently implemented only for the FLTK graphics toolkit.\n\ -@seealso{mouse_wheel_zoom}\n\ -@end deftypefn") -{ -#if defined (HAVE_FLTK) - caseless_str mode_str; - - if (gui_mode == pan_zoom) - mode_str = "2d"; - else if (gui_mode == rotate_zoom) - mode_str = "3d"; - else - mode_str = "none"; - - bool failed = false; - - if (args.length () == 1) - { - if (args(0).is_string ()) - { - mode_str = args(0).string_value (); - - if (mode_str.compare ("2d")) - gui_mode = pan_zoom; - else if (mode_str.compare ("3d")) - gui_mode = rotate_zoom; - else if (mode_str.compare ("none")) - gui_mode = none; - else - failed = true; - } - else - failed = true; - } - - if (failed) - error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); - - return octave_value (mode_str); -#else - error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); - return octave_value (); -#endif -} - diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__init_gnuplot__.cc --- a/src/DLD-FUNCTIONS/__init_gnuplot__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,193 +0,0 @@ -/* - -Copyright (C) 2007-2012 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 3 of the License, 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, see -. - -*/ - -/* - -To initialize: - - graphics_toolkit ("gnuplot"); - plot (randn (1e3, 1)); - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" -#include "graphics.h" -#include "parse.h" -#include "variables.h" - -// PKG_ADD: register_graphics_toolkit ("gnuplot"); - -static bool toolkit_loaded = false; - -class gnuplot_graphics_toolkit : public base_graphics_toolkit -{ -public: - gnuplot_graphics_toolkit (void) - : base_graphics_toolkit ("gnuplot") { } - - ~gnuplot_graphics_toolkit (void) { } - - bool is_valid (void) const { return true; } - - bool initialize (const graphics_object& go) - { - return go.isa ("figure"); - } - - void finalize (const graphics_object& go) - { - if (go.isa ("figure")) - { - const figure::properties& props = - dynamic_cast (go.get_properties ()); - - send_quit (props.get___plot_stream__ ()); - } - } - - void update (const graphics_object& go, int id) - { - if (go.isa ("figure")) - { - graphics_object obj (go); - - figure::properties& props = - dynamic_cast (obj.get_properties ()); - - switch (id) - { - case base_properties::ID_VISIBLE: - if (! props.is_visible ()) - { - send_quit (props.get___plot_stream__ ()); - props.set___plot_stream__ (Matrix ()); - props.set___enhanced__ (false); - } - break; - } - } - } - - void redraw_figure (const graphics_object& go) const - { - octave_value_list args; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file) const - { - octave_value_list args; - if (! debug_file.empty ()) - args(4) = debug_file; - args(3) = mono; - args(2) = file; - args(1) = term; - args(0) = go.get_handle ().as_octave_value (); - feval ("__gnuplot_drawnow__", args); - } - - Matrix get_canvas_size (const graphics_handle&) const - { - Matrix sz (1, 2, 0.0); - return sz; - } - - double get_screen_resolution (void) const - { return 72.0; } - - Matrix get_screen_size (void) const - { return Matrix (1, 2, 0.0); } - - void close (void) - { - if (toolkit_loaded) - { - munlock ("__init_gnuplot__"); - - gtk_manager::unload_toolkit ("gnuplot"); - - toolkit_loaded = false; - } - } - -private: - - void send_quit (const octave_value& pstream) const - { - if (! pstream.is_empty ()) - { - octave_value_list args; - Matrix fids = pstream.matrix_value (); - - if (! error_state) - { - args(1) = "\nquit;\n"; - args(0) = fids(0); - feval ("fputs", args); - - args.resize (1); - feval ("fflush", args); - feval ("pclose", args); - - if (fids.numel () > 1) - { - args(0) = fids(1); - feval ("pclose", args); - - if (fids.numel () > 2) - { - args(0) = fids(2); - feval ("waitpid", args); - } - } - } - } - } -}; - -// Initialize the fltk graphics toolkit. - -DEFUN_DLD (__init_gnuplot__, , , "") -{ - octave_value retval; - - if (! toolkit_loaded) - { - mlock (); - - graphics_toolkit tk (new gnuplot_graphics_toolkit ()); - gtk_manager::load_toolkit (tk); - - toolkit_loaded = true; - } - - return retval; -} - diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__magick_read__.cc --- a/src/DLD-FUNCTIONS/__magick_read__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1216 +0,0 @@ -/* - -Copyright (C) 2002-2012 Andy Adler -Copyright (C) 2008 Thomas L. Scofield -Copyright (C) 2010 David Grundberg - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" - -#include "defun-dld.h" -#include "error.h" -#include "ov-struct.h" - -#ifdef HAVE_MAGICK - -#include -#include - -octave_value_list -read_indexed_images (std::vector& imvec, - const Array& frameidx, bool wantalpha) -{ - octave_value_list output; - - int rows = imvec[0].baseRows (); - int columns = imvec[0].baseColumns (); - int nframes = frameidx.length (); - - dim_vector idim = dim_vector (); - idim.resize (4); - idim(0) = rows; - idim(1) = columns; - idim(2) = 1; - idim(3) = nframes; - - Array idx (dim_vector (4, 1)); - - Magick::ImageType type = imvec[0].type (); - - unsigned int mapsize = imvec[0].colorMapSize (); - unsigned int i = mapsize; - unsigned int depth = 0; - while (i >>= 1) - depth++; - i = 0; - depth--; - while (depth >>= 1) - i++; - depth = 1 << i; - - switch (depth) - { - case 1: - case 2: - case 4: - case 8: - { - uint8NDArray im = uint8NDArray (idim); - - idx(2) = 0; - for (int frame = 0; frame < nframes; frame++) - { - imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - const Magick::IndexPacket *pix - = imvec[frameidx(frame)].getConstIndexes (); - - i = 0; - idx(3) = frame; - - for (int y = 0; y < rows; y++) - { - idx(0) = y; - for (int x = 0; x < columns; x++) - { - idx(1) = x; - im(idx) = static_cast (pix[i++]); - } - } - } - - output(0) = octave_value (im); - } - break; - - case 16: - { - uint16NDArray im = uint16NDArray (idim); - - idx(2) = 0; - for (int frame = 0; frame < nframes; frame++) - { - imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - const Magick::IndexPacket *pix - = imvec[frameidx(frame)].getConstIndexes (); - - i = 0; - idx(3) = frame; - - for (int y = 0; y < rows; y++) - { - idx(0) = y; - for (int x = 0; x < columns; x++) - { - idx(1) = x; - im(idx) = static_cast (pix[i++]); - } - } - } - - output(0) = octave_value (im); - } - break; - - default: - error ("__magic_read__: index depths greater than 16-bit are not supported"); - return octave_value_list (); - } - - Matrix map = Matrix (mapsize, 3); - Matrix alpha; - - switch (type) - { - case Magick::PaletteMatteType: -#if 0 - warning ("palettematte"); - Matrix map (mapsize, 3); - Matrix alpha (mapsize, 1); - for (i = 0; i < mapsize; i++) - { - warning ("%d", i); - Magick::ColorRGB c = imvec[0].colorMap (i); - map(i,0) = c.red (); - map(i,1) = c.green (); - map(i,2) = c.blue (); - alpha(i,1) = c.alpha (); - } - break; -#endif - - case Magick::PaletteType: - alpha = Matrix (0, 0); - for (i = 0; i < mapsize; i++) - { - Magick::ColorRGB c = imvec[0].colorMap (i); - map(i,0) = c.red (); - map(i,1) = c.green (); - map(i,2) = c.blue (); - } - break; - - default: - error ("__magick_read__: unsupported indexed image type"); - return octave_value_list (); - } - - if (wantalpha) - output(2) = alpha; - - output(1) = map; - - return output; -} - -template -octave_value_list -read_images (const std::vector& imvec, - const Array& frameidx, unsigned int depth) -{ - typedef typename T::element_type P; - - octave_value_list retval (3, Matrix ()); - - T im; - - int rows = imvec[0].baseRows (); - int columns = imvec[0].baseColumns (); - int nframes = frameidx.length (); - - dim_vector idim = dim_vector (); - idim.resize (4); - idim(0) = rows; - idim(1) = columns; - idim(2) = 1; - idim(3) = nframes; - - Magick::ImageType type = imvec[0].type (); - const int divisor = ((uint64_t (1) << QuantumDepth) - 1) / - ((uint64_t (1) << depth) - 1); - - switch (type) - { - case Magick::BilevelType: - case Magick::GrayscaleType: - { - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - pix++; - rbuf += rows; - } - rbuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::GrayscaleMatteType: - { - idim(2) = 2; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *obuf = vec + rows * columns; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *obuf = pix->opacity / divisor; - pix++; - rbuf += rows; - obuf += rows; - } - rbuf -= rows * columns - 1; - obuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::PaletteType: - case Magick::TrueColorType: - { - idim(2) = 3; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *gbuf = vec + rows * columns; - P *bbuf = vec + rows * columns * 2; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *gbuf = pix->green / divisor; - *bbuf = pix->blue / divisor; - pix++; - rbuf += rows; - gbuf += rows; - bbuf += rows; - } - rbuf -= rows * columns - 1; - gbuf -= rows * columns - 1; - bbuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - case Magick::PaletteMatteType: - case Magick::TrueColorMatteType: - case Magick::ColorSeparationType: - { - idim(2) = 4; - im = T (idim); - P *vec = im.fortran_vec (); - - for (int frame = 0; frame < nframes; frame++) - { - const Magick::PixelPacket *pix - = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); - - P *rbuf = vec; - P *gbuf = vec + rows * columns; - P *bbuf = vec + rows * columns * 2; - P *obuf = vec + rows * columns * 3; - for (int y = 0; y < rows; y++) - { - for (int x = 0; x < columns; x++) - { - *rbuf = pix->red / divisor; - *gbuf = pix->green / divisor; - *bbuf = pix->blue / divisor; - *obuf = pix->opacity / divisor; - pix++; - rbuf += rows; - gbuf += rows; - bbuf += rows; - obuf += rows; - } - rbuf -= rows * columns - 1; - gbuf -= rows * columns - 1; - bbuf -= rows * columns - 1; - obuf -= rows * columns - 1; - } - - // Next frame. - vec += rows * columns * idim(2); - } - } - break; - - default: - error ("__magick_read__: undefined ImageMagick image type"); - return retval; - } - - retval(0) = im; - - return retval; -} - -#endif - -static void -maybe_initialize_magick (void) -{ -#ifdef HAVE_MAGICK - - static bool initialized = false; - - if (! initialized) - { - // Save the locale as GraphicsMagick might change this (depending on version) - const char *static_locale = setlocale (LC_ALL, NULL); - const std::string locale (static_locale); - - std::string program_name = octave_env::get_program_invocation_name (); - - Magick::InitializeMagick (program_name.c_str ()); - - // Restore locale from before GraphicsMagick initialisation - setlocale (LC_ALL, locale.c_str ()); - - if (QuantumDepth < 32) - warning ("your version of %s limits images to %d bits per pixel", - MagickPackageName, QuantumDepth); - - initialized = true; - } -#endif -} - -DEFUN_DLD (__magick_read__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Function File} {@var{m} =} __magick_read__ (@var{fname}, @var{index})\n\ -@deftypefnx {Function File} {[@var{m}, @var{colormap}] =} __magick_read__ (@var{fname}, @var{index})\n\ -@deftypefnx {Function File} {[@var{m}, @var{colormap}, @var{alpha}] =} __magick_read__ (@var{fname}, @var{index})\n\ -Read images with ImageMagick++. In general you should not be using this\n\ -function. Instead use @code{imread}.\n\ -@seealso{imread}\n\ -@end deftypefn") -{ - octave_value_list output; - -#ifdef HAVE_MAGICK - - maybe_initialize_magick (); - - if (args.length () > 3 || args.length () < 1 || ! args(0).is_string () - || nargout > 3) - { - print_usage (); - return output; - } - - Array frameidx; - bool all_frames = false; - - if (args.length () == 2 && args(1).is_real_type ()) - frameidx = args(1).int_vector_value (); - else if (args.length () == 3 && args(1).is_string () - && args(1).string_value () == "frames") - { - if (args(2).is_string () && args(2).string_value () == "all") - all_frames = true; - else if (args(2).is_real_type ()) - frameidx = args(2).int_vector_value (); - } - else - { - frameidx = Array (dim_vector (1, 1)); - frameidx(0) = 1; - } - - std::vector imvec; - - try - { - // Read a file into vector of image objects - Magick::readImages (&imvec, args(0).string_value ()); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - return output; - } - - int nframes = imvec.size (); - if (all_frames) - { - frameidx = Array (dim_vector (1, nframes)); - for (int i = 0; i < frameidx.length (); i++) - frameidx(i) = i; - } - else - { - for (int i = 0; i < frameidx.length (); i++) - { - frameidx(i) = frameidx(i) - 1; - - if (frameidx(i) >= nframes || frameidx(i) < 0) - { - error ("__magick_read__: invalid INDEX vector"); - return output; - } - } - } - - Magick::ClassType klass = imvec[0].classType (); - - if (klass == Magick::PseudoClass && nargout > 1) - output = read_indexed_images (imvec, frameidx, (nargout == 3)); - else - { - unsigned int depth = imvec[0].modulusDepth (); - if (depth > 1) - { - --depth; - int i = 1; - while (depth >>= 1) - i++; - depth = 1 << i; - } - - switch (depth) - { - case 1: - output = read_images (imvec, frameidx, depth); - break; - - case 2: - case 4: - case 8: - output = read_images (imvec, frameidx, depth) ; - break; - - case 16: - output = read_images (imvec, frameidx, depth); - break; - - case 32: - case 64: - default: - error ("__magick_read__: image depths greater than 16-bit are not supported"); - } - } -#else - - error ("imread: image reading capabilities were disabled when Octave was compiled"); - -#endif - - return output; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#ifdef HAVE_MAGICK - -static void -jpg_settings (std::vector& imvec, - const Octave_map& options, - bool) -{ - bool something_set = false; - - // Quality setting - octave_value result; - Octave_map::const_iterator p; - bool found_it = false; - - for (p = options.begin (); p != options.end (); p++) - { - if (options.key (p) == "Quality") - { - found_it = true; - result = options.contents (p).elem (0); - break; - } - } - - if (found_it && (! result.is_empty ())) - { - something_set = true; - - if (result.is_real_type ()) - { - int qlev = result.int_value (); - - if (qlev < 0 || qlev > 100) - warning ("warning: Quality setting invalid--use default of 75"); - else - { - for (size_t fnum = 0; fnum < imvec.size (); fnum++) - imvec[fnum].quality (static_cast(qlev)); - } - } - else - warning ("warning: Quality setting invalid--use default of 75"); - } - - // Other settings go here - - if (! something_set) - warning ("__magick_write__ warning: all write parameters ignored"); -} - -static void -encode_bool_image (std::vector& imvec, const octave_value& img) -{ - unsigned int nframes = 1; - boolNDArray m = img.bool_array_value (); - - dim_vector dsizes = m.dims (); - if (dsizes.length () == 4) - nframes = dsizes(3); - - Array idx (dim_vector (dsizes.length (), 1)); - - octave_idx_type rows = m.rows (); - octave_idx_type columns = m.columns (); - - for (unsigned int ii = 0; ii < nframes; ii++) - { - Magick::Image im (Magick::Geometry (columns, rows), "black"); - im.classType (Magick::DirectClass); - im.depth (1); - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x = 0; x < rows; x++) - { - if (nframes > 1) - { - idx(2) = 0; - idx(3) = ii; - } - - idx(0) = x; - - if (m(idx)) - im.pixelColor (y, x, "white"); - } - } - - im.quantizeColorSpace (Magick::GRAYColorspace); - im.quantizeColors (2); - im.quantize (); - - imvec.push_back (im); - } -} - -template -static void -encode_uint_image (std::vector& imvec, - const octave_value& img, - bool has_map) -{ - unsigned int bitdepth = 0; - T m; - - if (img.is_uint8_type ()) - { - bitdepth = 8; - m = img.uint8_array_value (); - } - else if (img.is_uint16_type ()) - { - bitdepth = 16; - m = img.uint16_array_value (); - } - else - error ("__magick_write__: invalid image class"); - - dim_vector dsizes = m.dims (); - unsigned int nframes = 1; - if (dsizes.length () == 4) - nframes = dsizes(3); - - bool is_color = ((dsizes.length () > 2) && (dsizes(2) > 2)); - bool has_alpha = (dsizes.length () > 2 && (dsizes(2) == 2 || dsizes(2) == 4)); - - Array idx (dim_vector (dsizes.length (), 1)); - octave_idx_type rows = m.rows (); - octave_idx_type columns = m.columns (); - - unsigned int div_factor = (1 << bitdepth) - 1; - - for (unsigned int ii = 0; ii < nframes; ii++) - { - Magick::Image im (Magick::Geometry (columns, rows), "black"); - - im.depth (bitdepth); - - if (has_map) - im.classType (Magick::PseudoClass); - else - im.classType (Magick::DirectClass); - - if (is_color) - { - if (has_alpha) - im.type (Magick::TrueColorMatteType); - else - im.type (Magick::TrueColorType); - - Magick::ColorRGB c; - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x = 0; x < rows; x++) - { - idx(0) = x; - - if (nframes > 1) - idx(3) = ii; - - idx(2) = 0; - c.red (static_cast(m(idx)) / div_factor); - - idx(2) = 1; - c.green (static_cast(m(idx)) / div_factor); - - idx(2) = 2; - c.blue (static_cast(m(idx)) / div_factor); - - if (has_alpha) - { - idx(2) = 3; - c.alpha (static_cast(m(idx)) / div_factor); - } - - im.pixelColor (y, x, c); - } - } - } - else - { - if (has_alpha) - im.type (Magick::GrayscaleMatteType); - else - im.type (Magick::GrayscaleType); - - Magick::ColorGray c; - - for (int y = 0; y < columns; y++) - { - idx(1) = y; - - for (int x=0; x < rows; x++) - { - idx(0) = x; - - if (nframes > 1) - { - idx(2) = 0; - idx(3) = ii; - } - - if (has_alpha) - { - idx(2) = 1; - c.alpha (static_cast(m(idx)) / div_factor); - idx(2) = 0; - } - - c.shade (static_cast(m(idx)) / div_factor); - - im.pixelColor (y, x, c); - } - } - - im.quantizeColorSpace (Magick::GRAYColorspace); - im.quantizeColors (1 << bitdepth); - im.quantize (); - } - - imvec.push_back (im); - } -} - -static void -encode_map (std::vector& imvec, const NDArray& cmap) -{ - unsigned int mapsize = cmap.dim1 (); - - for (size_t fnum = 0; fnum < imvec.size (); fnum++) - { - imvec[fnum].colorMapSize (mapsize); - imvec[fnum].type (Magick::PaletteType); - } - - for (unsigned int ii = 0; ii < mapsize; ii++) - { - Magick::ColorRGB c (cmap(ii,0), cmap(ii,1), cmap(ii,2)); - - // FIXME -- is this case needed? - if (cmap.dim2 () == 4) - c.alpha (cmap(ii,3)); - - try - { - for_each (imvec.begin (), imvec.end (), - Magick::colorMapImage (ii, c)); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - } - } -} - -static void -write_image (const std::string& filename, const std::string& fmt, - const octave_value& img, - const octave_value& map = octave_value (), - const octave_value& params = octave_value ()) -{ - std::vector imvec; - - bool has_map = map.is_defined (); - - if (has_map) - { - error ("__magick_write__: direct saving of indexed images not currently supported; use ind2rgb and save converted image"); - return; - } - - if (img.is_bool_type ()) - encode_bool_image (imvec, img); - else if (img.is_uint8_type ()) - encode_uint_image (imvec, img, has_map); - else if (img.is_uint16_type ()) - encode_uint_image (imvec, img, has_map); - else - error ("__magick_write__: image type not supported"); - - if (! error_state && has_map) - { - NDArray cmap = map.array_value (); - - if (! error_state) - encode_map (imvec, cmap); - } - - if (! error_state && params.is_defined ()) - { - Octave_map options = params.map_value (); - - // Insert calls here to handle parameters for various image formats - if (fmt == "jpg" || fmt == "jpeg") - jpg_settings (imvec, options, has_map); - else - warning ("warning: your parameter(s) currently not supported"); - } - - try - { - Magick::writeImages (imvec.begin (), imvec.end (), fmt + ":" + filename); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - } -} - -#endif - -DEFUN_DLD (__magick_write__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img})\n\ -@deftypefnx {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img}, @var{map})\n\ -Write images with ImageMagick++. In general you should not be using this\n\ -function. Instead use @code{imwrite}.\n\ -@seealso{imread}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_MAGICK - maybe_initialize_magick (); - - int nargin = args.length (); - - if (nargin > 2) - { - std::string filename = args(0).string_value (); - - if (! error_state) - { - std::string fmt = args(1).string_value (); - - if (! error_state) - { - if (nargin > 4) - write_image (filename, fmt, args(2), args(3), args(4)); - else if (nargin > 3) - if (args(3).is_real_type ()) - write_image (filename, fmt, args(2), args(3)); - else - write_image (filename, fmt, args(2), octave_value (), args(3)); - else - write_image (filename, fmt, args(2)); - } - else - error ("__magick_write__: FMT must be string"); - } - else - error ("__magick_write__: FNAME must be a string"); - } - else - print_usage (); -#else - - error ("__magick_write__: not available in this version of Octave"); - -#endif - -return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#ifdef HAVE_MAGICK - -template -static octave_value -magick_to_octave_value (const T magick) -{ - return octave_value (magick); -} - -static octave_value -magick_to_octave_value (const Magick::EndianType magick) -{ - switch (magick) - { - case Magick::LSBEndian: - return octave_value ("little-endian"); - - case Magick::MSBEndian: - return octave_value ("big-endian"); - - default: - return octave_value ("undefined"); - } -} - -static octave_value -magick_to_octave_value (const Magick::ResolutionType magick) -{ - switch (magick) - { - case Magick::PixelsPerInchResolution: - return octave_value ("pixels per inch"); - - case Magick::PixelsPerCentimeterResolution: - return octave_value ("pixels per centimeter"); - - default: - return octave_value ("undefined"); - } -} - -static octave_value -magick_to_octave_value (const Magick::ImageType magick) -{ - switch (magick) - { - case Magick::BilevelType: - case Magick::GrayscaleType: - case Magick::GrayscaleMatteType: - return octave_value ("grayscale"); - - case Magick::PaletteType: - case Magick::PaletteMatteType: - return octave_value ("indexed"); - - case Magick::TrueColorType: - case Magick::TrueColorMatteType: - case Magick::ColorSeparationType: - return octave_value ("truecolor"); - - default: - return octave_value ("undefined"); - } -} - -// We put this in a try-block because GraphicsMagick will throw -// exceptions if a parameter isn't present in the current image. -#define GET_PARAM(NAME, OUTNAME) \ - try \ - { \ - info.contents (OUTNAME)(frame,0) = magick_to_octave_value (im.NAME ()); \ - } \ - catch (Magick::Warning& w) \ - { \ - } - -#endif - -DEFUN_DLD (__magick_finfo__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __magick_finfo__ (@var{fname})\n\ -Read image information with GraphicsMagick++. In general you should\n\ -not be using this function. Instead use @code{imfinfo}.\n\ -@seealso{imfinfo, imread}\n\ -@end deftypefn") -{ - octave_value retval; - -#ifdef HAVE_MAGICK - - maybe_initialize_magick (); - - if (args.length () < 1 || ! args (0).is_string ()) - { - print_usage (); - return retval; - } - - const std::string filename = args (0).string_value (); - - try - { - // Read the file. - std::vector imvec; - Magick::readImages (&imvec, args(0).string_value ()); - int nframes = imvec.size (); - - // Create the right size for the output. - - static const char *fields[] = - { - "Filename", - "FileModDate", - "FileSize", - "Height", - "Width", - "BitDepth", - "Format", - "LongFormat", - "XResolution", - "YResolution", - "TotalColors", - "TileName", - "AnimationDelay", - "AnimationIterations", - "ByteOrder", - "Gamma", - "Matte", - "ModulusDepth", - "Quality", - "QuantizeColors", - "ResolutionUnits", - "ColorType", - "View", - 0 - }; - - Octave_map info (string_vector (fields), dim_vector (nframes, 1)); - - file_stat fs (filename); - - std::string filetime; - - if (fs) - { - octave_localtime mtime = fs.mtime (); - - filetime = mtime.strftime ("%e-%b-%Y %H:%M:%S"); - } - else - { - std::string msg = fs.error (); - - error ("imfinfo: error reading `%s': %s", - filename.c_str (), msg.c_str ()); - - return retval; - } - - // For each frame in the image (some images contain multiple - // layers, each to be treated like a separate image). - for (int frame = 0; frame < nframes; frame++) - { - Magick::Image im = imvec[frame]; - - // Add file name and timestamp. - info.contents ("Filename")(frame,0) = filename; - info.contents ("FileModDate")(frame,0) = filetime; - - // Annoying CamelCase naming is for Matlab compatibility. - GET_PARAM (fileSize, "FileSize") - GET_PARAM (rows, "Height") - GET_PARAM (columns, "Width") - GET_PARAM (depth, "BitDepth") - GET_PARAM (magick, "Format") - GET_PARAM (format, "LongFormat") - GET_PARAM (xResolution, "XResolution") - GET_PARAM (yResolution, "YResolution") - GET_PARAM (totalColors, "TotalColors") - GET_PARAM (tileName, "TileName") - GET_PARAM (animationDelay, "AnimationDelay") - GET_PARAM (animationIterations, "AnimationIterations") - GET_PARAM (endian, "ByteOrder") - GET_PARAM (gamma, "Gamma") - GET_PARAM (matte, "Matte") - GET_PARAM (modulusDepth, "ModulusDepth") - GET_PARAM (quality, "Quality") - GET_PARAM (quantizeColors, "QuantizeColors") - GET_PARAM (resolutionUnits, "ResolutionUnits") - GET_PARAM (type, "ColorType") - GET_PARAM (view, "View") - } - - retval = octave_value (info); - } - catch (Magick::Warning& w) - { - warning ("Magick++ warning: %s", w.what ()); - } - catch (Magick::ErrorCoder& e) - { - warning ("Magick++ coder error: %s", e.what ()); - } - catch (Magick::Exception& e) - { - error ("Magick++ exception: %s", e.what ()); - return retval; - } - -#else - - error ("imfinfo: not available in this version of Octave"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ - -#undef GET_PARAM - -// Determine the file formats supported by GraphicsMagick. This is -// called once at the beginning of imread or imwrite to determine -// exactly which file formats are supported, so error messages can be -// displayed properly. - -DEFUN_DLD (__magick_format_list__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {} __magick_format_list__ (@var{formats})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - -#ifdef HAVE_MAGICK - maybe_initialize_magick (); - - std::list accepted_formats; - - if (args.length () == 1) - { - Cell c = args (0).cell_value (); - - if (! error_state) - { - for (octave_idx_type i = 0; i < c.nelem (); i++) - { - try - { - std::string fmt = c.elem (i).string_value (); - - Magick::CoderInfo info(fmt); - - if (info.isReadable () && info.isWritable ()) - accepted_formats.push_back (fmt); - } - catch (Magick::Exception& e) - { - // Do nothing: exception here are simply missing formats. - } - } - } - else - error ("__magick_format_list__: expecting a cell array of image format names"); - } - else - print_usage (); - - retval = Cell (accepted_formats); - -#else - - error ("__magick_format_list__: not available in this version of Octave"); - -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/__voronoi__.cc --- a/src/DLD-FUNCTIONS/__voronoi__.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,334 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -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 3 of the License, 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, see -. - -*/ - -/* -20. Augiust 2000 - Kai Habel: first release -*/ - -/* -2003-12-14 Rafael Laboissiere -Added optional second argument to pass options to the underlying -qhull command -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include - -#include "lo-ieee.h" - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "__voronoi__.oct 2007-07-24"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (__voronoi__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts})\n\ -@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts}, @var{options})\n\ -@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - std::string caller = args(0).string_value (); - -#if defined (HAVE_QHULL) - - retval(0) = 0.0; - - int nargin = args.length (); - if (nargin < 2 || nargin > 3) - { - print_usage (); - return retval; - } - - Matrix points = args(1).matrix_value (); - const octave_idx_type dim = points.columns (); - const octave_idx_type num_points = points.rows (); - - points = points.transpose (); - - std::string options; - - if (dim <= 4) - options = " Qbb"; - else - options = " Qbb Qx"; - - if (nargin == 3) - { - octave_value opt_arg = args(2); - - if (opt_arg.is_string ()) - options = " " + opt_arg.string_value (); - else if (opt_arg.is_empty ()) - ; // Use default options. - else if (opt_arg.is_cellstr ()) - { - options = ""; - - Array tmp = opt_arg.cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += " " + tmp(i); - } - else - { - error ("%s: OPTIONS must be a string, cell array of strings, or empty", - caller.c_str ()); - return retval; - } - } - - boolT ismalloc = false; - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("__voronoi__: unable to create temporary file for output"); - return retval; - } - - // qh_new_qhull command and points arguments are not const... - - std::string cmd = "qhull v" + options; - - OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); - - strcpy (cmd_str, cmd.c_str ()); - - int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), - ismalloc, cmd_str, outfile, errfile); - if (! exitcode) - { - // Calling findgood_all provides the number of Voronoi vertices - // (sets qh num_good). - - qh_findgood_all (qh facet_list); - - octave_idx_type num_voronoi_regions - = qh num_vertices - qh_setsize (qh del_vertices); - - octave_idx_type num_voronoi_vertices = qh num_good; - - // Find the voronoi centers for all facets. - - qh_setvoronoi_all (); - - facetT *facet; - vertexT *vertex; - octave_idx_type k; - - // Find the number of Voronoi vertices for each Voronoi cell and - // store them in NI so we can use them later to set the dimensions - // of the RowVector objects used to collect them. - - FORALLfacets - { - facet->seen = false; - } - - OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, num_voronoi_regions); - for (octave_idx_type i = 0; i < num_voronoi_regions; i++) - ni[i] = 0; - - k = 0; - - FORALLvertices - { - if (qh hull_dim == 3) - qh_order_vertexneighbors (vertex); - - bool infinity_seen = false; - - facetT *neighbor, **neighborp; - - FOREACHneighbor_ (vertex) - { - if (neighbor->upperdelaunay) - { - if (! infinity_seen) - { - infinity_seen = true; - ni[k]++; - } - } - else - { - neighbor->seen = true; - ni[k]++; - } - } - - k++; - } - - // If Qhull finds fewer regions than points, we will pad the end - // of the at_inf and C arrays so that they always contain at least - // as many elements as the given points array. - - // FIXME -- is it possible (or does it make sense) for - // num_voronoi_regions to ever be larger than num_points? - - octave_idx_type nr = (num_points > num_voronoi_regions - ? num_points : num_voronoi_regions); - - boolMatrix at_inf (nr, 1, false); - - // The list of Voronoi vertices. The first element is always - // Inf. - Matrix F (num_voronoi_vertices+1, dim); - - for (octave_idx_type d = 0; d < dim; d++) - F(0,d) = octave_Inf; - - // The cell array of vectors of indices into F that represent the - // vertices of the Voronoi regions (cells). - - Cell C (nr, 1); - - // Now loop through the list of vertices again and store the - // coordinates of the Voronoi vertices and the lists of indices - // for the cells. - - FORALLfacets - { - facet->seen = false; - } - - octave_idx_type i = 0; - k = 0; - - FORALLvertices - { - if (qh hull_dim == 3) - qh_order_vertexneighbors (vertex); - - bool infinity_seen = false; - - octave_idx_type idx = qh_pointid (vertex->point); - - octave_idx_type num_vertices = ni[k++]; - - // Qhull seems to sometimes produces regions with a single - // vertex. Is that a bug? How can a region have just one - // vertex? Let's skip it. - - if (num_vertices == 1) - continue; - - RowVector facet_list (num_vertices); - - octave_idx_type m = 0; - - facetT *neighbor, **neighborp; - - FOREACHneighbor_(vertex) - { - if (neighbor->upperdelaunay) - { - if (! infinity_seen) - { - infinity_seen = true; - facet_list(m++) = 1; - at_inf(idx) = true; - } - } - else - { - if (! neighbor->seen) - { - i++; - for (octave_idx_type d = 0; d < dim; d++) - F(i,d) = neighbor->center[d]; - - neighbor->seen = true; - neighbor->visitid = i; - } - - facet_list(m++) = neighbor->visitid + 1; - } - } - - C(idx) = facet_list; - } - - retval(2) = at_inf; - retval(1) = C; - retval(0) = F; - } - else - error ("%s: qhull failed", caller.c_str ()); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("%s: qhull did not free %d bytes of long memory (%d pieces)", - caller.c_str (), totlong, curlong); - -#else - error ("%s: not available in this version of Octave", caller.c_str ()); -#endif - - return retval; -} - -/* -## No test needed for internal helper function. -%!assert (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/amd.cc --- a/src/DLD-FUNCTIONS/amd.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,206 +0,0 @@ -/* - -Copyright (C) 2008-2012 David Bateman - -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 3 of the License, 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, see -. - -*/ - -// This is the octave interface to amd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-map.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define AMD_NAME(name) amd_l ## name -#else -#define AMD_NAME(name) amd ## name -#endif - -DEFUN_DLD (amd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} amd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} amd (@var{S}, @var{opts})\n\ -\n\ -Return the approximate minimum degree permutation of a matrix. This\n\ -permutation such that the Cholesky@tie{}factorization of @code{@var{S}\n\ -(@var{p}, @var{p})} tends to be sparser than the Cholesky@tie{}factorization\n\ -of @var{S} itself. @code{amd} is typically faster than @code{symamd} but\n\ -serves a similar purpose.\n\ -\n\ -The optional parameter @var{opts} is a structure that controls the\n\ -behavior of @code{amd}. The fields of the structure are\n\ -\n\ -@table @asis\n\ -@item @var{opts}.dense\n\ -Determines what @code{amd} considers to be a dense row or column of the\n\ -input matrix. Rows or columns with more than @code{max(16, (dense *\n\ -sqrt (@var{n})} entries, where @var{n} is the order of the matrix @var{S},\n\ -are ignored by @code{amd} during the calculation of the permutation\n\ -The value of dense must be a positive scalar and its default value is 10.0\n\ -\n\ -@item @var{opts}.aggressive\n\ -If this value is a non zero scalar, then @code{amd} performs aggressive\n\ -absorption. The default is not to perform aggressive absorption.\n\ -@end table\n\ -\n\ -The author of the code itself is Timothy A. Davis\n\ -@email{davis@@cise.ufl.edu}, University of Florida (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/amd}).\n\ -@seealso{symamd, colamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_AMD - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage (); - else - { - octave_idx_type n_row, n_col; - const octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (!error_state && n_row != n_col) - error ("amd: matrix S must be square"); - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (double, Control, AMD_CONTROL); - AMD_NAME (_defaults) (Control) ; - if (nargin > 1) - { - octave_scalar_map arg1 = args(1).scalar_map_value (); - - if (!error_state) - { - octave_value tmp; - - tmp = arg1.getfield ("dense"); - if (tmp.is_defined ()) - Control[AMD_DENSE] = tmp.double_value (); - - tmp = arg1.getfield ("aggressive"); - if (tmp.is_defined ()) - Control[AMD_AGGRESSIVE] = tmp.double_value (); - } - else - error ("amd: OPTS argument must be a scalar structure"); - } - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, P, n_col); - Matrix xinfo (AMD_INFO, 1); - double *Info = xinfo.fortran_vec (); - - // FIXME -- how can we manage the memory allocation of - // amd in a cleaner manner? - amd_malloc = malloc; - amd_free = free; - amd_calloc = calloc; - amd_realloc = realloc; - amd_printf = printf; - - octave_idx_type result = AMD_NAME (_order) (n_col, cidx, ridx, P, - Control, Info); - - switch (result) - { - case AMD_OUT_OF_MEMORY: - error ("amd: out of memory"); - break; - case AMD_INVALID: - error ("amd: matrix S is corrupted"); - break; - default: - { - if (nargout > 1) - retval(1) = xinfo; - - Matrix Pout (1, n_col); - for (octave_idx_type i = 0; i < n_col; i++) - Pout.xelem (i) = P[i] + 1; - - retval(0) = Pout; - } - } - } - } - } -#else - - error ("amd: not available in this version of Octave"); - -#endif - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/ccolamd.cc --- a/src/DLD-FUNCTIONS/ccolamd.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,583 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman - -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 3 of the License, 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, see -. - -*/ - -// This is the octave interface to ccolamd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define CCOLAMD_NAME(name) ccolamd_l ## name -#define CSYMAMD_NAME(name) csymamd_l ## name -#else -#define CCOLAMD_NAME(name) ccolamd ## name -#define CSYMAMD_NAME(name) csymamd ## name -#endif - -DEFUN_DLD (ccolamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} ccolamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs}, @var{cmember})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} ccolamd (@dots{})\n\ -\n\ -Constrained column approximate minimum degree permutation.\n\ -@code{@var{p} = ccolamd (@var{S})} returns the column approximate minimum\n\ -degree permutation vector for the sparse matrix @var{S}. For a non-symmetric\n\ -matrix\n\ -@var{S},\n\ -@code{@var{S}(:, @var{p})} tends to have sparser LU@tie{}factors than\n\ -@var{S}. @code{chol (@var{S}(:, @var{p})' * @var{S}(:, @var{p}))} also\n\ -tends to be sparser than @code{chol (@var{S}' * @var{S})}. @code{@var{p} =\n\ -ccolamd (@var{S}, 1)} optimizes the ordering for @code{lu (@var{S}(:,\n\ -@var{p}))}. The ordering is followed by a column elimination tree\n\ -post-ordering.\n\ -\n\ -@var{knobs} is an optional 1-element to 5-element input vector, with a\n\ -default value of @code{[0 10 10 1 0]} if not present or empty. Entries not\n\ -present are set to their defaults.\n\ -\n\ -@table @code\n\ -@item @var{knobs}(1)\n\ -if nonzero, the ordering is optimized for @code{lu (S(:, p))}. It will be a\n\ -poor ordering for @code{chol (@var{S}(:, @var{p})' * @var{S}(:,\n\ -@var{p}))}. This is the most important knob for ccolamd.\n\ -\n\ -@item @var{knobs}(2)\n\ -if @var{S} is m-by-n, rows with more than @code{max (16, @var{knobs}(2) *\n\ -sqrt (n))} entries are ignored.\n\ -\n\ -@item @var{knobs}(3)\n\ -columns with more than @code{max (16, @var{knobs}(3) * sqrt (min (@var{m},\n\ -@var{n})))} entries are ignored and ordered last in the output permutation\n\ -(subject to the cmember constraints).\n\ -\n\ -@item @var{knobs}(4)\n\ -if nonzero, aggressive absorption is performed.\n\ -\n\ -@item @var{knobs}(5)\n\ -if nonzero, statistics and knobs are printed.\n\ -\n\ -@end table\n\ -\n\ -@var{cmember} is an optional vector of length @math{n}. It defines the\n\ -constraints on the column ordering. If @code{@var{cmember}(j) = @var{c}},\n\ -then column @var{j} is in constraint set @var{c} (@var{c} must be in the\n\ -range 1 to\n\ -n). In the output permutation @var{p}, all columns in set 1 appear\n\ -first, followed by all columns in set 2, and so on. @code{@var{cmember} =\n\ -ones (1,n)} if not present or empty.\n\ -@code{ccolamd (@var{S}, [], 1 : n)} returns @code{1 : n}\n\ -\n\ -@code{@var{p} = ccolamd (@var{S})} is about the same as\n\ -@code{@var{p} = colamd (@var{S})}. @var{knobs} and its default values\n\ -differ. @code{colamd} always does aggressive absorption, and it finds an\n\ -ordering suitable for both @code{lu (@var{S}(:, @var{p}))} and @code{chol\n\ -(@var{S}(:, @var{p})' * @var{S}(:, @var{p}))}; it cannot optimize its\n\ -ordering for @code{lu (@var{S}(:, @var{p}))} to the extent that\n\ -@code{ccolamd (@var{S}, 1)} can.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1 : 3)}. @code{@var{stats}(1)} and\n\ -@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ -ignored by @sc{ccolamd} and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by @sc{ccolamd}\n\ -(roughly of size @code{2.2 * nnz (@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ -integers).\n\ -\n\ -@code{@var{stats}(4 : 7)} provide information if CCOLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8 : 20)} is always zero in\n\ -the current version of @sc{ccolamd} (reserved for future use).\n\ -\n\ -The authors of the code itself are S. Larimore, T. Davis (Univ. of Florida)\n\ -and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ -by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ -and a grant from Sandia National Lab. See\n\ -@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ -colamd, symamd, and other related orderings.\n\ -@seealso{colamd, csymamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_CCOLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 3) - usage ("ccolamd: incorrect number of input and/or output arguments"); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); - CCOLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin > 1) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[CCOLAMD_LU] = (User_knobs(0) != 0); - if (nel_User_knobs > 1) - knobs[CCOLAMD_DENSE_ROW] = User_knobs(1); - if (nel_User_knobs > 2) - knobs[CCOLAMD_DENSE_COL] = User_knobs(2); - if (nel_User_knobs > 3) - knobs[CCOLAMD_AGGRESSIVE] = (User_knobs(3) != 0); - if (nel_User_knobs > 4) - spumoni = (User_knobs(4) != 0); - - // print knob settings if spumoni is set - if (spumoni) - { - octave_stdout << "\nccolamd version " << CCOLAMD_MAIN_VERSION << "." - << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE - << ":\nknobs(1): " << User_knobs(0) << ", order for "; - if (knobs[CCOLAMD_LU] != 0) - octave_stdout << "lu (A)\n"; - else - octave_stdout << "chol (A'*A)\n"; - - if (knobs[CCOLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(2): " << User_knobs(1) - << ", rows with > max (16," - << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(2): " << User_knobs(1) - << ", no dense rows removed\n"; - - if (knobs[CCOLAMD_DENSE_COL] >= 0) - octave_stdout << "knobs(3): " << User_knobs(2) - << ", cols with > max (16," - << knobs[CCOLAMD_DENSE_COL] << "*sqrt (size(A)))" - << " entries removed\n"; - else - octave_stdout << "knobs(3): " << User_knobs(2) - << ", no dense columns removed\n"; - - if (knobs[CCOLAMD_AGGRESSIVE] != 0) - octave_stdout << "knobs(4): " << User_knobs(3) - << ", aggressive absorption: yes"; - else - octave_stdout << "knobs(4): " << User_knobs(3) - << ", aggressive absorption: no"; - - octave_stdout << "knobs(5): " << User_knobs(4) - << ", statistics and knobs printed\n"; - } - } - - octave_idx_type n_row, n_col, nnz; - octave_idx_type *ridx, *cidx; - SparseComplexMatrix scm; - SparseMatrix sm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0). sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - nnz = scm.nnz (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - // Allocate workspace for ccolamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); - for (octave_idx_type i = 0; i < n_col+1; i++) - p[i] = cidx[i]; - - octave_idx_type Alen = CCOLAMD_NAME (_recommended) (nnz, n_row, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); - for (octave_idx_type i = 0; i < nnz; i++) - A[i] = ridx[i]; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); - - if (nargin > 2) - { - NDArray in_cmember = args(2).array_value (); - octave_idx_type cslen = in_cmember.length (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); - for (octave_idx_type i = 0; i < cslen; i++) - // convert cmember from 1-based to 0-based - cmember[i] = static_cast(in_cmember(i) - 1); - - if (cslen != n_col) - error ("ccolamd: CMEMBER must be of length equal to #cols of A"); - else - // Order the columns (destroys A) - if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, cmember)) - { - CCOLAMD_NAME (_report) (stats) ; - error ("ccolamd: internal error!"); - return retval; - } - } - else - { - // Order the columns (destroys A) - if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, 0)) - { - CCOLAMD_NAME (_report) (stats) ; - error ("ccolamd: internal error!"); - return retval; - } - } - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = p[i] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - CCOLAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - } - -#else - - error ("ccolamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (csymamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} csymamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs}, @var{cmember})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} csymamd (@dots{})\n\ -\n\ -For a symmetric positive definite matrix @var{S}, returns the permutation\n\ -vector @var{p} such that @code{@var{S}(@var{p},@var{p})} tends to have a\n\ -sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{csymamd} works\n\ -well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ -to be symmetric; only the strictly lower triangular part is referenced.\n\ -@var{S} must be square. The ordering is followed by an elimination tree\n\ -post-ordering.\n\ -\n\ -@var{knobs} is an optional 1-element to 3-element input vector, with a\n\ -default value of @code{[10 1 0]} if present or empty. Entries not\n\ -present are set to their defaults.\n\ -\n\ -@table @code\n\ -@item @var{knobs}(1)\n\ -If @var{S} is n-by-n, then rows and columns with more than\n\ -@code{max(16,@var{knobs}(1)*sqrt(n))} entries are ignored, and ordered\n\ -last in the output permutation (subject to the cmember constraints).\n\ -\n\ -@item @var{knobs}(2)\n\ -If nonzero, aggressive absorption is performed.\n\ -\n\ -@item @var{knobs}(3)\n\ -If nonzero, statistics and knobs are printed.\n\ -\n\ -@end table\n\ -\n\ -@var{cmember} is an optional vector of length n. It defines the constraints\n\ -on the ordering. If @code{@var{cmember}(j) = @var{S}}, then row/column j is\n\ -in constraint set @var{c} (@var{c} must be in the range 1 to n). In the\n\ -output permutation @var{p}, rows/columns in set 1 appear first, followed\n\ -by all rows/columns in set 2, and so on. @code{@var{cmember} = ones (1,n)}\n\ -if not present or empty. @code{csymamd (@var{S},[],1:n)} returns @code{1:n}.\n\ -\n\ -@code{@var{p} = csymamd (@var{S})} is about the same as @code{@var{p} =\n\ -symamd (@var{S})}. @var{knobs} and its default values differ.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if CCOLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ -the current version of @sc{ccolamd} (reserved for future use).\n\ -\n\ -The authors of the code itself are S. Larimore, T. Davis (Uni of Florida)\n\ -and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ -by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ -and a grant from Sandia National Lab. See\n\ -@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ -colamd, symamd, and other related orderings.\n\ -@seealso{symamd, ccolamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#if HAVE_CCOLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 3) - usage ("ccolamd: incorrect number of input and/or output arguments"); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); - CCOLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin > 1) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[CCOLAMD_DENSE_ROW] = User_knobs(0); - if (nel_User_knobs > 0) - knobs[CCOLAMD_AGGRESSIVE] = User_knobs(1); - if (nel_User_knobs > 1) - spumoni = static_cast (User_knobs(2)); - - // print knob settings if spumoni is set - if (spumoni) - { - octave_stdout << "\ncsymamd version " << CCOLAMD_MAIN_VERSION << "." - << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE << "\n"; - - if (knobs[CCOLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(1): " << User_knobs(0) - << ", rows/cols with > max (16," - << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(1): " << User_knobs(0) - << ", no dense rows/cols removed\n"; - - if (knobs[CCOLAMD_AGGRESSIVE] != 0) - octave_stdout << "knobs(2): " << User_knobs(1) - << ", aggressive absorption: yes"; - else - octave_stdout << "knobs(2): " << User_knobs(1) - << ", aggressive absorption: no"; - - - octave_stdout << "knobs(3): " << User_knobs(2) - << ", statistics and knobs printed\n"; - } - } - - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (n_row != n_col) - { - error ("csymamd: matrix S must be square"); - return retval; - } - - // Allocate workspace for symamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); - - if (nargin > 2) - { - NDArray in_cmember = args(2).array_value (); - octave_idx_type cslen = in_cmember.length (); - OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); - for (octave_idx_type i = 0; i < cslen; i++) - // convert cmember from 1-based to 0-based - cmember[i] = static_cast(in_cmember(i) - 1); - - if (cslen != n_col) - error ("csymamd: CMEMBER must be of length equal to #cols of A"); - else - if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, - &calloc, &free, cmember, -1)) - { - CSYMAMD_NAME (_report) (stats) ; - error ("csymamd: internal error!") ; - return retval; - } - } - else - { - if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, - &calloc, &free, 0, -1)) - { - CSYMAMD_NAME (_report) (stats) ; - error ("csymamd: internal error!") ; - return retval; - } - } - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = perm[i] + 1; - - retval(0) = out_perm; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - - // print stats if spumoni > 0 - if (spumoni > 0) - CSYMAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); - for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (CCOLAMD_INFO1) ++ ; - out_stats (CCOLAMD_INFO2) ++ ; - } - } - -#else - - error ("csymamd: not available in this version of Octave"); - -#endif - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/chol.cc --- a/src/DLD-FUNCTIONS/chol.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1385 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2008-2009 Jaroslav Hajek -Copyright (C) 2008-2009 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "CmplxCHOL.h" -#include "dbleCHOL.h" -#include "fCmplxCHOL.h" -#include "floatCHOL.h" -#include "SparseCmplxCHOL.h" -#include "SparsedbleCHOL.h" -#include "oct-spparms.h" -#include "sparse-util.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -template -static octave_value -get_chol_r (const CHOLT& fact) -{ - return octave_value (fact.chol_matrix (), - MatrixType (MatrixType::Upper)); -} - -template -static octave_value -get_chol_l (const CHOLT& fact) -{ - return octave_value (fact.chol_matrix ().transpose (), - MatrixType (MatrixType::Lower)); -} - -DEFUN_DLD (chol, args, nargout, -"-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R} =} chol (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}] =} chol (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S}, \"vector\")\n\ -@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"lower\")\n\ -@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"upper\")\n\ -@cindex Cholesky factorization\n\ -Compute the Cholesky@tie{}factor, @var{R}, of the symmetric positive definite\n\ -matrix @var{A}, where\n\ -@tex\n\ -$ R^T R = A $.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{A}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -Called with one output argument @code{chol} fails if @var{A} or @var{S} is\n\ -not positive definite. With two or more output arguments @var{p} flags\n\ -whether the matrix was positive definite and @code{chol} does not fail. A\n\ -zero value indicated that the matrix was positive definite and the @var{R}\n\ -gives the factorization, and @var{p} will have a positive value otherwise.\n\ -\n\ -If called with 3 outputs then a sparsity preserving row/column permutation\n\ -is applied to @var{A} prior to the factorization. That is @var{R}\n\ -is the factorization of @code{@var{A}(@var{Q},@var{Q})} such that\n\ -@tex\n\ -$ R^T R = Q^T A Q$.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{Q}' * @var{A} * @var{Q}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -The sparsity preserving permutation is generally returned as a matrix.\n\ -However, given the flag \"vector\", @var{Q} will be returned as a vector\n\ -such that\n\ -@tex\n\ -$ R^T R = A (Q, Q)$.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{R}' * @var{R} = @var{A}(@var{Q}, @var{Q}).\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -Called with either a sparse or full matrix and using the \"lower\" flag,\n\ -@code{chol} returns the lower triangular factorization such that\n\ -@tex\n\ -$ L L^T = A $.\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@var{L} * @var{L}' = @var{A}.\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -For full matrices, if the \"lower\" flag is set only the lower triangular\n\ -part of the matrix is used for the factorization, otherwise the upper\n\ -triangular part is used.\n\ -\n\ -In general the lower triangular factorization is significantly faster for\n\ -sparse matrices.\n\ -@seealso{cholinv, chol2inv}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - bool LLt = false; - bool vecout = false; - - if (nargin < 1 || nargin > 3 || nargout > 3 - || (! args(0).is_sparse_type () && nargout > 2)) - { - print_usage (); - return retval; - } - - int n = 1; - while (n < nargin && ! error_state) - { - std::string tmp = args(n++).string_value (); - - if (! error_state ) - { - if (tmp.compare ("vector") == 0) - vecout = true; - else if (tmp.compare ("lower") == 0) - // FIXME currently the option "lower" is handled by transposing the - // matrix, factorizing it with the lapack function DPOTRF ('U', ...) - // and finally transposing the factor. It would be more efficient to use - // DPOTRF ('L', ...) in this case. - LLt = true; - else if (tmp.compare ("upper") == 0) - LLt = false; - else - error ("chol: unexpected second or third input"); - } - else - error ("chol: expecting trailing string arguments"); - } - - if (! error_state) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - bool natural = (nargout != 3); - - int arg_is_empty = empty_arg ("chol", nr, nc); - - if (arg_is_empty < 0) - return retval; - if (arg_is_empty > 0) - return octave_value (Matrix ()); - - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix m = arg.sparse_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseCHOL fact (m, info, natural); - if (nargout == 3) - { - if (vecout) - retval(2) = fact.perm (); - else - retval(2) = fact.Q (); - } - - if (nargout > 1 || info == 0) - { - retval(1) = fact.P (); - if (LLt) - retval(0) = fact.L (); - else - retval(0) = fact.R (); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix m = arg.sparse_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseComplexCHOL fact (m, info, natural); - - if (nargout == 3) - { - if (vecout) - retval(2) = fact.perm (); - else - retval(2) = fact.Q (); - } - - if (nargout > 1 || info == 0) - { - retval(1) = fact.P (); - if (LLt) - retval(0) = fact.L (); - else - retval(0) = fact.R (); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - FloatCHOL fact; - if (LLt) - fact = FloatCHOL (m.transpose (), info); - else - fact = FloatCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - FloatComplexCHOL fact; - if (LLt) - fact = FloatComplexCHOL (m.transpose (), info); - else - fact = FloatComplexCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - CHOL fact; - if (LLt) - fact = CHOL (m.transpose (), info); - else - fact = CHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - - ComplexCHOL fact; - if (LLt) - fact = ComplexCHOL (m.transpose (), info); - else - fact = ComplexCHOL (m, info); - - if (nargout == 2 || info == 0) - { - retval(1) = info; - if (LLt) - retval(0) = get_chol_l (fact); - else - retval(0) = get_chol_r (fact); - } - else - error ("chol: input matrix must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - } - - return retval; -} - -/* -%!assert (chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)) -%!assert (chol (single ([2, 1; 1, 1])), single ([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps ("single"))) - -%!error chol () -%!error chol ([1, 2; 3, 4]) -%!error chol ([1, 2; 3, 4; 5, 6]) -%!error chol (1, 2) -*/ - -DEFUN_DLD (cholinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} cholinv (@var{A})\n\ -Use the Cholesky@tie{}factorization to compute the inverse of the\n\ -symmetric positive definite matrix @var{A}.\n\ -@seealso{chol, chol2inv, inv}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr == 0 || nc == 0) - retval = Matrix (); - else - { - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix m = arg.sparse_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix m = arg.sparse_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - SparseComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("cholinv", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - FloatCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - FloatComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - octave_idx_type info; - CHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - octave_idx_type info; - ComplexCHOL chol (m, info); - if (info == 0) - retval = chol.inverse (); - else - error ("cholinv: A must be positive definite"); - } - } - else - gripe_wrong_type_arg ("chol", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!shared A, Ainv -%! A = [2,0.2;0.2,1]; -%! Ainv = inv (A); -%!test -%! Ainv1 = cholinv (A); -%! assert (norm (Ainv-Ainv1), 0, 1e-10); -%!testif HAVE_CHOLMOD -%! Ainv2 = inv (sparse (A)); -%! assert (norm (Ainv-Ainv2), 0, 1e-10); -%!testif HAVE_CHOLMOD -%! Ainv3 = cholinv (sparse (A)); -%! assert (norm (Ainv-Ainv3), 0, 1e-10); -*/ - -DEFUN_DLD (chol2inv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} chol2inv (@var{U})\n\ -Invert a symmetric, positive definite square matrix from its Cholesky\n\ -decomposition, @var{U}. Note that @var{U} should be an upper-triangular\n\ -matrix with positive diagonal elements. @code{chol2inv (@var{U})}\n\ -provides @code{inv (@var{U}'*@var{U})} but it is much faster than\n\ -using @code{inv}.\n\ -@seealso{chol, cholinv, inv}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr == 0 || nc == 0) - retval = Matrix (); - else - { - if (arg.is_sparse_type ()) - { - if (arg.is_real_type ()) - { - SparseMatrix r = arg.sparse_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - SparseComplexMatrix r = arg.sparse_complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - } - else if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix r = arg.float_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix r = arg.float_complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - - } - else - { - if (arg.is_real_type ()) - { - Matrix r = arg.matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else if (arg.is_complex_type ()) - { - ComplexMatrix r = arg.complex_matrix_value (); - - if (! error_state) - retval = chol2inv (r); - } - else - gripe_wrong_type_arg ("chol2inv", arg); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN_DLD (cholupdate, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{R1}, @var{info}] =} cholupdate (@var{R}, @var{u}, @var{op})\n\ -Update or downdate a Cholesky@tie{}factorization. Given an upper triangular\n\ -matrix @var{R} and a column vector @var{u}, attempt to determine another\n\ -upper triangular matrix @var{R1} such that\n\ -\n\ -@itemize @bullet\n\ -@item\n\ -@var{R1}'*@var{R1} = @var{R}'*@var{R} + @var{u}*@var{u}'\n\ -if @var{op} is \"+\"\n\ -\n\ -@item\n\ -@var{R1}'*@var{R1} = @var{R}'*@var{R} - @var{u}*@var{u}'\n\ -if @var{op} is \"-\"\n\ -@end itemize\n\ -\n\ -If @var{op} is \"-\", @var{info} is set to\n\ -\n\ -@itemize\n\ -@item 0 if the downdate was successful,\n\ -\n\ -@item 1 if @var{R}'*@var{R} - @var{u}*@var{u}' is not positive definite,\n\ -\n\ -@item 2 if @var{R} is singular.\n\ -@end itemize\n\ -\n\ -If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ -@seealso{chol, qrupdate}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin > 3 || nargin < 2) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argu = args(1); - - if (argr.is_numeric_type () && argu.is_numeric_type () - && (nargin < 3 || args(2).is_string ())) - { - octave_idx_type n = argr.rows (); - - std::string op = (nargin < 3) ? "+" : args(2).string_value (); - - bool down = op == "-"; - - if (down || op == "+") - if (argr.columns () == n && argu.rows () == n && argu.columns () == 1) - { - int err = 0; - if (argr.is_single_type () || argu.is_single_type ()) - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - FloatColumnVector u = argu.float_column_vector_value (); - - FloatCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexColumnVector u = argu.float_complex_column_vector_value (); - - FloatComplexCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - ColumnVector u = argu.column_vector_value (); - - CHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - ComplexColumnVector u = argu.complex_column_vector_value (); - - ComplexCHOL fact; - fact.set (R); - - if (down) - err = fact.downdate (u); - else - fact.update (u); - - retval(0) = get_chol_r (fact); - } - } - - if (nargout > 1) - retval(1) = err; - else if (err == 1) - error ("cholupdate: downdate violates positiveness"); - else if (err == 2) - error ("cholupdate: singular matrix"); - } - else - error ("cholupdate: dimension mismatch between R and U"); - else - error ("cholupdate: OP must be \"+\" or \"-\""); - } - else - print_usage (); - - return retval; -} - -/* -%!shared A, u, Ac, uc -%! A = [ 0.436997 -0.131721 0.124120 -0.061673 ; -%! -0.131721 0.738529 0.019851 -0.140295 ; -%! 0.124120 0.019851 0.354879 -0.059472 ; -%! -0.061673 -0.140295 -0.059472 0.600939 ]; -%! -%! u = [ 0.98950 ; -%! 0.39844 ; -%! 0.63484 ; -%! 0.13351 ]; -%! Ac = [ 0.5585528 + 0.0000000i -0.1662088 - 0.0315341i 0.0107873 + 0.0236411i -0.0276775 - 0.0186073i ; -%! -0.1662088 + 0.0315341i 0.6760061 + 0.0000000i 0.0011452 - 0.0475528i 0.0145967 + 0.0247641i ; -%! 0.0107873 - 0.0236411i 0.0011452 + 0.0475528i 0.6263149 - 0.0000000i -0.1585837 - 0.0719763i ; -%! -0.0276775 + 0.0186073i 0.0145967 - 0.0247641i -0.1585837 + 0.0719763i 0.6034234 - 0.0000000i ]; -%! -%! uc = [ 0.54267 + 0.91519i ; -%! 0.99647 + 0.43141i ; -%! 0.83760 + 0.68977i ; -%! 0.39160 + 0.90378i ]; - -%!test -%! R = chol (A); -%! R1 = cholupdate (R, u); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - R'*R - u*u', Inf) < 1e1*eps); -%! -%! R1 = cholupdate (R1, u, "-"); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1 - R, Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! R1 = cholupdate (R, uc); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - R'*R - uc*uc', Inf) < 1e1*eps); -%! -%! R1 = cholupdate (R1, uc, "-"); -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1 - R, Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! R1 = cholupdate (R, single (u)); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - R'*R - single (u*u'), Inf) < 1e1*eps ("single")); -%! -%! R1 = cholupdate (R1, single (u), "-"); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! R1 = cholupdate (R, single (uc)); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - R'*R - single (uc*uc'), Inf) < 1e1*eps ("single")); -%! -%! R1 = cholupdate (R1, single (uc), "-"); -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); -*/ - -DEFUN_DLD (cholinsert, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} cholinsert (@var{R}, @var{j}, @var{u})\n\ -@deftypefnx {Loadable Function} {[@var{R1}, @var{info}] =} cholinsert (@var{R}, @var{j}, @var{u})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of\n\ -@var{A1}, where @w{A1(p,p) = A}, @w{A1(:,j) = A1(j,:)' = u} and\n\ -@w{p = [1:j-1,j+1:n+1]}. @w{u(j)} should be positive.\n\ -On return, @var{info} is set to\n\ -\n\ -@itemize\n\ -@item 0 if the insertion was successful,\n\ -\n\ -@item 1 if @var{A1} is not positive definite,\n\ -\n\ -@item 2 if @var{R} is singular.\n\ -@end itemize\n\ -\n\ -If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ -@seealso{chol, cholupdate, choldelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 3) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argj = args(1); - octave_value argu = args(2); - - if (argr.is_numeric_type () && argu.is_numeric_type () - && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n && argu.rows () == n+1 && argu.columns () == 1) - { - if (j > 0 && j <= n+1) - { - int err = 0; - if (argr.is_single_type () || argu.is_single_type ()) - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - FloatColumnVector u = argu.float_column_vector_value (); - - FloatCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexColumnVector u = argu.float_complex_column_vector_value (); - - FloatComplexCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type () && argu.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - ColumnVector u = argu.column_vector_value (); - - CHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - ComplexColumnVector u = argu.complex_column_vector_value (); - - ComplexCHOL fact; - fact.set (R); - err = fact.insert_sym (u, j-1); - - retval(0) = get_chol_r (fact); - } - } - - if (nargout > 1) - retval(1) = err; - else if (err == 1) - error ("cholinsert: insertion violates positiveness"); - else if (err == 2) - error ("cholinsert: singular matrix"); - else if (err == 3) - error ("cholinsert: diagonal element must be real"); - } - else - error ("cholinsert: index J out of range"); - } - else - error ("cholinsert: dimension mismatch between R and U"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! u2 = [ 0.35080 ; -%! 0.63930 ; -%! 3.31057 ; -%! -0.13825 ; -%! 0.45266 ]; -%! -%! R = chol (A); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps); - -%!test -%! u2 = [ 0.35080 + 0.04298i; -%! 0.63930 + 0.23778i; -%! 3.31057 + 0.00000i; -%! -0.13825 + 0.19879i; -%! 0.45266 + 0.50020i]; -%! -%! R = chol (Ac); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (A1(p,p) - Ac, Inf) < 1e1*eps); - -%!test -%! u2 = single ([ 0.35080 ; -%! 0.63930 ; -%! 3.31057 ; -%! -0.13825 ; -%! 0.45266 ]); -%! -%! R = chol (single (A)); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps ("single")); - -%!test -%! u2 = single ([ 0.35080 + 0.04298i; -%! 0.63930 + 0.23778i; -%! 3.31057 + 0.00000i; -%! -0.13825 + 0.19879i; -%! 0.45266 + 0.50020i]); -%! -%! R = chol (single (Ac)); -%! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert (R, j, u2); -%! A1 = R1'*R1; -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (A1(p,p) - single (Ac), Inf) < 2e1*eps ("single")); - -%!test -%! cu = chol (triu (A), "upper"); -%! cl = chol (tril (A), "lower"); -%! assert (cu, cl', eps); - -%!test -%! cca = chol (Ac); -%! -%! ccal = chol (Ac, "lower"); -%! ccal2 = chol (tril (Ac), "lower"); -%! -%! ccau = chol (Ac, "upper"); -%! ccau2 = chol (triu (Ac), "upper"); -%! -%! assert (cca'*cca, Ac, eps); -%! assert (ccau'*ccau, Ac, eps); -%! assert (ccau2'*ccau2, Ac, eps); -%! -%! assert (cca, ccal', eps); -%! assert (cca, ccau, eps); -%! assert (cca, ccal2', eps); -%! assert (cca, ccau2, eps); - -%!test -%! cca = chol (single (Ac)); -%! -%! ccal = chol (single (Ac), "lower"); -%! ccal2 = chol (tril (single (Ac)), "lower"); -%! -%! ccau = chol (single (Ac), "upper"); -%! ccau2 = chol (triu (single (Ac)), "upper"); -%! -%! assert (cca'*cca, single (Ac), eps ("single")); -%! assert (ccau'*ccau, single (Ac), eps ("single")); -%! assert (ccau2'*ccau2, single (Ac), eps ("single")); -%! -%! assert (cca, ccal', eps ("single")); -%! assert (cca, ccau, eps ("single")); -%! assert (cca, ccal2', eps ("single")); -%! assert (cca, ccau2, eps ("single")); - -%!test -%! a = [12, 2, 3, 4; -%! 2, 14, 5, 3; -%! 3, 5, 16, 6; -%! 4, 3, 6, 16]; -%! -%! b = [0, 1, 2, 3; -%! -1, 0, 1, 2; -%! -2, -1, 0, 1; -%! -3, -2, -1, 0]; -%! -%! ca = a + i*b; -%! -%! cca = chol (ca); -%! -%! ccal = chol (ca, "lower"); -%! ccal2 = chol (tril (ca), "lower"); -%! -%! ccau = chol (ca, "upper"); -%! ccau2 = chol (triu (ca), "upper"); -%! -%! assert (cca'*cca, ca, 16*eps); -%! assert (ccau'*ccau, ca, 16*eps); -%! assert (ccau2'*ccau2, ca, 16*eps); -%! -%! assert (cca, ccal', 16*eps); -%! assert (cca, ccau, 16*eps); -%! assert (cca, ccal2', 16*eps); -%! assert (cca, ccau2, 16*eps); -*/ - -DEFUN_DLD (choldelete, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} choldelete (@var{R}, @var{j})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of @w{A(p,p)}, where\n\ -@w{p = [1:j-1,j+1:n+1]}.\n\ -@seealso{chol, cholupdate, cholinsert}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 2) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argj = args(1); - - if (argr.is_numeric_type () && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n) - { - if (j > 0 && j <= n) - { - if (argr.is_single_type ()) - { - if (argr.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - - FloatCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - - CHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexCHOL fact; - fact.set (R); - fact.delete_sym (j-1); - - retval(0) = get_chol_r (fact); - } - } - } - else - error ("choldelete: index J out of range"); - } - else - error ("choldelete: matrix R must be square"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! R = chol (A); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R, j); -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete (R,j); -%! -%! assert (norm (triu (R1)-R1, Inf), single (0)); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -*/ - -DEFUN_DLD (cholshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{R1} =} cholshift (@var{R}, @var{i}, @var{j})\n\ -Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ -positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ -triangular, return the Cholesky@tie{}factorization of\n\ -@w{@var{A}(p,p)}, where @w{p} is the permutation @*\n\ -@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ - or @*\n\ -@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ -\n\ -@seealso{chol, cholinsert, choldelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - - octave_value_list retval; - - if (nargin != 3) - { - print_usage (); - return retval; - } - - octave_value argr = args(0); - octave_value argi = args(1); - octave_value argj = args(2); - - if (argr.is_numeric_type () && argi.is_real_scalar () && argj.is_real_scalar ()) - { - octave_idx_type n = argr.rows (); - octave_idx_type i = argi.scalar_value (); - octave_idx_type j = argj.scalar_value (); - - if (argr.columns () == n) - { - if (j > 0 && j <= n+1 && i > 0 && i <= n+1) - { - - if (argr.is_single_type () && argi.is_single_type () && - argj.is_single_type ()) - { - if (argr.is_real_type ()) - { - // real case - FloatMatrix R = argr.float_matrix_value (); - - FloatCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - } - else - { - if (argr.is_real_type ()) - { - // real case - Matrix R = argr.matrix_value (); - - CHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - else - { - // complex case - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexCHOL fact; - fact.set (R); - fact.shift_sym (i-1, j-1); - - retval(0) = get_chol_r (fact); - } - } - } - else - error ("cholshift: index I or J is out of range"); - } - else - error ("cholshift: R must be a square matrix"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! R = chol (A); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1) - R1, Inf), 0); -%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (Ac); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); - -%!test -%! R = chol (single (A)); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); - -%!test -%! R = chol (single (Ac)); -%! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift (R, i, j); -%! -%! assert (norm (triu (R1)-R1, Inf), 0); -%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/colamd.cc --- a/src/DLD-FUNCTIONS/colamd.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,768 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler - -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 3 of the License, 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, see -. - -*/ - -// This is the octave interface to colamd, which bore the copyright given -// in the help of the functions. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "ov.h" -#include "defun-dld.h" -#include "pager.h" -#include "ov-re-mat.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" - -#include "oct-sparse.h" -#include "oct-locbuf.h" - -#ifdef IDX_TYPE_LONG -#define COLAMD_NAME(name) colamd_l ## name -#define SYMAMD_NAME(name) symamd_l ## name -#else -#define COLAMD_NAME(name) colamd ## name -#define SYMAMD_NAME(name) symamd ## name -#endif - -// The symmetric column elimination tree code take from the Davis LDL code. -// Copyright given elsewhere in this file. -static void -symetree (const octave_idx_type *ridx, const octave_idx_type *cidx, - octave_idx_type *Parent, octave_idx_type *P, octave_idx_type n) -{ - OCTAVE_LOCAL_BUFFER (octave_idx_type, Flag, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Pinv, (P ? n : 0)); - if (P) - // If P is present then compute Pinv, the inverse of P - for (octave_idx_type k = 0 ; k < n ; k++) - Pinv[P[k]] = k ; - - for (octave_idx_type k = 0 ; k < n ; k++) - { - // L(k,:) pattern: all nodes reachable in etree from nz in A(0:k-1,k) - Parent[k] = n ; // parent of k is not yet known - Flag[k] = k ; // mark node k as visited - octave_idx_type kk = (P) ? (P[k]) : (k) ; // kth original, or permuted, column - octave_idx_type p2 = cidx[kk+1] ; - for (octave_idx_type p = cidx[kk] ; p < p2 ; p++) - { - // A (i,k) is nonzero (original or permuted A) - octave_idx_type i = (Pinv) ? (Pinv[ridx[p]]) : (ridx[p]) ; - if (i < k) - { - // follow path from i to root of etree, stop at flagged node - for ( ; Flag[i] != k ; i = Parent[i]) - { - // find parent of i if not yet determined - if (Parent[i] == n) - Parent[i] = k ; - Flag[i] = k ; // mark i as visited - } - } - } - } -} - -// The elimination tree post-ordering code below is taken from SuperLU -static inline octave_idx_type -make_set (octave_idx_type i, octave_idx_type *pp) -{ - pp[i] = i; - return i; -} - -static inline octave_idx_type -link (octave_idx_type s, octave_idx_type t, octave_idx_type *pp) -{ - pp[s] = t; - return t; -} - -static inline octave_idx_type -find (octave_idx_type i, octave_idx_type *pp) -{ - register octave_idx_type p, gp; - - p = pp[i]; - gp = pp[p]; - - while (gp != p) - { - pp[i] = gp; - i = gp; - p = pp[i]; - gp = pp[p]; - } - - return p; -} - -static octave_idx_type -etdfs (octave_idx_type v, octave_idx_type *first_kid, - octave_idx_type *next_kid, octave_idx_type *post, - octave_idx_type postnum) -{ - for (octave_idx_type w = first_kid[v]; w != -1; w = next_kid[w]) - postnum = etdfs (w, first_kid, next_kid, post, postnum); - - post[postnum++] = v; - - return postnum; -} - -static void -tree_postorder (octave_idx_type n, octave_idx_type *parent, - octave_idx_type *post) -{ - // Allocate storage for working arrays and results - OCTAVE_LOCAL_BUFFER (octave_idx_type, first_kid, n+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, next_kid, n+1); - - // Set up structure describing children - for (octave_idx_type v = 0; v <= n; first_kid[v++] = -1) - /* do nothing */; - - for (octave_idx_type v = n-1; v >= 0; v--) - { - octave_idx_type dad = parent[v]; - next_kid[v] = first_kid[dad]; - first_kid[dad] = v; - } - - // Depth-first search from dummy root vertex #n - etdfs (n, first_kid, next_kid, post, 0); -} - -static void -coletree (const octave_idx_type *ridx, const octave_idx_type *colbeg, - octave_idx_type *colend, octave_idx_type *parent, - octave_idx_type nr, octave_idx_type nc) -{ - OCTAVE_LOCAL_BUFFER (octave_idx_type, root, nc); - OCTAVE_LOCAL_BUFFER (octave_idx_type, pp, nc); - OCTAVE_LOCAL_BUFFER (octave_idx_type, firstcol, nr); - - // Compute firstcol[row] = first nonzero column in row - for (octave_idx_type row = 0; row < nr; firstcol[row++] = nc) - /* do nothing */; - - for (octave_idx_type col = 0; col < nc; col++) - for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) - { - octave_idx_type row = ridx[p]; - if (firstcol[row] > col) - firstcol[row] = col; - } - - // Compute etree by Liu's algorithm for symmetric matrices, - // except use (firstcol[r],c) in place of an edge (r,c) of A. - // Thus each row clique in A'*A is replaced by a star - // centered at its first vertex, which has the same fill. - for (octave_idx_type col = 0; col < nc; col++) - { - octave_idx_type cset = make_set (col, pp); - root[cset] = col; - parent[col] = nc; - for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) - { - octave_idx_type row = firstcol[ridx[p]]; - if (row >= col) - continue; - octave_idx_type rset = find (row, pp); - octave_idx_type rroot = root[rset]; - if (rroot != col) - { - parent[rroot] = col; - cset = link (cset, rset, pp); - root[cset] = col; - } - } - } -} - -DEFUN_DLD (colamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} colamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} colamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S}, @var{knobs})\n\ -\n\ -Column approximate minimum degree permutation.\n\ -@code{@var{p} = colamd (@var{S})} returns the column approximate minimum\n\ -degree permutation vector for the sparse matrix @var{S}. For a\n\ -non-symmetric matrix @var{S}, @code{@var{S}(:,@var{p})} tends to have\n\ -sparser LU@tie{}factors than @var{S}. The Cholesky@tie{}factorization of\n\ -@code{@var{S}(:,@var{p})' * @var{S}(:,@var{p})} also tends to be sparser\n\ -than that of @code{@var{S}' * @var{S}}.\n\ -\n\ -@var{knobs} is an optional one- to three-element input vector. If @var{S} is\n\ -m-by-n, then rows with more than @code{max(16,@var{knobs}(1)*sqrt(n))}\n\ -entries are ignored. Columns with more than\n\ -@code{max (16,@var{knobs}(2)*sqrt(min(m,n)))} entries are removed prior to\n\ -ordering, and ordered last in the output permutation @var{p}. Only\n\ -completely dense rows or columns are removed if @code{@var{knobs}(1)} and\n\ -@code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is\n\ -nonzero, @var{stats} and @var{knobs} are printed. The default is\n\ -@code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier\n\ -versions of colamd.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1)} and\n\ -@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ -ignored by @sc{colamd} and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by @sc{colamd}\n\ -(roughly of size @code{2.2 * nnz(@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ -integers).\n\ -\n\ -Octave built-in functions are intended to generate valid sparse matrices,\n\ -with no duplicate entries, with ascending row indices of the nonzeros\n\ -in each column, with a non-negative number of entries in each column (!)\n\ -and so on. If a matrix is invalid, then @sc{colamd} may or may not be able\n\ -to continue. If there are duplicate entries (a row index appears two or\n\ -more times in the same column) or if the row indices in a column are out\n\ -of order, then @sc{colamd} can correct these errors by ignoring the duplicate\n\ -entries and sorting each column of its internal copy of the matrix\n\ -@var{S} (the input matrix @var{S} is not repaired, however). If a matrix\n\ -is invalid in other ways then @sc{colamd} cannot continue, an error message\n\ -is printed, and no output arguments (@var{p} or @var{stats}) are returned.\n\ -@sc{colamd} is thus a simple way to check a sparse matrix to see if it's\n\ -valid.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if COLAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ -invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ -unsorted or contains duplicate entries, or zero if no such column exists.\n\ -@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ -index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ -such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ -or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ -the current version of @sc{colamd} (reserved for future use).\n\ -\n\ -The ordering is followed by a column elimination tree post-ordering.\n\ -\n\ -The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ -Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ -developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ -Ng, Oak Ridge National Laboratory. (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ -@seealso{colperm, symamd, ccolamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_COLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); - COLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin == 2) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[COLAMD_DENSE_ROW] = User_knobs(0); - if (nel_User_knobs > 1) - knobs[COLAMD_DENSE_COL] = User_knobs(1) ; - if (nel_User_knobs > 2) - spumoni = static_cast (User_knobs(2)); - - // print knob settings if spumoni is set - if (spumoni) - { - - octave_stdout << "\ncolamd version " << COLAMD_MAIN_VERSION << "." - << COLAMD_SUB_VERSION << ", " << COLAMD_DATE << ":\n"; - - if (knobs[COLAMD_DENSE_ROW] >= 0) - octave_stdout << "knobs(1): " << User_knobs (0) - << ", rows with > max (16," - << knobs[COLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" - << " entries removed\n"; - else - octave_stdout << "knobs(1): " << User_knobs (0) - << ", only completely dense rows removed\n"; - - if (knobs[COLAMD_DENSE_COL] >= 0) - octave_stdout << "knobs(2): " << User_knobs (1) - << ", cols with > max (16," - << knobs[COLAMD_DENSE_COL] << "*sqrt (size(A)))" - << " entries removed\n"; - else - octave_stdout << "knobs(2): " << User_knobs (1) - << ", only completely dense columns removed\n"; - - octave_stdout << "knobs(3): " << User_knobs (2) - << ", statistics and knobs printed\n"; - - } - } - - octave_idx_type n_row, n_col, nnz; - octave_idx_type *ridx, *cidx; - SparseComplexMatrix scm; - SparseMatrix sm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0). sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - nnz = scm.nnz (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - nnz = sm.nnz (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - // Allocate workspace for colamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); - for (octave_idx_type i = 0; i < n_col+1; i++) - p[i] = cidx[i]; - - octave_idx_type Alen = COLAMD_NAME (_recommended) (nnz, n_row, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); - for (octave_idx_type i = 0; i < nnz; i++) - A[i] = ridx[i]; - - // Order the columns (destroys A) - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); - if (! COLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats)) - { - COLAMD_NAME (_report) (stats) ; - error ("colamd: internal error!"); - return retval; - } - - // column elimination tree post-ordering (reuse variables) - OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - - for (octave_idx_type i = 0; i < n_col; i++) - { - colbeg[i] = cidx[p[i]]; - colend[i] = cidx[p[i]+1]; - } - - coletree (ridx, colbeg, colend, etree, n_row, n_col); - - // Calculate the tree post-ordering - tree_postorder (n_col, etree, colbeg); - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = p[colbeg[i]] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - COLAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, COLAMD_STATS)); - for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (COLAMD_INFO1) ++ ; - out_stats (COLAMD_INFO2) ++ ; - } - } - -#else - - error ("colamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (symamd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} symamd (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} symamd (@var{S}, @var{knobs})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S}, @var{knobs})\n\ -\n\ -For a symmetric positive definite matrix @var{S}, returns the permutation\n\ -vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a\n\ -sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{symamd} works\n\ -well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ -to be symmetric; only the strictly lower triangular part is referenced.\n\ -@var{S} must be square.\n\ -\n\ -@var{knobs} is an optional one- to two-element input vector. If @var{S} is\n\ -n-by-n, then rows and columns with more than\n\ -@code{max (16,@var{knobs}(1)*sqrt(n))} entries are removed prior to ordering,\n\ -and ordered last in the output permutation @var{p}. No rows/columns are\n\ -removed if @code{@var{knobs}(1) < 0}. If @code{@var{knobs} (2)} is nonzero,\n\ -@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs}\n\ -= [10 0]}. Note that @var{knobs} differs from earlier versions of symamd.\n\ -\n\ -@var{stats} is an optional 20-element output vector that provides data\n\ -about the ordering and the validity of the input matrix @var{S}. Ordering\n\ -statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1) =\n\ -@var{stats}(2)} is the number of dense or empty rows and columns\n\ -ignored by SYMAMD and @code{@var{stats}(3)} is the number of garbage\n\ -collections performed on the internal data structure used by SYMAMD\n\ -(roughly of size @code{8.4 * nnz (tril (@var{S}, -1)) + 9 * @var{n}}\n\ -integers).\n\ -\n\ -Octave built-in functions are intended to generate valid sparse matrices,\n\ -with no duplicate entries, with ascending row indices of the nonzeros\n\ -in each column, with a non-negative number of entries in each column (!)\n\ -and so on. If a matrix is invalid, then SYMAMD may or may not be able\n\ -to continue. If there are duplicate entries (a row index appears two or\n\ -more times in the same column) or if the row indices in a column are out\n\ -of order, then SYMAMD can correct these errors by ignoring the duplicate\n\ -entries and sorting each column of its internal copy of the matrix S (the\n\ -input matrix S is not repaired, however). If a matrix is invalid in\n\ -other ways then SYMAMD cannot continue, an error message is printed, and\n\ -no output arguments (@var{p} or @var{stats}) are returned. SYMAMD is\n\ -thus a simple way to check a sparse matrix to see if it's valid.\n\ -\n\ -@code{@var{stats}(4:7)} provide information if SYMAMD was able to\n\ -continue. The matrix is OK if @code{@var{stats} (4)} is zero, or 1\n\ -if invalid. @code{@var{stats}(5)} is the rightmost column index that\n\ -is unsorted or contains duplicate entries, or zero if no such column\n\ -exists. @code{@var{stats}(6)} is the last seen duplicate or out-of-order\n\ -row index in the column index given by @code{@var{stats}(5)}, or zero\n\ -if no such row index exists. @code{@var{stats}(7)} is the number of\n\ -duplicate or out-of-order row indices. @code{@var{stats}(8:20)} is\n\ -always zero in the current version of SYMAMD (reserved for future use).\n\ -\n\ -The ordering is followed by a column elimination tree post-ordering.\n\ -\n\ -The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ -Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ -developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ -Ng, Oak Ridge National Laboratory. (see\n\ -@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ -@seealso{colperm, colamd}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_COLAMD - - int nargin = args.length (); - int spumoni = 0; - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - // Get knobs - OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); - COLAMD_NAME (_set_defaults) (knobs); - - // Check for user-passed knobs - if (nargin == 2) - { - NDArray User_knobs = args(1).array_value (); - int nel_User_knobs = User_knobs.length (); - - if (nel_User_knobs > 0) - knobs[COLAMD_DENSE_ROW] = User_knobs(COLAMD_DENSE_ROW); - if (nel_User_knobs > 1) - spumoni = static_cast (User_knobs (1)); - } - - // print knob settings if spumoni is set - if (spumoni > 0) - octave_stdout << "symamd: dense row/col fraction: " - << knobs[COLAMD_DENSE_ROW] << std::endl; - - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - } - else - { - if (args(0).is_complex_type ()) - sm = SparseMatrix (real (args(0).complex_matrix_value ())); - else - sm = SparseMatrix (args(0).matrix_value ()); - - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - if (n_row != n_col) - { - error ("symamd: matrix S must be square"); - return retval; - } - - // Allocate workspace for symamd - OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); - if (!SYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, &calloc, &free)) - { - SYMAMD_NAME (_report) (stats) ; - error ("symamd: internal error!") ; - return retval; - } - - // column elimination tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - symetree (ridx, cidx, etree, perm, n_col); - - // Calculate the tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); - tree_postorder (n_col, etree, post); - - // return the permutation vector - NDArray out_perm (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - out_perm(i) = perm[post[i]] + 1; - - retval(0) = out_perm; - - // print stats if spumoni > 0 - if (spumoni > 0) - SYMAMD_NAME (_report) (stats) ; - - // Return the stats vector - if (nargout == 2) - { - NDArray out_stats (dim_vector (1, COLAMD_STATS)); - for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) - out_stats(i) = stats[i] ; - retval(1) = out_stats; - - // fix stats (5) and (6), for 1-based information on - // jumbled matrix. note that this correction doesn't - // occur if symamd returns FALSE - out_stats (COLAMD_INFO1) ++ ; - out_stats (COLAMD_INFO2) ++ ; - } - } - -#else - - error ("symamd: not available in this version of Octave"); - -#endif - - return retval; -} - -DEFUN_DLD (etree, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} etree (@var{S})\n\ -@deftypefnx {Loadable Function} {@var{p} =} etree (@var{S}, @var{typ})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})\n\ -\n\ -Return the elimination tree for the matrix @var{S}. By default @var{S}\n\ -is assumed to be symmetric and the symmetric elimination tree is\n\ -returned. The argument @var{typ} controls whether a symmetric or\n\ -column elimination tree is returned. Valid values of @var{typ} are\n\ -\"sym\" or \"col\", for symmetric or column elimination tree respectively\n\ -\n\ -Called with a second argument, @code{etree} also returns the postorder\n\ -permutations on the tree.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargout > 2 || nargin < 1 || nargin > 2) - print_usage (); - else - { - octave_idx_type n_row, n_col; - octave_idx_type *ridx, *cidx; - bool is_sym = true; - SparseMatrix sm; - SparseComplexMatrix scm; - - if (args(0).is_sparse_type ()) - { - if (args(0).is_complex_type ()) - { - scm = args(0).sparse_complex_matrix_value (); - n_row = scm.rows (); - n_col = scm.cols (); - ridx = scm.xridx (); - cidx = scm.xcidx (); - } - else - { - sm = args(0).sparse_matrix_value (); - n_row = sm.rows (); - n_col = sm.cols (); - ridx = sm.xridx (); - cidx = sm.xcidx (); - } - - } - else - { - error ("etree: S must be a sparse matrix"); - return retval; - } - - if (nargin == 2) - { - if (args(1).is_string ()) - { - std::string str = args(1).string_value (); - if (str.find ("C") == 0 || str.find ("c") == 0) - is_sym = false; - } - else - { - error ("etree: TYP must be a string"); - return retval; - } - } - - // column elimination tree post-ordering (reuse variables) - OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); - - if (is_sym) - { - if (n_row != n_col) - { - error ("etree: S is marked as symmetric, but is not square"); - return retval; - } - - symetree (ridx, cidx, etree, 0, n_col); - } - else - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col); - OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col); - - for (octave_idx_type i = 0; i < n_col; i++) - { - colbeg[i] = cidx[i]; - colend[i] = cidx[i+1]; - } - - coletree (ridx, colbeg, colend, etree, n_row, n_col); - } - - NDArray tree (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - // We flag a root with n_col while Matlab does it with zero - // Convert for matlab compatiable output - if (etree[i] == n_col) - tree(i) = 0; - else - tree(i) = etree[i] + 1; - - retval(0) = tree; - - if (nargout == 2) - { - // Calculate the tree post-ordering - OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); - tree_postorder (n_col, etree, post); - - NDArray postorder (dim_vector (1, n_col)); - for (octave_idx_type i = 0; i < n_col; i++) - postorder(i) = post[i] + 1; - - retval(1) = postorder; - } - } - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/config-module.awk --- a/src/DLD-FUNCTIONS/config-module.awk Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -BEGIN { - FS = "|"; - nfiles = 0; - - print "## DO NOT EDIT -- generated from module-files by config-module.awk"; - print "" - print "EXTRA_DIST += \\" - print " DLD-FUNCTIONS/config-module.sh \\" - print " DLD-FUNCTIONS/config-module.awk \\" - print " DLD-FUNCTIONS/module-files \\" - print " DLD-FUNCTIONS/oct-qhull.h" - print "" -} -/^#.*/ { next; } -{ - nfiles++; - files[nfiles] = $1; - cppflags[nfiles] = $2; - ldflags[nfiles] = $3; - libraries[nfiles] = $4; -} END { - sep = " \\\n"; - print "DLD_FUNCTIONS_SRC = \\"; - for (i = 1; i <= nfiles; i++) { - if (i == nfiles) - sep = "\n"; - printf (" DLD-FUNCTIONS/%s%s", files[i], sep); - } - print ""; - - sep = " \\\n"; - print "DLD_FUNCTIONS_LIBS = $(DLD_FUNCTIONS_SRC:.cc=.la)"; - print ""; - print "if AMCOND_ENABLE_DYNAMIC_LINKING"; - print ""; - print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; - print ""; - print "## Use stamp files to avoid problems with checking timestamps"; - print "## of symbolic links"; - print ""; - for (i = 1; i <= nfiles; i++) { - basename = files[i]; - sub (/\.cc$/, "", basename); - printf ("DLD-FUNCTIONS/$(am__leading_dot)%s.oct-stamp: DLD-FUNCTIONS/%s.la\n", basename, basename); - print "\trm -f $(<:.la=.oct)"; - print "\tla=$( $dld_dir/module.mk-t - -$move_if_change $dld_dir/module.mk-t $dld_dir/module.mk diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/convhulln.cc --- a/src/DLD-FUNCTIONS/convhulln.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,316 +0,0 @@ -/* - -Copyright (C) 2000-2012 Kai Habel - -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 3 of the License, 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, see -. - -*/ - -/* -29. July 2000 - Kai Habel: first release -2002-04-22 Paul Kienzle -* Use warning(...) function rather than writing to cerr -2006-05-01 Tom Holroyd -* add support for consistent winding in all dimensions; output is -* guaranteed to be simplicial. -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "Cell.h" -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "parse.h" -#include "unwind-prot.h" - -#if defined (HAVE_QHULL) -# include "oct-qhull.h" -# if defined (NEED_QHULL_VERSION) -char qh_version[] = "convhulln.oct 2007-07-24"; -# endif -#endif - -static void -close_fcn (FILE *f) -{ - gnulib::fclose (f); -} - -DEFUN_DLD (convhulln, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ -@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ -@deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ -Compute the convex hull of the set of points @var{pts} which is a matrix\n\ -of size [n, dim] containing n points in a space of dimension dim.\n\ -The hull @var{h} is an index vector into the set of points and specifies\n\ -which points form the enclosing hull.\n\ -\n\ -An optional second argument, which must be a string or cell array of strings,\n\ -contains options passed to the underlying qhull command.\n\ -See the documentation for the Qhull library for details\n\ -@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ -The default options depend on the dimension of the input:\n\ -\n\ -@itemize\n\ -@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ -\n\ -@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ -@end itemize\n\ -\n\ -If @var{options} is not present or @code{[]} then the default arguments are\n\ -used. Otherwise, @var{options} replaces the default argument list.\n\ -To append user options to the defaults it is necessary to repeat the\n\ -default arguments in @var{options}. Use a null string to pass no arguments.\n\ -\n\ -If the second output @var{v} is requested the volume of the enclosing\n\ -convex hull is calculated.\n\n\ -@seealso{convhull, delaunayn, voronoin}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#if defined (HAVE_QHULL) - - int nargin = args.length (); - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - - Matrix points (args(0).matrix_value ()); - const octave_idx_type dim = points.columns (); - const octave_idx_type num_points = points.rows (); - - points = points.transpose (); - - std::string options; - - if (dim <= 4) - options = " Qt"; - else - options = " Qt Qx"; - - if (nargin == 2) - { - if (args(1).is_string ()) - options = " " + args(1).string_value (); - else if (args(1).is_empty ()) - ; // Use default options. - else if (args(1).is_cellstr ()) - { - options = ""; - - Array tmp = args(1).cellstr_value (); - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - options += " " + tmp(i); - } - else - { - error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); - return retval; - } - } - - boolT ismalloc = false; - - unwind_protect frame; - - // Replace the outfile pointer with stdout for debugging information. -#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) - FILE *outfile = gnulib::fopen ("NUL", "w"); -#else - FILE *outfile = gnulib::fopen ("/dev/null", "w"); -#endif - FILE *errfile = stderr; - - if (outfile) - frame.add_fcn (close_fcn, outfile); - else - { - error ("convhulln: unable to create temporary file for output"); - return retval; - } - - // qh_new_qhull command and points arguments are not const... - - std::string cmd = "qhull" + options; - - OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); - - strcpy (cmd_str, cmd.c_str ()); - - int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), - ismalloc, cmd_str, outfile, errfile); - if (! exitcode) - { - bool nonsimp_seen = false; - - octave_idx_type nf = qh num_facets; - - Matrix idx (nf, dim + 1); - - facetT *facet; - - octave_idx_type i = 0; - - FORALLfacets - { - octave_idx_type j = 0; - - if (! nonsimp_seen && ! facet->simplicial) - { - nonsimp_seen = true; - - if (cmd.find ("QJ") != std::string::npos) - { - // Should never happen with QJ. - error ("convhulln: qhull failed: option 'QJ' returned non-simplicial facet"); - return retval; - } - } - - if (dim == 3) - { - setT *vertices = qh_facet3vertex (facet); - - vertexT *vertex, **vertexp; - - FOREACHvertex_ (vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - - qh_settempfree (&vertices); - } - else - { - if (facet->toporient ^ qh_ORIENTclock) - { - vertexT *vertex, **vertexp; - - FOREACHvertex_ (facet->vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - } - else - { - vertexT *vertex, **vertexp; - - FOREACHvertexreverse12_ (facet->vertices) - idx(i, j++) = 1 + qh_pointid(vertex->point); - } - } - if (j < dim) - warning ("convhulln: facet %d only has %d vertices", i, j); - - i++; - } - - // Remove extra dimension if all facets were simplicial. - - if (! nonsimp_seen) - idx.resize (nf, dim, 0.0); - - if (nargout == 2) - { - // Calculate volume of convex hull, taken from qhull src/geom2.c. - - realT area; - realT dist; - - FORALLfacets - { - if (! facet->normal) - continue; - - if (facet->upperdelaunay && qh ATinfinity) - continue; - - facet->f.area = area = qh_facetarea (facet); - facet->isarea = True; - - if (qh DELAUNAY) - { - if (facet->upperdelaunay == qh UPPERdelaunay) - qh totarea += area; - } - else - { - qh totarea += area; - qh_distplane (qh interior_point, facet, &dist); - qh totvol += -dist * area/ qh hull_dim; - } - } - - retval(1) = octave_value (qh totvol); - } - - retval(0) = idx; - } - else - error ("convhulln: qhull failed"); - - // Free memory from Qhull - qh_freeqhull (! qh_ALL); - - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("convhulln: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); - -#else - error ("convhulln: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_QHULL -%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln (cube, "Qt"); -%! assert (size (h), [12 3]); -%! h = sortrows (sort (h, 2), [1:3]); -%! assert (h, [1 2 4; 1 2 6; 1 4 8; 1 5 6; 1 5 8; 2 3 4; 2 3 7; 2 6 7; 3 4 7; 4 7 8; 5 6 7; 5 7 8]); -%! assert (v, 1, 10*eps); -%! [h2, v2] = convhulln (cube); % Test defaut option = "Qt" -%! assert (size (h2), size (h)); -%! h2 = sortrows (sort (h2, 2), [1:3]); -%! assert (h2, h); -%! assert (v2, v, 10*eps); - -%!testif HAVE_QHULL -%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln (cube, "QJ"); -%! assert (size (h), [12 3]); -%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); -%! assert (v, 1.0, 1e6*eps); - -%!testif HAVE_QHULL -%! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; -%! [h, v] = convhulln (tetrahedron); -%! h = sortrows (sort (h, 2), [1 2 3]); -%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); -%! assert (v, 8/3, 10*eps); -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/dmperm.cc --- a/src/DLD-FUNCTIONS/dmperm.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman -Copyright (C) 1998-2005 Andy Adler - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -#include "oct-sparse.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "SparseQR.h" -#include "SparseCmplxQR.h" - -#ifdef IDX_TYPE_LONG -#define CXSPARSE_NAME(name) cs_dl ## name -#else -#define CXSPARSE_NAME(name) cs_di ## name -#endif - -static RowVector -put_int (octave_idx_type *p, octave_idx_type n) -{ - RowVector ret (n); - for (octave_idx_type i = 0; i < n; i++) - ret.xelem (i) = p[i] + 1; - return ret; -} - -#if HAVE_CXSPARSE -static octave_value_list -dmperm_internal (bool rank, const octave_value arg, int nargout) -{ - octave_value_list retval; - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - SparseMatrix m; - SparseComplexMatrix cm; - CXSPARSE_NAME () csm; - csm.m = nr; - csm.n = nc; - csm.x = 0; - csm.nz = -1; - - if (arg.is_real_type ()) - { - m = arg.sparse_matrix_value (); - csm.nzmax = m.nnz (); - csm.p = m.xcidx (); - csm.i = m.xridx (); - } - else - { - cm = arg.sparse_complex_matrix_value (); - csm.nzmax = cm.nnz (); - csm.p = cm.xcidx (); - csm.i = cm.xridx (); - } - - if (!error_state) - { - if (nargout <= 1 || rank) - { -#if defined(CS_VER) && (CS_VER >= 2) - octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm, 0); -#else - octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm); -#endif - if (rank) - { - octave_idx_type r = 0; - for (octave_idx_type i = 0; i < nc; i++) - if (jmatch[nr+i] >= 0) - r++; - retval(0) = static_cast(r); - } - else - retval(0) = put_int (jmatch + nr, nc); - CXSPARSE_NAME (_free) (jmatch); - } - else - { -#if defined(CS_VER) && (CS_VER >= 2) - CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm, 0); -#else - CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm); -#endif - - //retval(5) = put_int (dm->rr, 5); - //retval(4) = put_int (dm->cc, 5); -#if defined(CS_VER) && (CS_VER >= 2) - retval(3) = put_int (dm->s, dm->nb+1); - retval(2) = put_int (dm->r, dm->nb+1); - retval(1) = put_int (dm->q, nc); - retval(0) = put_int (dm->p, nr); -#else - retval(3) = put_int (dm->S, dm->nb+1); - retval(2) = put_int (dm->R, dm->nb+1); - retval(1) = put_int (dm->Q, nc); - retval(0) = put_int (dm->P, nr); -#endif - CXSPARSE_NAME (_dfree) (dm); - } - } - return retval; -} -#endif - -DEFUN_DLD (dmperm, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} dmperm (@var{S})\n\ -@deftypefnx {Loadable Function} {[@var{p}, @var{q}, @var{r}, @var{S}] =} dmperm (@var{S})\n\ -\n\ -@cindex Dulmage-Mendelsohn decomposition\n\ -Perform a Dulmage-Mendelsohn permutation of the sparse matrix @var{S}.\n\ -With a single output argument @code{dmperm} performs the row permutations\n\ -@var{p} such that @code{@var{S}(@var{p},:)} has no zero elements on the\n\ -diagonal.\n\ -\n\ -Called with two or more output arguments, returns the row and column\n\ -permutations, such that @code{@var{S}(@var{p}, @var{q})} is in block\n\ -triangular form. The values of @var{r} and @var{S} define the boundaries\n\ -of the blocks. If @var{S} is square then @code{@var{r} == @var{S}}.\n\ -\n\ -The method used is described in: A. Pothen & C.-J. Fan. @cite{Computing the\n\ -Block Triangular Form of a Sparse Matrix}. ACM Trans. Math. Software,\n\ -16(4):303-324, 1990.\n\ -@seealso{colamd, ccolamd}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 1) - { - print_usage (); - return retval; - } - -#if HAVE_CXSPARSE - retval = dmperm_internal (false, args(0), nargout); -#else - error ("dmperm: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_CXSPARSE -%! n = 20; -%! a = speye (n,n); -%! a = a(randperm (n),:); -%! assert (a(dmperm (a),:), speye (n)); - -%!testif HAVE_CXSPARSE -%! n = 20; -%! d = 0.2; -%! a = tril (sprandn (n,n,d), -1) + speye (n,n); -%! a = a(randperm (n), randperm (n)); -%! [p,q,r,s] = dmperm (a); -%! assert (tril (a(p,q), -1), sparse (n, n)); -*/ - -DEFUN_DLD (sprank, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} sprank (@var{S})\n\ -@cindex structural rank\n\ -\n\ -Calculate the structural rank of the sparse matrix @var{S}. Note that\n\ -only the structure of the matrix is used in this calculation based on\n\ -a Dulmage-Mendelsohn permutation to block triangular form. As such the\n\ -numerical rank of the matrix @var{S} is bounded by\n\ -@code{sprank (@var{S}) >= rank (@var{S})}. Ignoring floating point errors\n\ -@code{sprank (@var{S}) == rank (@var{S})}.\n\ -@seealso{dmperm}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value_list retval; - - if (nargin != 1) - { - print_usage (); - return retval; - } - -#if HAVE_CXSPARSE - retval = dmperm_internal (true, args(0), nargout); -#else - error ("sprank: not available in this version of Octave"); -#endif - - return retval; -} - -/* -%!testif HAVE_CXSPARSE -%! assert (sprank (speye (20)), 20) -%!testif HAVE_CXSPARSE -%! assert (sprank ([1,0,2,0;2,0,4,0]), 2) - -%!error sprank (1,2) -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/eigs.cc --- a/src/DLD-FUNCTIONS/eigs.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1521 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "quit.h" -#include "variables.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-map.h" -#include "pager.h" -#include "unwind-prot.h" - -#include "eigs-base.cc" - -// Global pointer for user defined function. -static octave_function *eigs_fcn = 0; - -// Have we warned about imaginary values returned from user function? -static bool warned_imaginary = false; - -// Is this a recursive call? -static int call_depth = 0; - -ColumnVector -eigs_func (const ColumnVector &x, int &eigs_error) -{ - ColumnVector retval; - octave_value_list args; - args(0) = x; - - if (eigs_fcn) - { - octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - return retval; - } - - if (tmp.length () && tmp(0).is_defined ()) - { - if (! warned_imaginary && tmp(0).is_complex_type ()) - { - warning ("eigs: ignoring imaginary part returned from user-supplied function"); - warned_imaginary = true; - } - - retval = ColumnVector (tmp(0).vector_value ()); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - else - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - - return retval; -} - -ComplexColumnVector -eigs_complex_func (const ComplexColumnVector &x, int &eigs_error) -{ - ComplexColumnVector retval; - octave_value_list args; - args(0) = x; - - if (eigs_fcn) - { - octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - return retval; - } - - if (tmp.length () && tmp(0).is_defined ()) - { - retval = ComplexColumnVector (tmp(0).complex_vector_value ()); - - if (error_state) - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - else - { - eigs_error = 1; - gripe_user_supplied_eval ("eigs"); - } - } - - return retval; -} - -DEFUN_DLD (eigs, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{d} =} eigs (@var{A})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{A}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{af}, @var{n}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{A}, @dots{})\n\ -@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{af}, @var{n}, @dots{})\n\ -Calculate a limited number of eigenvalues and eigenvectors of @var{A},\n\ -based on a selection criteria. The number of eigenvalues and eigenvectors to\n\ -calculate is given by @var{k} and defaults to 6.\n\ -\n\ -By default, @code{eigs} solve the equation\n\ -@tex\n\ -$A \\nu = \\lambda \\nu$,\n\ -@end tex\n\ -@ifinfo\n\ -@code{A * v = lambda * v},\n\ -@end ifinfo\n\ -where\n\ -@tex\n\ -$\\lambda$ is a scalar representing one of the eigenvalues, and $\\nu$\n\ -@end tex\n\ -@ifinfo\n\ -@code{lambda} is a scalar representing one of the eigenvalues, and @code{v}\n\ -@end ifinfo\n\ -is the corresponding eigenvector. If given the positive definite matrix\n\ -@var{B} then @code{eigs} solves the general eigenvalue equation\n\ -@tex\n\ -$A \\nu = \\lambda B \\nu$.\n\ -@end tex\n\ -@ifinfo\n\ -@code{A * v = lambda * B * v}.\n\ -@end ifinfo\n\ -\n\ -The argument @var{sigma} determines which eigenvalues are returned.\n\ -@var{sigma} can be either a scalar or a string. When @var{sigma} is a\n\ -scalar, the @var{k} eigenvalues closest to @var{sigma} are returned. If\n\ -@var{sigma} is a string, it must have one of the following values.\n\ -\n\ -@table @asis\n\ -@item \"lm\"\n\ -Largest Magnitude (default).\n\ -\n\ -@item \"sm\"\n\ -Smallest Magnitude.\n\ -\n\ -@item \"la\"\n\ -Largest Algebraic (valid only for real symmetric problems).\n\ -\n\ -@item \"sa\"\n\ -Smallest Algebraic (valid only for real symmetric problems).\n\ -\n\ -@item \"be\"\n\ -Both Ends, with one more from the high-end if @var{k} is odd (valid only for\n\ -real symmetric problems).\n\ -\n\ -@item \"lr\"\n\ -Largest Real part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"sr\"\n\ -Smallest Real part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"li\"\n\ -Largest Imaginary part (valid only for complex or unsymmetric problems).\n\ -\n\ -@item \"si\"\n\ -Smallest Imaginary part (valid only for complex or unsymmetric problems).\n\ -@end table\n\ -\n\ -If @var{opts} is given, it is a structure defining possible options that\n\ -@code{eigs} should use. The fields of the @var{opts} structure are:\n\ -\n\ -@table @code\n\ -@item issym\n\ -If @var{af} is given, then flags whether the function @var{af} defines a\n\ -symmetric problem. It is ignored if @var{A} is given. The default is false.\n\ -\n\ -@item isreal\n\ -If @var{af} is given, then flags whether the function @var{af} defines a\n\ -real problem. It is ignored if @var{A} is given. The default is true.\n\ -\n\ -@item tol\n\ -Defines the required convergence tolerance, calculated as\n\ -@code{tol * norm (A)}. The default is @code{eps}.\n\ -\n\ -@item maxit\n\ -The maximum number of iterations. The default is 300.\n\ -\n\ -@item p\n\ -The number of Lanzcos basis vectors to use. More vectors will result in\n\ -faster convergence, but a greater use of memory. The optimal value of\n\ -@code{p} is problem dependent and should be in the range @var{k} to @var{n}.\n\ -The default value is @code{2 * @var{k}}.\n\ -\n\ -@item v0\n\ -The starting vector for the algorithm. An initial vector close to the\n\ -final vector will speed up convergence. The default is for @sc{arpack}\n\ -to randomly generate a starting vector. If specified, @code{v0} must be\n\ -an @var{n}-by-1 vector where @code{@var{n} = rows (@var{A})}\n\ -\n\ -@item disp\n\ -The level of diagnostic printout (0|1|2). If @code{disp} is 0 then\n\ -diagnostics are disabled. The default value is 0.\n\ -\n\ -@item cholB\n\ -Flag if @code{chol (@var{B})} is passed rather than @var{B}. The default is\n\ -false.\n\ -\n\ -@item permB\n\ -The permutation vector of the Cholesky@tie{}factorization of @var{B} if\n\ -@code{cholB} is true. That is @code{chol (@var{B}(permB, permB))}. The\n\ -default is @code{1:@var{n}}.\n\ -\n\ -@end table\n\ -\n\ -It is also possible to represent @var{A} by a function denoted @var{af}.\n\ -@var{af} must be followed by a scalar argument @var{n} defining the length\n\ -of the vector argument accepted by @var{af}. @var{af} can be\n\ -a function handle, an inline function, or a string. When @var{af} is a\n\ -string it holds the name of the function to use.\n\ -\n\ -@var{af} is a function of the form @code{y = af (x)}\n\ -where the required return value of @var{af} is determined by\n\ -the value of @var{sigma}. The four possible forms are\n\ -\n\ -@table @code\n\ -@item A * x\n\ -if @var{sigma} is not given or is a string other than \"sm\".\n\ -\n\ -@item A \\ x\n\ -if @var{sigma} is 0 or \"sm\".\n\ -\n\ -@item (A - sigma * I) \\ x\n\ -for the standard eigenvalue problem, where @code{I} is the identity matrix of\n\ -the same size as @var{A}.\n\ -\n\ -@item (A - sigma * B) \\ x\n\ -for the general eigenvalue problem.\n\ -@end table\n\ -\n\ -The return arguments of @code{eigs} depend on the number of return arguments\n\ -requested. With a single return argument, a vector @var{d} of length @var{k}\n\ -is returned containing the @var{k} eigenvalues that have been found. With\n\ -two return arguments, @var{V} is a @var{n}-by-@var{k} matrix whose columns\n\ -are the @var{k} eigenvectors corresponding to the returned eigenvalues. The\n\ -eigenvalues themselves are returned in @var{d} in the form of a\n\ -@var{n}-by-@var{k} matrix, where the elements on the diagonal are the\n\ -eigenvalues.\n\ -\n\ -Given a third return argument @var{flag}, @code{eigs} returns the status\n\ -of the convergence. If @var{flag} is 0 then all eigenvalues have converged.\n\ -Any other value indicates a failure to converge.\n\ -\n\ -This function is based on the @sc{arpack} package, written by R. Lehoucq,\n\ -K. Maschhoff, D. Sorensen, and C. Yang. For more information see\n\ -@url{http://www.caam.rice.edu/software/ARPACK/}.\n\ -\n\ -@seealso{eig, svds}\n\ -@end deftypefn") -{ - octave_value_list retval; -#ifdef HAVE_ARPACK - int nargin = args.length (); - std::string fcn_name; - octave_idx_type n = 0; - octave_idx_type k = 6; - Complex sigma = 0.; - double sigmar, sigmai; - bool have_sigma = false; - std::string typ = "LM"; - Matrix amm, bmm, bmt; - ComplexMatrix acm, bcm, bct; - SparseMatrix asmm, bsmm, bsmt; - SparseComplexMatrix ascm, bscm, bsct; - int b_arg = 0; - bool have_b = false; - bool have_a_fun = false; - bool a_is_complex = false; - bool b_is_complex = false; - bool symmetric = false; - bool sym_tested = false; - bool cholB = false; - bool a_is_sparse = false; - ColumnVector permB; - int arg_offset = 0; - double tol = DBL_EPSILON; - int maxit = 300; - int disp = 0; - octave_idx_type p = -1; - ColumnVector resid; - ComplexColumnVector cresid; - octave_idx_type info = 1; - - warned_imaginary = false; - - unwind_protect frame; - - frame.protect_var (call_depth); - call_depth++; - - if (call_depth > 1) - { - error ("eigs: invalid recursive call"); - if (fcn_name.length ()) - clear_function (fcn_name); - return retval; - } - - if (nargin == 0) - print_usage (); - else if (args(0).is_function_handle () || args(0).is_inline_function () - || args(0).is_string ()) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - std::string fname = "function y = "; - fcn_name = unique_symbol_name ("__eigs_fcn_"); - fname.append (fcn_name); - fname.append ("(x) y = "); - eigs_fcn = extract_function (args(0), "eigs", fcn_name, fname, - "; endfunction"); - } - else - eigs_fcn = args(0).function_value (); - - if (!eigs_fcn) - { - error ("eigs: unknown function"); - return retval; - } - - if (nargin < 2) - { - error ("eigs: incorrect number of arguments"); - return retval; - } - else - { - n = args(1).nint_value (); - arg_offset = 1; - have_a_fun = true; - } - } - else - { - if (args(0).is_complex_type ()) - { - if (args(0).is_sparse_type ()) - { - ascm = (args(0).sparse_complex_matrix_value ()); - a_is_sparse = true; - } - else - acm = (args(0).complex_matrix_value ()); - a_is_complex = true; - symmetric = false; // ARPACK doesn't special case complex symmetric - sym_tested = true; - } - else - { - if (args(0).is_sparse_type ()) - { - asmm = (args(0).sparse_matrix_value ()); - a_is_sparse = true; - } - else - { - amm = (args(0).matrix_value ()); - } - } - - } - - // Note hold off reading B till later to avoid issues of double - // copies of the matrix if B is full/real while A is complex. - if (!error_state && nargin > 1 + arg_offset && - !(args(1 + arg_offset).is_real_scalar ())) - { - if (args(1+arg_offset).is_complex_type ()) - { - b_arg = 1+arg_offset; - have_b = true; - b_is_complex = true; - arg_offset++; - } - else - { - b_arg = 1+arg_offset; - have_b = true; - arg_offset++; - } - } - - if (!error_state && nargin > (1+arg_offset)) - k = args(1+arg_offset).nint_value (); - - if (!error_state && nargin > (2+arg_offset)) - { - if (args(2+arg_offset).is_string ()) - { - typ = args(2+arg_offset).string_value (); - - // Use STL function to convert to upper case - transform (typ.begin (), typ.end (), typ.begin (), toupper); - - sigma = 0.; - } - else - { - sigma = args(2+arg_offset).complex_value (); - - if (! error_state) - have_sigma = true; - else - { - error ("eigs: SIGMA must be a scalar or a string"); - return retval; - } - } - } - - sigmar = std::real (sigma); - sigmai = std::imag (sigma); - - if (!error_state && nargin > (3+arg_offset)) - { - if (args(3+arg_offset).is_map ()) - { - octave_scalar_map map = args(3+arg_offset).scalar_map_value (); - - if (! error_state) - { - octave_value tmp; - - // issym is ignored for complex matrix inputs - tmp = map.getfield ("issym"); - if (tmp.is_defined () && !sym_tested) - { - symmetric = tmp.double_value () != 0.; - sym_tested = true; - } - - // isreal is ignored if A is not a function - tmp = map.getfield ("isreal"); - if (tmp.is_defined () && have_a_fun) - a_is_complex = ! (tmp.double_value () != 0.); - - tmp = map.getfield ("tol"); - if (tmp.is_defined ()) - tol = tmp.double_value (); - - tmp = map.getfield ("maxit"); - if (tmp.is_defined ()) - maxit = tmp.nint_value (); - - tmp = map.getfield ("p"); - if (tmp.is_defined ()) - p = tmp.nint_value (); - - tmp = map.getfield ("v0"); - if (tmp.is_defined ()) - { - if (a_is_complex || b_is_complex) - cresid = ComplexColumnVector (tmp.complex_vector_value ()); - else - resid = ColumnVector (tmp.vector_value ()); - } - - tmp = map.getfield ("disp"); - if (tmp.is_defined ()) - disp = tmp.nint_value (); - - tmp = map.getfield ("cholB"); - if (tmp.is_defined ()) - cholB = tmp.double_value () != 0.; - - tmp = map.getfield ("permB"); - if (tmp.is_defined ()) - permB = ColumnVector (tmp.vector_value ()) - 1.0; - } - else - { - error ("eigs: OPTS argument must be a scalar structure"); - return retval; - } - } - else - { - error ("eigs: OPTS argument must be a structure"); - return retval; - } - } - - if (nargin > (4+arg_offset)) - { - error ("eigs: incorrect number of arguments"); - return retval; - } - - // Test undeclared (no issym) matrix inputs for symmetry - if (!sym_tested && !have_a_fun) - { - if (a_is_sparse) - symmetric = asmm.is_symmetric (); - else - symmetric = amm.is_symmetric (); - } - - if (have_b) - { - if (a_is_complex || b_is_complex) - { - if (a_is_sparse) - bscm = args(b_arg).sparse_complex_matrix_value (); - else - bcm = args(b_arg).complex_matrix_value (); - } - else - { - if (a_is_sparse) - bsmm = args(b_arg).sparse_matrix_value (); - else - bmm = args(b_arg).matrix_value (); - } - } - - // Mode 1 for SM mode seems unstable for some reason. - // Use Mode 3 instead, with sigma = 0. - if (!error_state && !have_sigma && typ == "SM") - have_sigma = true; - - if (!error_state) - { - octave_idx_type nconv; - if (a_is_complex || b_is_complex) - { - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - - if (have_a_fun) - nconv = EigsComplexNonSymmetricFunc - (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrixShift - (ascm, sigma, k, p, info, eig_vec, eig_val, bscm, permB, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsComplexNonSymmetricMatrixShift - (acm, sigma, k, p, info, eig_vec, eig_val, bcm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - else - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrix - (ascm, typ, k, p, info, eig_vec, eig_val, bscm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - nconv = EigsComplexNonSymmetricMatrix - (acm, typ, k, p, info, eig_vec, eig_val, bcm, permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else if (sigmai != 0.) - { - // Promote real problem to a complex one. - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - if (have_a_fun) - nconv = EigsComplexNonSymmetricFunc - (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, - cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - { - if (a_is_sparse) - nconv = EigsComplexNonSymmetricMatrixShift - (SparseComplexMatrix (asmm), sigma, k, p, info, eig_vec, - eig_val, SparseComplexMatrix (bsmm), permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - else - nconv = EigsComplexNonSymmetricMatrixShift - (ComplexMatrix (amm), sigma, k, p, info, eig_vec, - eig_val, ComplexMatrix (bmm), permB, cresid, - octave_stdout, tol, (nargout > 1), cholB, disp, maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else - { - if (symmetric) - { - Matrix eig_vec; - ColumnVector eig_val; - - if (have_a_fun) - nconv = EigsRealSymmetricFunc - (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsRealSymmetricMatrixShift - (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealSymmetricMatrixShift - (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - else - { - if (a_is_sparse) - nconv = EigsRealSymmetricMatrix - (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealSymmetricMatrix - (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = DiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - else - { - ComplexMatrix eig_vec; - ComplexColumnVector eig_val; - - if (have_a_fun) - nconv = EigsRealNonSymmetricFunc - (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else if (have_sigma) - { - if (a_is_sparse) - nconv = EigsRealNonSymmetricMatrixShift - (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealNonSymmetricMatrixShift - (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - else - { - if (a_is_sparse) - nconv = EigsRealNonSymmetricMatrix - (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - else - nconv = EigsRealNonSymmetricMatrix - (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, - resid, octave_stdout, tol, (nargout > 1), cholB, disp, - maxit); - } - - if (nargout < 2) - retval(0) = eig_val; - else - { - retval(2) = double (info); - retval(1) = ComplexDiagMatrix (eig_val); - retval(0) = eig_vec; - } - } - } - - if (nconv <= 0) - warning ("eigs: None of the %d requested eigenvalues converged", k); - else if (nconv < k) - warning ("eigs: Only %d of the %d requested eigenvalues converged", - nconv, k); - } - - if (! fcn_name.empty ()) - clear_function (fcn_name); -#else - error ("eigs: not available in this version of Octave"); -#endif - - return retval; -} - -/* #### SPARSE MATRIX VERSIONS #### */ - -/* -## Real positive definite tests, n must be even -%!shared n, k, A, d0, d2 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); -%! d0 = eig (A); -%! d2 = sort (d0); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); # initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (d1, d0(end:-1:(end-k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "la"); -%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sa"); -%! assert (d1, d2(1:k), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "be"); -%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, "be"); -%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! AA = speye (10); -%! fn = @(x) AA * x; -%! opts.issym = 1; opts.isreal = 1; -%! assert (eigs (fn, 10, AA, 3, "lm", opts), [1; 1; 1], 10*eps); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "la"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sa"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "be"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Real unsymmetric tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (d0)); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Complex hermitian tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs (A, speye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! d1 = eigs (A, speye (n), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* #### FULL MATRIX VERSIONS #### */ - -/* -## Real positive definite tests, n must be even -%!shared n, k, A, d0, d2 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); -%! d0 = eig (A); -%! d2 = sort (d0); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (d1, d0(end:-1:(end-k)),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "la"); -%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sa"); -%! assert (d1, d2(1:k), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "be"); -%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, "be"); -%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (d1, d0(k:-1:1), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "la"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sa"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "be"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Real unsymmetric tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (d0)); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ - -/* -## Complex hermitian tests -%!shared n, k, A, d0 -%! n = 20; -%! k = 4; -%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); -%! d0 = eig (A); -%! [~, idx] = sort (abs (d0)); -%! d0 = d0(idx); -%! rand ("state", 42); % initialize generator to make eigs behavior reproducible -%!testif HAVE_ARPACK -%! d1 = eigs (A, k); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k+1); -%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sm"); -%! assert (abs (d1), abs (d0(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "lr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "sr"); -%! [~, idx] = sort (real (abs (d0))); -%! d2 = d0(idx); -%! assert (real (d1), real (d2(1:k)), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "li"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, "si"); -%! [~, idx] = sort (imag (abs (d0))); -%! d2 = d0(idx); -%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, k, 4.1); -%! [~, idx0] = sort (abs (d0 - 4.1)); -%! [~, idx1] = sort (abs (d1 - 4.1)); -%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); -%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); -%!testif HAVE_ARPACK -%! d1 = eigs (A, eye (n), k, "lm"); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! d1 = eigs (A, eye (n), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! opts.cholB = true; -%! q = [2:n,1]; -%! opts.permB = q; -%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); -%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); -%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); -%!testif HAVE_ARPACK -%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "lm", opts); -%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, "sm", opts); -%! assert (abs (d1), d0(1:k), 1e-11); -%!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye (n)) \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sm"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "lr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "sr"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "li"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -%!testif HAVE_ARPACK -%! [v1,d1] = eigs (A, k, "si"); -%! d1 = diag (d1); -%! for i=1:k -%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); -%! endfor -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/fftw.cc --- a/src/DLD-FUNCTIONS/fftw.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,269 +0,0 @@ -/* - -Copyright (C) 2006-2012 David Bateman - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "oct-fftw.h" - -#include "defun-dld.h" -#include "error.h" -#include "ov.h" - -DEFUN_DLD (fftw, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{method} =} fftw (\"planner\")\n\ -@deftypefnx {Loadable Function} {} fftw (\"planner\", @var{method})\n\ -@deftypefnx {Loadable Function} {@var{wisdom} =} fftw (\"dwisdom\")\n\ -@deftypefnx {Loadable Function} {} fftw (\"dwisdom\", @var{wisdom})\n\ -\n\ -Manage @sc{fftw} wisdom data. Wisdom data can be used to significantly\n\ -accelerate the calculation of the FFTs, but implies an initial cost\n\ -in its calculation. When the @sc{fftw} libraries are initialized, they read\n\ -a system wide wisdom file (typically in @file{/etc/fftw/wisdom}), allowing\n\ -wisdom to be shared between applications other than Octave. Alternatively,\n\ -the @code{fftw} function can be used to import wisdom. For example,\n\ -\n\ -@example\n\ -@var{wisdom} = fftw (\"dwisdom\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will save the existing wisdom used by Octave to the string @var{wisdom}.\n\ -This string can then be saved to a file and restored using the @code{save}\n\ -and @code{load} commands respectively. This existing wisdom can be\n\ -reimported as follows\n\ -\n\ -@example\n\ -fftw (\"dwisdom\", @var{wisdom})\n\ -@end example\n\ -\n\ -If @var{wisdom} is an empty matrix, then the wisdom used is cleared.\n\ -\n\ -During the calculation of Fourier transforms further wisdom is generated.\n\ -The fashion in which this wisdom is generated is also controlled by\n\ -the @code{fftw} function. There are five different manners in which the\n\ -wisdom can be treated:\n\ -\n\ -@table @asis\n\ -@item \"estimate\"\n\ -Specifies that no run-time measurement of the optimal means of\n\ -calculating a particular is performed, and a simple heuristic is used\n\ -to pick a (probably sub-optimal) plan. The advantage of this method is\n\ -that there is little or no overhead in the generation of the plan, which\n\ -is appropriate for a Fourier transform that will be calculated once.\n\ -\n\ -@item \"measure\"\n\ -In this case a range of algorithms to perform the transform is considered\n\ -and the best is selected based on their execution time.\n\ -\n\ -@item \"patient\"\n\ -Similar to \"measure\", but a wider range of algorithms is considered.\n\ -\n\ -@item \"exhaustive\"\n\ -Like \"measure\", but all possible algorithms that may be used to\n\ -treat the transform are considered.\n\ -\n\ -@item \"hybrid\"\n\ -As run-time measurement of the algorithm can be expensive, this is a\n\ -compromise where \"measure\" is used for transforms up to the size of 8192\n\ -and beyond that the \"estimate\" method is used.\n\ -@end table\n\ -\n\ -The default method is \"estimate\". The current method can\n\ -be queried with\n\ -\n\ -@example\n\ -@var{method} = fftw (\"planner\")\n\ -@end example\n\ -\n\ -@noindent\n\ -or set by using\n\ -\n\ -@example\n\ -fftw (\"planner\", @var{method})\n\ -@end example\n\ -\n\ -Note that calculated wisdom will be lost when restarting Octave. However,\n\ -the wisdom data can be reloaded if it is saved to a file as described\n\ -above. Saved wisdom files should not be used on different platforms since\n\ -they will not be efficient and the point of calculating the wisdom is lost.\n\ -@seealso{fft, ifft, fft2, ifft2, fftn, ifftn}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - { - print_usage (); - return retval; - } - -#if defined (HAVE_FFTW) - if (args(0).is_string ()) - { - std::string arg0 = args(0).string_value (); - - if (!error_state) - { - // Use STL function to convert to lower case - std::transform (arg0.begin (), arg0.end (), arg0.begin (), tolower); - - if (nargin == 2) - { - std::string arg1 = args(1).string_value (); - if (!error_state) - { - if (arg0 == "planner") - { - std::transform (arg1.begin (), arg1.end (), - arg1.begin (), tolower); - octave_fftw_planner::FftwMethod meth - = octave_fftw_planner::UNKNOWN; - octave_float_fftw_planner::FftwMethod methf - = octave_float_fftw_planner::UNKNOWN; - - if (arg1 == "estimate") - { - meth = octave_fftw_planner::ESTIMATE; - methf = octave_float_fftw_planner::ESTIMATE; - } - else if (arg1 == "measure") - { - meth = octave_fftw_planner::MEASURE; - methf = octave_float_fftw_planner::MEASURE; - } - else if (arg1 == "patient") - { - meth = octave_fftw_planner::PATIENT; - methf = octave_float_fftw_planner::PATIENT; - } - else if (arg1 == "exhaustive") - { - meth = octave_fftw_planner::EXHAUSTIVE; - methf = octave_float_fftw_planner::EXHAUSTIVE; - } - else if (arg1 == "hybrid") - { - meth = octave_fftw_planner::HYBRID; - methf = octave_float_fftw_planner::HYBRID; - } - else - error ("unrecognized planner METHOD"); - - if (!error_state) - { - meth = octave_fftw_planner::method (meth); - octave_float_fftw_planner::method (methf); - - if (meth == octave_fftw_planner::MEASURE) - retval = octave_value ("measure"); - else if (meth == octave_fftw_planner::PATIENT) - retval = octave_value ("patient"); - else if (meth == octave_fftw_planner::EXHAUSTIVE) - retval = octave_value ("exhaustive"); - else if (meth == octave_fftw_planner::HYBRID) - retval = octave_value ("hybrid"); - else - retval = octave_value ("estimate"); - } - } - else if (arg0 == "dwisdom") - { - char *str = fftw_export_wisdom_to_string (); - - if (arg1.length () < 1) - fftw_forget_wisdom (); - else if (! fftw_import_wisdom_from_string (arg1.c_str ())) - error ("could not import supplied WISDOM"); - - if (!error_state) - retval = octave_value (std::string (str)); - - free (str); - } - else if (arg0 == "swisdom") - { - char *str = fftwf_export_wisdom_to_string (); - - if (arg1.length () < 1) - fftwf_forget_wisdom (); - else if (! fftwf_import_wisdom_from_string (arg1.c_str ())) - error ("could not import supplied WISDOM"); - - if (!error_state) - retval = octave_value (std::string (str)); - - free (str); - } - else - error ("unrecognized argument"); - } - } - else - { - if (arg0 == "planner") - { - octave_fftw_planner::FftwMethod meth = - octave_fftw_planner::method (); - - if (meth == octave_fftw_planner::MEASURE) - retval = octave_value ("measure"); - else if (meth == octave_fftw_planner::PATIENT) - retval = octave_value ("patient"); - else if (meth == octave_fftw_planner::EXHAUSTIVE) - retval = octave_value ("exhaustive"); - else if (meth == octave_fftw_planner::HYBRID) - retval = octave_value ("hybrid"); - else - retval = octave_value ("estimate"); - } - else if (arg0 == "dwisdom") - { - char *str = fftw_export_wisdom_to_string (); - retval = octave_value (std::string (str)); - free (str); - } - else if (arg0 == "swisdom") - { - char *str = fftwf_export_wisdom_to_string (); - retval = octave_value (std::string (str)); - free (str); - } - else - error ("unrecognized argument"); - } - } - } -#else - - warning ("fftw: this copy of Octave was not configured to use the FFTW3 planner"); - -#endif - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/module-files --- a/src/DLD-FUNCTIONS/module-files Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -# FILE|CPPFLAGS|LDFLAGS|LIBRARIES -__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -__dsearchn__.cc -__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) -__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) -__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) -__init_gnuplot__.cc -__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) -__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -chol.cc -colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) -dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -eigs.cc|$(ARPACK_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(ARPACK_LDFLAGS) $(SPARSE_XLDFLAGS)|$(ARPACK_LIBS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) -fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) -qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) -symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) -tsearch.cc -urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS) diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/oct-qhull.h --- a/src/DLD-FUNCTIONS/oct-qhull.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,60 +0,0 @@ -/* - -Copyright (C) 2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_oct_qhull_h) -#define octave_oct_qhull_h 1 - -#include - -extern "C" { - -#if defined (HAVE_LIBQHULL_LIBQHULL_H) -# include -# include -# include -# include -# include -#elif defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) -# if defined (HAVE_QHULL_LIBQHULL_H) -# include -# else -# include -# endif -# include -# include -# include -# include -#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) -# if defined (HAVE_LIBQHULL_H) -# include -# else -# include -# endif -# include -# include -# include -# include -#endif - -} - -#endif diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/qr.cc --- a/src/DLD-FUNCTIONS/qr.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1598 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2008-2009 Jaroslav Hajek -Copyright (C) 2008-2009 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "CmplxQR.h" -#include "CmplxQRP.h" -#include "dbleQR.h" -#include "dbleQRP.h" -#include "fCmplxQR.h" -#include "fCmplxQRP.h" -#include "floatQR.h" -#include "floatQRP.h" -#include "SparseQR.h" -#include "SparseCmplxQR.h" - - -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -template -static octave_value -get_qr_r (const base_qr& fact) -{ - MT R = fact.R (); - if (R.is_square () && fact.regular ()) - return octave_value (R, MatrixType (MatrixType::Upper)); - else - return R; -} - -// [Q, R] = qr (X): form Q unitary and R upper triangular such -// that Q * R = X -// -// [Q, R] = qr (X, 0): form the economy decomposition such that if X is -// m by n then only the first n columns of Q are -// computed. -// -// [Q, R, P] = qr (X): form QRP factorization of X where -// P is a permutation matrix such that -// A * P = Q * R -// -// [Q, R, P] = qr (X, 0): form the economy decomposition with -// permutation vector P such that Q * R = X (:, P) -// -// qr (X) alone returns the output of the LAPACK routine dgeqrf, such -// that R = triu (qr (X)) - -DEFUN_DLD (qr, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ -@deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ -@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ -@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ -@cindex QR factorization\n\ -Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ -subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ -\n\ -@example\n\ -[@var{Q}, @var{R}] = qr (@var{A})\n\ -@end example\n\ -\n\ -@noindent\n\ -returns\n\ -\n\ -@example\n\ -@group\n\ -@var{Q} =\n\ -\n\ - -0.31623 -0.94868\n\ - -0.94868 0.31623\n\ -\n\ -@var{R} =\n\ -\n\ - -3.16228 -4.42719\n\ - 0.00000 -0.63246\n\ -@end group\n\ -@end example\n\ -\n\ -The @code{qr} factorization has applications in the solution of least\n\ -squares problems\n\ -@tex\n\ -$$\n\ -\\min_x \\left\\Vert A x - b \\right\\Vert_2\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -min norm(A x - b)\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -for overdetermined systems of equations (i.e.,\n\ -@tex\n\ -$A$\n\ -@end tex\n\ -@ifnottex\n\ -@var{A}\n\ -@end ifnottex\n\ - is a tall, thin matrix). The QR@tie{}factorization is\n\ -@tex\n\ -$QR = A$ where $Q$ is an orthogonal matrix and $R$ is upper triangular.\n\ -@end tex\n\ -@ifnottex\n\ -@code{@var{Q} * @var{Q} = @var{A}} where @var{Q} is an orthogonal matrix and\n\ -@var{R} is upper triangular.\n\ -@end ifnottex\n\ -\n\ -If given a second argument of '0', @code{qr} returns an economy-sized\n\ -QR@tie{}factorization, omitting zero rows of @var{R} and the corresponding\n\ -columns of @var{Q}.\n\ -\n\ -If the matrix @var{A} is full, the permuted QR@tie{}factorization\n\ -@code{[@var{Q}, @var{R}, @var{P}] = qr (@var{A})} forms the\n\ -QR@tie{}factorization such that the diagonal entries of @var{R} are\n\ -decreasing in magnitude order. For example, given the matrix @code{a = [1,\n\ -2; 3, 4]},\n\ -\n\ -@example\n\ -[@var{Q}, @var{R}, @var{P}] = qr (@var{A})\n\ -@end example\n\ -\n\ -@noindent\n\ -returns\n\ -\n\ -@example\n\ -@group\n\ -@var{Q} =\n\ -\n\ - -0.44721 -0.89443\n\ - -0.89443 0.44721\n\ -\n\ -@var{R} =\n\ -\n\ - -4.47214 -3.13050\n\ - 0.00000 0.44721\n\ -\n\ -@var{P} =\n\ -\n\ - 0 1\n\ - 1 0\n\ -@end group\n\ -@end example\n\ -\n\ -The permuted @code{qr} factorization @code{[@var{Q}, @var{R}, @var{P}] = qr\n\ -(@var{A})} factorization allows the construction of an orthogonal basis of\n\ -@code{span (A)}.\n\ -\n\ -If the matrix @var{A} is sparse, then compute the sparse\n\ -QR@tie{}factorization of @var{A}, using @sc{CSparse}. As the matrix @var{Q}\n\ -is in general a full matrix, this function returns the @var{Q}-less\n\ -factorization @var{R} of @var{A}, such that @code{@var{R} = chol (@var{A}' *\n\ -@var{A})}.\n\ -\n\ -If the final argument is the scalar @code{0} and the number of rows is\n\ -larger than the number of columns, then an economy factorization is\n\ -returned. That is @var{R} will have only @code{size (@var{A},1)} rows.\n\ -\n\ -If an additional matrix @var{B} is supplied, then @code{qr} returns\n\ -@var{C}, where @code{@var{C} = @var{Q}' * @var{B}}. This allows the\n\ -least squares approximation of @code{@var{A} \\ @var{B}} to be calculated\n\ -as\n\ -\n\ -@example\n\ -@group\n\ -[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ -x = @var{R} \\ @var{C}\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > (args(0).is_sparse_type () ? 3 : 2)) - { - print_usage (); - return retval; - } - - octave_value arg = args(0); - - int arg_is_empty = empty_arg ("qr", arg.rows (), arg.columns ()); - - if (arg_is_empty < 0) - return retval; - - if (arg.is_sparse_type ()) - { - bool economy = false; - bool is_cmplx = false; - int have_b = 0; - - if (arg.is_complex_type ()) - is_cmplx = true; - if (nargin > 1) - { - have_b = 1; - if (args(nargin-1).is_scalar_type ()) - { - int val = args(nargin-1).int_value (); - if (val == 0) - { - economy = true; - have_b = (nargin > 2 ? 2 : 0); - } - } - if (have_b > 0 && args(have_b).is_complex_type ()) - is_cmplx = true; - } - - if (!error_state) - { - if (have_b && nargout < 2) - error ("qr: incorrect number of output arguments"); - else if (is_cmplx) - { - SparseComplexQR q (arg.sparse_complex_matrix_value ()); - if (!error_state) - { - if (have_b > 0) - { - retval(1) = q.R (economy); - retval(0) = q.C (args(have_b).complex_matrix_value ()); - if (arg.rows () < arg.columns ()) - warning ("qr: non minimum norm solution for under-determined problem"); - } - else if (nargout > 1) - { - retval(1) = q.R (economy); - retval(0) = q.Q (); - } - else - retval(0) = q.R (economy); - } - } - else - { - SparseQR q (arg.sparse_matrix_value ()); - if (!error_state) - { - if (have_b > 0) - { - retval(1) = q.R (economy); - retval(0) = q.C (args(have_b).matrix_value ()); - if (args(0).rows () < args(0).columns ()) - warning ("qr: non minimum norm solution for under-determined problem"); - } - else if (nargout > 1) - { - retval(1) = q.R (economy); - retval(0) = q.Q (); - } - else - retval(0) = q.R (economy); - } - } - } - } - else - { - QR::type type = (nargout == 0 || nargout == 1) ? QR::raw - : (nargin == 2 ? QR::economy : QR::std); - - if (arg.is_single_type ()) - { - if (arg.is_real_type ()) - { - FloatMatrix m = arg.float_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - FloatQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - FloatQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - FloatQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else if (arg.is_complex_type ()) - { - FloatComplexMatrix m = arg.float_complex_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - FloatComplexQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - FloatComplexQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - FloatComplexQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - } - else - { - if (arg.is_real_type ()) - { - Matrix m = arg.matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - QR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - QR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - QRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else if (arg.is_complex_type ()) - { - ComplexMatrix m = arg.complex_matrix_value (); - - if (! error_state) - { - switch (nargout) - { - case 0: - case 1: - { - ComplexQR fact (m, type); - retval(0) = fact.R (); - } - break; - - case 2: - { - ComplexQR fact (m, type); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - - default: - { - ComplexQRP fact (m, type); - if (type == QR::economy) - retval(2) = fact.Pvec (); - else - retval(2) = fact.P (); - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - break; - } - } - } - else - gripe_wrong_type_arg ("qr", arg); - } - } - - return retval; -} - -/* -%!test -%! a = [0, 2, 1; 2, 1, 2]; -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps)); -%! assert (qe * re, a, sqrt (eps)); - -%!test -%! a = [0, 2, 1; 2, 1, 2]; -%! -%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps)); -%! assert (qe * re, a(:, pe), sqrt (eps)); - -%!test -%! a = [0, 2; 2, 1; 1, 2]; -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps)); -%! assert (qe * re, a, sqrt (eps)); - -%!test -%! a = [0, 2; 2, 1; 1, 2]; -%! -%! [q, r, p] = qr (a); -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps)); -%! assert (qe * re, a(:, pe), sqrt (eps)); - -%!error qr () -%!error qr ([1, 2; 3, 4], 0, 2) - -%!function retval = __testqr (q, r, a, p) -%! tol = 100*eps (class (q)); -%! retval = 0; -%! if (nargin == 3) -%! n1 = norm (q*r - a); -%! n2 = norm (q'*q - eye (columns (q))); -%! retval = (n1 < tol && n2 < tol); -%! else -%! n1 = norm (q'*q - eye (columns (q))); -%! retval = (n1 < tol); -%! if (isvector (p)) -%! n2 = norm (q*r - a(:,p)); -%! retval = (retval && n2 < tol); -%! else -%! n2 = norm (q*r - a*p); -%! retval = (retval && n2 < tol); -%! endif -%! endif -%!endfunction - -%!test -%! t = ones (24, 1); -%! j = 1; -%! -%! if (false) # eliminate big matrix tests -%! a = rand (5000, 20); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! endif -%! -%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 ]; -%! [q,r] = qr (a); -%! -%! assert (all (t) && norm (q*r - a) < 5000*eps); - -%!test -%! a = single ([0, 2, 1; 2, 1, 2]); -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps ("single"))); -%! assert (qe * re, a, sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2, 1; 2, 1, 2]); -%! -%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps ("single"))); -%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2; 2, 1; 1, 2]); -%! -%! [q, r] = qr (a); -%! [qe, re] = qr (a, 0); -%! -%! assert (q * r, a, sqrt (eps ("single"))); -%! assert (qe * re, a, sqrt (eps ("single"))); - -%!test -%! a = single ([0, 2; 2, 1; 1, 2]); -%! -%! [q, r, p] = qr (a); -%! [qe, re, pe] = qr (a, 0); -%! -%! assert (q * r, a * p, sqrt (eps ("single"))); -%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); - -%!error qr () -%!error qr ([1, 2; 3, 4], 0, 2) - -%!test -%! t = ones (24, 1); -%! j = 1; -%! -%! if (false) # eliminate big matrix tests -%! a = rand (5000,20); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! endif -%! -%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); -%! -%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); -%! -%! a = a+1i*eps ("single"); -%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); -%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); -%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); -%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a',p); -%! -%! a = [ 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 ]; -%! [q,r] = qr (a); -%! -%! assert (all (t) && norm (q*r-a) < 5000*eps ("single")); - -## The deactivated tests below can't be tested till rectangular back-subs is -## implemented for sparse matrices. - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_COLAMD -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! q = symamd (a); -%! a = a(q,q); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! [c,r] = qr (a, ones (n,1)); -%! assert (r\c, full (a)\ones (n,1), 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n,d) + speye (n,n); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%% Test under-determined systems!! -%!#testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = sprandn (n,n+1,d) + speye (n,n+1); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! r = qr (a); -%! assert (r'*r,a'*a,1e-10) - -%!testif HAVE_COLAMD -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! q = symamd (a); -%! a = a(q,q); -%! r = qr (a); -%! assert (r'*r, a'*a, 1e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! [c,r] = qr (a, ones (n,1)); -%! assert (r\c, full (a)\ones (n,1), 10e-10) - -%!testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n,d) + speye (n,n); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%% Test under-determined systems!! -%!#testif HAVE_CXSPARSE -%! n = 20; d = 0.2; -%! a = 1i*sprandn (n,n+1,d) + speye (n,n+1); -%! b = randn (n,2); -%! [c,r] = qr (a, b); -%! assert (r\c, full (a)\b, 10e-10) - -%!error qr (sprandn (10,10,0.2), ones (10,1)) -*/ - -static -bool check_qr_dims (const octave_value& q, const octave_value& r, - bool allow_ecf = false) -{ - octave_idx_type m = q.rows (), k = r.rows (), n = r.columns (); - return ((q.ndims () == 2 && r.ndims () == 2 && k == q.columns ()) - && (m == k || (allow_ecf && k == n && k < m))); -} - -static -bool check_index (const octave_value& i, bool vector_allowed = false) -{ - return ((i.is_real_type () || i.is_integer_type ()) - && (i.is_scalar_type () || vector_allowed)); -} - -DEFUN_DLD (qrupdate, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrupdate (@var{Q}, @var{R}, @var{u}, @var{v})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ -of @w{@var{A} + @var{u}*@var{v}'}, where @var{u} and @var{v} are\n\ -column vectors (rank-1 update) or matrices with equal number of columns\n\ -(rank-k update). Notice that the latter case is done as a sequence of rank-1\n\ -updates; thus, for k large enough, it will be both faster and more accurate\n\ -to recompute the factorization from scratch.\n\ -\n\ -The QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -@seealso{qr, qrinsert, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin != 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argu = args(2); - octave_value argv = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && argu.is_numeric_type () && argv.is_numeric_type ()) - { - if (check_qr_dims (argq, argr, true)) - { - if (argq.is_real_type () - && argr.is_real_type () - && argu.is_real_type () - && argv.is_real_type ()) - { - // all real case - if (argq.is_single_type () - || argr.is_single_type () - || argu.is_single_type () - || argv.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - FloatMatrix u = argu.float_matrix_value (); - FloatMatrix v = argv.float_matrix_value (); - - FloatQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - Matrix u = argu.matrix_value (); - Matrix v = argv.matrix_value (); - - QR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type () - || argu.is_single_type () - || argv.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexMatrix u = argu.float_complex_matrix_value (); - FloatComplexMatrix v = argv.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - ComplexMatrix u = argu.complex_matrix_value (); - ComplexMatrix v = argv.complex_matrix_value (); - - ComplexQR fact (Q, R); - fact.update (u, v); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrupdate: Q and R dimensions don't match"); - } - else - error ("qrupdate: Q, R, U, and V must be numeric"); - - return retval; -} - -/* -%!shared A, u, v, Ac, uc, vc -%! A = [0.091364 0.613038 0.999083; -%! 0.594638 0.425302 0.603537; -%! 0.383594 0.291238 0.085574; -%! 0.265712 0.268003 0.238409; -%! 0.669966 0.743851 0.445057 ]; -%! -%! u = [0.85082; -%! 0.76426; -%! 0.42883; -%! 0.53010; -%! 0.80683 ]; -%! -%! v = [0.98810; -%! 0.24295; -%! 0.43167 ]; -%! -%! Ac = [0.620405 + 0.956953i 0.480013 + 0.048806i 0.402627 + 0.338171i; -%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; -%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; -%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; -%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; -%! -%! uc = [0.20351 + 0.05401i; -%! 0.13141 + 0.43708i; -%! 0.29808 + 0.08789i; -%! 0.69821 + 0.38844i; -%! 0.74871 + 0.25821i ]; -%! -%! vc = [0.85839 + 0.29468i; -%! 0.20820 + 0.93090i; -%! 0.86184 + 0.34689i ]; -%! - -%!test -%! [Q,R] = qr (A); -%! [Q,R] = qrupdate (Q, R, u, v); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - A - u*v'), Inf) < norm (A)*1e1*eps); -%! -%!test -%! [Q,R] = qr (Ac); -%! [Q,R] = qrupdate (Q, R, uc, vc); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - Ac - uc*vc'), Inf) < norm (Ac)*1e1*eps); - -%!test -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrupdate (Q, R, single (u), single (v)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - single (A) - single (u)*single (v)'), Inf) < norm (single (A))*1e1*eps ("single")); -%! -%!test -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrupdate (Q, R, single (uc), single (vc)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R)-R), Inf) == 0); -%! assert (norm (vec (Q*R - single (Ac) - single (uc)*single (vc)'), Inf) < norm (single (Ac))*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrinsert, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrinsert (@var{Q}, @var{R}, @var{j}, @var{x}, @var{orient})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ -@w{[A(:,1:j-1) x A(:,j:n)]}, where @var{u} is a column vector to be\n\ -inserted into @var{A} (if @var{orient} is @code{\"col\"}), or the\n\ -QR@tie{}factorization of @w{[A(1:j-1,:);x;A(:,j:n)]}, where @var{x}\n\ -is a row vector to be inserted into @var{A} (if @var{orient} is\n\ -@code{\"row\"}).\n\ -\n\ -The default value of @var{orient} is @code{\"col\"}.\n\ -If @var{orient} is @code{\"col\"},\n\ -@var{u} may be a matrix and @var{j} an index vector\n\ -resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ -@w{B(:,@var{j})} gives @var{u} and @w{B(:,@var{j}) = []} gives @var{A}.\n\ -Notice that the latter case is done as a sequence of k insertions;\n\ -thus, for k large enough, it will be both faster and more accurate to\n\ -recompute the factorization from scratch.\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -the QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ -@seealso{qr, qrupdate, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin < 4 || nargin > 5) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argj = args(2); - octave_value argx = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && argx.is_numeric_type () - && (nargin < 5 || args(4).is_string ())) - { - std::string orient = (nargin < 5) ? "col" : args(4).string_value (); - - bool col = orient == "col"; - - if (col || orient == "row") - if (check_qr_dims (argq, argr, col) - && (col || argx.rows () == 1)) - { - if (check_index (argj, col)) - { - MArray j - = argj.octave_idx_type_vector_value (); - - octave_idx_type one = 1; - - if (argq.is_real_type () - && argr.is_real_type () - && argx.is_real_type ()) - { - // real case - if (argq.is_single_type () - || argr.is_single_type () - || argx.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - FloatMatrix x = argx.float_matrix_value (); - - FloatQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - Matrix x = argx.matrix_value (); - - QR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type () - || argx.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - FloatComplexMatrix x = argx.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - ComplexMatrix x = argx.complex_matrix_value (); - - ComplexQR fact (Q, R); - - if (col) - fact.insert_col (x, j-one); - else - fact.insert_row (x.row (0), j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - - } - else - error ("qrinsert: invalid index J"); - } - else - error ("qrinsert: dimension mismatch"); - - else - error ("qrinsert: ORIENT must be \"col\" or \"row\""); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! [Q,R] = qr (A); -%! [Q,R] = qrinsert (Q, R, 3, u); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [A(:,1:2) u A(:,3)]), Inf) < norm (A)*1e1*eps); -%!test -%! [Q,R] = qr (Ac); -%! [Q,R] = qrinsert (Q, R, 3, uc); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [Ac(:,1:2) uc Ac(:,3)]), Inf) < norm (Ac)*1e1*eps); -%!test -%! x = [0.85082 0.76426 0.42883 ]; -%! -%! [Q,R] = qr (A); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [A(1:2,:);x;A(3:5,:)]), Inf) < norm (A)*1e1*eps); -%!test -%! x = [0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]; -%! -%! [Q,R] = qr (Ac); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [Ac(1:2,:);x;Ac(3:5,:)]), Inf) < norm (Ac)*1e1*eps); - -%!test -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrinsert (Q, R, 3, single (u)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([A(:,1:2) u A(:,3)])), Inf) < norm (single (A))*1e1*eps ("single")); -%!test -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrinsert (Q, R, 3, single (uc)); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([Ac(:,1:2) uc Ac(:,3)])), Inf) < norm (single (Ac))*1e1*eps ("single")); -%!test -%! x = single ([0.85082 0.76426 0.42883 ]); -%! -%! [Q,R] = qr (single (A)); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([A(1:2,:);x;A(3:5,:)])), Inf) < norm (single (A))*1e1*eps ("single")); -%!test -%! x = single ([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); -%! -%! [Q,R] = qr (single (Ac)); -%! [Q,R] = qrinsert (Q, R, 3, x, "row"); -%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - single ([Ac(1:2,:);x;Ac(3:5,:)])), Inf) < norm (single (Ac))*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrdelete, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrdelete (@var{Q}, @var{R}, @var{j}, @var{orient})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ -@w{[A(:,1:j-1) A(:,j+1:n)]}, i.e., @var{A} with one column deleted\n\ -(if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\ -@w{[A(1:j-1,:);A(j+1:n,:)]}, i.e., @var{A} with one row deleted (if\n\ -@var{orient} is \"row\").\n\ -\n\ -The default value of @var{orient} is \"col\".\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -@var{j} may be an index vector\n\ -resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ -@w{A(:,@var{j}) = []} gives @var{B}.\n\ -Notice that the latter case is done as a sequence of k deletions;\n\ -thus, for k large enough, it will be both faster and more accurate to\n\ -recompute the factorization from scratch.\n\ -\n\ -If @var{orient} is @code{\"col\"},\n\ -the QR@tie{}factorization supplied may be either full\n\ -(Q is square) or economized (R is square).\n\ -\n\ -If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ -@seealso{qr, qrinsert, qrupdate}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin < 3 || nargin > 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argj = args(2); - - if (argq.is_numeric_type () && argr.is_numeric_type () - && (nargin < 4 || args(3).is_string ())) - { - std::string orient = (nargin < 4) ? "col" : args(3).string_value (); - - bool col = orient == "col"; - - if (col || orient == "row") - if (check_qr_dims (argq, argr, col)) - { - if (check_index (argj, col)) - { - MArray j - = argj.octave_idx_type_vector_value (); - - octave_idx_type one = 1; - - if (argq.is_real_type () - && argr.is_real_type ()) - { - // real case - if (argq.is_single_type () - || argr.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - - FloatQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - - QR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - || argr.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexQR fact (Q, R); - - if (col) - fact.delete_col (j-one); - else - fact.delete_row (j(0)-one); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrdelete: invalid index J"); - } - else - error ("qrdelete: dimension mismatch"); - - else - error ("qrdelete: ORIENT must be \"col\" or \"row\""); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! AA = [0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); - -%!test -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3); -%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1.5e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -%!testif HAVE_QRUPDATE -%! # Same test as above but with more precicision -%! AA = single ([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrdelete (Q, R, 3, "row"); -%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); -*/ - -DEFUN_DLD (qrshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrshift (@var{Q}, @var{R}, @var{i}, @var{j})\n\ -Given a QR@tie{}factorization of a real or complex matrix\n\ -@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ -@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ -of @w{@var{A}(:,p)}, where @w{p} is the permutation @*\n\ -@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ - or @*\n\ -@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ -\n\ -@seealso{qr, qrinsert, qrdelete}\n\ -@end deftypefn") -{ - octave_idx_type nargin = args.length (); - octave_value_list retval; - - if (nargin != 4) - { - print_usage (); - return retval; - } - - octave_value argq = args(0); - octave_value argr = args(1); - octave_value argi = args(2); - octave_value argj = args(3); - - if (argq.is_numeric_type () && argr.is_numeric_type ()) - { - if (check_qr_dims (argq, argr, true)) - { - if (check_index (argi) && check_index (argj)) - { - octave_idx_type i = argi.int_value (); - octave_idx_type j = argj.int_value (); - - if (argq.is_real_type () - && argr.is_real_type ()) - { - // all real case - if (argq.is_single_type () - && argr.is_single_type ()) - { - FloatMatrix Q = argq.float_matrix_value (); - FloatMatrix R = argr.float_matrix_value (); - - FloatQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - Matrix Q = argq.matrix_value (); - Matrix R = argr.matrix_value (); - - QR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - else - { - // complex case - if (argq.is_single_type () - && argr.is_single_type ()) - { - FloatComplexMatrix Q = argq.float_complex_matrix_value (); - FloatComplexMatrix R = argr.float_complex_matrix_value (); - - FloatComplexQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - else - { - ComplexMatrix Q = argq.complex_matrix_value (); - ComplexMatrix R = argr.complex_matrix_value (); - - ComplexQR fact (Q, R); - fact.shift_cols (i-1, j-1); - - retval(1) = get_qr_r (fact); - retval(0) = fact.Q (); - } - } - } - else - error ("qrshift: invalid index I or J"); - } - else - error ("qrshift: dimensions mismatch"); - } - else - error ("qrshift: Q and R must be numeric"); - - return retval; -} - -/* -%!test -%! AA = A.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%!test -%! AA = Ac.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); - -%!test -%! AA = single (A).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%!test -%! AA = single (Ac).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -%! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; -%! -%! [Q,R] = qr (AA); -%! [Q,R] = qrshift (Q, R, i, j); -%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); -%! assert (norm (vec (triu (R) - R), Inf) == 0); -%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/symbfact.cc --- a/src/DLD-FUNCTIONS/symbfact.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,363 +0,0 @@ -/* - -Copyright (C) 2005-2012 David Bateman -Copyright (C) 1998-2005 Andy Adler - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "SparseCmplxCHOL.h" -#include "SparsedbleCHOL.h" -#include "oct-spparms.h" -#include "sparse-util.h" -#include "oct-locbuf.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "utils.h" - -DEFUN_DLD (symbfact, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{count}, @var{h}, @var{parent}, @var{post}, @var{r}] =} symbfact (@var{S})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ}, @var{mode})\n\ -\n\ -Perform a symbolic factorization analysis on the sparse matrix @var{S}.\n\ -Where\n\ -\n\ -@table @var\n\ -@item S\n\ -@var{S} is a complex or real sparse matrix.\n\ -\n\ -@item typ\n\ -Is the type of the factorization and can be one of\n\ -\n\ -@table @samp\n\ -@item sym\n\ -Factorize @var{S}. This is the default.\n\ -\n\ -@item col\n\ -Factorize @code{@var{S}' * @var{S}}.\n\ -\n\ -@item row\n\ -Factorize @xcode{@var{S} * @var{S}'}.\n\ -\n\ -@item lo\n\ -Factorize @xcode{@var{S}'}\n\ -@end table\n\ -\n\ -@item mode\n\ -The default is to return the Cholesky@tie{}factorization for @var{r}, and if\n\ -@var{mode} is 'L', the conjugate transpose of the Cholesky@tie{}factorization\n\ -is returned. The conjugate transpose version is faster and uses less\n\ -memory, but returns the same values for @var{count}, @var{h}, @var{parent}\n\ -and @var{post} outputs.\n\ -@end table\n\ -\n\ -The output variables are\n\ -\n\ -@table @var\n\ -@item count\n\ -The row counts of the Cholesky@tie{}factorization as determined by @var{typ}.\n\ -\n\ -@item h\n\ -The height of the elimination tree.\n\ -\n\ -@item parent\n\ -The elimination tree itself.\n\ -\n\ -@item post\n\ -A sparse boolean matrix whose structure is that of the Cholesky\n\ -factorization as determined by @var{typ}.\n\ -@end table\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - - if (nargin < 1 || nargin > 3 || nargout > 5) - { - print_usage (); - return retval; - } - -#ifdef HAVE_CHOLMOD - - cholmod_common Common; - cholmod_common *cm = &Common; - CHOLMOD_NAME(start) (cm); - - double spu = octave_sparse_params::get_key ("spumoni"); - if (spu == 0.) - { - cm->print = -1; - cm->print_function = 0; - } - else - { - cm->print = static_cast (spu) + 2; - cm->print_function =&SparseCholPrint; - } - - cm->error_handler = &SparseCholError; - cm->complex_divide = CHOLMOD_NAME(divcomplex); - cm->hypotenuse = CHOLMOD_NAME(hypot); - - double dummy; - cholmod_sparse Astore; - cholmod_sparse *A = &Astore; - A->packed = true; - A->sorted = true; - A->nz = 0; -#ifdef IDX_TYPE_LONG - A->itype = CHOLMOD_LONG; -#else - A->itype = CHOLMOD_INT; -#endif - A->dtype = CHOLMOD_DOUBLE; - A->stype = 1; - A->x = &dummy; - - if (args(0).is_real_type ()) - { - const SparseMatrix a = args(0).sparse_matrix_value (); - A->nrow = a.rows (); - A->ncol = a.cols (); - A->p = a.cidx (); - A->i = a.ridx (); - A->nzmax = a.nnz (); - A->xtype = CHOLMOD_REAL; - - if (a.rows () > 0 && a.cols () > 0) - A->x = a.data (); - } - else if (args(0).is_complex_type ()) - { - const SparseComplexMatrix a = args(0).sparse_complex_matrix_value (); - A->nrow = a.rows (); - A->ncol = a.cols (); - A->p = a.cidx (); - A->i = a.ridx (); - A->nzmax = a.nnz (); - A->xtype = CHOLMOD_COMPLEX; - - if (a.rows () > 0 && a.cols () > 0) - A->x = a.data (); - } - else - gripe_wrong_type_arg ("symbfact", args(0)); - - octave_idx_type coletree = false; - octave_idx_type n = A->nrow; - - if (nargin > 1) - { - char ch; - std::string str = args(1).string_value (); - ch = tolower (str.c_str ()[0]); - if (ch == 'r') - A->stype = 0; - else if (ch == 'c') - { - n = A->ncol; - coletree = true; - A->stype = 0; - } - else if (ch == 's') - A->stype = 1; - else if (ch == 's') - A->stype = -1; - else - error ("symbfact: unrecognized TYP in symbolic factorization"); - } - - if (A->stype && A->nrow != A->ncol) - error ("symbfact: S must be a square matrix"); - - if (!error_state) - { - OCTAVE_LOCAL_BUFFER (octave_idx_type, Parent, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Post, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, ColCount, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, First, n); - OCTAVE_LOCAL_BUFFER (octave_idx_type, Level, n); - - cholmod_sparse *F = CHOLMOD_NAME(transpose) (A, 0, cm); - cholmod_sparse *Aup, *Alo; - - if (A->stype == 1 || coletree) - { - Aup = A ; - Alo = F ; - } - else - { - Aup = F ; - Alo = A ; - } - - CHOLMOD_NAME(etree) (Aup, Parent, cm); - - if (cm->status < CHOLMOD_OK) - { - error ("matrix corrupted"); - goto symbfact_error; - } - - if (CHOLMOD_NAME(postorder) (Parent, n, 0, Post, cm) != n) - { - error ("postorder failed"); - goto symbfact_error; - } - - CHOLMOD_NAME(rowcolcounts) (Alo, 0, 0, Parent, Post, 0, - ColCount, First, Level, cm); - - if (cm->status < CHOLMOD_OK) - { - error ("matrix corrupted"); - goto symbfact_error; - } - - if (nargout > 4) - { - cholmod_sparse *A1, *A2; - - if (A->stype == 1) - { - A1 = A; - A2 = 0; - } - else if (A->stype == -1) - { - A1 = F; - A2 = 0; - } - else if (coletree) - { - A1 = F; - A2 = A; - } - else - { - A1 = A; - A2 = F; - } - - // count the total number of entries in L - octave_idx_type lnz = 0 ; - for (octave_idx_type j = 0 ; j < n ; j++) - lnz += ColCount[j]; - - - // allocate the output matrix L (pattern-only) - SparseBoolMatrix L (n, n, lnz); - - // initialize column pointers - lnz = 0; - for (octave_idx_type j = 0 ; j < n ; j++) - { - L.xcidx(j) = lnz; - lnz += ColCount[j]; - } - L.xcidx(n) = lnz; - - - /* create a copy of the column pointers */ - octave_idx_type *W = First; - for (octave_idx_type j = 0 ; j < n ; j++) - W[j] = L.xcidx (j); - - // get workspace for computing one row of L - cholmod_sparse *R = cholmod_allocate_sparse (n, 1, n, false, true, - 0, CHOLMOD_PATTERN, cm); - octave_idx_type *Rp = static_cast(R->p); - octave_idx_type *Ri = static_cast(R->i); - - // compute L one row at a time - for (octave_idx_type k = 0 ; k < n ; k++) - { - // get the kth row of L and store in the columns of L - CHOLMOD_NAME (row_subtree) (A1, A2, k, Parent, R, cm) ; - for (octave_idx_type p = 0 ; p < Rp[1] ; p++) - L.xridx (W[Ri[p]]++) = k ; - - // add the diagonal entry - L.xridx (W[k]++) = k ; - } - - // free workspace - cholmod_free_sparse (&R, cm) ; - - - // transpose L to get R, or leave as is - if (nargin < 3) - L = L.transpose (); - - // fill numerical values of L with one's - for (octave_idx_type p = 0 ; p < lnz ; p++) - L.xdata(p) = true; - - retval(4) = L; - } - - ColumnVector tmp (n); - if (nargout > 3) - { - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = Post[i] + 1; - retval(3) = tmp; - } - - if (nargout > 2) - { - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = Parent[i] + 1; - retval(2) = tmp; - } - - if (nargout > 1) - { - /* compute the elimination tree height */ - octave_idx_type height = 0 ; - for (int i = 0 ; i < n ; i++) - height = (height > Level[i] ? height : Level[i]); - height++ ; - retval(1) = static_cast (height); - } - - for (octave_idx_type i = 0; i < n; i++) - tmp(i) = ColCount[i]; - retval(0) = tmp; - } - - symbfact_error: -#else - error ("symbfact: not available in this version of Octave"); -#endif - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/symrcm.cc --- a/src/DLD-FUNCTIONS/symrcm.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,702 +0,0 @@ -/* - -Copyright (C) 2007-2012 Michael Weitzel - -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 3 of the License, 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, see -. - -*/ - -/* -An implementation of the Reverse Cuthill-McKee algorithm (symrcm) - -The implementation of this algorithm is based in the descriptions found in - -@INPROCEEDINGS{, - author = {E. Cuthill and J. McKee}, - title = {Reducing the Bandwidth of Sparse Symmetric Matrices}, - booktitle = {Proceedings of the 24th ACM National Conference}, - publisher = {Brandon Press}, - pages = {157 -- 172}, - location = {New Jersey}, - year = {1969} -} - -@BOOK{, - author = {Alan George and Joseph W. H. Liu}, - title = {Computer Solution of Large Sparse Positive Definite Systems}, - publisher = {Prentice Hall Series in Computational Mathematics}, - ISBN = {0-13-165274-5}, - year = {1981} -} - -The algorithm represents a heuristic approach to the NP-complete minimum -bandwidth problem. - -Written by Michael Weitzel - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "ov.h" -#include "defun-dld.h" -#include "error.h" -#include "gripes.h" -#include "utils.h" -#include "oct-locbuf.h" - -#include "ov-re-mat.h" -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "oct-sparse.h" - -// A node struct for the Cuthill-McKee algorithm -struct CMK_Node -{ - // the node's id (matrix row index) - octave_idx_type id; - // the node's degree - octave_idx_type deg; - // minimal distance to the root of the spanning tree - octave_idx_type dist; -}; - -// A simple queue. -// Queues Q have a fixed maximum size N (rows,cols of the matrix) and are -// stored in an array. qh and qt point to queue head and tail. - -// Enqueue operation (adds a node "o" at the tail) - -inline static void -Q_enq (CMK_Node *Q, octave_idx_type N, octave_idx_type& qt, const CMK_Node& o) -{ - Q[qt] = o; - qt = (qt + 1) % (N + 1); -} - -// Dequeue operation (removes a node from the head) - -inline static CMK_Node -Q_deq (CMK_Node * Q, octave_idx_type N, octave_idx_type& qh) -{ - CMK_Node r = Q[qh]; - qh = (qh + 1) % (N + 1); - return r; -} - -// Predicate (queue empty) -#define Q_empty(Q, N, qh, qt) ((qh) == (qt)) - -// A simple, array-based binary heap (used as a priority queue for nodes) - -// the left descendant of entry i -#define LEFT(i) (((i) << 1) + 1) // = (2*(i)+1) -// the right descendant of entry i -#define RIGHT(i) (((i) << 1) + 2) // = (2*(i)+2) -// the parent of entry i -#define PARENT(i) (((i) - 1) >> 1) // = floor(((i)-1)/2) - -// Builds a min-heap (the root contains the smallest element). A is an array -// with the graph's nodes, i is a starting position, size is the length of A. - -static void -H_heapify_min (CMK_Node *A, octave_idx_type i, octave_idx_type size) -{ - octave_idx_type j = i; - for (;;) - { - octave_idx_type l = LEFT(j); - octave_idx_type r = RIGHT(j); - - octave_idx_type smallest; - if (l < size && A[l].deg < A[j].deg) - smallest = l; - else - smallest = j; - - if (r < size && A[r].deg < A[smallest].deg) - smallest = r; - - if (smallest != j) - { - std::swap (A[j], A[smallest]); - j = smallest; - } - else - break; - } -} - -// Heap operation insert. Running time is O(log(n)) - -static void -H_insert (CMK_Node *H, octave_idx_type& h, const CMK_Node& o) -{ - octave_idx_type i = h++; - - H[i] = o; - - if (i == 0) - return; - do - { - octave_idx_type p = PARENT(i); - if (H[i].deg < H[p].deg) - { - std::swap (H[i], H[p]); - - i = p; - } - else - break; - } - while (i > 0); -} - -// Heap operation remove-min. Removes the smalles element in O(1) and -// reorganizes the heap optionally in O(log(n)) - -inline static CMK_Node -H_remove_min (CMK_Node *H, octave_idx_type& h, int reorg/*=1*/) -{ - CMK_Node r = H[0]; - H[0] = H[--h]; - if (reorg) - H_heapify_min (H, 0, h); - return r; -} - -// Predicate (heap empty) -#define H_empty(H, h) ((h) == 0) - -// Helper function for the Cuthill-McKee algorithm. Tries to determine a -// pseudo-peripheral node of the graph as starting node. - -static octave_idx_type -find_starting_node (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, const octave_idx_type *ridx2, - const octave_idx_type *cidx2, octave_idx_type *D, - octave_idx_type start) -{ - CMK_Node w; - - OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); - boolNDArray btmp (dim_vector (1, N), false); - bool *visit = btmp.fortran_vec (); - - octave_idx_type qh = 0; - octave_idx_type qt = 0; - CMK_Node x; - x.id = start; - x.deg = D[start]; - x.dist = 0; - Q_enq (Q, N, qt, x); - visit[start] = true; - - // distance level - octave_idx_type level = 0; - // current largest "eccentricity" - octave_idx_type max_dist = 0; - - for (;;) - { - while (! Q_empty (Q, N, qh, qt)) - { - CMK_Node v = Q_deq (Q, N, qh); - - if (v.dist > x.dist || (v.id != x.id && v.deg > x.deg)) - x = v; - - octave_idx_type i = v.id; - - // add all unvisited neighbors to the queue - octave_idx_type j1 = cidx[i]; - octave_idx_type j2 = cidx2[i]; - while (j1 < cidx[i+1] || j2 < cidx2[i+1]) - { - OCTAVE_QUIT; - - if (j1 == cidx[i+1]) - { - octave_idx_type r2 = ridx2[j2++]; - if (! visit[r2]) - { - // the distance of node j is dist(i)+1 - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r2] = true; - - if (w.dist > level) - level = w.dist; - } - } - else if (j2 == cidx2[i+1]) - { - octave_idx_type r1 = ridx[j1++]; - if (! visit[r1]) - { - // the distance of node j is dist(i)+1 - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r1] = true; - - if (w.dist > level) - level = w.dist; - } - } - else - { - octave_idx_type r1 = ridx[j1]; - octave_idx_type r2 = ridx2[j2]; - if (r1 <= r2) - { - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r1] = true; - - if (w.dist > level) - level = w.dist; - } - j1++; - if (r1 == r2) - j2++; - } - else - { - if (! visit[r2]) - { - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - Q_enq (Q, N, qt, w); - visit[r2] = true; - - if (w.dist > level) - level = w.dist; - } - j2++; - } - } - } - } // finish of BFS - - if (max_dist < x.dist) - { - max_dist = x.dist; - - for (octave_idx_type i = 0; i < N; i++) - visit[i] = false; - - visit[x.id] = true; - x.dist = 0; - qt = qh = 0; - Q_enq (Q, N, qt, x); - } - else - break; - } - return x.id; -} - -// Calculates the node's degrees. This means counting the non-zero elements -// in the symmetric matrix' rows. This works for non-symmetric matrices -// as well. - -static octave_idx_type -calc_degrees (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, octave_idx_type *D) -{ - octave_idx_type max_deg = 0; - - for (octave_idx_type i = 0; i < N; i++) - D[i] = 0; - - for (octave_idx_type j = 0; j < N; j++) - { - for (octave_idx_type i = cidx[j]; i < cidx[j+1]; i++) - { - OCTAVE_QUIT; - octave_idx_type k = ridx[i]; - // there is a non-zero element (k,j) - D[k]++; - if (D[k] > max_deg) - max_deg = D[k]; - // if there is no element (j,k) there is one in - // the symmetric matrix: - if (k != j) - { - bool found = false; - for (octave_idx_type l = cidx[k]; l < cidx[k + 1]; l++) - { - OCTAVE_QUIT; - - if (ridx[l] == j) - { - found = true; - break; - } - else if (ridx[l] > j) - break; - } - - if (! found) - { - // A(j,k) == 0 - D[j]++; - if (D[j] > max_deg) - max_deg = D[j]; - } - } - } - } - return max_deg; -} - -// Transpose of the structure of a square sparse matrix - -static void -transpose (octave_idx_type N, const octave_idx_type *ridx, - const octave_idx_type *cidx, octave_idx_type *ridx2, - octave_idx_type *cidx2) -{ - octave_idx_type nz = cidx[N]; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, w, N + 1); - for (octave_idx_type i = 0; i < N; i++) - w[i] = 0; - for (octave_idx_type i = 0; i < nz; i++) - w[ridx[i]]++; - nz = 0; - for (octave_idx_type i = 0; i < N; i++) - { - OCTAVE_QUIT; - cidx2[i] = nz; - nz += w[i]; - w[i] = cidx2[i]; - } - cidx2[N] = nz; - w[N] = nz; - - for (octave_idx_type j = 0; j < N; j++) - for (octave_idx_type k = cidx[j]; k < cidx[j + 1]; k++) - { - OCTAVE_QUIT; - octave_idx_type q = w[ridx[k]]++; - ridx2[q] = j; - } -} - -// An implementation of the Cuthill-McKee algorithm. -DEFUN_DLD (symrcm, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{p} =} symrcm (@var{S})\n\ -Return the symmetric reverse Cuthill-McKee permutation of @var{S}.\n\ -@var{p} is a permutation vector such that\n\ -@code{@var{S}(@var{p}, @var{p})} tends to have its diagonal elements\n\ -closer to the diagonal than @var{S}. This is a good preordering for LU\n\ -or Cholesky@tie{}factorization of matrices that come from ``long, skinny''\n\ -problems. It works for both symmetric and asymmetric @var{S}.\n\ -\n\ -The algorithm represents a heuristic approach to the NP-complete\n\ -bandwidth minimization problem. The implementation is based in the\n\ -descriptions found in\n\ -\n\ -E. Cuthill, J. McKee. @cite{Reducing the Bandwidth of Sparse Symmetric\n\ -Matrices}. Proceedings of the 24th ACM National Conference, 157--172\n\ -1969, Brandon Press, New Jersey.\n\ -\n\ -A. George, J.W.H. Liu. @cite{Computer Solution of Large Sparse\n\ -Positive Definite Systems}, Prentice Hall Series in Computational\n\ -Mathematics, ISBN 0-13-165274-5, 1981.\n\ -\n\ -@seealso{colperm, colamd, symamd}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin != 1) - { - print_usage (); - return retval; - } - - octave_value arg = args(0); - - // the parameter of the matrix is converted into a sparse matrix - //(if necessary) - octave_idx_type *cidx; - octave_idx_type *ridx; - SparseMatrix Ar; - SparseComplexMatrix Ac; - - if (arg.is_real_type ()) - { - Ar = arg.sparse_matrix_value (); - // Note cidx/ridx are const, so use xridx and xcidx... - cidx = Ar.xcidx (); - ridx = Ar.xridx (); - } - else - { - Ac = arg.sparse_complex_matrix_value (); - cidx = Ac.xcidx (); - ridx = Ac.xridx (); - } - - if (error_state) - return retval; - - octave_idx_type nr = arg.rows (); - octave_idx_type nc = arg.columns (); - - if (nr != nc) - { - gripe_square_matrix_required ("symrcm"); - return retval; - } - - if (nr == 0 && nc == 0) - return octave_value (NDArray (dim_vector (1, 0))); - - // sizes of the heaps - octave_idx_type s = 0; - - // head- and tail-indices for the queue - octave_idx_type qt = 0, qh = 0; - CMK_Node v, w; - // dimension of the matrix - octave_idx_type N = nr; - - OCTAVE_LOCAL_BUFFER (octave_idx_type, cidx2, N + 1); - OCTAVE_LOCAL_BUFFER (octave_idx_type, ridx2, cidx[N]); - transpose (N, ridx, cidx, ridx2, cidx2); - - // the permutation vector - NDArray P (dim_vector (1, N)); - - // compute the node degrees - OCTAVE_LOCAL_BUFFER (octave_idx_type, D, N); - octave_idx_type max_deg = calc_degrees (N, ridx, cidx, D); - - // if none of the nodes has a degree > 0 (a matrix of zeros) - // the return value corresponds to the identity permutation - if (max_deg == 0) - { - for (octave_idx_type i = 0; i < N; i++) - P(i) = i; - return octave_value (P); - } - - // a heap for the a node's neighbors. The number of neighbors is - // limited by the maximum degree max_deg: - OCTAVE_LOCAL_BUFFER (CMK_Node, S, max_deg); - - // a queue for the BFS. The array is always one element larger than - // the number of entries that are stored. - OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); - - // a counter (for building the permutation) - octave_idx_type c = -1; - - // upper bound for the bandwidth (=quality of solution) - // initialize the bandwidth of the graph with 0. B contains the - // the maximum of the theoretical lower limits of the subgraphs - // bandwidths. - octave_idx_type B = 0; - - // mark all nodes as unvisited; with the exception of the nodes - // that have degree==0 and build a CC of the graph. - - boolNDArray btmp (dim_vector (1, N), false); - bool *visit = btmp.fortran_vec (); - - do - { - // locate an unvisited starting node of the graph - octave_idx_type i; - for (i = 0; i < N; i++) - if (! visit[i]) - break; - - // locate a probably better starting node - v.id = find_starting_node (N, ridx, cidx, ridx2, cidx2, D, i); - - // mark the node as visited and enqueue it (a starting node - // for the BFS). Since the node will be a root of a spanning - // tree, its dist is 0. - v.deg = D[v.id]; - v.dist = 0; - visit[v.id] = true; - Q_enq (Q, N, qt, v); - - // lower bound for the bandwidth of a subgraph - // keep a "level" in the spanning tree (= min. distance to the - // root) for determining the bandwidth of the computed - // permutation P - octave_idx_type Bsub = 0; - // min. dist. to the root is 0 - octave_idx_type level = 0; - // the root is the first/only node on level 0 - octave_idx_type level_N = 1; - - while (! Q_empty (Q, N, qh, qt)) - { - v = Q_deq (Q, N, qh); - i = v.id; - - c++; - - // for computing the inverse permutation P where - // A(inv(P),inv(P)) or P'*A*P is banded - // P(i) = c; - - // for computing permutation P where - // A(P(i),P(j)) or P*A*P' is banded - P(c) = i; - - // put all unvisited neighbors j of node i on the heap - s = 0; - octave_idx_type j1 = cidx[i]; - octave_idx_type j2 = cidx2[i]; - - OCTAVE_QUIT; - while (j1 < cidx[i+1] || j2 < cidx2[i+1]) - { - OCTAVE_QUIT; - if (j1 == cidx[i+1]) - { - octave_idx_type r2 = ridx2[j2++]; - if (! visit[r2]) - { - // the distance of node j is dist(i)+1 - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r2] = true; - } - } - else if (j2 == cidx2[i+1]) - { - octave_idx_type r1 = ridx[j1++]; - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r1] = true; - } - } - else - { - octave_idx_type r1 = ridx[j1]; - octave_idx_type r2 = ridx2[j2]; - if (r1 <= r2) - { - if (! visit[r1]) - { - w.id = r1; - w.deg = D[r1]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r1] = true; - } - j1++; - if (r1 == r2) - j2++; - } - else - { - if (! visit[r2]) - { - w.id = r2; - w.deg = D[r2]; - w.dist = v.dist+1; - H_insert (S, s, w); - visit[r2] = true; - } - j2++; - } - } - } - - // add the neighbors to the queue (sorted by node degree) - while (! H_empty (S, s)) - { - OCTAVE_QUIT; - - // locate a neighbor of i with minimal degree in O(log(N)) - v = H_remove_min (S, s, 1); - - // entered the BFS a new level? - if (v.dist > level) - { - // adjustment of bandwith: - // "[...] the minimum bandwidth that - // can be obtained [...] is the - // maximum number of nodes per level" - if (Bsub < level_N) - Bsub = level_N; - - level = v.dist; - // v is the first node on the new level - level_N = 1; - } - else - { - // there is no new level but another node on - // this level: - level_N++; - } - - // enqueue v in O(1) - Q_enq (Q, N, qt, v); - } - - // synchronize the bandwidth with level_N once again: - if (Bsub < level_N) - Bsub = level_N; - } - // finish of BFS. If there are still unvisited nodes in the graph - // then it is split into CCs. The computed bandwidth is the maximum - // of all subgraphs. Update: - if (Bsub > B) - B = Bsub; - } - // are there any nodes left? - while (c+1 < N); - - // compute the reverse-ordering - s = N / 2 - 1; - for (octave_idx_type i = 0, j = N - 1; i <= s; i++, j--) - std::swap (P.elem (i), P.elem (j)); - - // increment all indices, since Octave is not C - return octave_value (P+1); -} diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/tsearch.cc --- a/src/DLD-FUNCTIONS/tsearch.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,186 +0,0 @@ -/* - -Copyright (C) 2002-2012 Andreas Stahel - -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 3 of the License, 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, see -. - -*/ - -// Author: Andreas Stahel - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "lo-ieee.h" -#include "lo-math.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "parse.h" - -inline double max (double a, double b, double c) -{ - if (a < b) - return (b < c ? c : b); - else - return (a < c ? c : a); -} - -inline double min (double a, double b, double c) -{ - if (a > b) - return (b > c ? c : b); - else - return (a > c ? c : a); -} - -#define REF(x,k,i) x(static_cast(elem((k), (i))) - 1) - -// for large data set the algorithm is very slow -// one should presort (how?) either the elements of the points of evaluation -// to cut down the time needed to decide which triangle contains the -// given point - -// e.g., build up a neighbouring triangle structure and use a simplex-like -// method to traverse it - -DEFUN_DLD (tsearch, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{idx} =} tsearch (@var{x}, @var{y}, @var{t}, @var{xi}, @var{yi})\n\ -Search for the enclosing Delaunay convex hull. For @code{@var{t} =\n\ -delaunay (@var{x}, @var{y})}, finds the index in @var{t} containing the\n\ -points @code{(@var{xi}, @var{yi})}. For points outside the convex hull,\n\ -@var{idx} is NaN.\n\ -@seealso{delaunay, delaunayn}\n\ -@end deftypefn") -{ - const double eps=1.0e-12; - - octave_value_list retval; - const int nargin = args.length (); - if (nargin != 5) - { - print_usage (); - return retval; - } - - const ColumnVector x (args(0).vector_value ()); - const ColumnVector y (args(1).vector_value ()); - const Matrix elem (args(2).matrix_value ()); - const ColumnVector xi (args(3).vector_value ()); - const ColumnVector yi (args(4).vector_value ()); - - if (error_state) - return retval; - - const octave_idx_type nelem = elem.rows (); - - ColumnVector minx (nelem); - ColumnVector maxx (nelem); - ColumnVector miny (nelem); - ColumnVector maxy (nelem); - for (octave_idx_type k = 0; k < nelem; k++) - { - minx(k) = min (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) - eps; - maxx(k) = max (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) + eps; - miny(k) = min (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) - eps; - maxy(k) = max (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) + eps; - } - - const octave_idx_type np = xi.length (); - ColumnVector values (np); - - double x0 = 0.0, y0 = 0.0; - double a11 = 0.0, a12 = 0.0, a21 = 0.0, a22 = 0.0, det = 0.0; - - octave_idx_type k = nelem; // k is a counter of elements - for (octave_idx_type kp = 0; kp < np; kp++) - { - const double xt = xi(kp); - const double yt = yi(kp); - - // check if last triangle contains the next point - if (k < nelem) - { - const double dx1 = xt - x0; - const double dx2 = yt - y0; - const double c1 = (a22 * dx1 - a21 * dx2) / det; - const double c2 = (-a12 * dx1 + a11 * dx2) / det; - if (c1 >= -eps && c2 >= -eps && (c1 + c2) <= (1 + eps)) - { - values(kp) = double(k+1); - continue; - } - } - - // it doesn't, so go through all elements - for (k = 0; k < nelem; k++) - { - OCTAVE_QUIT; - if (xt >= minx(k) && xt <= maxx(k) && yt >= miny(k) && yt <= maxy(k)) - { - // element inside the minimum rectangle: examine it closely - x0 = REF (x, k, 0); - y0 = REF (y, k, 0); - a11 = REF (x, k, 1) - x0; - a12 = REF (y, k, 1) - y0; - a21 = REF (x, k, 2) - x0; - a22 = REF (y, k, 2) - y0; - det = a11 * a22 - a21 * a12; - - // solve the system - const double dx1 = xt - x0; - const double dx2 = yt - y0; - const double c1 = (a22 * dx1 - a21 * dx2) / det; - const double c2 = (-a12 * dx1 + a11 * dx2) / det; - if ((c1 >= -eps) && (c2 >= -eps) && ((c1 + c2) <= (1 + eps))) - { - values(kp) = double(k+1); - break; - } - } //endif # examine this element closely - } //endfor # each element - - if (k == nelem) - values(kp) = lo_ieee_nan_value (); - - } //endfor # kp - - retval(0) = values; - - return retval; -} - -/* -%!shared x, y, tri -%! x = [-1;-1;1]; -%! y = [-1;1;-1]; -%! tri = [1, 2, 3]; -%!assert (tsearch (x,y,tri,-1,-1), 1) -%!assert (tsearch (x,y,tri, 1,-1), 1) -%!assert (tsearch (x,y,tri,-1, 1), 1) -%!assert (tsearch (x,y,tri,-1/3, -1/3), 1) -%!assert (tsearch (x,y,tri, 1, 1), NaN) - -%!error tsearch () -*/ diff -r 069c552587a0 -r 959953dba519 src/DLD-FUNCTIONS/urlwrite.cc --- a/src/DLD-FUNCTIONS/urlwrite.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1740 +0,0 @@ -// urlwrite and urlread, a curl front-end for octave -/* - -Copyright (C) 2006-2012 Alexander Barth -Copyright (C) 2009 David Bateman - -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 3 of the License, 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, see -. - -*/ - -// Author: Alexander Barth -// Adapted-By: jwe - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "glob-match.h" - -#include "defun-dld.h" -#include "error.h" -#include "oct-obj.h" -#include "ov-cell.h" -#include "pager.h" -#include "oct-map.h" -#include "oct-refcount.h" -#include "unwind-prot.h" - -#ifdef HAVE_CURL - -#include -#include -#include - -// Backwards compatibility for curl < 7.17.0 -#if LIBCURL_VERSION_NUM < 0x071100 -#define CURLOPT_DIRLISTONLY CURLOPT_FTPLISTONLY -#endif - -static int -write_data (void *buffer, size_t size, size_t nmemb, void *streamp) -{ - std::ostream& stream = *(static_cast (streamp)); - stream.write (static_cast (buffer), size*nmemb); - return (stream.fail () ? 0 : size * nmemb); -} - -static int -read_data (void *buffer, size_t size, size_t nmemb, void *streamp) -{ - std::istream& stream = *(static_cast (streamp)); - stream.read (static_cast (buffer), size*nmemb); - if (stream.eof ()) - return stream.gcount (); - else - return (stream.fail () ? 0 : size * nmemb); -} - -static size_t -throw_away (void *, size_t size, size_t nmemb, void *) -{ - return static_cast(size * nmemb); -} - -class -curl_handle -{ -private: - class - curl_handle_rep - { - public: - curl_handle_rep (void) : count (1), valid (true), ascii (false) - { - curl = curl_easy_init (); - if (!curl) - error ("can not create curl handle"); - } - - ~curl_handle_rep (void) - { - if (curl) - curl_easy_cleanup (curl); - } - - bool is_valid (void) const - { - return valid; - } - - bool perform (bool curlerror) const - { - bool retval = false; - if (!error_state) - { - BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - - errnum = curl_easy_perform (curl); - if (errnum != CURLE_OK) - { - if (curlerror) - error ("%s", curl_easy_strerror (errnum)); - } - else - retval = true; - - END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - } - return retval; - } - - CURL* handle (void) const - { - return curl; - } - - bool is_ascii (void) const - { - return ascii; - } - - bool is_binary (void) const - { - return !ascii; - } - - octave_refcount count; - std::string host; - bool valid; - bool ascii; - mutable CURLcode errnum; - - private: - CURL *curl; - - // No copying! - - curl_handle_rep (const curl_handle_rep& ov); - - curl_handle_rep& operator = (const curl_handle_rep&); - }; - -public: - -// I'd love to rewrite this as a private method of the curl_handle -// class, but you can't pass the va_list from the wrapper setopt to -// the curl_easy_setopt function. -#define setopt(option, parameter) \ - { \ - CURLcode res = curl_easy_setopt (rep->handle (), option, parameter); \ - if (res != CURLE_OK) \ - error ("%s", curl_easy_strerror (res)); \ - } - - curl_handle (void) : rep (new curl_handle_rep ()) - { - rep->valid = false; - } - - curl_handle (const std::string& _host, const std::string& user, - const std::string& passwd) : - rep (new curl_handle_rep ()) - { - rep->host = _host; - init (user, passwd, std::cin, octave_stdout); - - std::string url = "ftp://" + _host; - setopt (CURLOPT_URL, url.c_str ()); - - // Setup the link, with no transfer - if (!error_state) - perform (); - } - - curl_handle (const std::string& url, const std::string& method, - const Cell& param, std::ostream& os, bool& retval) : - rep (new curl_handle_rep ()) - { - retval = false; - - init ("", "", std::cin, os); - - setopt (CURLOPT_NOBODY, 0); - - // Don't need to store the parameters here as we can't change - // the URL after the handle is created - std::string query_string = form_query_string (param); - - if (method == "get") - { - query_string = url + "?" + query_string; - setopt (CURLOPT_URL, query_string.c_str ()); - } - else if (method == "post") - { - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_POSTFIELDS, query_string.c_str ()); - } - else - setopt (CURLOPT_URL, url.c_str ()); - - if (!error_state) - retval = perform (false); - } - - curl_handle (const curl_handle& h) : rep (h.rep) - { - rep->count++; - } - - ~curl_handle (void) - { - if (--rep->count == 0) - delete rep; - } - - curl_handle& operator = (const curl_handle& h) - { - if (this != &h) - { - if (--rep->count == 0) - delete rep; - - rep = h.rep; - rep->count++; - } - return *this; - } - - bool is_valid (void) const - { - return rep->is_valid (); - } - - std::string lasterror (void) const - { - return std::string (curl_easy_strerror (rep->errnum)); - } - - void set_ostream (std::ostream& os) const - { - setopt (CURLOPT_WRITEDATA, static_cast (&os)); - } - - void set_istream (std::istream& is) const - { - setopt (CURLOPT_READDATA, static_cast (&is)); - } - - void ascii (void) const - { - setopt (CURLOPT_TRANSFERTEXT, 1); - rep->ascii = true; - } - - void binary (void) const - { - setopt (CURLOPT_TRANSFERTEXT, 0); - rep->ascii = false; - } - - bool is_ascii (void) const - { - return rep->is_ascii (); - } - - bool is_binary (void) const - { - return rep->is_binary (); - } - - void cwd (const std::string& path) const - { - struct curl_slist *slist = 0; - std::string cmd = "cwd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void del (const std::string& file) const - { - struct curl_slist *slist = 0; - std::string cmd = "dele " + file; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void rmdir (const std::string& path) const - { - struct curl_slist *slist = 0; - std::string cmd = "rmd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - bool mkdir (const std::string& path, bool curlerror = true) const - { - bool retval = false; - struct curl_slist *slist = 0; - std::string cmd = "mkd " + path; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - retval = perform (curlerror); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - return retval; - } - - void rename (const std::string& oldname, const std::string& newname) const - { - struct curl_slist *slist = 0; - std::string cmd = "rnfr " + oldname; - slist = curl_slist_append (slist, cmd.c_str ()); - cmd = "rnto " + newname; - slist = curl_slist_append (slist, cmd.c_str ()); - setopt (CURLOPT_POSTQUOTE, slist); - if (! error_state) - perform (); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - } - - void put (const std::string& file, std::istream& is) const - { - std::string url = "ftp://" + rep->host + "/" + file; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_UPLOAD, 1); - setopt (CURLOPT_NOBODY, 0); - set_istream (is); - if (! error_state) - perform (); - set_istream (std::cin); - setopt (CURLOPT_NOBODY, 1); - setopt (CURLOPT_UPLOAD, 0); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - void get (const std::string& file, std::ostream& os) const - { - std::string url = "ftp://" + rep->host + "/" + file; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_NOBODY, 0); - set_ostream (os); - if (! error_state) - perform (); - set_ostream (octave_stdout); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - void dir (void) const - { - std::string url = "ftp://" + rep->host + "/"; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_NOBODY, 0); - if (! error_state) - perform (); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - } - - string_vector list (void) const - { - std::ostringstream buf; - std::string url = "ftp://" + rep->host + "/"; - setopt (CURLOPT_WRITEDATA, static_cast (&buf)); - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_DIRLISTONLY, 1); - setopt (CURLOPT_NOBODY, 0); - if (! error_state) - perform (); - setopt (CURLOPT_NOBODY, 1); - url = "ftp://" + rep->host; - setopt (CURLOPT_WRITEDATA, static_cast (&octave_stdout)); - setopt (CURLOPT_DIRLISTONLY, 0); - setopt (CURLOPT_URL, url.c_str ()); - - // Count number of directory entries - std::string str = buf.str (); - octave_idx_type n = 0; - size_t pos = 0; - while (true) - { - pos = str.find_first_of ('\n', pos); - if (pos == std::string::npos) - break; - pos++; - n++; - } - string_vector retval (n); - pos = 0; - for (octave_idx_type i = 0; i < n; i++) - { - size_t newpos = str.find_first_of ('\n', pos); - if (newpos == std::string::npos) - break; - - retval(i) = str.substr(pos, newpos - pos); - pos = newpos + 1; - } - return retval; - } - - void get_fileinfo (const std::string& filename, double& filesize, - time_t& filetime, bool& fileisdir) const - { - std::string path = pwd (); - - std::string url = "ftp://" + rep->host + "/" + path + "/" + filename; - setopt (CURLOPT_URL, url.c_str ()); - setopt (CURLOPT_FILETIME, 1); - setopt (CURLOPT_HEADERFUNCTION, throw_away); - setopt (CURLOPT_WRITEFUNCTION, throw_away); - - // FIXME - // The MDTM command fails for a directory on the servers I tested - // so this is a means of testing for directories. It also means - // I can't get the date of directories! - if (! error_state) - { - if (! perform (false)) - { - fileisdir = true; - filetime = -1; - filesize = 0; - } - else - { - fileisdir = false; - time_t ft; - curl_easy_getinfo (rep->handle (), CURLINFO_FILETIME, &ft); - filetime = ft; - double fs; - curl_easy_getinfo (rep->handle (), - CURLINFO_CONTENT_LENGTH_DOWNLOAD, &fs); - filesize = fs; - } - } - - setopt (CURLOPT_WRITEFUNCTION, write_data); - setopt (CURLOPT_HEADERFUNCTION, 0); - setopt (CURLOPT_FILETIME, 0); - url = "ftp://" + rep->host; - setopt (CURLOPT_URL, url.c_str ()); - - // The MDTM command seems to reset the path to the root with the - // servers I tested with, so cd again into the correct path. Make - // the path absolute so that this will work even with servers that - // don't end up in the root after an MDTM command. - cwd ("/" + path); - } - - std::string pwd (void) const - { - struct curl_slist *slist = 0; - std::string retval; - std::ostringstream buf; - - slist = curl_slist_append (slist, "pwd"); - setopt (CURLOPT_POSTQUOTE, slist); - setopt (CURLOPT_HEADERFUNCTION, write_data); - setopt (CURLOPT_WRITEHEADER, static_cast(&buf)); - - if (! error_state) - { - perform (); - retval = buf.str (); - - // Can I assume that the path is alway in "" on the last line - size_t pos2 = retval.rfind ('"'); - size_t pos1 = retval.rfind ('"', pos2 - 1); - retval = retval.substr (pos1 + 1, pos2 - pos1 - 1); - } - setopt (CURLOPT_HEADERFUNCTION, 0); - setopt (CURLOPT_WRITEHEADER, 0); - setopt (CURLOPT_POSTQUOTE, 0); - curl_slist_free_all (slist); - - return retval; - } - - bool perform (bool curlerror = true) const - { - return rep->perform (curlerror); - } - -private: - curl_handle_rep *rep; - - std::string form_query_string (const Cell& param) - { - std::ostringstream query; - - for (int i = 0; i < param.numel (); i += 2) - { - std::string name = param(i).string_value (); - std::string text = param(i+1).string_value (); - - // Encode strings. - char *enc_name = curl_easy_escape (rep->handle (), name.c_str (), - name.length ()); - char *enc_text = curl_easy_escape (rep->handle (), text.c_str (), - text.length ()); - - query << enc_name << "=" << enc_text; - - curl_free (enc_name); - curl_free (enc_text); - - if (i < param.numel ()-1) - query << "&"; - } - - query.flush (); - - return query.str (); - } - - void init (const std::string& user, const std::string& passwd, - std::istream& is, std::ostream& os) - { - // No data transfer by default - setopt (CURLOPT_NOBODY, 1); - - // Set the username and password - std::string userpwd = user; - if (! passwd.empty ()) - userpwd += ":" + passwd; - if (! userpwd.empty ()) - setopt (CURLOPT_USERPWD, userpwd.c_str ()); - - // Define our callback to get called when there's data to be written. - setopt (CURLOPT_WRITEFUNCTION, write_data); - - // Set a pointer to our struct to pass to the callback. - setopt (CURLOPT_WRITEDATA, static_cast (&os)); - - // Define our callback to get called when there's data to be read - setopt (CURLOPT_READFUNCTION, read_data); - - // Set a pointer to our struct to pass to the callback. - setopt (CURLOPT_READDATA, static_cast (&is)); - - // Follow redirects. - setopt (CURLOPT_FOLLOWLOCATION, true); - - // Don't use EPSV since connecting to sites that don't support it - // will hang for some time (3 minutes?) before moving on to try PASV - // instead. - setopt (CURLOPT_FTP_USE_EPSV, false); - - setopt (CURLOPT_NOPROGRESS, true); - setopt (CURLOPT_FAILONERROR, true); - - setopt (CURLOPT_POSTQUOTE, 0); - setopt (CURLOPT_QUOTE, 0); - } - -#undef setopt -}; - -class -curl_handles -{ -public: - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - curl_handles (void) : map () - { - curl_global_init (CURL_GLOBAL_DEFAULT); - } - - ~curl_handles (void) - { - // Remove the elements of the map explicitly as they should - // be deleted before the call to curl_global_cleanup - map.erase (begin (), end ()); - - curl_global_cleanup (); - } - - iterator begin (void) { return iterator (map.begin ()); } - const_iterator begin (void) const { return const_iterator (map.begin ()); } - - iterator end (void) { return iterator (map.end ()); } - const_iterator end (void) const { return const_iterator (map.end ()); } - - iterator seek (const std::string& k) { return map.find (k); } - const_iterator seek (const std::string& k) const { return map.find (k); } - - std::string key (const_iterator p) const { return p->first; } - - curl_handle& contents (const std::string& k) - { - return map[k]; - } - - curl_handle contents (const std::string& k) const - { - const_iterator p = seek (k); - return p != end () ? p->second : curl_handle (); - } - - curl_handle& contents (iterator p) - { return p->second; } - - curl_handle contents (const_iterator p) const - { return p->second; } - - void del (const std::string& k) - { - iterator p = map.find (k); - - if (p != map.end ()) - map.erase (p); - } - -private: - std::map map; -}; - -static curl_handles handles; - -static void -cleanup_urlwrite (std::string filename) -{ - octave_unlink (filename); -} - -static void -reset_path (const curl_handle curl) -{ - curl.cwd (".."); -} - -static void -delete_file (std::string file) -{ - octave_unlink (file); -} -#endif - -DEFUN_DLD (urlwrite, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {@var{f} =} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {[@var{f}, @var{success}] =} urlwrite (@var{url}, @var{localfile})\n\ -@deftypefnx {Loadable Function} {[@var{f}, @var{success}, @var{message}] =} urlwrite (@var{url}, @var{localfile})\n\ -Download a remote file specified by its @var{url} and save it as\n\ -@var{localfile}. For example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"ftp://ftp.octave.org/pub/octave/README\",\n\ - \"README.txt\");\n\ -@end group\n\ -@end example\n\ -\n\ -The full path of the downloaded file is returned in @var{f}. The\n\ -variable @var{success} is 1 if the download was successful,\n\ -otherwise it is 0 in which case @var{message} contains an error\n\ -message. If no output argument is specified and an error occurs,\n\ -then the error is signaled through Octave's error handling mechanism.\n\ -\n\ -This function uses libcurl. Curl supports, among others, the HTTP,\n\ -FTP and FILE protocols. Username and password may be specified in\n\ -the URL, for example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"http://username:password@@example.com/file.txt\",\n\ - \"file.txt\");\n\ -@end group\n\ -@end example\n\ -\n\ -GET and POST requests can be specified by @var{method} and @var{param}.\n\ -The parameter @var{method} is either @samp{get} or @samp{post}\n\ -and @var{param} is a cell array of parameter and value pairs.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -urlwrite (\"http://www.google.com/search\", \"search.html\",\n\ - \"get\", @{\"query\", \"octave\"@});\n\ -@end group\n\ -@end example\n\ -@seealso{urlread}\n\ -@end deftypefn") -{ - octave_value_list retval; - -#ifdef HAVE_CURL - - int nargin = args.length (); - - // verify arguments - if (nargin != 2 && nargin != 4) - { - print_usage (); - return retval; - } - - std::string url = args(0).string_value (); - - if (error_state) - { - error ("urlwrite: URL must be a character string"); - return retval; - } - - // name to store the file if download is succesful - std::string filename = args(1).string_value (); - - if (error_state) - { - error ("urlwrite: LOCALFILE must be a character string"); - return retval; - } - - std::string method; - Cell param; // empty cell array - - if (nargin == 4) - { - method = args(2).string_value (); - - if (error_state) - { - error ("urlwrite: METHOD must be \"get\" or \"post\""); - return retval; - } - - if (method != "get" && method != "post") - { - error ("urlwrite: METHOD must be \"get\" or \"post\""); - return retval; - } - - param = args(3).cell_value (); - - if (error_state) - { - error ("urlwrite: parameters (PARAM) for get and post requests must be given as a cell"); - return retval; - } - - - if (param.numel () % 2 == 1 ) - { - error ("urlwrite: number of elements in PARAM must be even"); - return retval; - } - } - - // The file should only be deleted if it doesn't initially exist, we - // create it, and the download fails. We use unwind_protect to do - // it so that the deletion happens no matter how we exit the function. - - file_stat fs (filename); - - std::ofstream ofile (filename.c_str (), std::ios::out | std::ios::binary); - - if (! ofile.is_open ()) - { - error ("urlwrite: unable to open file"); - return retval; - } - - unwind_protect_safe frame; - - frame.add_fcn (cleanup_urlwrite, filename); - - bool ok; - curl_handle curl = curl_handle (url, method, param, ofile, ok); - - ofile.close (); - - if (!error_state) - frame.discard (); - else - frame.run (); - - if (nargout > 0) - { - if (ok) - { - retval(2) = std::string (); - retval(1) = true; - retval(0) = octave_env::make_absolute (filename); - } - else - { - retval(2) = curl.lasterror (); - retval(1) = false; - retval(0) = std::string (); - } - } - - if (nargout < 2 && ! ok) - error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); - -#else - error ("urlwrite: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (urlread, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{s} =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@var{s}, @var{success}] =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@var{s}, @var{success}, @var{message}] =} urlread (@var{url})\n\ -@deftypefnx {Loadable Function} {[@dots{}] =} urlread (@var{url}, @var{method}, @var{param})\n\ -Download a remote file specified by its @var{url} and return its content\n\ -in string @var{s}. For example:\n\ -\n\ -@example\n\ -s = urlread (\"ftp://ftp.octave.org/pub/octave/README\");\n\ -@end example\n\ -\n\ -The variable @var{success} is 1 if the download was successful,\n\ -otherwise it is 0 in which case @var{message} contains an error\n\ -message. If no output argument is specified and an error occurs,\n\ -then the error is signaled through Octave's error handling mechanism.\n\ -\n\ -This function uses libcurl. Curl supports, among others, the HTTP,\n\ -FTP and FILE protocols. Username and password may be specified in the\n\ -URL@. For example:\n\ -\n\ -@example\n\ -s = urlread (\"http://user:password@@example.com/file.txt\");\n\ -@end example\n\ -\n\ -GET and POST requests can be specified by @var{method} and @var{param}.\n\ -The parameter @var{method} is either @samp{get} or @samp{post}\n\ -and @var{param} is a cell array of parameter and value pairs.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -s = urlread (\"http://www.google.com/search\", \"get\",\n\ - @{\"query\", \"octave\"@});\n\ -@end group\n\ -@end example\n\ -@seealso{urlwrite}\n\ -@end deftypefn") -{ - // Octave's return value - octave_value_list retval; - -#ifdef HAVE_CURL - - int nargin = args.length (); - - // verify arguments - if (nargin != 1 && nargin != 3) - { - print_usage (); - return retval; - } - - std::string url = args(0).string_value (); - - if (error_state) - { - error ("urlread: URL must be a character string"); - return retval; - } - - std::string method; - Cell param; // empty cell array - - if (nargin == 3) - { - method = args(1).string_value (); - - if (error_state) - { - error ("urlread: METHOD must be \"get\" or \"post\""); - return retval; - } - - if (method != "get" && method != "post") - { - error ("urlread: METHOD must be \"get\" or \"post\""); - return retval; - } - - param = args(2).cell_value (); - - if (error_state) - { - error ("urlread: parameters (PARAM) for get and post requests must be given as a cell"); - return retval; - } - - if (param.numel () % 2 == 1 ) - { - error ("urlread: number of elements in PARAM must be even"); - return retval; - } - } - - std::ostringstream buf; - - bool ok; - curl_handle curl = curl_handle (url, method, param, buf, ok); - - if (nargout > 0) - { - // Return empty string if no error occured. - retval(2) = ok ? "" : curl.lasterror (); - retval(1) = ok; - retval(0) = buf.str (); - } - - if (nargout < 2 && ! ok) - error ("urlread: curl: %s", curl.lasterror().c_str()); - -#else - error ("urlread: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp__ (@var{handle}, @var{host})\n\ -@deftypefnx {Loadable Function} {} __ftp__ (@var{handle}, @var{host}, @var{username}, @var{password})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - std::string handle; - std::string host; - std::string user = "anonymous"; - std::string passwd = ""; - - if (nargin < 2 || nargin > 4) - error ("incorrect number of arguments"); - else - { - handle = args(0).string_value (); - host = args(1).string_value (); - - if (nargin > 1) - user = args(2).string_value (); - - if (nargin > 2) - passwd = args(3).string_value (); - - if (!error_state) - { - handles.contents (handle) = curl_handle (host, user, passwd); - - if (error_state) - handles.del (handle); - } - } -#else - error ("__ftp__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_pwd__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_pwd__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - octave_value retval; -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_pwd__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - retval = curl.pwd (); - else - error ("__ftp_pwd__: invalid ftp handle"); - } - } -#else - error ("__ftp_pwd__: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp_cwd__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_cwd__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1 && nargin != 2) - error ("__ftp_cwd__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string path = ""; - - if (nargin > 1) - path = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.cwd (path); - else - error ("__ftp_cwd__: invalid ftp handle"); - } - } -#else - error ("__ftp_cwd__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_dir__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_dir__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - octave_value retval; -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_dir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - if (nargout == 0) - curl.dir (); - else - { - string_vector sv = curl.list (); - octave_idx_type n = sv.length (); - if (n == 0) - { - string_vector flds (5); - flds(0) = "name"; - flds(1) = "date"; - flds(2) = "bytes"; - flds(3) = "isdir"; - flds(4) = "datenum"; - retval = octave_map (flds); - } - else - { - octave_map st; - Cell filectime (dim_vector (n, 1)); - Cell filesize (dim_vector (n, 1)); - Cell fileisdir (dim_vector (n, 1)); - Cell filedatenum (dim_vector (n, 1)); - - st.assign ("name", Cell (sv)); - - for (octave_idx_type i = 0; i < n; i++) - { - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - fileisdir (i) = fisdir; - filectime (i) = ctime (&ftime); - filesize (i) = fsize; - filedatenum (i) = double (ftime); - } - st.assign ("date", filectime); - st.assign ("bytes", filesize); - st.assign ("isdir", fileisdir); - st.assign ("datenum", filedatenum); - retval = st; - } - } - } - else - error ("__ftp_dir__: invalid ftp handle"); - } - } -#else - error ("__ftp_dir__: not available in this version of Octave"); -#endif - - return retval; -} - -DEFUN_DLD (__ftp_ascii__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_ascii__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_ascii__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.ascii (); - else - error ("__ftp_ascii__: invalid ftp handle"); - } - } -#else - error ("__ftp_ascii__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_binary__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_binary__ (@var{handle})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_binary__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.binary (); - else - error ("__ftp_binary__: invalid ftp handle"); - } - } -#else - error ("__ftp_binary__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_close__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_close__ (@var{handle})\n\ - Undocumented internal function\n\ - @end deftypefn") - { - #ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_close__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - if (!error_state) - handles.del (handle); - } - #else - error ("__ftp_close__: not available in this version of Octave"); - #endif - - return octave_value (); - } - -DEFUN_DLD (__ftp_mode__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mode__ (@var{handle})\n\ - Undocumented internal function\n\ - @end deftypefn") - { - octave_value retval; - #ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 1) - error ("__ftp_mode__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - retval = (curl.is_ascii () ? "ascii" : "binary"); - else - error ("__ftp_binary__: invalid ftp handle"); - } - } - #else - error ("__ftp_mode__: not available in this version of Octave"); - #endif - - return retval; - } - -DEFUN_DLD (__ftp_delete__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_delete__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_delete__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string file = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.del (file); - else - error ("__ftp_delete__: invalid ftp handle"); - } - } -#else - error ("__ftp_delete__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_rmdir__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_rmdir__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_rmdir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.rmdir (dir); - else - error ("__ftp_rmdir__: invalid ftp handle"); - } - } -#else - error ("__ftp_rmdir__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_mkdir__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mkdir__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_mkdir__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.mkdir (dir); - else - error ("__ftp_mkdir__: invalid ftp handle"); - } - } -#else - error ("__ftp_mkdir__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -DEFUN_DLD (__ftp_rename__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_rename__ (@var{handle}, @var{path})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 3) - error ("__ftp_rename__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string oldname = args(1).string_value (); - std::string newname = args(2).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - curl.rename (oldname, newname); - else - error ("__ftp_rename__: invalid ftp handle"); - } - } -#else - error ("__ftp_rename__: not available in this version of Octave"); -#endif - - return octave_value (); -} - -#ifdef HAVE_CURL -static string_vector -mput_directory (const curl_handle& curl, const std::string& base, - const std::string& dir) -{ - string_vector retval; - - if (! curl.mkdir (dir, false)) - warning ("__ftp_mput__: can not create the remote directory ""%s""", - (base.length () == 0 ? dir : base + - file_ops::dir_sep_str () + dir).c_str ()); - - curl.cwd (dir); - - if (! error_state) - { - unwind_protect_safe frame; - - frame.add_fcn (reset_path, curl); - - std::string realdir = base.length () == 0 ? dir : base + - file_ops::dir_sep_str () + dir; - - dir_entry dirlist (realdir); - - if (dirlist) - { - string_vector files = dirlist.read (); - - for (octave_idx_type i = 0; i < files.length (); i++) - { - std::string file = files (i); - - if (file == "." || file == "..") - continue; - - std::string realfile = realdir + file_ops::dir_sep_str () + file; - file_stat fs (realfile); - - if (! fs.exists ()) - { - error ("__ftp__mput: file ""%s"" does not exist", - realfile.c_str ()); - break; - } - - if (fs.is_dir ()) - { - retval.append (mput_directory (curl, realdir, file)); - - if (error_state) - break; - } - else - { - // FIXME Does ascii mode need to be flagged here? - std::ifstream ifile (realfile.c_str (), std::ios::in | - std::ios::binary); - - if (! ifile.is_open ()) - { - error ("__ftp_mput__: unable to open file ""%s""", - realfile.c_str ()); - break; - } - - curl.put (file, ifile); - - ifile.close (); - - if (error_state) - break; - - retval.append (realfile); - } - } - } - else - error ("__ftp_mput__: can not read the directory ""%s""", - realdir.c_str ()); - } - - return retval; -} -#endif - -DEFUN_DLD (__ftp_mput__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mput__ (@var{handle}, @var{files})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ - string_vector retval; - -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2) - error ("__ftp_mput__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string pat = args(1).string_value (); - - if (!error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - glob_match pattern (file_ops::tilde_expand (pat)); - string_vector files = pattern.glob (); - - for (octave_idx_type i = 0; i < files.length (); i++) - { - std::string file = files (i); - - file_stat fs (file); - - if (! fs.exists ()) - { - error ("__ftp__mput: file does not exist"); - break; - } - - if (fs.is_dir ()) - { - retval.append (mput_directory (curl, "", file)); - if (error_state) - break; - } - else - { - // FIXME Does ascii mode need to be flagged here? - std::ifstream ifile (file.c_str (), std::ios::in | - std::ios::binary); - - if (! ifile.is_open ()) - { - error ("__ftp_mput__: unable to open file"); - break; - } - - curl.put (file, ifile); - - ifile.close (); - - if (error_state) - break; - - retval.append (file); - } - } - } - else - error ("__ftp_mput__: invalid ftp handle"); - } - } -#else - error ("__ftp_mput__: not available in this version of Octave"); -#endif - - return (nargout > 0 ? octave_value (retval) : octave_value ()); -} - -#ifdef HAVE_CURL -static void -getallfiles (const curl_handle& curl, const std::string& dir, - const std::string& target) -{ - std::string sep = file_ops::dir_sep_str (); - file_stat fs (dir); - - if (!fs || !fs.is_dir ()) - { - std::string msg; - int status = octave_mkdir (dir, 0777, msg); - - if (status < 0) - error ("__ftp_mget__: can't create directory %s%s%s. %s", - target.c_str (), sep.c_str (), dir.c_str (), msg.c_str ()); - } - - if (! error_state) - { - curl.cwd (dir); - - if (! error_state) - { - unwind_protect_safe frame; - - frame.add_fcn (reset_path, curl); - - string_vector sv = curl.list (); - - for (octave_idx_type i = 0; i < sv.length (); i++) - { - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - if (fisdir) - getallfiles (curl, sv(i), target + dir + sep); - else - { - std::string realfile = target + dir + sep + sv(i); - std::ofstream ofile (realfile.c_str (), - std::ios::out | - std::ios::binary); - - if (! ofile.is_open ()) - { - error ("__ftp_mget__: unable to open file"); - break; - } - - unwind_protect_safe frame2; - - frame2.add_fcn (delete_file, realfile); - - curl.get (sv(i), ofile); - - ofile.close (); - - if (!error_state) - frame2.discard (); - else - frame2.run (); - } - - if (error_state) - break; - } - } - } -} -#endif - -DEFUN_DLD (__ftp_mget__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {} __ftp_mget__ (@var{handle}, @var{files})\n\ -Undocumented internal function\n\ -@end deftypefn") -{ -#ifdef HAVE_CURL - int nargin = args.length (); - - if (nargin != 2 && nargin != 3) - error ("__ftp_mget__: incorrect number of arguments"); - else - { - std::string handle = args(0).string_value (); - std::string file = args(1).string_value (); - std::string target; - - if (nargin == 3) - target = args(2).string_value () + file_ops::dir_sep_str (); - - if (! error_state) - { - const curl_handle curl = handles.contents (handle); - - if (curl.is_valid ()) - { - string_vector sv = curl.list (); - octave_idx_type n = 0; - glob_match pattern (file); - - for (octave_idx_type i = 0; i < sv.length (); i++) - { - if (pattern.match (sv(i))) - { - n++; - - time_t ftime; - bool fisdir; - double fsize; - - curl.get_fileinfo (sv(i), fsize, ftime, fisdir); - - if (fisdir) - getallfiles (curl, sv(i), target); - else - { - std::ofstream ofile ((target + sv(i)).c_str (), - std::ios::out | - std::ios::binary); - - if (! ofile.is_open ()) - { - error ("__ftp_mget__: unable to open file"); - break; - } - - unwind_protect_safe frame; - - frame.add_fcn (delete_file, target + sv(i)); - - curl.get (sv(i), ofile); - - ofile.close (); - - if (!error_state) - frame.discard (); - else - frame.run (); - } - - if (error_state) - break; - } - } - if (n == 0) - error ("__ftp_mget__: file not found"); - } - } - } -#else - error ("__ftp_mget__: not available in this version of Octave"); -#endif - - return octave_value (); -} diff -r 069c552587a0 -r 959953dba519 src/Makefile.am --- a/src/Makefile.am Tue Jul 31 09:54:19 2012 -0400 +++ b/src/Makefile.am Fri Aug 03 14:35:44 2012 -0400 @@ -22,13 +22,14 @@ ## Search local directories before those specified by the user. AM_CPPFLAGS = \ - -I../libgnu -I$(top_srcdir)/libgnu \ -I$(top_srcdir)/libcruft/misc \ -I../liboctave -I$(top_srcdir)/liboctave \ + -Iinterpfcn -I$(srcdir)/interpfcn \ + -Icorefcn \ -Ioctave-value -I$(srcdir)/octave-value \ -Iparse-tree -I$(srcdir)/parse-tree \ - -Icorefcn -I$(srcdir)/corefcn \ -I. -I$(srcdir) \ + -I../libgnu -I$(top_srcdir)/libgnu \ @CPPFLAGS@ AUTOMAKE_OPTIONS = subdir-objects @@ -66,28 +67,28 @@ ## (except builtins.cc) to be available. BUILT_SOURCES = \ $(BUILT_SOURCES_EXTRA) \ - defaults.h \ - graphics.h \ - graphics-props.cc \ - lex.cc \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ + interpfcn/graphics-props.cc \ + parse-tree/lex.cc \ mxarray.h \ oct-conf.h \ oct-errno.cc \ oct-gperf.h \ - oct-parse.cc \ + parse-tree/oct-parse.cc \ ops.cc \ version.h \ builtins.cc BUILT_DISTFILES = \ oct-gperf.h \ - oct-parse.h + parse-tree/oct-parse.h ## Files that are created during build process and installed, ## BUT not distributed in tarball. BUILT_NODISTFILES = \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ oct-conf.h \ oct-errno.cc \ ops.cc \ @@ -123,20 +124,6 @@ version.in.h \ $(BUILT_DISTFILES) -OPT_HANDLERS = \ - DASPK-opts.cc \ - DASRT-opts.cc \ - DASSL-opts.cc \ - LSODE-opts.cc \ - Quad-opts.cc - -OPT_INC = \ - ../liboctave/DASPK-opts.h \ - ../liboctave/DASRT-opts.h \ - ../liboctave/DASSL-opts.h \ - ../liboctave/LSODE-opts.h \ - ../liboctave/Quad-opts.h - JIT_INCLUDES = \ jit-util.h \ jit-typeinfo.h \ @@ -149,32 +136,20 @@ c-file-ptr-stream.h \ comment-list.h \ cutils.h \ - data.h \ - debug.h \ defun-dld.h \ defun-int.h \ - defun.h \ - dirfns.h \ display.h \ dynamic-ld.h \ - error.h \ - file-io.h \ gl-render.h \ gl2ps.h \ gl2ps-renderer.h \ - graphics-props.cc \ + interpfcn/graphics-props.cc \ gripes.h \ - help.h \ - input.h \ - lex.h \ - load-path.h \ - load-save.h \ ls-ascii-helper.h \ ls-hdf5.h \ ls-mat-ascii.h \ ls-mat4.h \ ls-mat5.h \ - ls-oct-ascii.h \ ls-oct-binary.h \ ls-utils.h \ mex.h \ @@ -183,7 +158,6 @@ oct-fstrm.h \ oct-gperf.h \ oct-hdf5.h \ - oct-hist.h \ oct-iostrm.h \ oct-lvalue.h \ oct-map.h \ @@ -196,25 +170,14 @@ oct.h \ octave.h \ ops.h \ - pager.h \ - parse.h \ - parse-private.h \ - pr-output.h \ procstream.h \ - profiler.h \ - sighandlers.h \ siglist.h \ sparse-xdiv.h \ sparse-xpow.h \ - symtab.h \ - sysdep.h \ token.h \ - toplev.h \ txt-eng-ft.h \ txt-eng.h \ unwind-prot.h \ - utils.h \ - variables.h \ xdiv.h \ xnorm.h \ xpow.h \ @@ -222,11 +185,12 @@ $(OV_INCLUDES) \ $(OV_SPARSE_INCLUDES) \ $(PT_INCLUDES) \ + $(INTERPFCN_INCLUDES) \ $(JIT_INCLUDES) nodist_octinclude_HEADERS = \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ oct-conf.h \ mxarray.h \ version.h @@ -239,79 +203,50 @@ DIST_SRC = \ Cell.cc \ - bitfcns.cc \ c-file-ptr-stream.cc \ comment-list.cc \ cutils.c \ - data.cc \ - debug.cc \ - defaults.cc \ - defun.cc \ - dirfns.cc \ display.cc \ dynamic-ld.cc \ - error.cc \ - file-io.cc \ gl-render.cc \ gl2ps-renderer.cc \ - graphics.cc \ gripes.cc \ - help.cc \ - input.cc \ - lex.ll \ - load-path.cc \ - load-save.cc \ ls-ascii-helper.cc \ ls-hdf5.cc \ ls-mat-ascii.cc \ ls-mat4.cc \ ls-mat5.cc \ - ls-oct-ascii.cc \ ls-oct-binary.cc \ ls-utils.cc \ - mappers.cc \ matherr.c \ mex.cc \ oct-fstrm.cc \ - oct-hist.cc \ oct-iostrm.cc \ oct-lvalue.cc \ oct-map.cc \ oct-obj.cc \ - oct-parse.yy \ oct-prcstrm.cc \ oct-procbuf.cc \ oct-stream.cc \ oct-strstrm.cc \ octave.cc \ - pager.cc \ - pr-output.cc \ procstream.cc \ - profiler.cc \ - sighandlers.cc \ siglist.c \ - sparse.cc \ sparse-xdiv.cc \ sparse-xpow.cc \ - strfns.cc \ - symtab.cc \ - syscalls.cc \ - sysdep.cc \ token.cc \ - toplev.cc \ txt-eng-ft.cc \ unwind-prot.cc \ - utils.cc \ - variables.cc \ xdiv.cc \ xgl2ps.c \ xnorm.cc \ xpow.cc \ zfstream.cc \ - $(COREFCN_SRC) \ $(OCTAVE_VALUE_SRC) \ $(PARSE_TREE_SRC) \ - $(JIT_SRC) + $(JIT_SRC) \ + $(INTERPFCN_SRC) \ + $(COREFCN_SRC) noinst_LTLIBRARIES = @@ -319,15 +254,16 @@ include octave-value/module.mk include operators/module.mk include template-inst/module.mk +include interpfcn/module.mk include corefcn/module.mk -include DLD-FUNCTIONS/module.mk +include dldfcn/module.mk -$(srcdir)/DLD-FUNCTIONS/module.mk: $(srcdir)/DLD-FUNCTIONS/config-module.sh $(srcdir)/DLD-FUNCTIONS/config-module.awk $(srcdir)/DLD-FUNCTIONS/module-files - $(srcdir)/DLD-FUNCTIONS/config-module.sh $(top_srcdir) +$(srcdir)/dldfcn/module.mk: $(srcdir)/dldfcn/config-module.sh $(srcdir)/dldfcn/config-module.awk $(srcdir)/dldfcn/module-files + $(srcdir)/dldfcn/config-module.sh $(top_srcdir) if AMCOND_ENABLE_DYNAMIC_LINKING - OCT_FILES = $(DLD_FUNCTIONS_LIBS:.la=.oct) - OCT_STAMP_FILES = $(subst DLD-FUNCTIONS/,DLD-FUNCTIONS/$(am__leading_dot),$(DLD_FUNCTIONS_LIBS:.la=.oct-stamp)) + OCT_FILES = $(DLDFCN_LIBS:.la=.oct) + OCT_STAMP_FILES = $(subst dldfcn/,dldfcn/$(am__leading_dot),$(DLDFCN_LIBS:.la=.oct-stamp)) DLD_LIBOCTINTERP_LIBADD = liboctinterp.la else OCT_FILES = @@ -342,8 +278,8 @@ nodist_liboctinterp_la_SOURCES = \ builtins.cc \ - defaults.h \ - graphics.h \ + interpfcn/defaults.h \ + interpfcn/graphics.h \ mxarray.h \ oct-conf.h \ oct-errno.cc \ @@ -393,17 +329,17 @@ ## Section for defining and creating DEF_FILES SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) -DLD_FUNCTIONS_DEF_FILES = $(DLD_FUNCTIONS_SRC:.cc=.df) +DLDFCN_DEF_FILES = $(DLDFCN_SRC:.cc=.df) ## builtins.cc depends on $(DEF_FILES), so DEF_FILES should only include ## .df files that correspond to sources included in liboctave. if AMCOND_ENABLE_DYNAMIC_LINKING DEF_FILES = $(SRC_DEF_FILES) else - DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) + DEF_FILES = $(SRC_DEF_FILES) $(DLDFCN_DEF_FILES) endif -ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) +ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLDFCN_DEF_FILES) $(SRC_DEF_FILES): mkdefs Makefile @@ -425,13 +361,6 @@ ## defaults.h and oct-conf.h must depend on Makefile. Calling configure ## may change default/config values. However, calling configure will also ## regenerate the Makefiles from Makefile.am and trigger the rules below. -defaults.h: defaults.in.h Makefile - @$(do_subst_default_vals) - -graphics.h: graphics.in.h genprops.awk Makefile - $(AWK) -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - oct-conf.h: oct-conf.in.h Makefile @$(do_subst_config_vals) @@ -463,10 +392,6 @@ $(srcdir)/mkbuiltins $(DEF_FILES) > $@-t mv $@-t $@ -graphics-props.cc: graphics.in.h genprops.awk Makefile - $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t - mv $@-t $@ - ops.cc: $(OPERATORS_SRC) mkops $(srcdir)/mkops $(OPERATORS_SRC) > $@-t mv $@-t $@ @@ -481,24 +406,14 @@ fi mv $@-t $@ -$(OPT_HANDLERS) : %.cc : $(top_srcdir)/liboctave/%.in $(top_srcdir)/build-aux/mk-opts.pl - $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t - mv $@-t $@ +if AMCOND_ENABLE_DYNAMIC_LINKING +DLDFCN_PKG_ADD_FILE = dldfcn/PKG_ADD -$(OPT_INC) : %.h : %.in - $(MAKE) -C $(@D) $(@F) - -if AMCOND_ENABLE_DYNAMIC_LINKING -DLD_FUNCTIONS_PKG_ADD_FILE = DLD-FUNCTIONS/PKG_ADD - -DLD-FUNCTIONS/PKG_ADD: $(DLD_FUNCTIONS_DEF_FILES) mk-pkg-add - $(srcdir)/mk-pkg-add $(DLD_FUNCTIONS_DEF_FILES) > $@-t +dldfcn/PKG_ADD: $(DLDFCN_DEF_FILES) mk-pkg-add + $(srcdir)/mk-pkg-add $(DLDFCN_DEF_FILES) > $@-t mv $@-t $@ endif -lex.lo lex.o oct-parse.lo oct-parse.o: \ - AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) - __fltk_uigetfile__.lo __fltk_uigetfile__.o: \ AM_CXXFLAGS := $(filter-out $(DLL_CXXDEFS), $(AM_CXXFLAGS) $(GRAPHICS_CFLAGS)) @@ -516,9 +431,9 @@ $(top_srcdir)/build-aux/move-if-change $@ DOCSTRINGS touch $@ -all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) .DOCSTRINGS +all-local: $(OCT_STAMP_FILES) $(DLDFCN_PKG_ADD_FILE) .DOCSTRINGS else -all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) +all-local: $(OCT_STAMP_FILES) $(DLDFCN_PKG_ADD_FILE) endif if AMCOND_BUILD_COMPILED_AUX_PROGRAMS @@ -572,11 +487,11 @@ if AMCOND_ENABLE_DYNAMIC_LINKING install-oct: $(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(octfiledir) - if [ -n "`cat $(DLD_FUNCTIONS_PKG_ADD_FILE)`" ]; then \ - $(INSTALL_DATA) $(DLD_FUNCTIONS_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ + if [ -n "`cat $(DLDFCN_PKG_ADD_FILE)`" ]; then \ + $(INSTALL_DATA) $(DLDFCN_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ fi cd $(DESTDIR)$(octlibdir) && \ - for ltlib in $(DLD_FUNCTIONS_LIBS); do \ + for ltlib in $(DLDFCN_LIBS); do \ f=`echo $$ltlib | $(SED) 's,.*/,,'`; \ dl=`$(SED) -n -e "s/dlname='\([^']*\)'/\1/p" < $$f`; \ if [ -n "$$dl" ]; then \ @@ -601,9 +516,9 @@ CLEANFILES = \ $(bin_SCRIPTS) \ - $(DLD_FUNCTIONS_PKG_ADD_FILE) \ - graphics-props.cc \ - oct-parse.output + $(DLDFCN_PKG_ADD_FILE) \ + interpfcn/graphics-props.cc \ + parse-tree/oct-parse.output DISTCLEANFILES = \ .DOCSTRINGS \ diff -r 069c552587a0 -r 959953dba519 src/bitfcns.cc --- a/src/bitfcns.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,756 +0,0 @@ -/* - -Copyright (C) 2004-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "str-vec.h" -#include "quit.h" - -#include "defun.h" -#include "error.h" -#include "ov.h" -#include "ov-uint64.h" -#include "ov-uint32.h" -#include "ov-uint16.h" -#include "ov-uint8.h" -#include "ov-int64.h" -#include "ov-int32.h" -#include "ov-int16.h" -#include "ov-int8.h" -#include "ov-scalar.h" -#include "ov-re-mat.h" -#include "ov-bool.h" - -#include - -#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) -namespace std -{ - template - struct bit_and - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 & op2); } - }; - - template - struct bit_or - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 | op2); } - }; - - template - struct bit_xor - { - public: - T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } - }; -} -#endif - -template -octave_value -bitopxx (const OP& op, const std::string& fname, - const Array& x, const Array& y) -{ - int nelx = x.numel (); - int nely = y.numel (); - - bool is_scalar_op = (nelx == 1 || nely == 1); - - dim_vector dvx = x.dims (); - dim_vector dvy = y.dims (); - - bool is_array_op = (dvx == dvy); - - octave_value retval; - if (is_array_op || is_scalar_op) - { - Array result; - - if (nelx != 1) - result.resize (dvx); - else - result.resize (dvy); - - for (int i = 0; i < nelx; i++) - if (is_scalar_op) - for (int k = 0; k < nely; k++) - result(i+k) = op (x(i), y(k)); - else - result(i) = op (x(i), y(i)); - - retval = result; - } - else - error ("%s: size of X and Y must match, or one operand must be a scalar", - fname.c_str ()); - - return retval; -} - -// Trampoline function, instantiates the proper template above, with -// reflective information hardwired. We can't hardwire this information -// in Fbitxxx DEFUNs below, because at that moment, we still don't have -// information about which integer types we need to instantiate. -template -octave_value -bitopx (const std::string& fname, const Array& x, const Array& y) -{ - if (fname == "bitand") - return bitopxx (std::bit_and(), fname, x, y); - if (fname == "bitor") - return bitopxx (std::bit_or(), fname, x, y); - - //else (fname == "bitxor") - return bitopxx (std::bit_xor(), fname, x, y); -} - -octave_value -bitop (const std::string& fname, const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if ((args(0).class_name () == octave_scalar::static_class_name ()) - || (args(0).class_name () == octave_bool::static_class_name ()) - || (args(1).class_name () == octave_scalar::static_class_name ()) - || (args(1).class_name () == octave_bool::static_class_name ())) - { - bool arg0_is_int = (args(0).class_name () != - octave_scalar::static_class_name () && - args(0).class_name () != - octave_bool::static_class_name ()); - bool arg1_is_int = (args(1).class_name () != - octave_scalar::static_class_name () && - args(1).class_name () != - octave_bool::static_class_name ()); - - if (! (arg0_is_int || arg1_is_int)) - { - uint64NDArray x (args(0).array_value ()); - uint64NDArray y (args(1).array_value ()); - if (! error_state) - retval = bitopx (fname, x, y).array_value (); - } - else - { - int p = (arg0_is_int ? 1 : 0); - int q = (arg0_is_int ? 0 : 1); - - NDArray dx = args(p).array_value (); - - if (args(q).type_id () == octave_uint64_matrix::static_type_id () - || args(q).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x (dx); - uint64NDArray y = args(q).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint32_matrix::static_type_id () - || args(q).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x (dx); - uint32NDArray y = args(q).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint16_matrix::static_type_id () - || args(q).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x (dx); - uint16NDArray y = args(q).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_uint8_matrix::static_type_id () - || args(q).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x (dx); - uint8NDArray y = args(q).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int64_matrix::static_type_id () - || args(q).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x (dx); - int64NDArray y = args(q).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int32_matrix::static_type_id () - || args(q).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x (dx); - int32NDArray y = args(q).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int16_matrix::static_type_id () - || args(q).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x (dx); - int16NDArray y = args(q).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(q).type_id () == octave_int8_matrix::static_type_id () - || args(q).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x (dx); - int8NDArray y = args(q).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - } - else if (args(0).class_name () == args(1).class_name ()) - { - if (args(0).type_id () == octave_uint64_matrix::static_type_id () - || args(0).type_id () == octave_uint64_scalar::static_type_id ()) - { - uint64NDArray x = args(0).uint64_array_value (); - uint64NDArray y = args(1).uint64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint32_matrix::static_type_id () - || args(0).type_id () == octave_uint32_scalar::static_type_id ()) - { - uint32NDArray x = args(0).uint32_array_value (); - uint32NDArray y = args(1).uint32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint16_matrix::static_type_id () - || args(0).type_id () == octave_uint16_scalar::static_type_id ()) - { - uint16NDArray x = args(0).uint16_array_value (); - uint16NDArray y = args(1).uint16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_uint8_matrix::static_type_id () - || args(0).type_id () == octave_uint8_scalar::static_type_id ()) - { - uint8NDArray x = args(0).uint8_array_value (); - uint8NDArray y = args(1).uint8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int64_matrix::static_type_id () - || args(0).type_id () == octave_int64_scalar::static_type_id ()) - { - int64NDArray x = args(0).int64_array_value (); - int64NDArray y = args(1).int64_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int32_matrix::static_type_id () - || args(0).type_id () == octave_int32_scalar::static_type_id ()) - { - int32NDArray x = args(0).int32_array_value (); - int32NDArray y = args(1).int32_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int16_matrix::static_type_id () - || args(0).type_id () == octave_int16_scalar::static_type_id ()) - { - int16NDArray x = args(0).int16_array_value (); - int16NDArray y = args(1).int16_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else if (args(0).type_id () == octave_int8_matrix::static_type_id () - || args(0).type_id () == octave_int8_scalar::static_type_id ()) - { - int8NDArray x = args(0).int8_array_value (); - int8NDArray y = args(1).int8_array_value (); - if (! error_state) - retval = bitopx (fname, x, y); - } - else - error ("%s: invalid operand type", fname.c_str ()); - } - else - error ("%s: must have matching operand types", fname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ -Return the bitwise AND of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitand", args); -} - -DEFUN (bitor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ -Return the bitwise OR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitor", args); -} - -DEFUN (bitxor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ -Return the bitwise XOR of non-negative integers.\n\ -@var{x}, @var{y} must be in the range [0,bitmax]\n\ -@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ -@end deftypefn") -{ - return bitop ("bitxor", args); -} - -static int64_t -bitshift (double a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast (a) << n) & mask; - else if (n < 0) - return (static_cast (a) >> -n) & mask; - else - return static_cast (a) & mask; -} - -static int64_t -bitshift (float a, int n, int64_t mask) -{ - // In the name of bug-for-bug compatibility. - if (a < 0) - return -bitshift (-a, n, mask); - - if (n > 0) - return (static_cast (a) << n) & mask; - else if (n < 0) - return (static_cast (a) >> -n) & mask; - else - return static_cast (a) & mask; -} - -// Note that the bitshift operators are undefined if shifted by more -// bits than in the type, so we need to test for the size of the -// shift. - -#define DO_BITSHIFT(T) \ - if (! error_state) \ - { \ - double d1, d2; \ - \ - if (n.all_integers (d1, d2)) \ - { \ - int m_nel = m.numel (); \ - int n_nel = n.numel (); \ - \ - bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ - \ - dim_vector m_dv = m.dims (); \ - dim_vector n_dv = n.dims (); \ - \ - bool is_array_op = (m_dv == n_dv); \ - \ - if (is_array_op || is_scalar_op) \ - { \ - T ## NDArray result; \ - \ - if (m_nel != 1) \ - result.resize (m_dv); \ - else \ - result.resize (n_dv); \ - \ - for (int i = 0; i < m_nel; i++) \ - if (is_scalar_op) \ - for (int k = 0; k < n_nel; k++) \ - if (static_cast (n(k)) >= bits_in_type) \ - result(i+k) = 0; \ - else \ - result(i+k) = bitshift (m(i), static_cast (n(k)), mask); \ - else \ - if (static_cast (n(i)) >= bits_in_type) \ - result(i) = 0; \ - else \ - result(i) = bitshift (m(i), static_cast (n(i)), mask); \ - \ - retval = result; \ - } \ - else \ - error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ - } \ - else \ - error ("bitshift: expecting integer as second argument"); \ - } - -#define DO_UBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - DO_BITSHIFT (T); \ - } \ - while (0) - -#define DO_SBITSHIFT(T, N) \ - do \ - { \ - int bits_in_type = octave_ ## T :: nbits (); \ - T ## NDArray m = m_arg.T ## _array_value (); \ - octave_ ## T mask = octave_ ## T::max (); \ - if ((N) < bits_in_type) \ - mask = bitshift (mask, (N) - bits_in_type); \ - else if ((N) < 1) \ - mask = 0; \ - mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ - DO_BITSHIFT (T); \ - } \ - while (0) - -DEFUN (bitshift, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ -@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ -Return a @var{k} bit shift of @var{n}-digit unsigned\n\ -integers in @var{a}. A positive @var{k} leads to a left shift;\n\ -A negative value to a right shift. If @var{n} is omitted it defaults\n\ -to log2(bitmax)+1.\n\ -@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ -\n\ -@example\n\ -@group\n\ -bitshift (eye (3), 1)\n\ -@result{}\n\ -@group\n\ -2 0 0\n\ -0 2 0\n\ -0 0 2\n\ -@end group\n\ -\n\ -bitshift (10, [-2, -1, 0, 1, 2])\n\ -@result{} 2 5 10 20 40\n\ -@c FIXME -- restore this example when third arg is allowed to be an array.\n\ -@c\n\ -@c\n\ -@c bitshift ([1, 10], 2, [3,4])\n\ -@c @result{} 4 8\n\ -@end group\n\ -@end example\n\ -@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - int nbits = 64; - - NDArray n = args(1).array_value (); - - if (error_state) - error ("bitshift: expecting integer as second argument"); - else - { - if (nargin == 3) - { - // FIXME -- for compatibility, we should accept an array - // or a scalar as the third argument. - if (args(2).numel () > 1) - error ("bitshift: N must be a scalar integer"); - else - { - nbits = args(2).int_value (); - - if (error_state) - error ("bitshift: N must be an integer"); - else if (nbits < 0) - error ("bitshift: N must be positive"); - } - } - } - - if (error_state) - return retval; - - octave_value m_arg = args(0); - std::string cname = m_arg.class_name (); - - if (cname == "uint8") - DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); - else if (cname == "uint16") - DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); - else if (cname == "uint32") - DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); - else if (cname == "uint64") - DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); - else if (cname == "int8") - DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); - else if (cname == "int16") - DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); - else if (cname == "int32") - DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); - else if (cname == "int64") - DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); - else if (cname == "double") - { - nbits = (nbits < 53 ? nbits : 53); - int64_t mask = 0x1FFFFFFFFFFFFFLL; - if (nbits < 53) - mask = mask >> (53 - nbits); - else if (nbits < 1) - mask = 0; - int bits_in_type = 64; - NDArray m = m_arg.array_value (); - DO_BITSHIFT ( ); - } - else - error ("bitshift: not defined for %s objects", cname.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (bitmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} bitmax ()\n\ -@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ -@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ -Return the largest integer that can be represented within a floating point\n\ -value. The default class is \"double\", but \"single\" is a valid option.\n\ -On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "double"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "double") - retval = (static_cast (0x1FFFFFFFFFFFFFLL)); - else if (cname == "single") - retval = (static_cast (0xFFFFFFL)); - else - error ("bitmax: not defined for class '%s'", cname.c_str ()); - - return retval; -} - -DEFUN (intmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmax (@var{type})\n\ -Return the largest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmin, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits::max ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits::max ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits::max ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits::max ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits::max ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits::max ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits::max ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits::max ()); - else - error ("intmax: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (intmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} intmin (@var{type})\n\ -Return the smallest integer that can be represented in an integer type.\n\ -The variable @var{type} can be\n\ -\n\ -@table @code\n\ -@item int8\n\ -signed 8-bit integer.\n\ -\n\ -@item int16\n\ -signed 16-bit integer.\n\ -\n\ -@item int32\n\ -signed 32-bit integer.\n\ -\n\ -@item int64\n\ -signed 64-bit integer.\n\ -\n\ -@item uint8\n\ -unsigned 8-bit integer.\n\ -\n\ -@item uint16\n\ -unsigned 16-bit integer.\n\ -\n\ -@item uint32\n\ -unsigned 32-bit integer.\n\ -\n\ -@item uint64\n\ -unsigned 64-bit integer.\n\ -@end table\n\ -\n\ -The default for @var{type} is @code{uint32}.\n\ -@seealso{intmax, bitmax}\n\ -@end deftypefn") -{ - octave_value retval; - std::string cname = "int32"; - int nargin = args.length (); - - if (nargin == 1 && args(0).is_string ()) - cname = args(0).string_value (); - else if (nargin != 0) - { - print_usage (); - return retval; - } - - if (cname == "uint8") - retval = octave_uint8 (std::numeric_limits::min ()); - else if (cname == "uint16") - retval = octave_uint16 (std::numeric_limits::min ()); - else if (cname == "uint32") - retval = octave_uint32 (std::numeric_limits::min ()); - else if (cname == "uint64") - retval = octave_uint64 (std::numeric_limits::min ()); - else if (cname == "int8") - retval = octave_int8 (std::numeric_limits::min ()); - else if (cname == "int16") - retval = octave_int16 (std::numeric_limits::min ()); - else if (cname == "int32") - retval = octave_int32 (std::numeric_limits::min ()); - else if (cname == "int64") - retval = octave_int64 (std::numeric_limits::min ()); - else - error ("intmin: not defined for '%s' objects", cname.c_str ()); - - return retval; -} - -DEFUN (sizemax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sizemax ()\n\ -Return the largest value allowed for the size of an array.\n\ -If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ -otherwise it is of class int32. The maximum array size is slightly\n\ -smaller than the maximum value allowable for the relevant class as reported\n\ -by @code{intmax}.\n\ -@seealso{intmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_int (dim_vector::dim_max ()); - else - print_usage (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/corefcn/bitfcns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/bitfcns.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,756 @@ +/* + +Copyright (C) 2004-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "str-vec.h" +#include "quit.h" + +#include "defun.h" +#include "error.h" +#include "ov.h" +#include "ov-uint64.h" +#include "ov-uint32.h" +#include "ov-uint16.h" +#include "ov-uint8.h" +#include "ov-int64.h" +#include "ov-int32.h" +#include "ov-int16.h" +#include "ov-int8.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-bool.h" + +#include + +#if !defined (HAVE_CXX_BITWISE_OP_TEMPLATES) +namespace std +{ + template + struct bit_and + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 & op2); } + }; + + template + struct bit_or + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 | op2); } + }; + + template + struct bit_xor + { + public: + T operator() (const T & op1, const T & op2) const { return (op1 ^ op2); } + }; +} +#endif + +template +octave_value +bitopxx (const OP& op, const std::string& fname, + const Array& x, const Array& y) +{ + int nelx = x.numel (); + int nely = y.numel (); + + bool is_scalar_op = (nelx == 1 || nely == 1); + + dim_vector dvx = x.dims (); + dim_vector dvy = y.dims (); + + bool is_array_op = (dvx == dvy); + + octave_value retval; + if (is_array_op || is_scalar_op) + { + Array result; + + if (nelx != 1) + result.resize (dvx); + else + result.resize (dvy); + + for (int i = 0; i < nelx; i++) + if (is_scalar_op) + for (int k = 0; k < nely; k++) + result(i+k) = op (x(i), y(k)); + else + result(i) = op (x(i), y(i)); + + retval = result; + } + else + error ("%s: size of X and Y must match, or one operand must be a scalar", + fname.c_str ()); + + return retval; +} + +// Trampoline function, instantiates the proper template above, with +// reflective information hardwired. We can't hardwire this information +// in Fbitxxx DEFUNs below, because at that moment, we still don't have +// information about which integer types we need to instantiate. +template +octave_value +bitopx (const std::string& fname, const Array& x, const Array& y) +{ + if (fname == "bitand") + return bitopxx (std::bit_and(), fname, x, y); + if (fname == "bitor") + return bitopxx (std::bit_or(), fname, x, y); + + //else (fname == "bitxor") + return bitopxx (std::bit_xor(), fname, x, y); +} + +octave_value +bitop (const std::string& fname, const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if ((args(0).class_name () == octave_scalar::static_class_name ()) + || (args(0).class_name () == octave_bool::static_class_name ()) + || (args(1).class_name () == octave_scalar::static_class_name ()) + || (args(1).class_name () == octave_bool::static_class_name ())) + { + bool arg0_is_int = (args(0).class_name () != + octave_scalar::static_class_name () && + args(0).class_name () != + octave_bool::static_class_name ()); + bool arg1_is_int = (args(1).class_name () != + octave_scalar::static_class_name () && + args(1).class_name () != + octave_bool::static_class_name ()); + + if (! (arg0_is_int || arg1_is_int)) + { + uint64NDArray x (args(0).array_value ()); + uint64NDArray y (args(1).array_value ()); + if (! error_state) + retval = bitopx (fname, x, y).array_value (); + } + else + { + int p = (arg0_is_int ? 1 : 0); + int q = (arg0_is_int ? 0 : 1); + + NDArray dx = args(p).array_value (); + + if (args(q).type_id () == octave_uint64_matrix::static_type_id () + || args(q).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x (dx); + uint64NDArray y = args(q).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint32_matrix::static_type_id () + || args(q).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x (dx); + uint32NDArray y = args(q).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint16_matrix::static_type_id () + || args(q).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x (dx); + uint16NDArray y = args(q).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_uint8_matrix::static_type_id () + || args(q).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x (dx); + uint8NDArray y = args(q).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int64_matrix::static_type_id () + || args(q).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x (dx); + int64NDArray y = args(q).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int32_matrix::static_type_id () + || args(q).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x (dx); + int32NDArray y = args(q).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int16_matrix::static_type_id () + || args(q).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x (dx); + int16NDArray y = args(q).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(q).type_id () == octave_int8_matrix::static_type_id () + || args(q).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x (dx); + int8NDArray y = args(q).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + } + else if (args(0).class_name () == args(1).class_name ()) + { + if (args(0).type_id () == octave_uint64_matrix::static_type_id () + || args(0).type_id () == octave_uint64_scalar::static_type_id ()) + { + uint64NDArray x = args(0).uint64_array_value (); + uint64NDArray y = args(1).uint64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint32_matrix::static_type_id () + || args(0).type_id () == octave_uint32_scalar::static_type_id ()) + { + uint32NDArray x = args(0).uint32_array_value (); + uint32NDArray y = args(1).uint32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint16_matrix::static_type_id () + || args(0).type_id () == octave_uint16_scalar::static_type_id ()) + { + uint16NDArray x = args(0).uint16_array_value (); + uint16NDArray y = args(1).uint16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_uint8_matrix::static_type_id () + || args(0).type_id () == octave_uint8_scalar::static_type_id ()) + { + uint8NDArray x = args(0).uint8_array_value (); + uint8NDArray y = args(1).uint8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int64_matrix::static_type_id () + || args(0).type_id () == octave_int64_scalar::static_type_id ()) + { + int64NDArray x = args(0).int64_array_value (); + int64NDArray y = args(1).int64_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int32_matrix::static_type_id () + || args(0).type_id () == octave_int32_scalar::static_type_id ()) + { + int32NDArray x = args(0).int32_array_value (); + int32NDArray y = args(1).int32_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int16_matrix::static_type_id () + || args(0).type_id () == octave_int16_scalar::static_type_id ()) + { + int16NDArray x = args(0).int16_array_value (); + int16NDArray y = args(1).int16_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else if (args(0).type_id () == octave_int8_matrix::static_type_id () + || args(0).type_id () == octave_int8_scalar::static_type_id ()) + { + int8NDArray x = args(0).int8_array_value (); + int8NDArray y = args(1).int8_array_value (); + if (! error_state) + retval = bitopx (fname, x, y); + } + else + error ("%s: invalid operand type", fname.c_str ()); + } + else + error ("%s: must have matching operand types", fname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitand (@var{x}, @var{y})\n\ +Return the bitwise AND of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitand", args); +} + +DEFUN (bitor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitor (@var{x}, @var{y})\n\ +Return the bitwise OR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitor", args); +} + +DEFUN (bitxor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitxor (@var{x}, @var{y})\n\ +Return the bitwise XOR of non-negative integers.\n\ +@var{x}, @var{y} must be in the range [0,bitmax]\n\ +@seealso{bitand, bitor, bitset, bitget, bitcmp, bitshift, bitmax}\n\ +@end deftypefn") +{ + return bitop ("bitxor", args); +} + +static int64_t +bitshift (double a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast (a) << n) & mask; + else if (n < 0) + return (static_cast (a) >> -n) & mask; + else + return static_cast (a) & mask; +} + +static int64_t +bitshift (float a, int n, int64_t mask) +{ + // In the name of bug-for-bug compatibility. + if (a < 0) + return -bitshift (-a, n, mask); + + if (n > 0) + return (static_cast (a) << n) & mask; + else if (n < 0) + return (static_cast (a) >> -n) & mask; + else + return static_cast (a) & mask; +} + +// Note that the bitshift operators are undefined if shifted by more +// bits than in the type, so we need to test for the size of the +// shift. + +#define DO_BITSHIFT(T) \ + if (! error_state) \ + { \ + double d1, d2; \ + \ + if (n.all_integers (d1, d2)) \ + { \ + int m_nel = m.numel (); \ + int n_nel = n.numel (); \ + \ + bool is_scalar_op = (m_nel == 1 || n_nel == 1); \ + \ + dim_vector m_dv = m.dims (); \ + dim_vector n_dv = n.dims (); \ + \ + bool is_array_op = (m_dv == n_dv); \ + \ + if (is_array_op || is_scalar_op) \ + { \ + T ## NDArray result; \ + \ + if (m_nel != 1) \ + result.resize (m_dv); \ + else \ + result.resize (n_dv); \ + \ + for (int i = 0; i < m_nel; i++) \ + if (is_scalar_op) \ + for (int k = 0; k < n_nel; k++) \ + if (static_cast (n(k)) >= bits_in_type) \ + result(i+k) = 0; \ + else \ + result(i+k) = bitshift (m(i), static_cast (n(k)), mask); \ + else \ + if (static_cast (n(i)) >= bits_in_type) \ + result(i) = 0; \ + else \ + result(i) = bitshift (m(i), static_cast (n(i)), mask); \ + \ + retval = result; \ + } \ + else \ + error ("bitshift: size of A and N must match, or one operand must be a scalar"); \ + } \ + else \ + error ("bitshift: expecting integer as second argument"); \ + } + +#define DO_UBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + DO_BITSHIFT (T); \ + } \ + while (0) + +#define DO_SBITSHIFT(T, N) \ + do \ + { \ + int bits_in_type = octave_ ## T :: nbits (); \ + T ## NDArray m = m_arg.T ## _array_value (); \ + octave_ ## T mask = octave_ ## T::max (); \ + if ((N) < bits_in_type) \ + mask = bitshift (mask, (N) - bits_in_type); \ + else if ((N) < 1) \ + mask = 0; \ + mask = mask | octave_ ## T :: min (); /* FIXME: 2's complement only? */ \ + DO_BITSHIFT (T); \ + } \ + while (0) + +DEFUN (bitshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitshift (@var{a}, @var{k})\n\ +@deftypefnx {Built-in Function} {} bitshift (@var{a}, @var{k}, @var{n})\n\ +Return a @var{k} bit shift of @var{n}-digit unsigned\n\ +integers in @var{a}. A positive @var{k} leads to a left shift;\n\ +A negative value to a right shift. If @var{n} is omitted it defaults\n\ +to log2(bitmax)+1.\n\ +@var{n} must be in the range [1,log2(bitmax)+1] usually [1,33].\n\ +\n\ +@example\n\ +@group\n\ +bitshift (eye (3), 1)\n\ +@result{}\n\ +@group\n\ +2 0 0\n\ +0 2 0\n\ +0 0 2\n\ +@end group\n\ +\n\ +bitshift (10, [-2, -1, 0, 1, 2])\n\ +@result{} 2 5 10 20 40\n\ +@c FIXME -- restore this example when third arg is allowed to be an array.\n\ +@c\n\ +@c\n\ +@c bitshift ([1, 10], 2, [3,4])\n\ +@c @result{} 4 8\n\ +@end group\n\ +@end example\n\ +@seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + int nbits = 64; + + NDArray n = args(1).array_value (); + + if (error_state) + error ("bitshift: expecting integer as second argument"); + else + { + if (nargin == 3) + { + // FIXME -- for compatibility, we should accept an array + // or a scalar as the third argument. + if (args(2).numel () > 1) + error ("bitshift: N must be a scalar integer"); + else + { + nbits = args(2).int_value (); + + if (error_state) + error ("bitshift: N must be an integer"); + else if (nbits < 0) + error ("bitshift: N must be positive"); + } + } + } + + if (error_state) + return retval; + + octave_value m_arg = args(0); + std::string cname = m_arg.class_name (); + + if (cname == "uint8") + DO_UBITSHIFT (uint8, nbits < 8 ? nbits : 8); + else if (cname == "uint16") + DO_UBITSHIFT (uint16, nbits < 16 ? nbits : 16); + else if (cname == "uint32") + DO_UBITSHIFT (uint32, nbits < 32 ? nbits : 32); + else if (cname == "uint64") + DO_UBITSHIFT (uint64, nbits < 64 ? nbits : 64); + else if (cname == "int8") + DO_SBITSHIFT (int8, nbits < 8 ? nbits : 8); + else if (cname == "int16") + DO_SBITSHIFT (int16, nbits < 16 ? nbits : 16); + else if (cname == "int32") + DO_SBITSHIFT (int32, nbits < 32 ? nbits : 32); + else if (cname == "int64") + DO_SBITSHIFT (int64, nbits < 64 ? nbits : 64); + else if (cname == "double") + { + nbits = (nbits < 53 ? nbits : 53); + int64_t mask = 0x1FFFFFFFFFFFFFLL; + if (nbits < 53) + mask = mask >> (53 - nbits); + else if (nbits < 1) + mask = 0; + int bits_in_type = 64; + NDArray m = m_arg.array_value (); + DO_BITSHIFT ( ); + } + else + error ("bitshift: not defined for %s objects", cname.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (bitmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} bitmax ()\n\ +@deftypefnx {Built-in Function} {} bitmax (\"double\")\n\ +@deftypefnx {Built-in Function} {} bitmax (\"single\")\n\ +Return the largest integer that can be represented within a floating point\n\ +value. The default class is \"double\", but \"single\" is a valid option.\n\ +On IEEE-754 compatible systems, @code{bitmax} is @w{@math{2^{53} - 1}}.\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "double"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "double") + retval = (static_cast (0x1FFFFFFFFFFFFFLL)); + else if (cname == "single") + retval = (static_cast (0xFFFFFFL)); + else + error ("bitmax: not defined for class '%s'", cname.c_str ()); + + return retval; +} + +DEFUN (intmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmax (@var{type})\n\ +Return the largest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmin, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits::max ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits::max ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits::max ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits::max ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits::max ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits::max ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits::max ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits::max ()); + else + error ("intmax: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (intmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} intmin (@var{type})\n\ +Return the smallest integer that can be represented in an integer type.\n\ +The variable @var{type} can be\n\ +\n\ +@table @code\n\ +@item int8\n\ +signed 8-bit integer.\n\ +\n\ +@item int16\n\ +signed 16-bit integer.\n\ +\n\ +@item int32\n\ +signed 32-bit integer.\n\ +\n\ +@item int64\n\ +signed 64-bit integer.\n\ +\n\ +@item uint8\n\ +unsigned 8-bit integer.\n\ +\n\ +@item uint16\n\ +unsigned 16-bit integer.\n\ +\n\ +@item uint32\n\ +unsigned 32-bit integer.\n\ +\n\ +@item uint64\n\ +unsigned 64-bit integer.\n\ +@end table\n\ +\n\ +The default for @var{type} is @code{uint32}.\n\ +@seealso{intmax, bitmax}\n\ +@end deftypefn") +{ + octave_value retval; + std::string cname = "int32"; + int nargin = args.length (); + + if (nargin == 1 && args(0).is_string ()) + cname = args(0).string_value (); + else if (nargin != 0) + { + print_usage (); + return retval; + } + + if (cname == "uint8") + retval = octave_uint8 (std::numeric_limits::min ()); + else if (cname == "uint16") + retval = octave_uint16 (std::numeric_limits::min ()); + else if (cname == "uint32") + retval = octave_uint32 (std::numeric_limits::min ()); + else if (cname == "uint64") + retval = octave_uint64 (std::numeric_limits::min ()); + else if (cname == "int8") + retval = octave_int8 (std::numeric_limits::min ()); + else if (cname == "int16") + retval = octave_int16 (std::numeric_limits::min ()); + else if (cname == "int32") + retval = octave_int32 (std::numeric_limits::min ()); + else if (cname == "int64") + retval = octave_int64 (std::numeric_limits::min ()); + else + error ("intmin: not defined for '%s' objects", cname.c_str ()); + + return retval; +} + +DEFUN (sizemax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sizemax ()\n\ +Return the largest value allowed for the size of an array.\n\ +If Octave is compiled with 64-bit indexing, the result is of class int64,\n\ +otherwise it is of class int32. The maximum array size is slightly\n\ +smaller than the maximum value allowable for the relevant class as reported\n\ +by @code{intmax}.\n\ +@seealso{intmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_int (dim_vector::dim_max ()); + else + print_usage (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/corefcn/mappers.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/mappers.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2087 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "lo-ieee.h" +#include "lo-specfun.h" +#include "lo-mappers.h" + +#include "defun.h" +#include "error.h" +#include "variables.h" + +DEFUN (abs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} abs (@var{z})\n\ +Compute the magnitude of @var{z}, defined as\n\ +@tex\n\ +$|z| = \\sqrt{x^2 + y^2}$.\n\ +@end tex\n\ +@ifnottex\n\ +|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ +@end ifnottex\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +abs (3 + 4i)\n\ + @result{} 5\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).abs (); + else + print_usage (); + + return retval; +} + +/* +%!assert (abs (1), 1) +%!assert (abs (-3.5), 3.5) +%!assert (abs (3+4i), 5) +%!assert (abs (3-4i), 5) +%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) + +%!assert (abs (single (1)), single (1)) +%!assert (abs (single (-3.5)), single (3.5)) +%!assert (abs (single (3+4i)), single (5)) +%!assert (abs (single (3-4i)), single (5)) +%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) + +%!error abs () +%!error abs (1, 2) +*/ + +DEFUN (acos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acos (@var{x})\n\ +Compute the inverse cosine in radians for each element of @var{x}.\n\ +@seealso{cos, acosd}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! assert (acos (x), v, sqrt (eps)); + +%!test +%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! assert (acos (x), v, sqrt (eps ("single"))); + +%!error acos () +%!error acos (1, 2) +*/ + +DEFUN (acosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} acosh (@var{x})\n\ +Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ +@seealso{cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).acosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [1, 0, -1, 0]; +%! v = [0, pi/2*i, pi*i, pi/2*i]; +%! assert (acosh (x), v, sqrt (eps)); + +%!test +%! x = single ([1, 0, -1, 0]); +%! v = single ([0, pi/2*i, pi*i, pi/2*i]); +%! assert (acosh (x), v, sqrt (eps ("single"))); + +%!error acosh () +%!error acosh (1, 2) +*/ + +DEFUN (angle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} angle (@var{z})\n\ +See arg.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +DEFUN (arg, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} arg (@var{z})\n\ +@deftypefnx {Mapping Function} {} angle (@var{z})\n\ +Compute the argument of @var{z}, defined as,\n\ +@tex\n\ +$\\theta = atan2 (y, x),$\n\ +@end tex\n\ +@ifnottex\n\ +@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ +@end ifnottex\n\ +in radians.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +arg (3 + 4i)\n\ + @result{} 0.92730\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).arg (); + else + print_usage (); + + return retval; +} + +/* +%!assert (arg (1), 0) +%!assert (arg (i), pi/2) +%!assert (arg (-1), pi) +%!assert (arg (-i), -pi/2) +%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) + +%!assert (arg (single (1)), single (0)) +%!assert (arg (single (i)), single (pi/2)) +%!test +%! if (ismac ()) +%! ## Avoid failing for a MacOS feature +%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); +%! else +%! assert (arg (single (-1)), single (pi)); +%! endif +%!assert (arg (single (-i)), single (-pi/2)) +%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) + +%!error arg () +%!error arg (1, 2) +*/ + +DEFUN (asin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asin (@var{x})\n\ +Compute the inverse sine in radians for each element of @var{x}.\n\ +@seealso{sin, asind}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asin (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; +%! assert (all (abs (asin (x) - v) < sqrt (eps))); + +%!error asin () +%!error asin (1, 2) +*/ + +DEFUN (asinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} asinh (@var{x})\n\ +Compute the inverse hyperbolic sine for each element of @var{x}.\n\ +@seealso{sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).asinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, pi/2*i, 0, -pi/2*i]; +%! x = [0, i, 0, -i]; +%! assert (asinh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/2*i, 0, -pi/2*i]); +%! x = single ([0, i, 0, -i]); +%! assert (asinh (x), v, sqrt (eps ("single"))); + +%!error asinh () +%!error asinh (1, 2) +*/ + +DEFUN (atan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan (@var{x})\n\ +Compute the inverse tangent in radians for each element of @var{x}.\n\ +@seealso{tan, atand}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (atan (x), v, sqrt (eps)); + +%!test +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (atan (x), v, sqrt (eps ("single"))); + +%!error atan () +%!error atan (1, 2) +*/ + +DEFUN (atanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atanh (@var{x})\n\ +Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ +@seealso{tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).atanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! v = [0, 0]; +%! x = [0, 0]; +%! assert (atanh (x), v, sqrt (eps)); + +%!test +%! v = single ([0, 0]); +%! x = single ([0, 0]); +%! assert (atanh (x), v, sqrt (eps ("single"))); + +%!error atanh () +%!error atanh (1, 2) +*/ + +DEFUN (cbrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ +Compute the real cube root of each element of @var{x}.\n\ +Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ +negative.\n\ +@seealso{nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cbrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (cbrt (64), 4) +%!assert (cbrt (-125), -5) +%!assert (cbrt (0), 0) +%!assert (cbrt (Inf), Inf) +%!assert (cbrt (-Inf), -Inf) +%!assert (cbrt (NaN), NaN) +%!assert (cbrt (2^300), 2^100) +%!assert (cbrt (125*2^300), 5*2^100) + +%!error cbrt () +%!error cbrt (1, 2) +*/ + +DEFUN (ceil, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ceil (@var{x})\n\ +Return the smallest integer not less than @var{x}. This is equivalent to\n\ +rounding towards positive infinity. If @var{x} is\n\ +complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +ceil ([-2.7, 2.7])\n\ + @result{} -2 3\n\ +@end group\n\ +@end example\n\ +@seealso{floor, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).ceil (); + else + print_usage (); + + return retval; +} + +/* +## double precision +%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) + +## complex double precison +%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) + +## single precision +%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) + +## complex single precision +%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) + +%!error ceil () +%!error ceil (1, 2) +*/ + +DEFUN (conj, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} conj (@var{z})\n\ +Return the complex conjugate of @var{z}, defined as\n\ +@tex\n\ +$\\bar{z} = x - iy$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ +@end ifnottex\n\ +@seealso{real, imag}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).conj (); + else + print_usage (); + + return retval; +} + +/* +%!assert (conj (1), 1) +%!assert (conj (i), -i) +%!assert (conj (1+i), 1-i) +%!assert (conj (1-i), 1+i) +%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) + +%!assert (conj (single (1)), single (1)) +%!assert (conj (single (i)), single (-i)) +%!assert (conj (single (1+i)), single (1-i)) +%!assert (conj (single (1-i)), single (1+i)) +%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) + +%!error conj () +%!error conj (1, 2) +*/ + +DEFUN (cos, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cos (@var{x})\n\ +Compute the cosine for each element of @var{x} in radians.\n\ +@seealso{acos, cosd, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cos (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; +%! assert (cos (x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); +%! assert (cos (x), v, sqrt (eps ("single"))); + +%!error cos () +%!error cos (1, 2) +*/ + +DEFUN (cosh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} cosh (@var{x})\n\ +Compute the hyperbolic cosine for each element of @var{x}.\n\ +@seealso{acosh, sinh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).cosh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [1, 0, -1, 0]; +%! assert (cosh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([1, 0, -1, 0]); +%! assert (cosh (x), v, sqrt (eps ("single"))); + +%!error cosh () +%!error cosh (1, 2) +*/ + +DEFUN (erf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erf (@var{z})\n\ +Compute the error function,\n\ +@tex\n\ +$$\n\ + {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + z\n\ + 2 /\n\ +erf (z) = --------- * | e^(-t^2) dt\n\ + sqrt (pi) /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erfcx, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erf (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = [0,.5,1]; +%! v = [0, .520499877813047, .842700792949715]; +%! assert (erf (x), v, 1.e-10); +%! assert (erf (-x), -v, 1.e-10); +%! assert (erfc (x), 1-v, 1.e-10); +%! assert (erfinv (v), x, 1.e-10); + +%!test +%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); +%! assert (erf (a), erf (real (a))); + +%!test +%! x = single ([0,.5,1]); +%! v = single ([0, .520499877813047, .842700792949715]); +%! assert (erf (x), v, 1.e-6); +%! assert (erf (-x), -v, 1.e-6); +%! assert (erfc (x), 1-v, 1.e-6); +%! assert (erfinv (v), x, 1.e-6); + +%!error erf () +%!error erf (1, 2) +*/ + +DEFUN (erfinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ +Compute the inverse error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erf (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erf, erfc, erfcx, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) +%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) +## tail region +%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) +%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfinv (1+2i) + +%!error erfinv () +%!error erfinv (1, 2) +*/ + +DEFUN (erfcinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ +Compute the inverse complementary error function, i.e., @var{y} such that\n\ +\n\ +@example\n\ +erfc (@var{y}) == @var{x}\n\ +@end example\n\ +@seealso{erfc, erf, erfcx, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcinv (); + else + print_usage (); + + return retval; +} + +/* +## middle region +%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) +%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) +## tail region +%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) +%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) +## backward - loss of accuracy +%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) +%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) +## exceptional +%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) +%!error erfcinv (1+2i) + +%!error erfcinv () +%!error erfcinv (1, 2) +*/ + +DEFUN (erfc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfc (@var{z})\n\ +Compute the complementary error function,\n\ +@tex\n\ +$1 - {\\rm erf} (z)$.\n\ +@end tex\n\ +@ifnottex\n\ +@w{@code{1 - erf (@var{z})}}.\n\ +@end ifnottex\n\ +@seealso{erfcinv, erfcx, erf, erfinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfc (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (erfc (a), erfc (real (a))); + +%!error erfc () +%!error erfc (1, 2) +*/ + +DEFUN (erfcx, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ +Compute the scaled complementary error function,\n\ +@tex\n\ +$$\n\ + e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +exp (z^2) * erfc (x)\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{erfc, erf, erfinv, erfcinv}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).erfcx (); + else + print_usage (); + + return retval; +} + +/* +## FIXME: Need a test for erfcx + +%!error erfcx () +%!error erfcx (1, 2) +*/ + +DEFUN (exp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} exp (@var{x})\n\ +Compute\n\ +@tex\n\ +$e^{x}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{e^x}\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the matrix\n\ +exponential, see @ref{Linear Algebra}.\n\ +@seealso{log}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).exp (); + else + print_usage (); + + return retval; +} + +/* +%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) +%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) +%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) +%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) + +%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) +%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) + +%!error exp () +%!error exp (1, 2) +*/ + +DEFUN (expm1, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ +Compute\n\ +@tex\n\ +$ e^{x} - 1 $\n\ +@end tex\n\ +@ifnottex\n\ +@code{exp (@var{x}) - 1}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).expm1 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (expm1 (2*eps), 2*eps, 1e-29) + +%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) +%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) + +%!error expm1 () +%!error expm1 (1, 2) +*/ + +DEFUN (isfinite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ +@deftypefnx {Mapping Function} {} finite (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +finite values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +finite ([13, Inf, NA, NaN])\n\ + @result{} [ 1, 0, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isinf, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).finite (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!finite (Inf)) +%!assert (!finite (NaN)) +%!assert (finite (rand (1,10))) + +%!assert (!finite (single (Inf))) +%!assert (!finite (single (NaN))) +%!assert (finite (single (rand (1,10)))) + +%!error finite () +%!error finite (1, 2) +*/ + +DEFUN (fix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} fix (@var{x})\n\ +Truncate fractional portion of @var{x} and return the integer portion. This\n\ +is equivalent to rounding towards zero. If @var{x} is complex, return\n\ +@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +fix ([-2.7, 2.7])\n\ + @result{} -2 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).fix (); + else + print_usage (); + + return retval; +} + +/* +%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) +%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) +%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) +%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) + +%!error fix () +%!error fix (1, 2) +*/ + +DEFUN (floor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} floor (@var{x})\n\ +Return the largest integer not greater than @var{x}. This is equivalent to\n\ +rounding towards negative infinity. If @var{x} is\n\ +complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ +\n\ +@example\n\ +@group\n\ +floor ([-2.7, 2.7])\n\ + @result{} -3 2\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, round, fix}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).floor (); + else + print_usage (); + + return retval; +} + +/* +%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) +%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) +%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) +%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) + +%!error floor () +%!error floor (1, 2) +*/ + +DEFUN (gamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} gamma (@var{z})\n\ +Compute the Gamma function,\n\ +@tex\n\ +$$\n\ + \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + infinity\n\ + /\n\ +gamma (z) = | t^(z-1) exp (-t) dt.\n\ + /\n\ + t=0\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +@seealso{gammainc, lgamma}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).gamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (gamma (x), v, sqrt (eps)); + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (gamma (a), gamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (gamma (x), v, sqrt (eps ("single"))); + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 1, Inf]; +%! assert (gamma (x), v); +%! assert (gamma (single (x)), single (v)); + +%!error gamma () +%!error gamma (1, 2) +*/ + +DEFUN (imag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} imag (@var{z})\n\ +Return the imaginary part of @var{z} as a real number.\n\ +@seealso{real, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).imag (); + else + print_usage (); + + return retval; +} + +/* +%!assert (imag (1), 0) +%!assert (imag (i), 1) +%!assert (imag (1+i), 1) +%!assert (imag ([i, 1; 1, i]), full (eye (2))) + +%!assert (imag (single (1)), single (0)) +%!assert (imag (single (i)), single (1)) +%!assert (imag (single (1+i)), single (1)) +%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) + +%!error imag () +%!error imag (1, 2) +*/ + +DEFUNX ("isalnum", Fisalnum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters or digits and false where they are not. This is equivalent to\n\ +(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ +@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalnum (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalnum (charset), result); + +%!error isalnum () +%!error isalnum (1, 2) +*/ + +DEFUNX ("isalpha", Fisalpha, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +letters and false where they are not. This is equivalent to\n\ +(@code{islower (@var{s}) | isupper (@var{s})}).\n\ +@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisalpha (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! result(toascii ("a":"z") + 1) = true; +%! assert (isalpha (charset), result); + +%!error isalpha () +%!error isalpha (1, 2) +*/ + +DEFUNX ("isascii", Fisascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isascii (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ +not.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisascii (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = true (1, 128); +%! assert (isascii (charset), result); + +%!error isascii () +%!error isascii (1, 2) +*/ + +DEFUNX ("iscntrl", Fiscntrl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +control characters and false where they are not.\n\ +@seealso{ispunct, isspace, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xiscntrl (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(1:32) = true; +%! result(128) = true; +%! assert (iscntrl (charset), result); + +%!error iscntrl () +%!error iscntrl (1, 2) +*/ + +DEFUNX ("isdigit", Fisdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +decimal digits (0-9) and false where they are not.\n\ +@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("0":"9") + 1) = true; +%! assert (isdigit (charset), result); + +%!error isdigit () +%!error isdigit (1, 2) +*/ + +DEFUN (isinf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isinf (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +are infinite and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isinf ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isfinite, isnan, isna}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isinf (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isinf (Inf)) +%!assert (!isinf (NaN)) +%!assert (!isinf (NA)) +%!assert (isinf (rand (1,10)), false (1,10)) +%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) + +%!assert (isinf (single (Inf))) +%!assert (!isinf (single (NaN))) +%!assert (!isinf (single (NA))) +%!assert (isinf (single (rand (1,10))), false (1,10)) +%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) + +%!error isinf () +%!error isinf (1, 2) +*/ + +DEFUNX ("isgraph", Fisgraph, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (but not the space character) and false where they are\n\ +not.\n\ +@seealso{isprint}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisgraph (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:127) = true; +%! assert (isgraph (charset), result); + +%!error isgraph () +%!error isgraph (1, 2) +*/ + +DEFUNX ("islower", Fislower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} islower (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +lowercase letters and false where they are not.\n\ +@seealso{isupper, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xislower (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("a":"z") + 1) = true; +%! assert (islower (charset), result); + +%!error islower () +%!error islower (1, 2) +*/ + +DEFUN (isna, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isna (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NA (missing) values and false where they are not.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +isna ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 0 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isnan, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isna (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isna (Inf)) +%!assert (!isna (NaN)) +%!assert (isna (NA)) +%!assert (isna (rand (1,10)), false (1,10)) +%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) + +%!assert (!isna (single (Inf))) +%!assert (!isna (single (NaN))) +%!assert (isna (single (NA))) +%!assert (isna (single (rand (1,10))), false (1,10)) +%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) + +%!error isna () +%!error isna (1, 2) +*/ + +DEFUN (isnan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isnan (@var{x})\n\ +Return a logical array which is true where the elements of @var{x} are\n\ +NaN values and false where they are not.\n\ +NA values are also considered NaN values. For example:\n\ +\n\ +@example\n\ +@group\n\ +isnan ([13, Inf, NA, NaN])\n\ + @result{} [ 0, 0, 1, 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{isna, isinf, isfinite}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).isnan (); + else + print_usage (); + + return retval; +} + +/* +%!assert (!isnan (Inf)) +%!assert (isnan (NaN)) +%!assert (isnan (NA)) +%!assert (isnan (rand (1,10)), false (1,10)) +%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) + +%!assert (!isnan (single (Inf))) +%!assert (isnan (single (NaN))) +%!assert (isnan (single (NA))) +%!assert (isnan (single (rand (1,10))), false (1,10)) +%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) + +%!error isnan () +%!error isnan (1, 2) +*/ + +DEFUNX ("isprint", Fisprint, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isprint (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +printable characters (including the space character) and false where they\n\ +are not.\n\ +@seealso{isgraph}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisprint (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(33:127) = true; +%! assert (isprint (charset), result); + +%!error isprint () +%!error isprint (1, 2) +*/ + +DEFUNX ("ispunct", Fispunct, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +punctuation characters and false where they are not.\n\ +@seealso{isalpha, isdigit, isspace, iscntrl}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xispunct (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(34:48) = true; +%! result(59:65) = true; +%! result(92:97) = true; +%! result(124:127) = true; +%! assert (ispunct (charset), result); + +%!error ispunct () +%!error ispunct (1, 2) +*/ + +DEFUNX ("isspace", Fisspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isspace (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ +vertical tab) and false where they are not.\n\ +@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisspace (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii (" \f\n\r\t\v") + 1) = true; +%! assert (isspace (charset), result); + +%!error isspace () +%!error isspace (1, 2) +*/ + +DEFUNX ("isupper", Fisupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isupper (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +uppercase letters and false where they are not.\n\ +@seealso{islower, isalpha, isletter, isalnum}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisupper (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"Z") + 1) = true; +%! assert (isupper (charset), result); + +%!error isupper () +%!error isupper (1, 2) +*/ + +DEFUNX ("isxdigit", Fisxdigit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ +Return a logical array which is true where the elements of @var{s} are\n\ +hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ +@seealso{isdigit}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xisxdigit (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! charset = char (0:127); +%! result = false (1, 128); +%! result(toascii ("A":"F") + 1) = true; +%! result(toascii ("0":"9") + 1) = true; +%! result(toascii ("a":"f") + 1) = true; +%! assert (isxdigit (charset), result); + +%!error isxdigit () +%!error isxdigit (1, 2) +*/ + +DEFUN (lgamma, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ +@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ +Return the natural logarithm of the gamma function of @var{x}.\n\ +@seealso{gamma, gammainc}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).lgamma (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! a = -1i*sqrt (-1/(6.4187*6.4187)); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = [.5, 1, 1.5, 2, 3, 4, 5]; +%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; +%! assert (lgamma (x), log (v), sqrt (eps)) + +%!test +%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); +%! assert (lgamma (a), lgamma (real (a))); + +%!test +%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); +%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); +%! assert (lgamma (x), log (v), sqrt (eps ("single"))) + +%!test +%! x = [-1, 0, 1, Inf]; +%! v = [Inf, Inf, 0, Inf]; +%! assert (lgamma (x), v); +%! assert (lgamma (single (x)), single (v)); + +%!error lgamma () +%!error lgamma (1,2) +*/ + +DEFUN (log, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log (@var{x})\n\ +Compute the natural logarithm,\n\ +@tex\n\ +$\\ln{(x)},$\n\ +@end tex\n\ +@ifnottex\n\ +@code{ln (@var{x})},\n\ +@end ifnottex\n\ +for each element of @var{x}. To compute the\n\ +matrix logarithm, see @ref{Linear Algebra}.\n\ +@seealso{exp, log1p, log2, log10, logspace}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) +%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) + +%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) +%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) + +%!error log () +%!error log (1, 2) +*/ + +DEFUN (log10, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log10 (@var{x})\n\ +Compute the base-10 logarithm of each element of @var{x}.\n\ +@seealso{log, log2, logspace, exp}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log10 (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) +%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) + +%!error log10 () +%!error log10 (1, 2) +*/ + +DEFUN (log1p, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log1p (@var{x})\n\ +Compute\n\ +@tex\n\ +$\\ln{(1 + x)}$\n\ +@end tex\n\ +@ifnottex\n\ +@code{log (1 + @var{x})}\n\ +@end ifnottex\n\ +accurately in the neighborhood of zero.\n\ +@seealso{log, exp, expm1}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).log1p (); + else + print_usage (); + + return retval; +} + +/* +%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) +%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) + +%!error log1p () +%!error log1p (1, 2) +*/ + +DEFUN (real, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} real (@var{z})\n\ +Return the real part of @var{z}.\n\ +@seealso{imag, conj}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).real (); + else + print_usage (); + + return retval; +} + +/* +%!assert (real (1), 1) +%!assert (real (i), 0) +%!assert (real (1+i), 1) +%!assert (real ([1, i; i, 1]), full (eye (2))) + +%!assert (real (single (1)), single (1)) +%!assert (real (single (i)), single (0)) +%!assert (real (single (1+i)), single (1)) +%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) + +%!error real () +%!error real (1, 2) +*/ + +DEFUN (round, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} round (@var{x})\n\ +Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ +@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ +are two nearest integers, return the one further away from zero.\n\ +\n\ +@example\n\ +@group\n\ +round ([-2.7, 2.7])\n\ + @result{} -3 3\n\ +@end group\n\ +@end example\n\ +@seealso{ceil, floor, fix, roundb}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).round (); + else + print_usage (); + + return retval; +} + +/* +%!assert (round (1), 1) +%!assert (round (1.1), 1) +%!assert (round (5.5), 6) +%!assert (round (i), i) +%!assert (round (2.5+3.5i), 3+4i) +%!assert (round (-2.6), -3) +%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (round (single (1)), single (1)) +%!assert (round (single (1.1)), single (1)) +%!assert (round (single (5.5)), single (6)) +%!assert (round (single (i)), single (i)) +%!assert (round (single (2.5+3.5i)), single (3+4i)) +%!assert (round (single (-2.6)), single (-3)) +%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error round () +%!error round (1, 2) +*/ + +DEFUN (roundb, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} roundb (@var{x})\n\ +Return the integer nearest to @var{x}. If there are two nearest\n\ +integers, return the even one (banker's rounding). If @var{x} is complex,\n\ +return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ +@seealso{round}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).roundb (); + else + print_usage (); + + return retval; +} + +/* +%!assert (roundb (1), 1) +%!assert (roundb (1.1), 1) +%!assert (roundb (1.5), 2) +%!assert (roundb (4.5), 4) +%!assert (roundb (i), i) +%!assert (roundb (2.5+3.5i), 2+4i) +%!assert (roundb (-2.6), -3) +%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) + +%!assert (roundb (single (1)), single (1)) +%!assert (roundb (single (1.1)), single (1)) +%!assert (roundb (single (1.5)), single (2)) +%!assert (roundb (single (4.5)), single (4)) +%!assert (roundb (single (i)), single (i)) +%!assert (roundb (single (2.5+3.5i)), single (2+4i)) +%!assert (roundb (single (-2.6)), single (-3)) +%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) + +%!error roundb () +%!error roundb (1, 2) +*/ + +DEFUN (sign, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sign (@var{x})\n\ +Compute the @dfn{signum} function, which is defined as\n\ +@tex\n\ +$$\n\ +{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@group\n\ + -1, x < 0;\n\ +sign (x) = 0, x = 0;\n\ + 1, x > 0.\n\ +@end group\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).signum (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sign (-2) , -1) +%!assert (sign (0), 0) +%!assert (sign (3), 1) +%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) + +%!assert (sign (single (-2)) , single (-1)) +%!assert (sign (single (0)), single (0)) +%!assert (sign (single (3)), single (1)) +%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) + +%!error sign () +%!error sign (1, 2) +*/ + +DEFUN (sin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sin (@var{x})\n\ +Compute the sine for each element of @var{x} in radians.\n\ +@seealso{asin, sind, sinh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sin (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; +%! assert (sin (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); +%! assert (sin (x), v, sqrt (eps ("single"))); + +%!error sin () +%!error sin (1, 2) +*/ + +DEFUN (sinh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sinh (@var{x})\n\ +Compute the hyperbolic sine for each element of @var{x}.\n\ +@seealso{asinh, cosh, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sinh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; +%! v = [0, i, 0, -i]; +%! assert (sinh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); +%! v = single ([0, i, 0, -i]); +%! assert (sinh (x), v, sqrt (eps ("single"))); + +%!error sinh () +%!error sinh (1, 2) +*/ + +DEFUN (sqrt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ +Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ +a complex result is returned. To compute the matrix square root, see\n\ +@ref{Linear Algebra}.\n\ +@seealso{realsqrt, nthroot}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).sqrt (); + else + print_usage (); + + return retval; +} + +/* +%!assert (sqrt (4), 2) +%!assert (sqrt (-1), i) +%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) +%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) + +%!assert (sqrt (single (4)), single (2)) +%!assert (sqrt (single (-1)), single (i)) +%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) +%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) + +%!error sqrt () +%!error sqrt (1, 2) +*/ + +DEFUN (tan, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tan (@var{z})\n\ +Compute the tangent for each element of @var{x} in radians.\n\ +@seealso{atan, tand, tanh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tan (); + else + print_usage (); + + return retval; +} + +/* +%!shared rt2, rt3 +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); + +%!test +%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; +%! assert (tan (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); +%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); +%! assert (tan (x), v, sqrt (eps ("single"))); + +%!error tan () +%!error tan (1, 2) +*/ + +DEFUN (tanh, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tanh (@var{x})\n\ +Compute hyperbolic tangent for each element of @var{x}.\n\ +@seealso{atanh, sinh, cosh}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).tanh (); + else + print_usage (); + + return retval; +} + +/* +%!test +%! x = [0, pi*i]; +%! v = [0, 0]; +%! assert (tanh (x), v, sqrt (eps)); + +%!test +%! x = single ([0, pi*i]); +%! v = single ([0, 0]); +%! assert (tanh (x), v, sqrt (eps ("single"))); + +%!error tanh () +%!error tanh (1, 2) +*/ + +DEFUNX ("toascii", Ftoascii, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toascii (@var{s})\n\ +Return ASCII representation of @var{s} in a matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +toascii (\"ASCII\")\n\ + @result{} [ 65, 83, 67, 73, 73 ]\n\ +@end group\n\ +\n\ +@end example\n\ +@seealso{char}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoascii (); + else + print_usage (); + + return retval; +} + +/* +%!assert (toascii (char (0:127)), 0:127) +%!assert (toascii (" ":"@"), 32:64) +%!assert (toascii ("A":"Z"), 65:90) +%!assert (toascii ("[":"`"), 91:96) +%!assert (toascii ("a":"z"), 97:122) +%!assert (toascii ("{":"~"), 123:126) + +%!error toascii () +%!error toascii (1, 2) +*/ + +DEFUNX ("tolower", Ftolower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} tolower (@var{s})\n\ +@deftypefnx {Mapping Function} {} lower (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each uppercase\n\ +character replaced by the corresponding lowercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +tolower (\"MiXeD cAsE 123\")\n\ + @result{} \"mixed case 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{toupper}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtolower (); + else + print_usage (); + + return retval; +} + +DEFALIAS (lower, tolower); + +/* +%!assert (tolower ("OCTAVE"), "octave") +%!assert (tolower ("123OCTave!_&"), "123octave!_&") +%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) +%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) +%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) +%!assert (tolower (68), "d") +%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) +%!test +%! a(3,3,3,3) = "D"; +%! assert (tolower (a)(3,3,3,3), "d"); + +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); +%! assert (tolower (charset), result); + +%!error lower () +%!error tolower () +%!error tolower (1, 2) +*/ + +DEFUNX ("toupper", Ftoupper, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} toupper (@var{s})\n\ +@deftypefnx {Mapping Function} {} upper (@var{s})\n\ +Return a copy of the string or cell string @var{s}, with each lowercase\n\ +character replaced by the corresponding uppercase one; non-alphabetic\n\ +characters are left unchanged. For example:\n\ +\n\ +@example\n\ +@group\n\ +toupper (\"MiXeD cAsE 123\")\n\ + @result{} \"MIXED CASE 123\"\n\ +@end group\n\ +@end example\n\ +@seealso{tolower}\n\ +@end deftypefn") +{ + octave_value retval; + if (args.length () == 1) + retval = args(0).xtoupper (); + else + print_usage (); + + return retval; +} + +DEFALIAS (upper, toupper); + +/* +%!assert (toupper ("octave"), "OCTAVE") +%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") +%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) +%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) +%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) +%!assert (toupper (100), "D") +%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) +%!test +%! a(3,3,3,3) = "d"; +%! assert (toupper (a)(3,3,3,3), "D"); +%!test +%! charset = char (0:127); +%! result = charset; +%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); +%! assert (toupper (charset), result); + +%!error toupper () +%!error upper () +%!error toupper (1, 2) +*/ + +DEFALIAS (gammaln, lgamma); + +DEFALIAS (finite, isfinite); diff -r 069c552587a0 -r 959953dba519 src/corefcn/module.mk --- a/src/corefcn/module.mk Tue Jul 31 09:54:19 2012 -0400 +++ b/src/corefcn/module.mk Fri Aug 03 14:35:44 2012 -0400 @@ -1,6 +1,29 @@ EXTRA_DIST += \ corefcn/module.mk +## Options functions for Fortran packages like LSODE, DASPK. +## These are generated automagically by configure and Perl. +OPT_HANDLERS = \ + corefcn/DASPK-opts.cc \ + corefcn/DASRT-opts.cc \ + corefcn/DASSL-opts.cc \ + corefcn/LSODE-opts.cc \ + corefcn/Quad-opts.cc + +OPT_INC = \ + $(top_builddir)/liboctave/DASPK-opts.h \ + $(top_builddir)/liboctave/DASRT-opts.h \ + $(top_builddir)/liboctave/DASSL-opts.h \ + $(top_builddir)/liboctave/LSODE-opts.h \ + $(top_builddir)/liboctave/Quad-opts.h + +$(OPT_HANDLERS): corefcn/%.cc : $(top_builddir)/liboctave/%.in + $(PERL) $(top_srcdir)/build-aux/mk-opts.pl --opt-handler-fcns $< > $@-t + mv $@-t $@ + +$(OPT_INC) : %.h : %.in + $(MAKE) -C $(top_builddir)/liboctave $(@F) + COREFCN_SRC = \ corefcn/__contourc__.cc \ corefcn/__dispatch__.cc \ @@ -10,6 +33,7 @@ corefcn/balance.cc \ corefcn/besselj.cc \ corefcn/betainc.cc \ + corefcn/bitfcns.cc \ corefcn/bsxfun.cc \ corefcn/cellfun.cc \ corefcn/colloc.cc \ @@ -40,6 +64,7 @@ corefcn/lsode.cc \ corefcn/lu.cc \ corefcn/luinc.cc \ + corefcn/mappers.cc \ corefcn/matrix_type.cc \ corefcn/max.cc \ corefcn/md5sum.cc \ @@ -53,13 +78,16 @@ corefcn/rcond.cc \ corefcn/regexp.cc \ corefcn/schur.cc \ + corefcn/sparse.cc \ corefcn/spparms.cc \ corefcn/sqrtm.cc \ corefcn/str2double.cc \ corefcn/strfind.cc \ + corefcn/strfns.cc \ corefcn/sub2ind.cc \ corefcn/svd.cc \ corefcn/syl.cc \ + corefcn/syscalls.cc \ corefcn/time.cc \ corefcn/tril.cc \ corefcn/typecast.cc diff -r 069c552587a0 -r 959953dba519 src/corefcn/sparse.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/sparse.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,268 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler +Copyright (C) 2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "variables.h" +#include "utils.h" +#include "pager.h" +#include "defun.h" +#include "gripes.h" +#include "quit.h" +#include "unwind-prot.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "ov-bool-sparse.h" + +DEFUN (issparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issparse (@var{x})\n\ +Return true if @var{x} is a sparse matrix.\n\ +@seealso{ismatrix}\n\ +@end deftypefn") +{ + if (args.length () != 1) + { + print_usage (); + return octave_value (); + } + else + return octave_value (args(0).is_sparse_type ()); +} + +DEFUN (sparse, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ +@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ +Create a sparse matrix from the full matrix or row, column, value triplets.\n\ +If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ +removing all zero values in the process.\n\ +\n\ +Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ +of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ +of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ +compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ +their values are derived from the maximum index in the vectors @var{i} and\n\ +@var{j} as given by @code{@var{m} = max (@var{i})},\n\ +@code{@var{n} = max (@var{j})}.\n\ +\n\ +@strong{Note}: if multiple values are specified with the same\n\ +@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ +be added. See @code{accumarray} for an example of how to produce different\n\ +behavior, such as taking the minimum instead.\n\ +\n\ +The following are all equivalent:\n\ +\n\ +@example\n\ +@group\n\ +s = sparse (i, j, s, m, n)\n\ +s = sparse (i, j, s, m, n, \"summation\")\n\ +s = sparse (i, j, s, m, n, \"sum\")\n\ +@end group\n\ +@end example\n\ +\n\ +Given the option \"unique\". if more than two values are specified for the\n\ +same @var{i}, @var{j} indices, the last specified value will be used.\n\ +\n\ +@code{sparse (@var{m}, @var{n})} is equivalent to\n\ +@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ +\n\ +If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ +to have a common size.\n\ +@seealso{full, accumarray}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). + unwind_protect frame; + frame.protect_var (Vsparse_auto_mutate); + Vsparse_auto_mutate = false; + + if (nargin == 1) + { + octave_value arg = args (0); + if (arg.is_bool_type ()) + retval = arg.sparse_bool_matrix_value (); + else if (arg.is_complex_type ()) + retval = arg.sparse_complex_matrix_value (); + else if (arg.is_numeric_type ()) + retval = arg.sparse_matrix_value (); + else + gripe_wrong_type_arg ("sparse", arg); + } + else if (nargin == 2) + { + octave_idx_type m = 0, n = 0; + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + { + m = args(0).idx_type_value (); + n = args(1).idx_type_value (); + } + else + error ("sparse: dimensions M,N must be scalar"); + + if (! error_state) + { + if (m >= 0 && n >= 0) + retval = SparseMatrix (m, n); + else + error ("sparse: dimensions M,N must be positive or zero"); + } + } + else if (nargin >= 3) + { + bool summation = true; + if (nargin > 3 && args(nargin-1).is_string ()) + { + std::string opt = args(nargin-1).string_value (); + if (opt == "unique") + summation = false; + else if (opt == "sum" || opt == "summation") + summation = true; + else + error ("sparse: invalid option: %s", opt.c_str ()); + + nargin -= 1; + } + + if (! error_state) + { + octave_idx_type m = -1, n = -1, nzmax = -1; + if (nargin == 6) + { + nzmax = args(5).idx_type_value (); + nargin --; + } + + if (nargin == 5) + { + if (args(3).is_scalar_type () && args(4).is_scalar_type ()) + { + m = args(3).idx_type_value (); + n = args(4).idx_type_value (); + } + else + error ("sparse: expecting scalar dimensions"); + + + if (! error_state && (m < 0 || n < 0)) + error ("sparse: dimensions must be non-negative"); + } + else if (nargin != 3) + print_usage (); + + if (! error_state) + { + idx_vector i = args(0).index_vector (); + idx_vector j = args(1).index_vector (); + + if (args(2).is_bool_type ()) + retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, + m, n, summation, nzmax); + else if (args(2).is_complex_type ()) + retval = SparseComplexMatrix (args(2).complex_array_value (), + i, j, m, n, summation, nzmax); + else if (args(2).is_numeric_type ()) + retval = SparseMatrix (args(2).array_value (), i, j, + m, n, summation, nzmax); + else + gripe_wrong_type_arg ("sparse", args(2)); + } + + } + } + + return retval; +} + +DEFUN (spalloc, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ +Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ +most @var{nz} nonzero elements. This is useful for building the matrix\n\ +incrementally by a sequence of indexed assignments. Subsequent indexed\n\ +assignments will reuse the pre-allocated memory, provided they are of one of\n\ +the simple forms\n\ +\n\ +@itemize\n\ +@item @code{@var{s}(I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(:,I:J) = @var{x}}\n\ +\n\ +@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ +@end itemize\n\ +\n\ +@b{and} that the following conditions are met:\n\ +\n\ +@itemize\n\ +@item the assignment does not decrease nnz (@var{S}).\n\ +\n\ +@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ +\n\ +@item no index is out of bounds.\n\ +@end itemize\n\ +\n\ +Partial movement of data may still occur, but in general the assignment will\n\ +be more memory and time-efficient under these circumstances. In particular,\n\ +it is possible to efficiently build a pre-allocated sparse matrix from\n\ +contiguous block of columns.\n\ +\n\ +The amount of pre-allocated memory for a given matrix may be queried using\n\ +the function @code{nzmax}.\n\ +@seealso{nzmax, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_idx_type m = args(0).idx_type_value (); + octave_idx_type n = args(1).idx_type_value (); + octave_idx_type nz = 0; + if (nargin == 3) + nz = args(2).idx_type_value (); + if (error_state) + ; + else if (m >= 0 && n >= 0 && nz >= 0) + retval = SparseMatrix (dim_vector (m, n), nz); + else + error ("spalloc: M,N,NZ must be non-negative"); + } + else + print_usage (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/corefcn/strfns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/strfns.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,973 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "dMatrix.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "ov.h" +#include "oct-obj.h" +#include "unwind-prot.h" +#include "utils.h" + +DEFUN (char, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} char (@var{x})\n\ +@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ +Create a string array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Empty input strings are\n\ +significant and will concatenated in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{char} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \" \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{strvcat, cellstr}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = ""; + else if (nargin == 1) + retval = args(0).convert_to_str (true, true, + args(0).is_dq_string () ? '"' : '\''); + else + { + int n_elts = 0; + + int max_len = 0; + + std::queue args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("char: unable to convert some args to strings"); + return retval; + } + + if (s.length () > 0) + n_elts += s.length (); + else + n_elts += 1; + + int s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + int k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + int n = s.length (); + + if (n > 0) + { + for (int j = 0; j < n; j++) + { + std::string t = s[j]; + int t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + else + result[k++] = std::string (max_len, ' '); + } + + retval = octave_value (result, '\''); + } + + return retval; +} + +/* +%!assert (char (), ''); +%!assert (char (100), "d"); +%!assert (char (100,100), ["d";"d"]) +%!assert (char ({100,100}), ["d";"d"]) +%!assert (char ([100,100]), ["dd"]) +%!assert (char ({100,{100}}), ["d";"d"]) +%!assert (char (100, [], 100), ["d";" ";"d"]) +%!assert (char ({100, [], 100}), ["d";" ";"d"]) +%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) +%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) +%!assert (char ([65, 83, 67, 73, 73]), "ASCII") + +%!test +%! x = char ("foo", "bar", "foobar"); +%! assert (x(1,:), "foo "); +%! assert (x(2,:), "bar "); +%! assert (x(3,:), "foobar"); +*/ + +DEFUN (strvcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ +@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ +Create a character array from one or more numeric matrices, character\n\ +matrices, or cell arrays. Arguments are concatenated vertically.\n\ +The returned values are padded with blanks as needed to make each row\n\ +of the string array have the same length. Unlike @code{char}, empty\n\ +strings are removed and will not appear in the output.\n\ +\n\ +For numerical input, each element is converted\n\ +to the corresponding ASCII character. A range error results if an input\n\ +is outside the ASCII range (0-255).\n\ +\n\ +For cell arrays, each element is concatenated separately. Cell arrays\n\ +converted through\n\ +@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ + @result{} [\"abc \"\n\ + \"98 \"\n\ + \"99 \"\n\ + \"d \"\n\ + \"str1 \"\n\ + \"half \"]\n\ +@end group\n\ +@end example\n\ +@seealso{char, strcat, cstrcat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + int n_elts = 0; + + size_t max_len = 0; + + std::queue args_as_strings; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args(i).all_strings (); + + if (error_state) + { + error ("strvcat: unable to convert some args to strings"); + return retval; + } + + size_t n = s.length (); + + // do not count empty strings in calculation of number of elements + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + if (s[j].length () > 0) + n_elts++; + } + } + + size_t s_max_len = s.max_length (); + + if (s_max_len > max_len) + max_len = s_max_len; + + args_as_strings.push (s); + } + + string_vector result (n_elts); + + octave_idx_type k = 0; + + for (int i = 0; i < nargin; i++) + { + string_vector s = args_as_strings.front (); + args_as_strings.pop (); + + size_t n = s.length (); + + if (n > 0) + { + for (size_t j = 0; j < n; j++) + { + std::string t = s[j]; + if (t.length () > 0) + { + size_t t_len = t.length (); + + if (max_len > t_len) + t += std::string (max_len - t_len, ' '); + + result[k++] = t; + } + } + } + } + + retval = octave_value (result, '\''); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strvcat (""), ""); +%!assert (strvcat (100) == "d"); +%!assert (strvcat (100,100), ["d";"d"]) +%!assert (strvcat ({100,100}), ["d";"d"]) +%!assert (strvcat ([100,100]), ["dd"]) +%!assert (strvcat ({100,{100}}), ["d";"d"]) +%!assert (strvcat (100, [], 100), ["d";"d"]) +%!assert (strvcat ({100, [], 100}), ["d";"d"]) +%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) +%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) +%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) + +%!error strvcat () +*/ + + +DEFUN (ischar, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ischar (@var{x})\n\ +Return true if @var{x} is a character array.\n\ +@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).is_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar ("a"), true) +%!assert (ischar (["ab";"cd"]), true) +%!assert (ischar ({"ab"}), false) +%!assert (ischar (1), false) +%!assert (ischar ([1, 2]), false) +%!assert (ischar ([]), false) +%!assert (ischar ([1, 2; 3, 4]), false) +%!assert (ischar (""), true) +%!assert (ischar ("test"), true) +%!assert (ischar (["test"; "ing"]), true) +%!assert (ischar (struct ("foo", "bar")), false) + +%!error ischar () +%!error ischar ("test", 1) +*/ + +static octave_value +do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, + octave_idx_type n, const char *fcn_name, + bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), + bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) + +{ + octave_value retval; + + bool s1_string = arg0.is_string (); + bool s1_cell = arg0.is_cell (); + bool s2_string = arg1.is_string (); + bool s2_cell = arg1.is_cell (); + + if (s1_string && s2_string) + retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); + else if ((s1_string && s2_cell) || (s1_cell && s2_string)) + { + octave_value str_val, cell_val; + + if (s1_string) + { + str_val = arg0; + cell_val = arg1; + } + else + { + str_val = arg1; + cell_val = arg0; + } + + const Cell cell = cell_val.cell_value (); + const string_vector str = str_val.all_strings (); + octave_idx_type r = str.length (); + + if (r == 0 || r == 1) + { + // Broadcast the string. + + boolNDArray output (cell_val.dims (), false); + + std::string s = r == 0 ? std::string () : str[0]; + + if (cell_val.is_cellstr ()) + { + const Array cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), s, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < cell.length (); i++) + { + if (cell(i).is_string ()) + output(i) = str_op (cell(i).string_value (), s, n); + } + } + + retval = output; + } + else if (r > 1) + { + if (cell.length () == 1) + { + // Broadcast the cell. + + const dim_vector dv (r, 1); + boolNDArray output (dv, false); + + if (cell(0).is_string ()) + { + const std::string str2 = cell(0).string_value (); + + for (octave_idx_type i = 0; i < r; i++) + output(i) = str_op (str[i], str2, n); + } + + retval = output; + } + else + { + // Must match in all dimensions. + + boolNDArray output (cell.dims (), false); + + if (cell.length () == r) + { + if (cell_val.is_cellstr ()) + { + const Array cellstr = cell_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (str[i], cellstr(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r; i++) + { + if (cell(i).is_string ()) + output(i) = str_op (str[i], cell(i).string_value (), n); + } + } + + retval = output; + } + else + retval = false; + } + } + } + else if (s1_cell && s2_cell) + { + octave_value cell1_val, cell2_val; + octave_idx_type r1 = arg0.numel (), r2; + + if (r1 == 1) + { + // Make the singleton cell2. + + cell1_val = arg1; + cell2_val = arg0; + } + else + { + cell1_val = arg0; + cell2_val = arg1; + } + + const Cell cell1 = cell1_val.cell_value (); + const Cell cell2 = cell2_val.cell_value (); + r1 = cell1.numel (); + r2 = cell2.numel (); + + const dim_vector size1 = cell1.dims (); + const dim_vector size2 = cell2.dims (); + + boolNDArray output (size1, false); + + if (r2 == 1) + { + // Broadcast cell2. + + if (cell2(0).is_string ()) + { + const std::string str2 = cell2(0).string_value (); + + if (cell1_val.is_cellstr ()) + { + const Array cellstr = cell1_val.cellstr_value (); + for (octave_idx_type i = 0; i < cellstr.length (); i++) + output(i) = str_op (cellstr(i), str2, n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + } + else + { + if (size1 != size2) + { + error ("%s: nonconformant cell arrays", fcn_name); + return retval; + } + + if (cell1.is_cellstr () && cell2.is_cellstr ()) + { + const Array cellstr1 = cell1_val.cellstr_value (); + const Array cellstr2 = cell2_val.cellstr_value (); + for (octave_idx_type i = 0; i < r1; i++) + output (i) = str_op (cellstr1(i), cellstr2(i), n); + } + else + { + // FIXME: should we warn here? + for (octave_idx_type i = 0; i < r1; i++) + { + if (cell1(i).is_string () && cell2(i).is_string ()) + { + const std::string str1 = cell1(i).string_value (); + const std::string str2 = cell2(i).string_value (); + output(i) = str_op (str1, str2, n); + } + } + } + } + + retval = output; + } + else + retval = false; + + return retval; +} + +// If both args are arrays, dimensions may be significant. +static bool +strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); +} + +// Otherwise, just use strings. +static bool +strcmp_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return s1 == s2; +} + +DEFUN (strcmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strcmpi, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmp", strcmp_array_op, strcmp_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = char (zeros (0, 2)); +%!assert (strcmp ("", x), false) +%!assert (strcmp (x, ""), false) +%!assert (strcmp (x, x), true) +## %!assert (strcmp ({""}, x), true) +## %!assert (strcmp ({x}, ""), false) +## %!assert (strcmp ({x}, x), true) +## %!assert (strcmp ("", {x}), false) +## %!assert (strcmp (x, {""}), false) +## %!assert (strcmp (x, {x}), true) +## %!assert (strcmp ({x; x}, ""), [false; false]) +## %!assert (strcmp ({x; x}, {""}), [false; false]) +## %!assert (strcmp ("", {x; x}), [false; false]) +## %!assert (strcmp ({""}, {x; x}), [false; false]) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp ({"foo"}, "foo"), true) +%!assert (strcmp ({"foo"}, x), false) +%!assert (strcmp (x, {"foo"}), false) +%!assert (strcmp ("foo", {"foo"}), true) +%!assert (strcmp (x, {"foo"}), false) +%!shared y +%! y = char (zeros (2, 0)); +%!assert (strcmp ("", y), false) +%!assert (strcmp (y, ""), false) +%!assert (strcmp (y, y), true) +%!assert (strcmp ({""}, y), [true; true]) +%!assert (strcmp ({y}, ""), true) +%!assert (strcmp ({y}, y), [true; true]) +%!assert (strcmp ("", {y}), true) +%!assert (strcmp (y, {""}), [true; true]) +%!assert (strcmp (y, {y}), [true; true]) +%!assert (strcmp ({y; y}, ""), [true; true]) +%!assert (strcmp ({y; y}, {""}), [true; true]) +%!assert (strcmp ("", {y; y}), [true; true]) +%!assert (strcmp ({""}, {y; y}), [true; true]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp ({"foo"}, y), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp (y, {"foo"}), [false; false]) +%!assert (strcmp ("foobar", "foobar"), true) +%!assert (strcmp ("fooba", "foobar"), false) + +%!error strcmp () +%!error strcmp ("foo", "bar", 3) +*/ + +// Apparently, Matlab ignores the dims with strncmp. It also +static bool +strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +// Otherwise, just use strings. Note that we neither extract substrings (which +// would mean a copy, at least in GCC), nor use string::compare (which is a +// 3-way compare). +static bool +strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data ())); +} + +DEFUN (strncmp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ +the same, and 0 otherwise.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", \"abcd\", 3)\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@example\n\ +@group\n\ +strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ + @result{} [1, 0, 1]\n\ +@end group\n\ +@end example\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +@seealso{strncmpi, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmp", + strncmp_array_op, strncmp_str_op); + } + else + error ("strncmp: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmp ("abce", "abc", 3), true) +%!assert (strncmp (100, 100, 1), false) +%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) +%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) +%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) +%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) +%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) + +%!error strncmp () +%!error strncmp ("abc", "def") +*/ + +// case-insensitive character equality functor +struct icmp_char_eq : public std::binary_function +{ + bool operator () (char x, char y) const + { return std::toupper (x) == std::toupper (y); } +}; + +// strcmpi is equivalent to strcmp in that it checks all dims. +static bool +strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) +{ + return (s1.dims () == s2.dims () + && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), + icmp_char_eq ())); +} + +// Ditto for string. +static bool +strcmpi_str_op (const std::string& s1, const std::string& s2, + octave_idx_type) +{ + return (s1.size () == s2.size () + && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strcmpi", Fstrcmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ +Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ +disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strcmp, strncmp, strncmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + retval = do_strcmp_fun (args (0), args (1), 0, + "strcmpi", strcmpi_array_op, strcmpi_str_op); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strcmpi ("abc123", "ABC123"), true) +*/ + +// Like strncmp. +static bool +strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.numel (), l2 = s2.numel (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +// Ditto. +static bool +strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) +{ + octave_idx_type l1 = s1.length (), l2 = s2.length (); + return (n > 0 && n <= l1 && n <= l2 + && std::equal (s1.data (), s1.data () + n, s2.data (), + icmp_char_eq ())); +} + +DEFUNX ("strncmpi", Fstrncmpi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ +Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ +same, disregarding case of alphabetic characters, and 0 otherwise.\n\ +\n\ +If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ +of the same size is returned, containing the values described above for\n\ +every member of the cell array. The other argument may also be a cell\n\ +array of strings (of the same size or with only one element), char matrix\n\ +or character string.\n\ +\n\ +@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ +function returns 1 if the character strings are equal, and 0 otherwise.\n\ +This is just the opposite of the corresponding C library function.\n\ +\n\ +@strong{Caution:} National alphabets are not supported.\n\ +@seealso{strncmp, strcmp, strcmpi}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 3) + { + octave_idx_type n = args(2).idx_type_value (); + + if (! error_state) + { + if (n > 0) + { + retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", + strncmpi_array_op, strncmpi_str_op); + } + else + error ("strncmpi: N must be greater than 0"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (strncmpi ("abc123", "ABC456", 3), true) +*/ + +DEFUN (list_in_columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ +Return a string containing the elements of @var{arg} listed in\n\ +columns with an overall maximum width of @var{width} and optional\n\ +prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ +of character strings or a character array. If @var{width} is not\n\ +specified or is an empty matrix, or less than or equal to zero,\n\ +the width of the terminal screen is used.\n\ +Newline characters are used to break the lines in the output string.\n\ +For example:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +@group\n\ +list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ + @result{} abc mnop\n\ + def qrs\n\ + ghijkl tuv\n\ +\n\ +whos ans\n\ + @result{}\n\ + Variables in the current scope:\n\ +\n\ + Attr Name Size Bytes Class\n\ + ==== ==== ==== ===== =====\n\ + ans 1x37 37 char\n\ +\n\ + Total is 37 elements using 37 bytes\n\ +@end group\n\ +@end smallexample\n\ +\n\ +@seealso{terminal_size}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + string_vector s = args(0).all_strings (); + + if (error_state) + { + error ("list_in_columns: expecting cellstr or char array"); + return retval; + } + + int width = -1; + + if (nargin > 1 && ! args(1).is_empty ()) + { + width = args(1).int_value (); + + if (error_state) + { + error ("list_in_columns: WIDTH must be an integer"); + return retval; + } + } + + std::string prefix; + + if (nargin > 2) + { + if (args(2).is_string ()) + { + prefix = args(2).string_value (); + + if (error_state) + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + else + { + error ("list_in_columns: PREFIX must be a character string"); + return retval; + } + } + + std::ostringstream buf; + + s.list_in_columns (buf, width, prefix); + + retval = buf.str (); + + return retval; +} + +/* +%!test +%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; +%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; +%! assert (list_in_columns (input, 20), result); +%!test +%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; +%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; +%! assert (list_in_columns (input, 20, " "), result); + +%!error list_in_columns () +%!error list_in_columns (["abc", "def"], 20, 2) +%!error list_in_columns (["abc", "def"], 20, " ", 3) +%!error list_in_columns (["abc", "def"], "a") +*/ diff -r 069c552587a0 -r 959953dba519 src/corefcn/syscalls.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/corefcn/syscalls.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1943 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +// Thomas Baier added the original versions of +// the following functions: +// +// mkfifo unlink waitpid + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include + +#include + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-syscalls.h" +#include "oct-uname.h" + +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "lo-utils.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-stdstrm.h" +#include "oct-stream.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" +#include "input.h" + +static octave_scalar_map +mk_stat_map (const base_file_stat& fs) +{ + octave_scalar_map m; + + m.assign ("dev", static_cast (fs.dev ())); + m.assign ("ino", fs.ino ()); + m.assign ("mode", fs.mode ()); + m.assign ("modestr", fs.mode_as_string ()); + m.assign ("nlink", fs.nlink ()); + m.assign ("uid", fs.uid ()); + m.assign ("gid", fs.gid ()); +#if defined (HAVE_STRUCT_STAT_ST_RDEV) + m.assign ("rdev", static_cast (fs.rdev ())); +#endif + m.assign ("size", fs.size ()); + m.assign ("atime", fs.atime ()); + m.assign ("mtime", fs.mtime ()); + m.assign ("ctime", fs.ctime ()); +#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) + m.assign ("blksize", fs.blksize ()); +#endif +#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) + m.assign ("blocks", fs.blocks ()); +#endif + + return m; +} + +static octave_value_list +mk_stat_result (const base_file_stat& fs) +{ + octave_value_list retval; + + if (fs) + { + retval(2) = std::string (); + retval(1) = 0; + retval(0) = octave_value (mk_stat_map (fs)); + } + else + { + retval(2) = fs.error (); + retval(1) = -1; + retval(0) = Matrix (); + } + + return retval; +} + +DEFUNX ("dup2", Fdup2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ +Duplicate a file descriptor.\n\ +\n\ +If successful, @var{fid} is greater than zero and contains the new file\n\ +ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream old_stream + = octave_stream_list::lookup (args(0), "dup2"); + + if (! error_state) + { + octave_stream new_stream + = octave_stream_list::lookup (args(1), "dup2"); + + if (! error_state) + { + int i_old = old_stream.file_number (); + int i_new = new_stream.file_number (); + + if (i_old >= 0 && i_new >= 0) + { + std::string msg; + + int status = octave_syscalls::dup2 (i_old, i_new, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("dup2: invalid stream"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("exec", Fexec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ +Replace current process with a new process. Calling @code{exec} without\n\ +first calling @code{fork} will terminate your current Octave process and\n\ +replace it with the program named by @var{file}. For example,\n\ +\n\ +@example\n\ +exec (\"ls\" \"-l\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will run @code{ls} and return you to your shell prompt.\n\ +\n\ +If successful, @code{exec} does not return. If @code{exec} does return,\n\ +@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ +error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector exec_args; + + if (nargin == 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + exec_args.resize (len + 1); + + exec_args[0] = exec_file; + + for (int i = 0; i < len; i++) + exec_args[i+1] = tmp[i]; + } + else + error ("exec: arguments must be character strings"); + } + else + { + exec_args.resize (1); + + exec_args[0] = exec_file; + } + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::execvp (exec_file, exec_args, msg); + + retval(1) = msg; + retval(0) = status; + } + } + else + error ("exec: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("popen2", Fpopen2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ +Start a subprocess with two-way communication. The name of the process\n\ +is given by @var{command}, and @var{args} is an array of strings\n\ +containing options for the command. The file identifiers for the input\n\ +and output streams of the subprocess are returned in @var{in} and\n\ +@var{out}. If execution of the command is successful, @var{pid}\n\ +contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ +@minus{}1.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ +fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ +fclose (in);\n\ +EAGAIN = errno (\"EAGAIN\");\n\ +done = false;\n\ +do\n\ + s = fgets (out);\n\ + if (ischar (s))\n\ + fputs (stdout, s);\n\ + elseif (errno () == EAGAIN)\n\ + sleep (0.1);\n\ + fclear (out);\n\ + else\n\ + done = true;\n\ + endif\n\ +until (done)\n\ +fclose (out);\n\ +waitpid (pid);\n\ +\n\ + @print{} these\n\ + @print{} strings\n\ + @print{} some\n\ + @print{} are\n\ +@end example\n\ +\n\ +Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ +child process. If you don't use @code{waitpid} to check the child's\n\ +exit status, it will linger until Octave exits.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = -1; + retval(1) = Matrix (); + retval(0) = Matrix (); + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + std::string exec_file = args(0).string_value (); + + if (! error_state) + { + string_vector arg_list; + + if (nargin >= 2) + { + string_vector tmp = args(1).all_strings (); + + if (! error_state) + { + int len = tmp.length (); + + arg_list.resize (len + 1); + + arg_list[0] = exec_file; + + for (int i = 0; i < len; i++) + arg_list[i+1] = tmp[i]; + } + else + error ("popen2: arguments must be character strings"); + } + else + { + arg_list.resize (1); + + arg_list[0] = exec_file; + } + + if (! error_state) + { + bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); + + if (! error_state) + { + int fildes[2]; + std::string msg; + pid_t pid; + + pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); + if (pid >= 0) + { + FILE *ifile = fdopen (fildes[1], "r"); + FILE *ofile = fdopen (fildes[0], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + Cell file_ids (1, 2); + + retval(2) = pid; + retval(1) = octave_stream_list::insert (is); + retval(0) = octave_stream_list::insert (os); + } + else + error (msg.c_str ()); + } + } + else + error ("popen2: arguments must be character strings"); + } + else + error ("popen2: COMMAND argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! [in, out, pid] = popen2 ("sort", "-r"); +%! EAGAIN = errno ("EAGAIN"); +%! else +%! [in, out, pid] = popen2 ("sort", "/R"); +%! EAGAIN = errno ("EINVAL"); +%! endif +%! fputs (in, "these\nare\nsome\nstrings\n"); +%! fclose (in); +%! done = false; +%! str = {}; +%! idx = 0; +%! errs = 0; +%! do +%! if (!isunix ()) +%! errno (0); +%! endif +%! s = fgets (out); +%! if (ischar (s)) +%! idx++; +%! str{idx} = s; +%! elseif (errno () == EAGAIN) +%! fclear (out); +%! sleep (0.1); +%! if (++errs == 100) +%! done = true; +%! endif +%! else +%! done = true; +%! endif +%! until (done) +%! fclose (out); +%! if (isunix ()) +%! assert (str, {"these\n","strings\n","some\n","are\n"}); +%! else +%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); +%! endif +*/ + +DEFUNX ("fcntl", Ffcntl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ +Change the properties of the open file @var{fid}. The following values\n\ +may be passed as @var{request}:\n\ +\n\ +@vtable @code\n\ +@item F_DUPFD\n\ +Return a duplicate file descriptor.\n\ +\n\ +@item F_GETFD\n\ +Return the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_SETFD\n\ +Set the file descriptor flags for @var{fid}.\n\ +\n\ +@item F_GETFL\n\ +Return the file status flags for @var{fid}. The following codes may be\n\ +returned (some of the flags may be undefined on some systems).\n\ +\n\ +@vtable @code\n\ +@item O_RDONLY\n\ +Open for reading only.\n\ +\n\ +@item O_WRONLY\n\ +Open for writing only.\n\ +\n\ +@item O_RDWR\n\ +Open for reading and writing.\n\ +\n\ +@item O_APPEND\n\ +Append on each write.\n\ +\n\ +@item O_CREAT\n\ +Create the file if it does not exist.\n\ +\n\ +@item O_NONBLOCK\n\ +Non-blocking mode.\n\ +\n\ +@item O_SYNC\n\ +Wait for writes to complete.\n\ +\n\ +@item O_ASYNC\n\ +Asynchronous I/O.\n\ +@end vtable\n\ +\n\ +@item F_SETFL\n\ +Set the file status flags for @var{fid} to the value specified by\n\ +@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ +@w{@code{O_NONBLOCK}}.\n\ +@end vtable\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 3) + { + octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); + + if (! error_state) + { + int fid = strm.file_number (); + + int req = args(1).int_value (true); + int arg = args(2).int_value (true); + + if (! error_state) + { + // FIXME -- Need better checking here? + if (fid < 0) + error ("fcntl: invalid file id"); + else + { + std::string msg; + + int status = octave_fcntl (fid, req, arg, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + error ("fcntl: FID, REQUEST, and ARG must be integers"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("fork", Ffork, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ +Create a copy of the current process.\n\ +\n\ +Fork can return one of the following values:\n\ +\n\ +@table @asis\n\ +@item > 0\n\ +You are in the parent process. The value returned from @code{fork} is\n\ +the process id of the child process. You should probably arrange to\n\ +wait for any child processes to exit.\n\ +\n\ +@item 0\n\ +You are in the child process. You can call @code{exec} to start another\n\ +process. If that fails, you should probably call @code{exit}.\n\ +\n\ +@item < 0\n\ +The call to @code{fork} failed for some reason. You must take evasive\n\ +action. A system dependent error message will be waiting in @var{msg}.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + pid_t pid = octave_syscalls::fork (msg); + + retval(1) = msg; + retval(0) = pid; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpgrp", Fgetpgrp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ +Return the process group id of the current process.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + std::string msg; + + retval(1) = msg; + retval(0) = octave_syscalls::getpgrp (msg); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("getpid", Fgetpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getpid ()\n\ +Return the process id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getpid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getppid", Fgetppid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {pid =} getppid ()\n\ +Return the process id of the parent process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getppid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getegid", Fgetegid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {egid =} getegid ()\n\ +Return the effective group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getegid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getgid", Fgetgid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {gid =} getgid ()\n\ +Return the real group id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getgid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("geteuid", Fgeteuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {euid =} geteuid ()\n\ +Return the effective user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::geteuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("getuid", Fgetuid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {uid =} getuid ()\n\ +Return the real user id of the current process.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_syscalls::getuid (); + else + print_usage (); + + return retval; +} + +DEFUNX ("kill", Fkill, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ +Send signal @var{sig} to process @var{pid}.\n\ +\n\ +If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ +\n\ +If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ +in the process group of the current process.\n\ +\n\ +If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ +except process 1.\n\ +\n\ +If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ +process in the process group @var{-pid}.\n\ +\n\ +If @var{sig} is 0, then no signal is sent, but error checking is still\n\ +performed.\n\ +\n\ +Return 0 if successful, otherwise return -1.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + if (args.length () == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int sig = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = octave_syscalls::kill (pid, sig, msg); + + retval(1) = msg; + retval(0) = status; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("lstat", Flstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ +Return a structure @var{info} containing information about the symbolic link\n\ +@var{symlink}. The function outputs are described in the documentation for\n\ +@code{stat}.\n\ +@seealso{stat}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname, false); + + retval = mk_stat_result (fs); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("mkfifo", Fmkfifo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ +Create a @var{fifo} special file named @var{name} with file mode @var{mode}\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + if (args(1).is_scalar_type ()) + { + long mode = args(1).long_value (); + + if (! error_state) + { + std::string msg; + + int status = octave_mkfifo (name, mode, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + else + error ("mkfifo: invalid MODE"); + } + else + error ("mkfifo: MODE must be an integer"); + } + else + error ("mkfifo: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("pipe", Fpipe, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ +Create a pipe and return the reading and writing ends of the pipe\n\ +into @var{read_fd} and @var{write_fd} respectively.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(3) = std::string (); + retval(2) = -1; + retval(1) = -1; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + int fid[2]; + + std::string msg; + + int status = octave_syscalls::pipe (fid, msg); + + if (status < 0) + retval(3) = msg; + else + { + FILE *ifile = fdopen (fid[0], "r"); + FILE *ofile = fdopen (fid[1], "w"); + + std::string nm; + + octave_stream is = octave_stdiostream::create (nm, ifile, + std::ios::in); + + octave_stream os = octave_stdiostream::create (nm, ofile, + std::ios::out); + + retval(2) = status; + retval(1) = octave_stream_list::insert (os); + retval(0) = octave_stream_list::insert (is); + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("stat", Fstat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ +@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ +Return a structure @var{info} containing the following information about\n\ +@var{file} or file identifier @var{fid}.\n\ +\n\ +@table @code\n\ +@item dev\n\ +ID of device containing a directory entry for this file.\n\ +\n\ +@item ino\n\ +File number of the file.\n\ +\n\ +@item mode\n\ +File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ +@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ +@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ +value.\n\ +\n\ +@item modestr\n\ +File mode, as a string of ten letters or dashes as would be returned by\n\ +@kbd{ls -l}.\n\ +\n\ +@item nlink\n\ +Number of links.\n\ +\n\ +@item uid\n\ +User ID of file's owner.\n\ +\n\ +@item gid\n\ +Group ID of file's group.\n\ +\n\ +@item rdev\n\ +ID of device for block or character special files.\n\ +\n\ +@item size\n\ +Size in bytes.\n\ +\n\ +@item atime\n\ +Time of last access in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item mtime\n\ +Time of last modification in the same form as time values returned from\n\ +@code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item ctime\n\ +Time of last file status change in the same form as time values\n\ +returned from @code{time}. @xref{Timing Utilities}.\n\ +\n\ +@item blksize\n\ +Size of blocks in the file.\n\ +\n\ +@item blocks\n\ +Number of blocks allocated for file.\n\ +@end table\n\ +\n\ +If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ +string. If the file does not exist, or some other error occurs, @var{info}\n\ +is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ +corresponding system error message.\n\ +\n\ +If @var{file} is a symbolic link, @code{stat} will return information\n\ +about the actual file that is referenced by the link. Use @code{lstat}\n\ +if you want information about the symbolic link itself.\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +[info, err, msg] = stat (\"/vmlinuz\")\n\ + @result{} info =\n\ + @{\n\ + atime = 855399756\n\ + rdev = 0\n\ + ctime = 847219094\n\ + uid = 0\n\ + size = 389218\n\ + blksize = 4096\n\ + mtime = 847219094\n\ + gid = 6\n\ + nlink = 1\n\ + blocks = 768\n\ + mode = -rw-r--r--\n\ + modestr = -rw-r--r--\n\ + ino = 9316\n\ + dev = 2049\n\ + @}\n\ + @result{} err = 0\n\ + @result{} msg =\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (args(0).is_scalar_type ()) + { + int fid = octave_stream_list::get_file_number (args(0)); + + if (! error_state) + { + file_fstat fs (fid); + + retval = mk_stat_result (fs); + } + } + else + { + std::string fname = args(0).string_value (); + + if (! error_state) + { + file_stat fs (fname); + + retval = mk_stat_result (fs); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISREG", FS_ISREG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ +Return true if @var{mode} corresponds to a regular file. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_reg (static_cast (mode)); + else + error ("S_ISREG: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISDIR", FS_ISDIR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ +Return true if @var{mode} corresponds to a directory. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_dir (static_cast (mode)); + else + error ("S_ISDIR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISCHR", FS_ISCHR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ +Return true if @var{mode} corresponds to a character device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_chr (static_cast (mode)); + else + error ("S_ISCHR: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISBLK", FS_ISBLK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ +Return true if @var{mode} corresponds to a block device. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_blk (static_cast (mode)); + else + error ("S_ISBLK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ +Return true if @var{mode} corresponds to a fifo. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_fifo (static_cast (mode)); + else + error ("S_ISFIFO: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISLNK", FS_ISLNK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ +Return true if @var{mode} corresponds to a symbolic link. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_lnk (static_cast (mode)); + else + error ("S_ISLNK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ +Return true if @var{mode} corresponds to a socket. The value\n\ +of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ +@seealso{stat, lstat}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + double mode = args(0).double_value (); + + if (! error_state) + retval = file_stat::is_sock (static_cast (mode)); + else + error ("S_ISSOCK: invalid MODE value"); + } + else + print_usage (); + + return retval; +} + +DEFUN (gethostname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gethostname ()\n\ +Return the hostname of the system where Octave is running.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_env::get_host_name (); + else + print_usage (); + + return retval; +} + +DEFUN (uname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ +Return system information in the structure. For example:\n\ +\n\ +@example\n\ +@group\n\ +uname ()\n\ + @result{} @{\n\ + sysname = x86_64\n\ + nodename = segfault\n\ + release = 2.6.15-1-amd64-k8-smp\n\ + version = Linux\n\ + machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ + @}\n\ +@end group\n\ +@end example\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_uname sysinfo; + + octave_scalar_map m; + + m.assign ("sysname", sysinfo.sysname ()); + m.assign ("nodename", sysinfo.nodename ()); + m.assign ("release", sysinfo.release ()); + m.assign ("version", sysinfo.version ()); + m.assign ("machine", sysinfo.machine ()); + + retval(2) = sysinfo.message (); + retval(1) = sysinfo.error (); + retval(0) = m; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("unlink", Funlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ +Delete the file named @var{file}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + + std::string msg; + + int status = octave_unlink (name, msg); + + retval(1) = msg; + retval(0) = status; + } + else + error ("unlink: FILE must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("waitpid", Fwaitpid, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ +Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ +\n\ +@table @asis\n\ +@item @minus{}1\n\ +Wait for any child process.\n\ +\n\ +@item 0\n\ +Wait for any child process whose process group ID is equal to that of\n\ +the Octave interpreter process.\n\ +\n\ +@item > 0\n\ +Wait for termination of the child process with ID @var{pid}.\n\ +@end table\n\ +\n\ +The @var{options} argument can be a bitwise OR of zero or more of\n\ +the following constants:\n\ +\n\ +@table @code\n\ +@item 0\n\ +Wait until signal is received or a child process exits (this is the\n\ +default if the @var{options} argument is missing).\n\ +\n\ +@item WNOHANG\n\ +Do not hang if status is not immediately available.\n\ +\n\ +@item WUNTRACED\n\ +Report the status of any child processes that are stopped, and whose\n\ +status has not yet been reported since they stopped.\n\ +\n\ +@item WCONTINUE\n\ +Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ +This value may not be meaningful on all systems.\n\ +@end table\n\ +\n\ +If the returned value of @var{pid} is greater than 0, it is the process\n\ +ID of the child process that exited. If an error occurs, @var{pid} will\n\ +be less than zero and @var{msg} will contain a system-dependent error\n\ +message. The value of @var{status} contains additional system-dependent\n\ +information about the subprocess that exited.\n\ +@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + pid_t pid = args(0).int_value (true); + + if (! error_state) + { + int options = 0; + + if (args.length () == 2) + options = args(1).int_value (true); + + if (! error_state) + { + std::string msg; + + int status = 0; + + pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); + + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + else + error ("waitpid: OPTIONS must be an integer"); + } + else + error ("waitpid: PID must be an integer value"); + } + else + print_usage (); + + return retval; +} + +DEFUNX ("WIFEXITED", FWIFEXITED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child terminated normally.\n\ +@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFEXITED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFEXITED (status); + else + error ("WIFEXITED: STATUS must be an integer"); + } +#else + warning ("WIFEXITED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the exit\n\ +status of the child. This function should only be employed if\n\ +@code{WIFEXITED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WEXITSTATUS) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WEXITSTATUS (status); + else + error ("WEXITSTATUS: STATUS must be an integer"); + } +#else + warning ("WEXITSTATUS always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was terminated by a signal.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSIGNALED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSIGNALED (status); + else + error ("WIFSIGNALED: STATUS must be an integer"); + } +#else + warning ("WIFSIGNALED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WTERMSIG", FWTERMSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal that caused the child process to terminate. This function\n\ +should only be employed if @code{WIFSIGNALED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WTERMSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WTERMSIG (status); + else + error ("WTERMSIG: STATUS must be an integer"); + } +#else + warning ("WTERMSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child produced a core dump. This function should only be employed if\n\ +@code{WIFSIGNALED} returned true. The macro used to implement this\n\ +function is not specified in POSIX.1-2001 and is not available on some\n\ +Unix implementations (e.g., AIX, SunOS).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WCOREDUMP) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WCOREDUMP (status); + else + error ("WCOREDUMP: STATUS must be an integer"); + } +#else + warning ("WCOREDUMP always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was stopped by delivery of a signal; this is only\n\ +possible if the call was done using @code{WUNTRACED} or when the child\n\ +is being traced (see ptrace(2)).\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFSTOPPED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFSTOPPED (status); + else + error ("WIFSTOPPED: STATUS must be an integer"); + } +#else + warning ("WIFSTOPPED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return the number of\n\ +the signal which caused the child to stop. This function should only\n\ +be employed if @code{WIFSTOPPED} returned true.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WSTOPSIG) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WSTOPSIG (status); + else + error ("WSTOPSIG: STATUS must be an integer"); + } +#else + warning ("WSTOPSIG always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ +Given @var{status} from a call to @code{waitpid}, return true if the\n\ +child process was resumed by delivery of @code{SIGCONT}.\n\ +@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ +@end deftypefn") +{ + octave_value retval = 0.0; + +#if defined (WIFCONTINUED) + if (args.length () == 1) + { + int status = args(0).int_value (); + + if (! error_state) + retval = WIFCONTINUED (status); + else + error ("WIFCONTINUED: STATUS must be an integer"); + } +#else + warning ("WIFCONTINUED always returns false in this version of Octave"); +#endif + + return retval; +} + +DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ +Return the canonical name of file @var{fname}. If the file does not exist\n\ +the empty string (\"\") is returned.\n\ +@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string msg; + + std::string result = octave_canonicalize_file_name (name, msg); + + retval(2) = msg; + retval(1) = msg.empty () ? 0 : -1; + retval(0) = result; + } + else + error ("canonicalize_file_name: NAME must be a character string"); + } + else + print_usage (); + + return retval; +} + +static octave_value +const_value (const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +#if !defined (O_NONBLOCK) && defined (O_NDELAY) +#define O_NONBLOCK O_NDELAY +#endif + +DEFUNX ("F_DUPFD", FF_DUPFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_DUPFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return a\n\ +duplicate file descriptor.\n\ +@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_DUPFD) + return const_value (args, F_DUPFD); +#else + error ("F_DUPFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFD", FF_GETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFD) + return const_value (args, F_GETFD); +#else + error ("F_GETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_GETFL", FF_GETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_GETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to return the\n\ +file status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_GETFL) + return const_value (args, F_GETFL); +#else + error ("F_GETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFD", FF_SETFD, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFD ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +descriptor flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ +@end deftypefn") +{ +#if defined (F_SETFD) + return const_value (args, F_SETFD); +#else + error ("F_SETFD: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("F_SETFL", FF_SETFL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} F_SETFL ()\n\ +Return the numerical value to pass to @code{fcntl} to set the file\n\ +status flags.\n\ +@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ +@end deftypefn") +{ +#if defined (F_SETFL) + return const_value (args, F_SETFL); +#else + error ("F_SETFL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_APPEND", FO_APPEND, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_APPEND ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate each write operation appends,\n\ +or that may be passed to @code{fcntl} to set the write mode to append.\n\ +@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_APPEND) + return const_value (args, O_APPEND); +#else + error ("O_APPEND: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_ASYNC", FO_ASYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_ASYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate asynchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_ASYNC) + return const_value (args, O_ASYNC); +#else + error ("O_ASYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_CREAT", FO_CREAT, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_CREAT ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file should be\n\ +created if it does not exist.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_CREAT) + return const_value (args, O_CREAT); +#else + error ("O_CREAT: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_EXCL", FO_EXCL, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_EXCL ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that file locking is used.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_EXCL) + return const_value (args, O_EXCL); +#else + error ("O_EXCL: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ +or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_NONBLOCK) + return const_value (args, O_NONBLOCK); +#else + error ("O_NONBLOCK: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDONLY", FO_RDONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +reading only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDONLY) + return const_value (args, O_RDONLY); +#else + error ("O_RDONLY: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_RDWR", FO_RDWR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_RDWR ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for both\n\ +reading and writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_RDWR) + return const_value (args, O_RDWR); +#else + error ("O_RDWR: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_SYNC", FO_SYNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_SYNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +synchronous I/O.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_SYNC) + return const_value (args, O_SYNC); +#else + error ("O_SYNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_TRUNC", FO_TRUNC, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} O_TRUNC ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that if file exists, it should\n\ +be truncated when writing.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ +@end deftypefn") +{ +#if defined (O_TRUNC) + return const_value (args, O_TRUNC); +#else + error ("O_TRUNC: not available on this system"); + return octave_value (); +#endif +} + +DEFUNX ("O_WRONLY", FO_WRONLY, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} O_WRONLY ()\n\ +Return the numerical value of the file status flag that may be\n\ +returned by @code{fcntl} to indicate that a file is open for\n\ +writing only.\n\ +@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ +@end deftypefn") +{ +#if defined (O_WRONLY) + return const_value (args, O_WRONLY); +#else + error ("O_WRONLY: not available on this system"); + return octave_value (); +#endif +} + +#if !defined (WNOHANG) +#define WNOHANG 0 +#endif + +DEFUNX ("WNOHANG", FWNOHANG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WNOHANG ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should return its\n\ +status immediately instead of waiting for a process to exit.\n\ +@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WNOHANG); +} + +#if !defined (WUNTRACED) +#define WUNTRACED 0 +#endif + +DEFUNX ("WUNTRACED", FWUNTRACED, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WUNTRACED ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if the child process has stopped but is not traced via the\n\ +@code{ptrace} system call\n\ +@seealso{waitpid, WNOHANG, WCONTINUE}\n\ +@end deftypefn") +{ + return const_value (args, WUNTRACED); +} + +#if !defined (WCONTINUE) +#define WCONTINUE 0 +#endif + +DEFUNX ("WCONTINUE", FWCONTINUE, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} WCONTINUE ()\n\ +Return the numerical value of the option argument that may be\n\ +passed to @code{waitpid} to indicate that it should also return\n\ +if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ +signal.\n\ +@seealso{waitpid, WNOHANG, WUNTRACED}\n\ +@end deftypefn") +{ + return const_value (args, WCONTINUE); +} diff -r 069c552587a0 -r 959953dba519 src/data.cc --- a/src/data.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7370 +0,0 @@ -/* - -Copyright (C) 1994-2012 John W. Eaton -Copyright (C) 2009 Jaroslav Hajek -Copyright (C) 2009-2010 VZLU Prague -Copyright (C) 2012 Carlo de Falco - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#ifdef HAVE_SYS_RESOURCE_H -#include -#endif - -#include -#include - -#include -extern "C" -{ -#include -} - -#include "lo-ieee.h" -#include "lo-math.h" -#include "oct-time.h" -#include "str-vec.h" -#include "quit.h" -#include "mx-base.h" -#include "oct-binmap.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-float.h" -#include "ov-complex.h" -#include "ov-flt-complex.h" -#include "ov-cx-mat.h" -#include "ov-flt-cx-mat.h" -#include "ov-cx-sparse.h" -#include "parse.h" -#include "pt-mat.h" -#include "utils.h" -#include "variables.h" -#include "pager.h" -#include "xnorm.h" - -#if ! defined (CLOCKS_PER_SEC) -#if defined (CLK_TCK) -#define CLOCKS_PER_SEC CLK_TCK -#else -#error "no definition for CLOCKS_PER_SEC!" -#endif -#endif - -#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) -#define hypotf _hypotf -#define HAVE_HYPOTF 1 -#endif - -#define ANY_ALL(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - retval = args(0).FCN (dim); \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - else \ - error (#FCN ": expecting dimension argument to be an integer"); \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (all, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} all (@var{x})\n\ -@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if all elements of the vector\n\ -are nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether all of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -all ([2, 3; 1, 0]))\n\ - @result{} [ 1, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}.\n\ -@seealso{any}\n\ -@end deftypefn") -{ - ANY_ALL (all); -} - -/* -%!test -%! x = ones (3); -%! x(1,1) = 0; -%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!test -%! x = ones (3, "single"); -%! x(1,1) = 0; -%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); -%! assert (all (all (x) == [0, 1, 1]) == 1); -%! assert (all (x, 1) == [0, 1, 1]); -%! assert (all (x, 2) == [0; 1; 1]); - -%!error all () -%!error all (1, 2, 3) -*/ - -DEFUN (any, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} any (@var{x})\n\ -@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ -For a vector argument, return true (logical 1) if any element of the vector\n\ -is nonzero.\n\ -\n\ -For a matrix argument, return a row vector of logical ones and\n\ -zeros with each element indicating whether any of the elements of the\n\ -corresponding column of the matrix are nonzero. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4))\n\ - @result{} [ 1, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is supplied, work along dimension\n\ -@var{dim}. For example:\n\ -\n\ -@example\n\ -@group\n\ -any (eye (2, 4), 2)\n\ - @result{} [ 1; 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{all}\n\ -@end deftypefn") -{ - ANY_ALL (any); -} - -/* -%!test -%! x = zeros (3); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!test -%! x = zeros (3, "single"); -%! x(3,3) = 1; -%! assert (all (any (x) == [0, 0, 1]) == 1); -%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); -%! assert (any (x, 1) == [0, 0, 1]); -%! assert (any (x, 2) == [0; 0; 1]); - -%!error any () -%!error any (1, 2, 3) -*/ - -// These mapping functions may also be useful in other places, eh? - -DEFUN (atan2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ -Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ -and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ -and orientation.\n\ -@seealso{tan, tand, tanh, atanh}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("atan2", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("atan2: not defined for complex numbers"); - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = atan2f (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, ::atan2f, "atan2"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, ::atan2, "atan2"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, ::atan2, "atan2"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (atan2 (1, 2)), [1, 1]) - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; -%! x = [1, 3, 1, 1, 1, 1, 3, 1]; -%! assert (atan2 (y, x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); -%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); -%! assert (atan2 (y, x), v, sqrt (eps ("single"))); - -%!error atan2 () -%!error atan2 (1, 2, 3) -*/ - - -static octave_value -do_hypot (const octave_value& x, const octave_value& y) -{ - octave_value retval; - - octave_value arg0 = x, arg1 = y; - if (! arg0.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg0); - else if (! arg1.is_numeric_type ()) - gripe_wrong_type_arg ("hypot", arg1); - else - { - if (arg0.is_complex_type ()) - arg0 = arg0.abs (); - if (arg1.is_complex_type ()) - arg1 = arg1.abs (); - - if (arg0.is_single_type () || arg1.is_single_type ()) - { - if (arg0.is_scalar_type () && arg1.is_scalar_type ()) - retval = hypotf (arg0.float_value (), arg1.float_value ()); - else - { - FloatNDArray a0 = arg0.float_array_value (); - FloatNDArray a1 = arg1.float_array_value (); - retval = binmap (a0, a1, ::hypotf, "hypot"); - } - } - else - { - bool a0_scalar = arg0.is_scalar_type (); - bool a1_scalar = arg1.is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); - else if ((a0_scalar || arg0.is_sparse_type ()) - && (a1_scalar || arg1.is_sparse_type ())) - { - SparseMatrix m0 = arg0.sparse_matrix_value (); - SparseMatrix m1 = arg1.sparse_matrix_value (); - retval = binmap (m0, m1, ::hypot, "hypot"); - } - else - { - NDArray a0 = arg0.array_value (); - NDArray a1 = arg1.array_value (); - retval = binmap (a0, a1, ::hypot, "hypot"); - } - } - } - - return retval; -} - -DEFUN (hypot, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ -Compute the element-by-element square root of the sum of the squares of\n\ -@var{x} and @var{y}. This is equivalent to\n\ -@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ -avoids overflows for large values of @var{x} or @var{y}.\n\ -@code{hypot} can also be called with more than 2 arguments; in this case,\n\ -the arguments are accumulated from left to right:\n\ -\n\ -@example\n\ -@group\n\ -hypot (hypot (@var{x}, @var{y}), @var{z})\n\ -hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - retval = do_hypot (args(0), args(1)); - } - else if (nargin >= 3) - { - retval = args(0); - for (int i = 1; i < nargin && ! error_state; i++) - retval = do_hypot (retval, args(i)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (hypot (1, 2)), [1, 1]) -%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) -%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) -*/ - -template -void -map_2_xlog2 (const Array& x, Array& f, Array& e) -{ - f = Array(x.dims ()); - e = Array(x.dims ()); - for (octave_idx_type i = 0; i < x.numel (); i++) - { - int exp; - f.xelem (i) = xlog2 (x(i), exp); - e.xelem (i) = exp; - } -} - -DEFUN (log2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log2 (@var{x})\n\ -@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ -Compute the base-2 logarithm of each element of @var{x}.\n\ -\n\ -If called with two output arguments, split @var{x} into\n\ -binary mantissa and exponent so that\n\ -@tex\n\ -${1 \\over 2} \\le \\left| f \\right| < 1$\n\ -@end tex\n\ -@ifnottex\n\ -@code{1/2 <= abs(f) < 1}\n\ -@end ifnottex\n\ -and @var{e} is an integer. If\n\ -@tex\n\ -$x = 0$, $f = e = 0$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{x = 0}, @code{f = e = 0}.\n\ -@end ifnottex\n\ -@seealso{pow2, log, log10, exp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (nargout < 2) - retval(0) = args(0).log2 (); - else if (args(0).is_single_type ()) - { - if (args(0).is_real_type ()) - { - FloatNDArray f; - FloatNDArray x = args(0).float_array_value (); - // FIXME -- should E be an int value? - FloatMatrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - FloatComplexNDArray f; - FloatComplexNDArray x = args(0).float_complex_array_value (); - // FIXME -- should E be an int value? - FloatNDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - } - else if (args(0).is_real_type ()) - { - NDArray f; - NDArray x = args(0).array_value (); - // FIXME -- should E be an int value? - Matrix e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else if (args(0).is_complex_type ()) - { - ComplexNDArray f; - ComplexNDArray x = args(0).complex_array_value (); - // FIXME -- should E be an int value? - NDArray e; - map_2_xlog2 (x, f, e); - retval(1) = e; - retval(0) = f; - } - else - gripe_wrong_type_arg ("log2", args(0)); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) -%!assert (log2 (Inf), Inf) -%!assert (isnan (log2 (NaN))) -%!assert (log2 (4*i), 2 + log2 (1*i)) -%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) - -%!test -%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); -%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); -%! assert (e(1:2,:), [0,1;2,3]); - -%!test -%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); -%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); -%! assert (e(1:2,:), [0,1; 2,3]); -*/ - -DEFUN (rem, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ -@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ -Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ -using the expression\n\ -\n\ -@example\n\ -x - y .* fix (x ./ y)\n\ -@end example\n\ -\n\ -An error message is printed if the dimensions of the arguments do not\n\ -agree, or if either of the arguments is complex.\n\ -@seealso{mod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("rem", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("rem: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, rem, "rem"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("rem: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xrem (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xrem, "rem"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xrem, "rem"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) -%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) -%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) -%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) - -%!error rem (uint (8), int8 (5)) -%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) -%!error rem () -%!error rem (1, 2, 3) -%!error rem ([1, 2], [3, 4, 5]) -%!error rem (i, 1) -*/ - -/* - -%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) -%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) -%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) -%!assert (size (fmod (1, 2)), [1, 1]) -*/ - -DEFALIAS (fmod, rem) - -DEFUN (mod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ -Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ -\n\ -@example\n\ -x - y .* floor (x ./ y)\n\ -@end example\n\ -\n\ -@noindent\n\ -and is written such that the correct modulus is returned for\n\ -integer types. This function handles negative values correctly. That\n\ -is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ -@code{mod (@var{x}, 0)} returns @var{x}.\n\ -\n\ -An error results if the dimensions of the arguments do not agree, or if\n\ -either of the arguments is complex.\n\ -@seealso{rem}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2) - { - if (! args(0).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(0)); - else if (! args(1).is_numeric_type ()) - gripe_wrong_type_arg ("mod", args(1)); - else if (args(0).is_complex_type () || args(1).is_complex_type ()) - error ("mod: not defined for complex numbers"); - else if (args(0).is_integer_type () || args(1).is_integer_type ()) - { - builtin_type_t btyp0 = args(0).builtin_type (); - builtin_type_t btyp1 = args(1).builtin_type (); - if (btyp0 == btyp_double || btyp0 == btyp_float) - btyp0 = btyp1; - if (btyp1 == btyp_double || btyp1 == btyp_float) - btyp1 = btyp0; - - if (btyp0 == btyp1) - { - switch (btyp0) - { -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - { \ - X##NDArray a0 = args(0).X##_array_value (); \ - X##NDArray a1 = args(1).X##_array_value (); \ - retval = binmap (a0, a1, mod, "mod"); \ - } \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - panic_impossible (); - } - } - else - error ("mod: cannot combine %s and %d", - args(0).class_name ().c_str (), args(1).class_name ().c_str ()); - } - else if (args(0).is_single_type () || args(1).is_single_type ()) - { - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - retval = xmod (args(0).float_value (), args(1).float_value ()); - else - { - FloatNDArray a0 = args(0).float_array_value (); - FloatNDArray a1 = args(1).float_array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - else - { - bool a0_scalar = args(0).is_scalar_type (); - bool a1_scalar = args(1).is_scalar_type (); - if (a0_scalar && a1_scalar) - retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); - else if ((a0_scalar || args(0).is_sparse_type ()) - && (a1_scalar || args(1).is_sparse_type ())) - { - SparseMatrix m0 = args(0).sparse_matrix_value (); - SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap (m0, m1, xmod, "mod"); - } - else - { - NDArray a0 = args(0).array_value (); - NDArray a1 = args(1).array_value (); - retval = binmap (a0, a1, xmod, "mod"); - } - } - } - else - print_usage (); - - return retval; -} - -/* -## empty input test -%!assert (isempty (mod ([], []))) - -## x mod y, y != 0 tests -%!assert (mod (5, 3), 2) -%!assert (mod (-5, 3), 1) -%!assert (mod (0, 3), 0) -%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) -%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) - -## x mod 0 tests -%!assert (mod (5, 0), 5) -%!assert (mod (-5, 0), -5) -%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) -%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) -%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) -%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) - -## mixed scalar/matrix tests -%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) -%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) -%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) -%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) -%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) - -## integer types -%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) -%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) -%!error (mod (uint8 (5), int8 (4))) - -## mixed integer/real types -%!assert (mod (uint8 (5), 4), uint8 (1)) -%!assert (mod (5, uint8 (4)), uint8 (1)) -%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) - -## non-integer real numbers -%!assert (mod (2.1, 0.1), 0) -%!assert (mod (2.1, 0.2), 0.1, eps) -*/ - -// FIXME: Need to convert the reduction functions of this file for single precision - -#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ - (arg.is_ ## TYPE ## _type ()) \ - { \ - TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ - \ - if (! error_state) \ - { \ - retval = tmp.FCN (DIM); \ - } \ - } - -#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - bool isnative = false; \ - bool isdouble = false; \ - \ - if (nargin > 1 && args(nargin - 1).is_string ()) \ - { \ - std::string str = args(nargin - 1).string_value (); \ - \ - if (! error_state) \ - { \ - if (str == "native") \ - isnative = true; \ - else if (str == "double") \ - isdouble = true; \ - else \ - error ("sum: unrecognized string argument"); \ - nargin --; \ - } \ - } \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - if (isnative) \ - { \ - if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ - else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = boolNDArray (tmp.BOOL_FCN (dim)); \ - } \ - else if (arg.is_char_matrix ()) \ - { \ - error (#FCN, ": invalid char type"); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else if (arg.is_bool_type ()) \ - { \ - boolNDArray tmp = arg.bool_array_value (); \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (!isdouble && arg.is_single_type ()) \ - { \ - if (arg.is_real_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - FloatComplexNDArray tmp = \ - arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_real_type ()) \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_complex_type ()) \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - \ - } \ - else \ - print_usage (); \ - \ - return retval - -#define DATA_REDUCTION(FCN) \ - \ - octave_value retval; \ - \ - int nargin = args.length (); \ - \ - if (nargin == 1 || nargin == 2) \ - { \ - octave_value arg = args(0); \ - \ - int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ - \ - if (! error_state) \ - { \ - if (dim >= -1) \ - { \ - if (arg.is_real_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseMatrix tmp = arg.sparse_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatNDArray tmp = arg.float_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - NDArray tmp = arg.array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else if (arg.is_complex_type ()) \ - { \ - if (arg.is_sparse_type ()) \ - { \ - SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else if (arg.is_single_type ()) \ - { \ - FloatComplexNDArray tmp = arg.float_complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - else \ - { \ - ComplexNDArray tmp = arg.complex_array_value (); \ - \ - if (! error_state) \ - retval = tmp.FCN (dim); \ - } \ - } \ - else \ - { \ - gripe_wrong_type_arg (#FCN, arg); \ - return retval; \ - } \ - } \ - else \ - error (#FCN ": invalid dimension argument = %d", dim + 1); \ - } \ - } \ - else \ - print_usage (); \ - \ - return retval - -DEFUN (cumprod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ -Cumulative product of elements along dimension @var{dim}. If\n\ -@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -@seealso{prod, cumsum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (cumprod); -} - -/* -%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) -%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) -%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) -%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) - -%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) -%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) -%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) -%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) - -%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) -%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) - -%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) -%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) - -%!error cumprod () -*/ - -DEFUN (cumsum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ -@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ -Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -See @code{sum} for an explanation of the optional parameters \"native\",\n\ -\"double\", and \"extra\".\n\ -@seealso{sum, cumprod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("cumsum: invalid dimension argument = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - retval = arg.sparse_matrix_value ().cumsum (dim); - else - retval = arg.array_value ().cumsum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - retval = arg.sparse_complex_matrix_value ().cumsum (dim); - else - retval = arg.complex_array_value ().cumsum (dim); - break; - case btyp_float: - if (isdouble) - retval = arg.array_value ().cumsum (dim); - else - retval = arg.float_array_value ().cumsum (dim); - break; - case btyp_float_complex: - if (isdouble) - retval = arg.complex_array_value ().cumsum (dim); - else - retval = arg.float_complex_array_value ().cumsum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().cumsum (dim); \ - else \ - retval = arg.array_value ().cumsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - - case btyp_bool: - if (arg.is_sparse_type ()) - { - SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - else - { - NDArray cs = arg.bool_array_value ().cumsum (dim); - if (isnative) - retval = cs != 0.0; - else - retval = cs; - } - break; - - default: - gripe_wrong_type_arg ("cumsum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) -%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) -%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) -%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) - -%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) -%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) -%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) -%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) - -%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) -%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) - -%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) -%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) - -%!error cumsum () -*/ - -DEFUN (diag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ -@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ -@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ -Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ -second argument is optional. If it is positive, the vector is placed on\n\ -the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ -@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ -vector is placed on the main diagonal. For example:\n\ -\n\ -@example\n\ -@group\n\ -diag ([1, 2, 3], 1)\n\ - @result{} 0 1 0 0\n\ - 0 0 2 0\n\ - 0 0 0 3\n\ - 0 0 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ -diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ -columns.\n\ -\n\ -Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ -@var{k}-th diagonal of the matrix.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).diag (); - else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) - { - octave_idx_type k = args(1).int_value (); - - if (error_state) - error ("diag: invalid argument K"); - else - retval = args(0).diag (k); - } - else if (nargin == 3) - { - octave_value arg0 = args(0); - - if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) - { - octave_idx_type m = args(1).int_value (); - octave_idx_type n = args(2).int_value (); - - if (! error_state) - retval = arg0.diag (m, n); - else - error ("diag: invalid dimensions"); - } - else - error ("diag: V must be a vector"); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) -%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) -%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) -%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) - -%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) -%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) -%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) -%!assert (diag (ones (1, 0), 2), zeros (2)) -%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) - -%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) -%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) -%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) - -%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) -%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) -%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) -%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) - -%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) -%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) - -## Test non-square size -%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) -%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); -%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); -%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); - -%% Test input validation -%!error diag () -%!error diag (1,2,3,4) -%!error diag (ones (2), 3, 3) -%!error diag (1:3, -4, 3) - -%!assert (diag (1, 3, 3), diag ([1, 0, 0])) -%!assert (diag (i, 3, 3), diag ([i, 0, 0])) -%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) -%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) -%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) -%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) -%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) -%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) -*/ - -DEFUN (prod, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} prod (@var{x})\n\ -@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ -Product of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -@seealso{cumprod, sum}\n\ -@end deftypefn") -{ - DATA_REDUCTION (prod); -} - -/* -%!assert (prod ([1, 2, 3]), 6) -%!assert (prod ([-1; -2; -3]), -6) -%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) -%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) - -%!assert (prod (single ([1, 2, 3])), single (6)) -%!assert (prod (single ([-1; -2; -3])), single (-6)) -%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) -%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) - -%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) -%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) -%!assert (prod (zeros (1, 0)), 1) -%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (1, 0), 2), 1) -%!assert (prod (zeros (0, 1)), 1) -%!assert (prod (zeros (0, 1), 1), 1) -%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) -%!assert (prod (zeros (2, 0)), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) -%!assert (prod (zeros (2, 0), 2), [1; 1]) -%!assert (prod (zeros (0, 2)), [1, 1]) -%!assert (prod (zeros (0, 2), 1), [1, 1]) -%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) - -%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) -%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) -%!assert (prod (zeros (1, 0, "single")), single (1)) -%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (1, 0, "single"), 2), single (1)) -%!assert (prod (zeros (0, 1, "single")), single (1)) -%!assert (prod (zeros (0, 1, "single"), 1), single (1)) -%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) -%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) -%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) - -%!error prod () -*/ - -static bool -all_scalar_1x1 (const octave_value_list& args) -{ - int n_args = args.length (); - for (int i = 0; i < n_args; i++) - if (args(i).numel () != 1) - return false; - - return true; -} - -template -static void -single_type_concat (Array& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - if (! (equal_types::value - || equal_types::value) - && all_scalar_1x1 (args)) - { - // Optimize all scalars case. - dim_vector dv (1, 1); - if (dim == -1 || dim == -2) - dim = -dim - 1; - else if (dim >= 2) - dv.resize (dim+1, 1); - dv(dim) = n_args; - - result.clear (dv); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - result(j) = octave_value_extract (args(j)); - } - } - else - { - OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - array_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Array::cat (dim, n_args, array_list); - } -} - -template -static void -single_type_concat (Sparse& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - sparse_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = Sparse::cat (dim, n_args, sparse_list); -} - -// Dispatcher. -template -static TYPE -do_single_type_concat (const octave_value_list& args, int dim) -{ - TYPE result; - - single_type_concat (result, args, dim); - - return result; -} - -template -static void -single_type_concat_map (octave_map& result, - const octave_value_list& args, - int dim) -{ - int n_args = args.length (); - OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); - - for (int j = 0; j < n_args && ! error_state; j++) - { - octave_quit (); - - map_list[j] = octave_value_extract (args(j)); - } - - if (! error_state) - result = octave_map::cat (dim, n_args, map_list); -} - -static octave_map -do_single_type_concat_map (const octave_value_list& args, - int dim) -{ - octave_map result; - if (all_scalar_1x1 (args)) // optimize all scalars case. - single_type_concat_map (result, args, dim); - else - single_type_concat_map (result, args, dim); - - return result; -} - -static octave_value -attempt_type_conversion (const octave_value& ov, std::string dtype) -{ - octave_value retval; - - // First try to find function in the class of OV that can convert to - // the dispatch type dtype. It will have the name of the dispatch - // type. - - std::string cname = ov.class_name (); - - octave_value fcn = symbol_table::find_method (dtype, cname); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("conversion from %s to %s failed", dtype.c_str (), - cname.c_str ()); - } - else - { - // No conversion function available. Try the constructor for the - // dispatch type. - - fcn = symbol_table::find_method (dtype, dtype); - - if (fcn.is_defined ()) - { - octave_value_list result - = fcn.do_multi_index_op (1, octave_value_list (1, ov)); - - if (! error_state && result.length () > 0) - retval = result(0); - else - error ("%s constructor failed for %s argument", dtype.c_str (), - cname.c_str ()); - } - else - error ("no constructor for %s!", dtype.c_str ()); - } - - return retval; -} - -octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) -{ - octave_value retval; - - // Get dominant type for list - - std::string dtype = get_dispatch_type (ovl); - - octave_value fcn = symbol_table::find_method (cattype, dtype); - - if (fcn.is_defined ()) - { - // Have method for dominant type, so call it and let it handle - // conversions. - - octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); - - if (! error_state) - { - if (tmp2.length () > 0) - retval = tmp2(0); - else - { - error ("%s/%s method did not return a value", - dtype.c_str (), cattype.c_str ()); - goto done; - } - } - else - goto done; - } - else - { - // No method for dominant type, so attempt type conversions for - // all elements that are not of the dominant type, then do the - // default operation for octave_class values. - - octave_idx_type j = 0; - octave_idx_type len = ovl.length (); - octave_value_list tmp (len, octave_value ()); - for (octave_idx_type k = 0; k < len; k++) - { - octave_value elt = ovl(k); - - std::string t1_type = elt.class_name (); - - if (t1_type == dtype) - tmp(j++) = elt; - else if (elt.is_object () || ! elt.is_empty ()) - { - tmp(j++) = attempt_type_conversion (elt, dtype); - - if (error_state) - goto done; - } - } - - tmp.resize (j); - - octave_map m = do_single_type_concat_map (tmp, dim); - - std::string cname = tmp(0).class_name (); - std::list parents = tmp(0).parent_class_name_list (); - - retval = octave_value (new octave_class (m, cname, parents)); - } - - done: - return retval; -} - -static octave_value -do_cat (const octave_value_list& xargs, int dim, std::string fname) -{ - octave_value retval; - - // We may need to convert elements of the list to cells, so make a - // copy. This should be efficient, it is done mostly by incrementing - // reference counts. - octave_value_list args = xargs; - - int n_args = args.length (); - - if (n_args == 0) - retval = Matrix (); - else if (n_args == 1) - retval = args(0); - else if (n_args > 1) - { - std::string result_type; - - bool all_sq_strings_p = true; - bool all_dq_strings_p = true; - bool all_real_p = true; - bool all_cmplx_p = true; - bool any_sparse_p = false; - bool any_cell_p = false; - bool any_class_p = false; - - bool first_elem_is_struct = false; - - for (int i = 0; i < n_args; i++) - { - if (i == 0) - { - result_type = args(i).class_name (); - - first_elem_is_struct = args(i).is_map (); - } - else - result_type = get_concat_class (result_type, args(i).class_name ()); - - if (all_sq_strings_p && ! args(i).is_sq_string ()) - all_sq_strings_p = false; - if (all_dq_strings_p && ! args(i).is_dq_string ()) - all_dq_strings_p = false; - if (all_real_p && ! args(i).is_real_type ()) - all_real_p = false; - if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) - all_cmplx_p = false; - if (!any_sparse_p && args(i).is_sparse_type ()) - any_sparse_p = true; - if (!any_cell_p && args(i).is_cell ()) - any_cell_p = true; - if (!any_class_p && args(i).is_object ()) - any_class_p = true; - } - - if (any_cell_p && ! any_class_p && ! first_elem_is_struct) - { - for (int i = 0; i < n_args; i++) - { - if (! args(i).is_cell ()) - args(i) = Cell (args(i)); - } - } - - if (any_class_p) - { - retval = do_class_concat (args, fname, dim); - } - else if (result_type == "double") - { - if (any_sparse_p) - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - } - else if (result_type == "single") - { - if (all_real_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "char") - { - char type = all_dq_strings_p ? '"' : '\''; - - maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); - - charNDArray result = do_single_type_concat (args, dim); - - retval = octave_value (result, type); - } - else if (result_type == "logical") - { - if (any_sparse_p) - retval = do_single_type_concat (args, dim); - else - retval = do_single_type_concat (args, dim); - } - else if (result_type == "int8") - retval = do_single_type_concat (args, dim); - else if (result_type == "int16") - retval = do_single_type_concat (args, dim); - else if (result_type == "int32") - retval = do_single_type_concat (args, dim); - else if (result_type == "int64") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint8") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint16") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint32") - retval = do_single_type_concat (args, dim); - else if (result_type == "uint64") - retval = do_single_type_concat (args, dim); - else if (result_type == "cell") - retval = do_single_type_concat (args, dim); - else if (result_type == "struct") - retval = do_single_type_concat_map (args, dim); - else - { - dim_vector dv = args(0).dims (); - - // Default concatenation. - bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; - - if (dim == -1 || dim == -2) - { - concat_rule = &dim_vector::hvcat; - dim = -dim - 1; - } - - for (int i = 1; i < args.length (); i++) - { - if (! (dv.*concat_rule) (args(i).dims (), dim)) - { - // Dimensions do not match. - error ("cat: dimension mismatch"); - return retval; - } - } - - // The lines below might seem crazy, since we take a copy - // of the first argument, resize it to be empty and then resize - // it to be full. This is done since it means that there is no - // recopying of data, as would happen if we used a single resize. - // It should be noted that resize operation is also significantly - // slower than the do_cat_op function, so it makes sense to have - // an empty matrix and copy all data. - // - // We might also start with a empty octave_value using - // tmp = octave_value_typeinfo::lookup_type - // (args(1).type_name()); - // and then directly resize. However, for some types there might - // be some additional setup needed, and so this should be avoided. - - octave_value tmp = args (0); - tmp = tmp.resize (dim_vector (0,0)).resize (dv); - - if (error_state) - return retval; - - int dv_len = dv.length (); - Array ra_idx (dim_vector (dv_len, 1), 0); - - for (int j = 0; j < n_args; j++) - { - // Can't fast return here to skip empty matrices as something - // like cat (1,[],single ([])) must return an empty matrix of - // the right type. - tmp = do_cat_op (tmp, args (j), ra_idx); - - if (error_state) - return retval; - - dim_vector dv_tmp = args (j).dims (); - - if (dim >= dv_len) - { - if (j > 1) - error ("%s: indexing error", fname.c_str ()); - break; - } - else - ra_idx (dim) += (dim < dv_tmp.length () ? - dv_tmp (dim) : 1); - } - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (horzcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the horizontal concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ -\n\ -Arrays may also be concatenated horizontally using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ -@end example\n\ -@seealso{cat, vertcat}\n\ -@end deftypefn") -{ - return do_cat (args, -2, "horzcat"); -} - -/* -## Test concatenation with all zero matrices -%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); -%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); - -%!assert (class (horzcat (int64 (1), int64 (1))), "int64") -%!assert (class (horzcat (int64 (1), int32 (1))), "int64") -%!assert (class (horzcat (int64 (1), int16 (1))), "int64") -%!assert (class (horzcat (int64 (1), int8 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") -%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") -%!assert (class (horzcat (int64 (1), single (1))), "int64") -%!assert (class (horzcat (int64 (1), double (1))), "int64") -%!assert (class (horzcat (int64 (1), cell (1))), "cell") -%!assert (class (horzcat (int64 (1), true)), "int64") -%!assert (class (horzcat (int64 (1), "a")), "char") - -%!assert (class (horzcat (int32 (1), int64 (1))), "int32") -%!assert (class (horzcat (int32 (1), int32 (1))), "int32") -%!assert (class (horzcat (int32 (1), int16 (1))), "int32") -%!assert (class (horzcat (int32 (1), int8 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") -%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") -%!assert (class (horzcat (int32 (1), single (1))), "int32") -%!assert (class (horzcat (int32 (1), double (1))), "int32") -%!assert (class (horzcat (int32 (1), cell (1))), "cell") -%!assert (class (horzcat (int32 (1), true)), "int32") -%!assert (class (horzcat (int32 (1), "a")), "char") - -%!assert (class (horzcat (int16 (1), int64 (1))), "int16") -%!assert (class (horzcat (int16 (1), int32 (1))), "int16") -%!assert (class (horzcat (int16 (1), int16 (1))), "int16") -%!assert (class (horzcat (int16 (1), int8 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") -%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") -%!assert (class (horzcat (int16 (1), single (1))), "int16") -%!assert (class (horzcat (int16 (1), double (1))), "int16") -%!assert (class (horzcat (int16 (1), cell (1))), "cell") -%!assert (class (horzcat (int16 (1), true)), "int16") -%!assert (class (horzcat (int16 (1), "a")), "char") - -%!assert (class (horzcat (int8 (1), int64 (1))), "int8") -%!assert (class (horzcat (int8 (1), int32 (1))), "int8") -%!assert (class (horzcat (int8 (1), int16 (1))), "int8") -%!assert (class (horzcat (int8 (1), int8 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") -%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") -%!assert (class (horzcat (int8 (1), single (1))), "int8") -%!assert (class (horzcat (int8 (1), double (1))), "int8") -%!assert (class (horzcat (int8 (1), cell (1))), "cell") -%!assert (class (horzcat (int8 (1), true)), "int8") -%!assert (class (horzcat (int8 (1), "a")), "char") - -%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") -%!assert (class (horzcat (uint64 (1), single (1))), "uint64") -%!assert (class (horzcat (uint64 (1), double (1))), "uint64") -%!assert (class (horzcat (uint64 (1), cell (1))), "cell") -%!assert (class (horzcat (uint64 (1), true)), "uint64") -%!assert (class (horzcat (uint64 (1), "a")), "char") - -%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") -%!assert (class (horzcat (uint32 (1), single (1))), "uint32") -%!assert (class (horzcat (uint32 (1), double (1))), "uint32") -%!assert (class (horzcat (uint32 (1), cell (1))), "cell") -%!assert (class (horzcat (uint32 (1), true)), "uint32") -%!assert (class (horzcat (uint32 (1), "a")), "char") - -%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") -%!assert (class (horzcat (uint16 (1), single (1))), "uint16") -%!assert (class (horzcat (uint16 (1), double (1))), "uint16") -%!assert (class (horzcat (uint16 (1), cell (1))), "cell") -%!assert (class (horzcat (uint16 (1), true)), "uint16") -%!assert (class (horzcat (uint16 (1), "a")), "char") - -%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") -%!assert (class (horzcat (uint8 (1), single (1))), "uint8") -%!assert (class (horzcat (uint8 (1), double (1))), "uint8") -%!assert (class (horzcat (uint8 (1), cell (1))), "cell") -%!assert (class (horzcat (uint8 (1), true)), "uint8") -%!assert (class (horzcat (uint8 (1), "a")), "char") - -%!assert (class (horzcat (single (1), int64 (1))), "int64") -%!assert (class (horzcat (single (1), int32 (1))), "int32") -%!assert (class (horzcat (single (1), int16 (1))), "int16") -%!assert (class (horzcat (single (1), int8 (1))), "int8") -%!assert (class (horzcat (single (1), uint64 (1))), "uint64") -%!assert (class (horzcat (single (1), uint32 (1))), "uint32") -%!assert (class (horzcat (single (1), uint16 (1))), "uint16") -%!assert (class (horzcat (single (1), uint8 (1))), "uint8") -%!assert (class (horzcat (single (1), single (1))), "single") -%!assert (class (horzcat (single (1), double (1))), "single") -%!assert (class (horzcat (single (1), cell (1))), "cell") -%!assert (class (horzcat (single (1), true)), "single") -%!assert (class (horzcat (single (1), "a")), "char") - -%!assert (class (horzcat (double (1), int64 (1))), "int64") -%!assert (class (horzcat (double (1), int32 (1))), "int32") -%!assert (class (horzcat (double (1), int16 (1))), "int16") -%!assert (class (horzcat (double (1), int8 (1))), "int8") -%!assert (class (horzcat (double (1), uint64 (1))), "uint64") -%!assert (class (horzcat (double (1), uint32 (1))), "uint32") -%!assert (class (horzcat (double (1), uint16 (1))), "uint16") -%!assert (class (horzcat (double (1), uint8 (1))), "uint8") -%!assert (class (horzcat (double (1), single (1))), "single") -%!assert (class (horzcat (double (1), double (1))), "double") -%!assert (class (horzcat (double (1), cell (1))), "cell") -%!assert (class (horzcat (double (1), true)), "double") -%!assert (class (horzcat (double (1), "a")), "char") - -%!assert (class (horzcat (cell (1), int64 (1))), "cell") -%!assert (class (horzcat (cell (1), int32 (1))), "cell") -%!assert (class (horzcat (cell (1), int16 (1))), "cell") -%!assert (class (horzcat (cell (1), int8 (1))), "cell") -%!assert (class (horzcat (cell (1), uint64 (1))), "cell") -%!assert (class (horzcat (cell (1), uint32 (1))), "cell") -%!assert (class (horzcat (cell (1), uint16 (1))), "cell") -%!assert (class (horzcat (cell (1), uint8 (1))), "cell") -%!assert (class (horzcat (cell (1), single (1))), "cell") -%!assert (class (horzcat (cell (1), double (1))), "cell") -%!assert (class (horzcat (cell (1), cell (1))), "cell") -%!assert (class (horzcat (cell (1), true)), "cell") -%!assert (class (horzcat (cell (1), "a")), "cell") - -%!assert (class (horzcat (true, int64 (1))), "int64") -%!assert (class (horzcat (true, int32 (1))), "int32") -%!assert (class (horzcat (true, int16 (1))), "int16") -%!assert (class (horzcat (true, int8 (1))), "int8") -%!assert (class (horzcat (true, uint64 (1))), "uint64") -%!assert (class (horzcat (true, uint32 (1))), "uint32") -%!assert (class (horzcat (true, uint16 (1))), "uint16") -%!assert (class (horzcat (true, uint8 (1))), "uint8") -%!assert (class (horzcat (true, single (1))), "single") -%!assert (class (horzcat (true, double (1))), "double") -%!assert (class (horzcat (true, cell (1))), "cell") -%!assert (class (horzcat (true, true)), "logical") -%!assert (class (horzcat (true, "a")), "char") - -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", int64 (1))), "char") -%!assert (class (horzcat ("a", int32 (1))), "char") -%!assert (class (horzcat ("a", int16 (1))), "char") -%!assert (class (horzcat ("a", int8 (1))), "char") -%!assert (class (horzcat ("a", single (1))), "char") -%!assert (class (horzcat ("a", double (1))), "char") -%!assert (class (horzcat ("a", cell (1))), "cell") -%!assert (class (horzcat ("a", true)), "char") -%!assert (class (horzcat ("a", "a")), "char") - -%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") - -%!error horzcat (struct ("foo", "bar"), cell (1)) -*/ - -DEFUN (vertcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the vertical concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ -\n\ -Arrays may also be concatenated vertically using the syntax for creating\n\ -new matrices. For example:\n\ -\n\ -@example\n\ -@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ -@end example\n\ -@seealso{cat, horzcat}\n\ -@end deftypefn") -{ - return do_cat (args, -1, "vertcat"); -} - -/* -%!test -%! c = {"foo"; "bar"; "bazoloa"}; -%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); -*/ - -DEFUN (cat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ -Return the concatenation of N-D array objects, @var{array1},\n\ -@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ -\n\ -@example\n\ -@group\n\ -A = ones (2, 2);\n\ -B = zeros (2, 2);\n\ -cat (2, A, B)\n\ - @result{} 1 1 0 0\n\ - 1 1 0 0\n\ -@end group\n\ -@end example\n\ -\n\ -Alternatively, we can concatenate @var{A} and @var{B} along the\n\ -second dimension in the following way:\n\ -\n\ -@example\n\ -@group\n\ -[A, B]\n\ -@end group\n\ -@end example\n\ -\n\ -@var{dim} can be larger than the dimensions of the N-D array objects\n\ -and the result will thus have @var{dim} dimensions as the\n\ -following example shows:\n\ -\n\ -@example\n\ -@group\n\ -cat (4, ones (2, 2), zeros (2, 2))\n\ - @result{} ans(:,:,1,1) =\n\ -\n\ - 1 1\n\ - 1 1\n\ -\n\ - ans(:,:,1,2) =\n\ -\n\ - 0 0\n\ - 0 0\n\ -@end group\n\ -@end example\n\ -@seealso{horzcat, vertcat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () > 0) - { - int dim = args(0).int_value () - 1; - - if (! error_state) - { - if (dim >= 0) - retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); - else - error ("cat: DIM must be a valid dimension"); - } - else - error ("cat: DIM must be an integer"); - } - else - print_usage (); - - return retval; -} - -/* -%!function ret = __testcat (t1, t2, tr, cmplx) -%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); -%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); -%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); -%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); -%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); -%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); -%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); -%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); -%! -%! if (nargin == 3 || cmplx) -%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); -%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); -%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); -%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); -%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); -%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); -%! -%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); -%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); -%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); -%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); -%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); -%! -%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); -%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); -%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); -%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); -%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); -%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); -%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); -%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); -%! -%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); -%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); -%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); -%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); -%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); -%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); -%! -%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); -%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); -%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); -%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); -%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); -%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); -%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); -%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); -%! endif -%! ret = true; -%!endfunction - -%!assert (__testcat ("double", "double", "double")) -%!assert (__testcat ("single", "double", "single")) -%!assert (__testcat ("double", "single", "single")) -%!assert (__testcat ("single", "single", "single")) - -%!assert (__testcat ("double", "int8", "int8", false)) -%!assert (__testcat ("int8", "double", "int8", false)) -%!assert (__testcat ("single", "int8", "int8", false)) -%!assert (__testcat ("int8", "single", "int8", false)) -%!assert (__testcat ("int8", "int8", "int8", false)) -%!assert (__testcat ("double", "int16", "int16", false)) -%!assert (__testcat ("int16", "double", "int16", false)) -%!assert (__testcat ("single", "int16", "int16", false)) -%!assert (__testcat ("int16", "single", "int16", false)) -%!assert (__testcat ("int16", "int16", "int16", false)) -%!assert (__testcat ("double", "int32", "int32", false)) -%!assert (__testcat ("int32", "double", "int32", false)) -%!assert (__testcat ("single", "int32", "int32", false)) -%!assert (__testcat ("int32", "single", "int32", false)) -%!assert (__testcat ("int32", "int32", "int32", false)) -%!assert (__testcat ("double", "int64", "int64", false)) -%!assert (__testcat ("int64", "double", "int64", false)) -%!assert (__testcat ("single", "int64", "int64", false)) -%!assert (__testcat ("int64", "single", "int64", false)) -%!assert (__testcat ("int64", "int64", "int64", false)) - -%!assert (__testcat ("double", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "double", "uint8", false)) -%!assert (__testcat ("single", "uint8", "uint8", false)) -%!assert (__testcat ("uint8", "single", "uint8", false)) -%!assert (__testcat ("uint8", "uint8", "uint8", false)) -%!assert (__testcat ("double", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "double", "uint16", false)) -%!assert (__testcat ("single", "uint16", "uint16", false)) -%!assert (__testcat ("uint16", "single", "uint16", false)) -%!assert (__testcat ("uint16", "uint16", "uint16", false)) -%!assert (__testcat ("double", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "double", "uint32", false)) -%!assert (__testcat ("single", "uint32", "uint32", false)) -%!assert (__testcat ("uint32", "single", "uint32", false)) -%!assert (__testcat ("uint32", "uint32", "uint32", false)) -%!assert (__testcat ("double", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "double", "uint64", false)) -%!assert (__testcat ("single", "uint64", "uint64", false)) -%!assert (__testcat ("uint64", "single", "uint64", false)) -%!assert (__testcat ("uint64", "uint64", "uint64", false)) - -%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) -%!assert (cat (3, [], [], []), zeros (0, 0, 3)) - -%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) -%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) -%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) - -%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) -%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) - -%!error cat (3, cat (3, [], []), [1,2;3,4]) -%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) -*/ - -static octave_value -do_permute (const octave_value_list& args, bool inv) -{ - octave_value retval; - - if (args.length () == 2 && args(1).length () >= args(1).ndims ()) - { - Array vec = args(1).int_vector_value (); - - // FIXME -- maybe we should create an idx_vector object - // here and pass that to permute? - - int n = vec.length (); - - for (int i = 0; i < n; i++) - vec(i)--; - - octave_value ret = args(0).permute (vec, inv); - - if (! error_state) - retval = ret; - } - else - print_usage (); - - return retval; -} - -DEFUN (permute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ -Return the generalized transpose for an N-D array object @var{A}.\n\ -The permutation vector @var{perm} must contain the elements\n\ -@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ -@seealso{ipermute}\n\ -@end deftypefn") -{ - return do_permute (args, false); -} - -DEFUN (ipermute, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ -The inverse of the @code{permute} function. The expression\n\ -\n\ -@example\n\ -ipermute (permute (A, perm), perm)\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the original array @var{A}.\n\ -@seealso{permute}\n\ -@end deftypefn") -{ - return do_permute (args, true); -} - -DEFUN (length, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} length (@var{a})\n\ -Return the \"length\" of the object @var{a}. For matrix objects, the\n\ -length is the number of rows or columns, whichever is greater (this\n\ -odd definition is used for compatibility with @sc{matlab}).\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).length (); - else - print_usage (); - - return retval; -} - -DEFUN (ndims, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ndims (@var{a})\n\ -Return the number of dimensions of @var{a}.\n\ -For any array, the result will always be larger than or equal to 2.\n\ -Trailing singleton dimensions are not counted.\n\ -\n\ -@example\n\ -@group\n\ -ndims (ones (4, 1, 2, 1))\n\ - @result{} 3\n\ -@end group\n\ -@end example\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).ndims (); - else - print_usage (); - - return retval; -} - -DEFUN (numel, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} numel (@var{a})\n\ -@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ -Return the number of elements in the object @var{a}.\n\ -Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ -return the number of elements that would result from the indexing\n\ -\n\ -@example\n\ -@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ -@end example\n\ -\n\ -Note that the indices do not have to be numerical. For example,\n\ -\n\ -@example\n\ -@group\n\ -@var{a} = 1;\n\ -@var{b} = ones (2, 3);\n\ -numel (@var{a}, @var{b})\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will return 6, as this is the number of ways to index with @var{b}.\n\ -\n\ -This method is also called when an object appears as lvalue with cs-list\n\ -indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ -@seealso{size}\n\ -@end deftypefn") -{ - octave_value retval; - octave_idx_type nargin = args.length (); - - if (nargin == 1) - retval = args(0).numel (); - else if (nargin > 1) - { - // Don't use numel (const octave_value_list&) here as that corresponds to - // an overloaded call, not to builtin! - retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); - } - else - print_usage (); - - return retval; -} - -DEFUN (size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size (@var{a})\n\ -@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ -Return the number of rows and columns of @var{a}.\n\ -\n\ -With one input argument and one output argument, the result is returned\n\ -in a row vector. If there are multiple output arguments, the number of\n\ -rows is assigned to the first, and the number of columns to the second,\n\ -etc. For example:\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6])\n\ - @result{} [ 3, 2 ]\n\ -\n\ -[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ - @result{} nr = 3\n\ - @result{} nc = 2\n\ -@end group\n\ -@end example\n\ -\n\ -If given a second argument, @code{size} will return the size of the\n\ -corresponding dimension. For example,\n\ -\n\ -@example\n\ -@group\n\ -size ([1, 2; 3, 4; 5, 6], 2)\n\ - @result{} 2\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the number of columns in the given matrix.\n\ -@seealso{numel, ndims, length, rows, columns}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1) - { - const dim_vector dimensions = args(0).dims (); - - if (nargout > 1) - { - const dim_vector rdims = dimensions.redim (nargout); - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rdims(i); - } - else - { - int ndims = dimensions.length (); - - NoAlias m (1, ndims); - - for (int i = 0; i < ndims; i++) - m(i) = dimensions(i); - - retval(0) = m; - } - } - else if (nargin == 2 && nargout < 2) - { - octave_idx_type nd = args(1).int_value (true); - - if (error_state) - error ("size: DIM must be a scalar"); - else - { - const dim_vector dv = args(0).dims (); - - if (nd > 0) - { - if (nd <= dv.length ()) - retval(0) = dv(nd-1); - else - retval(0) = 1; - } - else - error ("size: requested dimension DIM (= %d) out of range", nd); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (size_equal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ -Return true if the dimensions of all arguments agree.\n\ -Trailing singleton dimensions are ignored.\n\ -Called with a single or no argument, size_equal returns true.\n\ -@seealso{size, numel, ndims}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - retval = true; - - if (nargin >= 1) - { - dim_vector a_dims = args(0).dims (); - - for (int i = 1; i < nargin; ++i) - { - dim_vector b_dims = args(i).dims (); - - if (a_dims != b_dims) - { - retval = false; - break; - } - } - } - - return retval; -} - -DEFUN (nnz, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ -Return the number of non zero elements in @var{a}.\n\ -@seealso{sparse, nzmax}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nnz (); - else - print_usage (); - - return retval; -} - -DEFUN (nzmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ -Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ -Note that Octave tends to crop unused memory at the first opportunity\n\ -for sparse objects. There are some cases of user created sparse objects\n\ -where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ -but in general they will give the same result.\n\ -@seealso{nnz, spalloc, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).nzmax (); - else - print_usage (); - - return retval; -} - -DEFUN (rows, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rows (@var{a})\n\ -Return the number of rows of @var{a}.\n\ -@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).rows (); - else - print_usage (); - - return retval; -} - -DEFUN (columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} columns (@var{a})\n\ -Return the number of columns of @var{a}.\n\ -@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).columns (); - else - print_usage (); - - return retval; -} - -DEFUN (sum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sum (@var{x})\n\ -@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ -@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ -Sum of elements along dimension @var{dim}. If @var{dim} is\n\ -omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -If the optional argument \"native\" is given, then the sum is performed\n\ -in the same type as the original argument, rather than in the default\n\ -double type. For example:\n\ -\n\ -@example\n\ -@group\n\ -sum ([true, true])\n\ - @result{} 2\n\ -sum ([true, true], \"native\")\n\ - @result{} true\n\ -@end group\n\ -@end example\n\ -\n\ -On the contrary, if \"double\" is given, the sum is performed in double\n\ -precision even for single precision inputs.\n\ -\n\ -For double precision inputs, \"extra\" indicates that a more accurate\n\ -algorithm than straightforward summation is to be used. For single precision\n\ -inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ -effect.\n\ -@seealso{cumsum, sumsq, prod}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - bool isnative = false; - bool isdouble = false; - bool isextra = false; - - if (nargin > 1 && args(nargin - 1).is_string ()) - { - std::string str = args(nargin - 1).string_value (); - - if (! error_state) - { - if (str == "native") - isnative = true; - else if (str == "double") - isdouble = true; - else if (str == "extra") - isextra = true; - else - error ("sum: unrecognized string argument"); - nargin --; - } - } - - if (error_state) - return retval; - - if (nargin == 1 || nargin == 2) - { - octave_value arg = args(0); - - int dim = -1; - if (nargin == 2) - { - dim = args(1).int_value () - 1; - if (dim < 0) - error ("sum: invalid dimension DIM = %d", dim + 1); - } - - if (! error_state) - { - switch (arg.builtin_type ()) - { - case btyp_double: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.array_value ().xsum (dim); - else - retval = arg.array_value ().sum (dim); - break; - case btyp_complex: - if (arg.is_sparse_type ()) - { - if (isextra) - warning ("sum: 'extra' not yet implemented for sparse matrices"); - retval = arg.sparse_complex_matrix_value ().sum (dim); - } - else if (isextra) - retval = arg.complex_array_value ().xsum (dim); - else - retval = arg.complex_array_value ().sum (dim); - break; - case btyp_float: - if (isdouble || isextra) - retval = arg.float_array_value ().dsum (dim); - else - retval = arg.float_array_value ().sum (dim); - break; - case btyp_float_complex: - if (isdouble || isextra) - retval = arg.float_complex_array_value ().dsum (dim); - else - retval = arg.float_complex_array_value ().sum (dim); - break; - -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - if (isnative) \ - retval = arg.X ## _array_value ().sum (dim); \ - else \ - retval = arg.X ## _array_value ().dsum (dim); \ - break - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - - case btyp_bool: - if (arg.is_sparse_type ()) - { - if (isnative) - retval = arg.sparse_bool_matrix_value ().any (dim); - else - retval = arg.sparse_bool_matrix_value ().sum (dim); - } - else if (isnative) - retval = arg.bool_array_value ().any (dim); - else - retval = arg.bool_array_value ().sum (dim); - break; - - default: - gripe_wrong_type_arg ("sum", arg); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (sum ([true,true]), 2) -%!assert (sum ([true,true],"native"), true) -%!assert (sum (int8 ([127,10,-20])), 117) -%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) - -%!assert (sum ([1, 2, 3]), 6) -%!assert (sum ([-1; -2; -3]), -6) -%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) -%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) - -%!assert (sum (single ([1, 2, 3])), single (6)) -%!assert (sum (single ([-1; -2; -3])), single (-6)) -%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) -%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) - -%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) -%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) -%!assert (sum (zeros (1, 0)), 0) -%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (1, 0), 2), 0) -%!assert (sum (zeros (0, 1)), 0) -%!assert (sum (zeros (0, 1), 1), 0) -%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 0)), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) -%!assert (sum (zeros (2, 0), 2), [0; 0]) -%!assert (sum (zeros (0, 2)), [0, 0]) -%!assert (sum (zeros (0, 2), 1), [0, 0]) -%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) -%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) -%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) -%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) - -%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) -%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) -%!assert (sum (zeros (1, 0, "single")), single (0)) -%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (1, 0, "single"), 2), single (0)) -%!assert (sum (zeros (0, 1, "single")), single (0)) -%!assert (sum (zeros (0, 1, "single"), 1), single (0)) -%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) -%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) -%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) -%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) -%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) - -%!error sum () -*/ - -DEFUN (sumsq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ -@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ -Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ -is omitted, it defaults to the first non-singleton dimension.\n\ -\n\ -This function is conceptually equivalent to computing\n\ -\n\ -@example\n\ -sum (x .* conj (x), dim)\n\ -@end example\n\ -\n\ -@noindent\n\ -but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ -@seealso{sum, prod}\n\ -@end deftypefn") -{ - DATA_REDUCTION (sumsq); -} - -/* -%!assert (sumsq ([1, 2, 3]), 14) -%!assert (sumsq ([-1; -2; 4i]), 21) -%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) - -%!assert (sumsq (single ([1, 2, 3])), single (14)) -%!assert (sumsq (single ([-1; -2; 4i])), single (21)) -%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) - -%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) -%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) - -%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) -%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) - -%!error sumsq () -*/ - -DEFUN (islogical, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} islogical (@var{x})\n\ -@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ -Return true if @var{x} is a logical object.\n\ -@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_bool_type (); - else - print_usage (); - - return retval; -} - -DEFALIAS (isbool, islogical); - -/* -%!assert (islogical (true), true) -%!assert (islogical (false), true) -%!assert (islogical ([true, false]), true) -%!assert (islogical (1), false) -%!assert (islogical (1i), false) -%!assert (islogical ([1,1]), false) -%!assert (islogical (single (1)), false) -%!assert (islogical (single (1i)), false) -%!assert (islogical (single ([1,1])), false) -%!assert (islogical (sparse ([true, false])), true) -%!assert (islogical (sparse ([1, 0])), false) -*/ - -DEFUN (isinteger, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ -Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ -Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ -Octave are double precision floating point values.\n\ -@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_integer_type (); - else - print_usage (); - - return retval; -} - -DEFUN (iscomplex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ -Return true if @var{x} is a complex-valued numeric object.\n\ -@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_complex_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isfloat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ -Return true if @var{x} is a floating-point numeric object.\n\ -Objects of class double or single are floating-point objects.\n\ -@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_float_type (); - else - print_usage (); - - return retval; -} - -// FIXME -- perhaps this should be implemented with an -// octave_value member function? - -DEFUN (complex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} complex (@var{x})\n\ -@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ -Return a complex result from real arguments. With 1 real argument @var{x},\n\ -return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ -return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ -often be more convenient than expressions such as @code{a + i*b}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -complex ([1, 2], [3, 4])\n\ - @result{} [ 1 + 3i 2 + 4i ]\n\ -@end group\n\ -@end example\n\ -@seealso{real, imag, iscomplex, abs, arg}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_complex_type ()) - retval = arg; - else - { - if (arg.is_sparse_type ()) - { - SparseComplexMatrix val = arg.sparse_complex_matrix_value (); - - if (! error_state) - retval = octave_value (new octave_sparse_complex_matrix (val)); - } - else if (arg.is_single_type ()) - { - if (arg.numel () == 1) - { - FloatComplex val = arg.float_complex_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (val)); - } - else - { - FloatComplexNDArray val = arg.float_complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex_matrix (val)); - } - } - else - { - if (arg.numel () == 1) - { - Complex val = arg.complex_value (); - - if (! error_state) - retval = octave_value (new octave_complex (val)); - } - else - { - ComplexNDArray val = arg.complex_array_value (); - - if (! error_state) - retval = octave_value (new octave_complex_matrix (val)); - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - } - else if (nargin == 2) - { - octave_value re = args(0); - octave_value im = args(1); - - if (re.is_sparse_type () && im.is_sparse_type ()) - { - const SparseMatrix re_val = re.sparse_matrix_value (); - const SparseMatrix im_val = im.sparse_matrix_value (); - - if (!error_state) - { - if (re.numel () == 1) - { - SparseComplexMatrix result; - if (re_val.nnz () == 0) - result = Complex (0, 1) * SparseComplexMatrix (im_val); - else - { - result = SparseComplexMatrix (im_val.dims (), re_val (0)); - octave_idx_type nr = im_val.rows (); - octave_idx_type nc = im_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = im_val.cidx (j); - i < im_val.cidx (j + 1); i++) - result.data (im_val.ridx (i) + off) = - result.data (im_val.ridx (i) + off) + - Complex (0, im_val.data (i)); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else if (im.numel () == 1) - { - SparseComplexMatrix result; - if (im_val.nnz () == 0) - result = SparseComplexMatrix (re_val); - else - { - result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); - octave_idx_type nr = re_val.rows (); - octave_idx_type nc = re_val.cols (); - - for (octave_idx_type j = 0; j < nc; j++) - { - octave_idx_type off = j * nr; - for (octave_idx_type i = re_val.cidx (j); - i < re_val.cidx (j + 1); i++) - result.data (re_val.ridx (i) + off) = - result.data (re_val.ridx (i) + off) + - re_val.data (i); - } - } - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - { - if (re_val.dims () == im_val.dims ()) - { - SparseComplexMatrix result = SparseComplexMatrix (re_val) - + Complex (0, 1) * SparseComplexMatrix (im_val); - retval = octave_value (new octave_sparse_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - else if (re.is_single_type () || im.is_single_type ()) - { - if (re.numel () == 1) - { - float re_val = re.float_value (); - - if (im.numel () == 1) - { - float im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - FloatComplexNDArray result (im_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val, im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - } - else - { - const FloatNDArray re_val = re.float_array_value (); - - if (im.numel () == 1) - { - float im_val = im.float_value (); - - if (! error_state) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - } - else - { - const FloatNDArray im_val = im.float_array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - FloatComplexNDArray result (re_val.dims (), FloatComplex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = FloatComplex (re_val(i), im_val(i)); - - retval = octave_value (new octave_float_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - } - else if (re.numel () == 1) - { - double re_val = re.double_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - retval = octave_value (new octave_complex (Complex (re_val, im_val))); - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - ComplexNDArray result (im_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < im_val.numel (); i++) - result.xelem (i) = Complex (re_val, im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - } - else - { - const NDArray re_val = re.array_value (); - - if (im.numel () == 1) - { - double im_val = im.double_value (); - - if (! error_state) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val); - - retval = octave_value (new octave_complex_matrix (result)); - } - } - else - { - const NDArray im_val = im.array_value (); - - if (! error_state) - { - if (re_val.dims () == im_val.dims ()) - { - ComplexNDArray result (re_val.dims (), Complex ()); - - for (octave_idx_type i = 0; i < re_val.numel (); i++) - result.xelem (i) = Complex (re_val(i), im_val(i)); - - retval = octave_value (new octave_complex_matrix (result)); - } - else - error ("complex: dimension mismatch"); - } - } - } - - if (error_state) - error ("complex: invalid conversion"); - } - else - print_usage (); - - return retval; -} - -DEFUN (isreal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isreal (@var{x})\n\ -Return true if @var{x} is a non-complex matrix or scalar.\n\ -For compatibility with @sc{matlab}, this includes logical and character\n\ -matrices.\n\ -@seealso{iscomplex, isnumeric, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_real_type (); - else - print_usage (); - - return retval; -} - -DEFUN (isempty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isempty (@var{a})\n\ -Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ -zero). Otherwise, return false.\n\ -@seealso{isnull, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = args(0).is_empty (); - else - print_usage (); - - return retval; -} - -DEFUN (isnumeric, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ -Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ -complex array. Logical and character arrays are not considered to be\n\ -numeric.\n\ -@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).is_numeric_type (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (1), true) -%!assert (isnumeric (1i), true) -%!assert (isnumeric ([1,1]), true) -%!assert (isnumeric (single (1)), true) -%!assert (isnumeric (single (1i)), true) -%!assert (isnumeric (single ([1,1])), true) -%!assert (isnumeric (int8 (1)), true) -%!assert (isnumeric (uint8 ([1,1])), true) -%!assert (isnumeric ("Hello World"), false) -%!assert (isnumeric (true), false) -%!assert (isnumeric (false), false) -%!assert (isnumeric ([true, false]), false) -%!assert (isnumeric (sparse ([true, false])), false) -*/ - -DEFUN (ismatrix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ -Return true if @var{a} is a numeric, logical, or character matrix.\n\ -Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ -are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ -will return true for these objects as well.\n\ -@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - octave_value arg = args(0); - - retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (ismatrix ([])) -%!assert (ismatrix (1)) -%!assert (ismatrix ([1, 2, 3])) -%!assert (ismatrix ([1, 2; 3, 4])) -%!assert (ismatrix (zeros (3, 2, 4))) - -%!assert (ismatrix (single ([]))) -%!assert (ismatrix (single (1))) -%!assert (ismatrix (single ([1, 2, 3]))) -%!assert (ismatrix (single ([1, 2; 3, 4]))) - -%!assert (ismatrix ("t")) -%!assert (ismatrix ("test")) -%!assert (ismatrix (["test"; "ing"])) - -%!test -%! s.a = 1; -%! assert (ismatrix (s), false); - -%!error ismatrix () -%!error ismatrix ([1, 2; 3, 4], 2) -*/ - -static octave_value -fill_matrix (const octave_value_list& args, int val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // FIXME -- perhaps this should be made extensible by - // using the class name to lookup a function to call to create - // the new value. - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = int8NDArray (dims, val); - break; - - case oct_data_conv::dt_uint8: - retval = uint8NDArray (dims, val); - break; - - case oct_data_conv::dt_int16: - retval = int16NDArray (dims, val); - break; - - case oct_data_conv::dt_uint16: - retval = uint16NDArray (dims, val); - break; - - case oct_data_conv::dt_int32: - retval = int32NDArray (dims, val); - break; - - case oct_data_conv::dt_uint32: - retval = uint32NDArray (dims, val); - break; - - case oct_data_conv::dt_int64: - retval = int64NDArray (dims, val); - break; - - case oct_data_conv::dt_uint64: - retval = uint64NDArray (dims, val); - break; - - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, val); - break; - - case oct_data_conv::dt_double: - { - if (val == 1 && dims.length () == 2 && dims (0) == 1) - retval = Range (1.0, 0.0, dims (1)); // packed form - else - retval = NDArray (dims, val); - } - break; - - case oct_data_conv::dt_logical: - retval = boolNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, float fval, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, fval); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, double val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = NDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, const Complex& val, - const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - dim_vector dims (1, 1); - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_single: - retval = FloatComplexNDArray (dims, static_cast (val)); - break; - - case oct_data_conv::dt_double: - retval = ComplexNDArray (dims, val); - break; - - default: - error ("%s: invalid class name", fcn); - break; - } - } - } - - return retval; -} - -static octave_value -fill_matrix (const octave_value_list& args, bool val, const char *fcn) -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector dims (1, 1); - - switch (nargin) - { - case 0: - break; - - case 1: - get_dimensions (args(0), fcn, dims); - break; - - default: - { - dims.resize (nargin); - - for (int i = 0; i < nargin; i++) - { - dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); - - if (error_state) - { - error ("%s: expecting scalar integer arguments", fcn); - break; - } - } - } - break; - } - - if (! error_state) - { - dims.chop_trailing_singletons (); - - check_dimensions (dims, fcn); - - // Note that automatic narrowing will handle conversion from - // NDArray to scalar. - - if (! error_state) - retval = boolNDArray (dims, val); - } - - return retval; -} - -DEFUN (ones, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ones (@var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 1.\n\ -If invoked with a single scalar integer argument @var{n}, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -If you need to create a matrix whose values are all the same, you should\n\ -use an expression like\n\ -\n\ -@example\n\ -val_matrix = val * ones (m, n)\n\ -@end example\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = ones (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{zeros}\n\ -@end deftypefn") -{ - return fill_matrix (args, 1, "ones"); -} - -/* -%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) -%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) -%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) -%!assert (size (ones (3, 4, 5)), [3, 4, 5]) - -%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) -%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) -%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) -%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (zeros, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} zeros (@var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ -Return a matrix or N-dimensional array whose elements are all 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -@nospell{NxN} matrix. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -the given dimensions.\n\ -\n\ -The optional argument @var{class} specifies the class of the return array\n\ -and defaults to double. For example:\n\ -\n\ -@example\n\ -val = zeros (m,n, \"uint8\")\n\ -@end example\n\ -@seealso{ones}\n\ -@end deftypefn") -{ - return fill_matrix (args, 0, "zeros"); -} - -/* -%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) -%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) -%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) -%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) - -%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) - -%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) -%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) -%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) -%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) -*/ - -DEFUN (Inf, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex inf\n\ -\n\ -@deftypefn {Built-in Function} {} Inf\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the IEEE representation for positive infinity.\n\ -\n\ -Infinity is produced when results are too large to be represented using the\n\ -the IEEE floating point format for numbers. Two common examples which\n\ -produce infinity are division by zero and overflow.\n\ -\n\ -@example\n\ -@group\n\ -[ 1/0 e^800 ]\n\ -@result{} Inf Inf\n\ -@end group\n\ -@end example\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{Inf}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isinf, NaN}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_inf_value (), - lo_ieee_float_inf_value (), "Inf"); -} - -DEFALIAS (inf, Inf); - -/* -%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) -%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) -%!assert (size (inf (3, 4, 5)), [3, 4, 5]) - -%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) -%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) -%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) - -%!error (inf (3, "int8")) -%!error (inf (2, 3, "int8")) -%!error (inf (3, 2, "int8")) -%!error (inf (3, 4, 5, "int8")) -*/ - -DEFUN (NaN, args, , - "-*- texinfo -*-\n\ -@c List other form of function in documentation index\n\ -@findex nan\n\ -\n\ -@deftypefn {Built-in Function} {} NaN\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the IEEE symbol NaN (Not a Number).\n\ -NaN is the result of operations which do not produce a well defined numerical\n\ -result. Common operations which produce a NaN are arithmetic with infinity\n\ -@tex\n\ -($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ -@end tex\n\ -@ifnottex\n\ -(Inf - Inf), zero divided by zero (0/0),\n\ -@end ifnottex\n\ -and any operation involving another NaN value (5 + NaN).\n\ -\n\ -Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ -is specified by the IEEE standard for floating point arithmetic. To\n\ -find NaN values, use the @code{isnan} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NaN}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isnan, Inf}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "NaN"); -} - -DEFALIAS (nan, NaN); - -/* -%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) -%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) -%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) - -%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) -%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) -%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) - -%!error (NaN (3, "int8")) -%!error (NaN (2, 3, "int8")) -%!error (NaN (3, 2, "int8")) -%!error (NaN (3, 4, 5, "int8")) -*/ - -DEFUN (e, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} e\n\ -@deftypefnx {Built-in Function} {} e (@var{n})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the base of natural logarithms. The constant\n\ -@tex\n\ -$e$ satisfies the equation $\\log (e) = 1$.\n\ -@end tex\n\ -@ifnottex\n\ -@samp{e} satisfies the equation @code{log} (e) = 1.\n\ -@end ifnottex\n\ -\n\ -When called with no arguments, return a scalar with the value @math{e}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{log, exp, pi, i, j}\n\ -@end deftypefn") -{ -#if defined (M_E) - double e_val = M_E; -#else - double e_val = exp (1.0); -#endif - - return fill_matrix (args, e_val, "e"); -} - -DEFUN (eps, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eps\n\ -@deftypefnx {Built-in Function} {} eps (@var{x})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ -the machine precision. More precisely, @code{eps} is the relative spacing\n\ -between any two adjacent numbers in the machine's floating point system.\n\ -This number is obviously system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{eps} is approximately\n\ -@tex\n\ -$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2204e-16 for double precision and 1.1921e-07\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{eps (1.0)}.\n\ -Given a single argument @var{x}, return the distance between @var{x} and\n\ -the next largest value.\n\ -When called with more than one argument the first two arguments are taken as\n\ -the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, realmin, intmax, bitmax}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 1 && ! args(0).is_string ()) - { - if (args(0).is_single_type ()) - { - float val = args(0).float_value (); - - if (! error_state) - { - val = ::fabsf (val); - if (xisnan (val) || xisinf (val)) - retval = fill_matrix (octave_value ("single"), - lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "eps"); - else if (val < FLT_MIN) - retval = fill_matrix (octave_value ("single"), 0e0, - powf (2.0, -149e0), "eps"); - else - { - int expon; - frexpf (val, &expon); - val = std::pow (static_cast (2.0), - static_cast (expon - 24)); - retval = fill_matrix (octave_value ("single"), DBL_EPSILON, - val, "eps"); - } - } - } - else - { - double val = args(0).double_value (); - - if (! error_state) - { - val = ::fabs (val); - if (xisnan (val) || xisinf (val)) - retval = fill_matrix (octave_value_list (), - lo_ieee_nan_value (), - lo_ieee_float_nan_value (), "eps"); - else if (val < DBL_MIN) - retval = fill_matrix (octave_value_list (), - pow (2.0, -1074e0), 0e0, "eps"); - else - { - int expon; - frexp (val, &expon); - val = std::pow (static_cast (2.0), - static_cast (expon - 53)); - retval = fill_matrix (octave_value_list (), val, - FLT_EPSILON, "eps"); - } - } - } - } - else - retval = fill_matrix (args, DBL_EPSILON, FLT_EPSILON, "eps"); - - return retval; -} - -/* -%!assert (eps (1/2), 2^(-53)) -%!assert (eps (1), 2^(-52)) -%!assert (eps (2), 2^(-51)) -%!assert (eps (realmax), 2^971) -%!assert (eps (0), 2^(-1074)) -%!assert (eps (realmin/2), 2^(-1074)) -%!assert (eps (realmin/16), 2^(-1074)) -%!assert (eps (Inf), NaN) -%!assert (eps (NaN), NaN) -%!assert (eps (single (1/2)), single (2^(-24))) -%!assert (eps (single (1)), single (2^(-23))) -%!assert (eps (single (2)), single (2^(-22))) -%!assert (eps (realmax ("single")), single (2^104)) -%!assert (eps (single (0)), single (2^(-149))) -%!assert (eps (realmin ("single")/2), single (2^(-149))) -%!assert (eps (realmin ("single")/16), single (2^(-149))) -%!assert (eps (single (Inf)), single (NaN)) -%!assert (eps (single (NaN)), single (NaN)) -*/ - -DEFUN (pi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pi\n\ -@deftypefnx {Built-in Function} {} pi (@var{n})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the ratio of the circumference of a circle to its\n\ -@tex\n\ -diameter($\\pi$).\n\ -@end tex\n\ -@ifnottex\n\ -diameter.\n\ -@end ifnottex\n\ -Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ -\n\ -When called with no arguments, return a scalar with the value of\n\ -@tex\n\ -$\\pi$.\n\ -@end tex\n\ -@ifnottex\n\ -pi.\n\ -@end ifnottex\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, i, j}\n\ -@end deftypefn") -{ -#if defined (M_PI) - double pi_val = M_PI; -#else - double pi_val = 4.0 * atan (1.0); -#endif - - return fill_matrix (args, pi_val, "pi"); -} - -DEFUN (realmax, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmax\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the largest floating point number that is representable. The actual\n\ -value is system dependent. On machines that support IEEE\n\ -floating point arithmetic, @code{realmax} is approximately\n\ -@tex\n\ -$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ -@end tex\n\ -@ifnottex\n\ -1.7977e+308 for double precision and 3.4028e+38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmax (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmin, intmax, bitmax, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, DBL_MAX, FLT_MAX, "realmax"); -} - -DEFUN (realmin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} realmin\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ -Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ -to the smallest normalized floating point number that is representable.\n\ -The actual value is system dependent. On machines that support\n\ -IEEE floating point arithmetic, @code{realmin} is approximately\n\ -@tex\n\ -$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ -@end tex\n\ -@ifnottex\n\ -2.2251e-308 for double precision and 1.1755e-38\n\ -@end ifnottex\n\ -for single precision.\n\ -\n\ -When called with no arguments, return a scalar with the value\n\ -@code{realmin (\"double\")}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{realmax, intmin, eps}\n\ -@end deftypefn") -{ - return fill_matrix (args, DBL_MIN, FLT_MIN, "realmin"); -} - -DEFUN (I, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex i\n\ -@findex j\n\ -@findex J\n\ -\n\ -@deftypefn {Built-in Function} {} I\n\ -@deftypefnx {Built-in Function} {} I (@var{n})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the pure imaginary unit, defined as\n\ -@tex\n\ -$\\sqrt{-1}$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{sqrt (-1)}.\n\ -@end ifnottex\n\ -\n\ -I, and its equivalents i, j, and J, are functions so any of the names may\n\ -be reused for other purposes (such as i for a counter variable).\n\ -\n\ -When called with no arguments, return a scalar with the value @math{i}. When\n\ -called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{e, pi, log, exp, i, j, J}\n\ -@end deftypefn") -{ - return fill_matrix (args, Complex (0.0, 1.0), "I"); -} - -DEFALIAS (i, I); -DEFALIAS (J, I); -DEFALIAS (j, I); - -DEFUN (NA, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} NA\n\ -@deftypefnx {Built-in Function} {} NA (@var{n})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ -@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ -Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ -to the special constant used to designate missing values.\n\ -\n\ -Note that NA always compares not equal to NA (NA != NA).\n\ -To find NA values, use the @code{isna} function.\n\ -\n\ -When called with no arguments, return a scalar with the value @samp{NA}.\n\ -When called with a single argument, return a square matrix with the dimension\n\ -specified. When called with more than one scalar argument the first two\n\ -arguments are taken as the number of rows and columns and any further\n\ -arguments specify additional matrix dimensions.\n\ -The optional argument @var{class} specifies the return type and may be\n\ -either \"double\" or \"single\".\n\ -@seealso{isna}\n\ -@end deftypefn") -{ - return fill_matrix (args, lo_ieee_na_value (), - lo_ieee_float_na_value (), "NA"); -} - -/* -%!assert (single (NA ("double")), NA ("single")) -%!assert (double (NA ("single")), NA ("double")) -*/ - -DEFUN (false, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} false (@var{x})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 0.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{true}\n\ -@end deftypefn") -{ - return fill_matrix (args, false, "false"); -} - -DEFUN (true, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} true (@var{x})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ -@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ -Return a matrix or N-dimensional array whose elements are all logical 1.\n\ -If invoked with a single scalar integer argument, return a square\n\ -matrix of the specified size. If invoked with two or more scalar\n\ -integer arguments, or a vector of integer values, return an array with\n\ -given dimensions.\n\ -@seealso{false}\n\ -@end deftypefn") -{ - return fill_matrix (args, true, "true"); -} - -template -octave_value -identity_matrix (int nr, int nc) -{ - octave_value retval; - - typename MT::element_type one (1); - - if (nr == 1 && nc == 1) - retval = one; - else - { - dim_vector dims (nr, nc); - - typename MT::element_type zero (0); - - MT m (dims, zero); - - if (nr > 0 && nc > 0) - { - int n = std::min (nr, nc); - - for (int i = 0; i < n; i++) - m(i,i) = one; - } - - retval = m; - } - - return retval; -} - -#define INSTANTIATE_EYE(T) \ - template octave_value identity_matrix (int, int) - -INSTANTIATE_EYE (int8NDArray); -INSTANTIATE_EYE (uint8NDArray); -INSTANTIATE_EYE (int16NDArray); -INSTANTIATE_EYE (uint16NDArray); -INSTANTIATE_EYE (int32NDArray); -INSTANTIATE_EYE (uint32NDArray); -INSTANTIATE_EYE (int64NDArray); -INSTANTIATE_EYE (uint64NDArray); -INSTANTIATE_EYE (FloatNDArray); -INSTANTIATE_EYE (NDArray); -INSTANTIATE_EYE (boolNDArray); - -static octave_value -identity_matrix (int nr, int nc, oct_data_conv::data_type dt) -{ - octave_value retval; - - // FIXME -- perhaps this should be made extensible by using - // the class name to lookup a function to call to create the new - // value. - - if (! error_state) - { - switch (dt) - { - case oct_data_conv::dt_int8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint8: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint16: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint32: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_int64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_uint64: - retval = identity_matrix (nr, nc); - break; - - case oct_data_conv::dt_single: - retval = FloatDiagMatrix (nr, nc, 1.0f); - break; - - case oct_data_conv::dt_double: - retval = DiagMatrix (nr, nc, 1.0); - break; - - case oct_data_conv::dt_logical: - retval = identity_matrix (nr, nc); - break; - - default: - error ("eye: invalid class name"); - break; - } - } - - return retval; -} - -#undef INT_EYE_MATRIX - -DEFUN (eye, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eye (@var{n})\n\ -@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ -@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ -@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ -Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ -return a square @nospell{NxN} identity matrix. If\n\ -supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ -the number of rows and columns. If given a vector with two elements,\n\ -@code{eye} uses the values of the elements as the number of rows and columns,\n\ -respectively. For example:\n\ -\n\ -@example\n\ -@group\n\ -eye (3)\n\ - @result{} 1 0 0\n\ - 0 1 0\n\ - 0 0 1\n\ -@end group\n\ -@end example\n\ -\n\ -The following expressions all produce the same result:\n\ -\n\ -@example\n\ -@group\n\ -eye (2)\n\ -@equiv{}\n\ -eye (2, 2)\n\ -@equiv{}\n\ -eye (size ([1, 2; 3, 4])\n\ -@end group\n\ -@end example\n\ -\n\ -The optional argument @var{class}, allows @code{eye} to return an array of\n\ -the specified type, like\n\ -\n\ -@example\n\ -val = zeros (n,m, \"uint8\")\n\ -@end example\n\ -\n\ -Calling @code{eye} with no arguments is equivalent to calling it\n\ -with an argument of 1. Any negative dimensions are treated as zero. \n\ -These odd definitions are for compatibility with @sc{matlab}.\n\ -@seealso{speye, ones, zeros}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - oct_data_conv::data_type dt = oct_data_conv::dt_double; - - // Check for type information. - - if (nargin > 0 && args(nargin-1).is_string ()) - { - std::string nm = args(nargin-1).string_value (); - nargin--; - - dt = oct_data_conv::string_to_data_type (nm); - - if (error_state) - return retval; - } - - switch (nargin) - { - case 0: - retval = identity_matrix (1, 1, dt); - break; - - case 1: - { - octave_idx_type nr, nc; - get_dimensions (args(0), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - case 2: - { - octave_idx_type nr, nc; - get_dimensions (args(0), args(1), "eye", nr, nc); - - if (! error_state) - retval = identity_matrix (nr, nc, dt); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -/* -%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) -%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) - -%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) - -%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) -%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) - -%!error eye (1, 2, 3) -*/ - -template -static octave_value -do_linspace (const octave_value& base, const octave_value& limit, - octave_idx_type n) -{ - typedef typename MT::column_vector_type CVT; - typedef typename MT::element_type T; - - octave_value retval; - - if (base.is_scalar_type ()) - { - T bs = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - retval = linspace (bs, ls, n); - } - else - { - CVT lv = octave_value_extract (limit); - CVT bv (lv.length (), bs); - retval = linspace (bv, lv, n); - } - } - else - { - CVT bv = octave_value_extract (base); - if (limit.is_scalar_type ()) - { - T ls = octave_value_extract (limit); - CVT lv (bv.length (), ls); - retval = linspace (bv, lv, n); - } - else - { - CVT lv = octave_value_extract (limit); - retval = linspace (bv, lv, n); - } - } - - return retval; -} - -DEFUN (linspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ -@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ -Return a row vector with @var{n} linearly spaced elements between\n\ -@var{base} and @var{limit}. If the number of elements is greater than one,\n\ -then the endpoints @var{base} and @var{limit} are always included in\n\ -the range. If @var{base} is greater than @var{limit}, the elements are\n\ -stored in decreasing order. If the number of points is not specified, a\n\ -value of 100 is used.\n\ -\n\ -The @code{linspace} function always returns a row vector if both\n\ -@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ -vectors, @code{linspace} returns a matrix.\n\ -\n\ -For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ -if fewer than two values are requested.\n\ -@seealso{logspace}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_idx_type npoints = 100; - - if (nargin != 2 && nargin != 3) - { - print_usage (); - return retval; - } - - if (nargin == 3) - npoints = args(2).idx_type_value (); - - if (! error_state) - { - octave_value arg_1 = args(0); - octave_value arg_2 = args(1); - - if (arg_1.is_single_type () || arg_2.is_single_type ()) - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - - } - else - { - if (arg_1.is_complex_type () || arg_2.is_complex_type ()) - retval = do_linspace (arg_1, arg_2, npoints); - else - retval = do_linspace (arg_1, arg_2, npoints); - } - } - else - error ("linspace: N must be an integer"); - - return retval; -} - - -/* -%!test -%! x1 = linspace (1, 2); -%! x2 = linspace (1, 2, 10); -%! x3 = linspace (1, -2, 10); -%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); -%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); -%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); - -%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) - -%!error linspace () -%!error linspace (1, 2, 3, 4) -*/ - -// FIXME -- should accept dimensions as separate args for N-d -// arrays as well as 1-d and 2-d arrays. - -DEFUN (resize, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ -Resize @var{x} cutting off elements as necessary.\n\ -\n\ -In the result, element with certain indices is equal to the corresponding\n\ -element of @var{x} if the indices are within the bounds of @var{x};\n\ -otherwise, the element is set to zero.\n\ -\n\ -In other words, the statement\n\ -\n\ -@example\n\ -y = resize (x, dv)\n\ -@end example\n\ -\n\ -@noindent\n\ -is equivalent to the following code:\n\ -\n\ -@example\n\ -@group\n\ -y = zeros (dv, class (x));\n\ -sz = min (dv, size (x));\n\ -for i = 1:length (sz)\n\ - idx@{i@} = 1:sz(i);\n\ -endfor\n\ -y(idx@{:@}) = x(idx@{:@});\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -but is performed more efficiently.\n\ -\n\ -If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ -result is @var{m}-by-@var{m}.\n\ -If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ -the result are @var{m}-by-@var{n}-by-@dots{}.\n\ -If given a vector as input, then the\n\ -dimensions of the result are given by the elements of that vector.\n\ -\n\ -An object can be resized to more dimensions than it has;\n\ -in such case the missing dimensions are assumed to be 1.\n\ -Resizing an object to fewer dimensions is not possible.\n\ -@seealso{reshape, postpad, prepad, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2) - { - Array vec = args(1).vector_value (); - int ndim = vec.length (); - if (ndim == 1) - { - octave_idx_type m = static_cast (vec(0)); - retval = args(0); - retval = retval.resize (dim_vector (m, m), true); - } - else - { - dim_vector dv; - dv.resize (ndim); - for (int i = 0; i < ndim; i++) - dv(i) = static_cast (vec(i)); - retval = args(0); - retval = retval.resize (dv, true); - } - } - else if (nargin > 2) - { - dim_vector dv; - dv.resize (nargin - 1); - for (octave_idx_type i = 1; i < nargin; i++) - dv(i-1) = static_cast (args(i).scalar_value ()); - if (!error_state) - { - retval = args(0); - retval = retval.resize (dv, true); - } - - } - else - print_usage (); - return retval; -} - -// FIXME -- should use octave_idx_type for dimensions. - -DEFUN (reshape, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ -@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ -Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ -whose elements are taken from the matrix @var{A}. The elements of the\n\ -matrix are accessed in column-major order (like Fortran arrays are stored).\n\ -\n\ -The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ -matrix.\n\ -\n\ -@example\n\ -@group\n\ -reshape ([1, 2, 3, 4], 2, 2)\n\ - @result{} 1 3\n\ - 2 4\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the total number of elements in the original\n\ -matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ -in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ -\n\ -A single dimension of the return matrix may be left unspecified and Octave\n\ -will determine its size automatically. An empty matrix ([]) is used to flag\n\ -the unspecified dimension.\n\ -@seealso{resize, vec, postpad, cat, squeeze}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - dim_vector new_dims; - - if (nargin == 2) - { - Array new_size = args(1).octave_idx_type_vector_value (); - - new_dims = dim_vector::alloc (new_size.length ()); - - for (octave_idx_type i = 0; i < new_size.length (); i++) - { - if (new_size(i) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - else - new_dims(i) = new_size(i); - } - } - else if (nargin > 2) - { - new_dims = dim_vector::alloc (nargin-1); - int empty_dim = -1; - - for (int i = 1; i < nargin; i++) - { - if (args(i).is_empty ()) - { - if (empty_dim > 0) - { - error ("reshape: only a single dimension can be unknown"); - break; - } - else - { - empty_dim = i; - new_dims(i-1) = 1; - } - } - else - { - new_dims(i-1) = args(i).idx_type_value (); - - if (error_state) - break; - else if (new_dims(i-1) < 0) - { - error ("reshape: SIZE must be non-negative"); - break; - } - } - } - - if (! error_state && (empty_dim > 0)) - { - octave_idx_type nel = new_dims.numel (); - - if (nel == 0) - new_dims(empty_dim-1) = 0; - else - { - octave_idx_type a_nel = args(0).numel (); - octave_idx_type size_empty_dim = a_nel / nel; - - if (a_nel != size_empty_dim * nel) - error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); - else - new_dims(empty_dim-1) = size_empty_dim; - } - } - } - else - { - print_usage (); - return retval; - } - - if (! error_state) - retval = args(0).reshape (new_dims); - - return retval; -} - -/* -%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) - -%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) -%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) -%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) -%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) - -%!test -%! s.a = 1; -%! fail ("reshape (s, 2, 3)"); - -%!error reshape () -%!error reshape (1, 2, 3, 4) -*/ - -DEFUN (vec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ -@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ -Return the vector obtained by stacking the columns of the matrix @var{x}\n\ -one above the other. Without @var{dim} this is equivalent to\n\ -@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ -are set to @var{dim} with all elements along the last dimension.\n\ -This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ -@seealso{vech, resize, cat}\n\ -@end deftypefn") -{ - octave_value retval; - int dim = 1; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage () ; - - if (! error_state && nargin == 2) - { - dim = args(1).idx_type_value (); - - if (dim < 1) - error ("vec: DIM must be greater than zero"); - } - - if (! error_state) - { - octave_value colon (octave_value::magic_colon_t); - octave_value arg = args(0); - retval = arg.single_subsref ("(", colon); - - - if (! error_state && dim > 1) - { - dim_vector new_dims = dim_vector::alloc (dim); - - for (int i = 0; i < dim-1; i++) - new_dims(i) = 1; - - new_dims(dim-1) = retval.numel (); - - retval = retval.reshape (new_dims); - } - } - - return retval; -} - -/* -%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) -%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) -%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) -%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) -%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) -%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) -%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) - -%!error vec () -%!error vec (1, 2, 3) -%!error vec ([1, 2; 3, 4], 0) -*/ - -DEFUN (squeeze, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ -Remove singleton dimensions from @var{x} and return the result.\n\ -Note that for compatibility with @sc{matlab}, all objects have\n\ -a minimum of two dimensions and row vectors are left unchanged.\n\ -@seealso{reshape}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).squeeze (); - else - print_usage (); - - return retval; -} - -DEFUN (full, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ -Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ -or a range.\n\ -@seealso{sparse}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = args(0).full_value (); - else - print_usage (); - - return retval; -} - -// Compute various norms of the vector X. - -DEFUN (norm, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} norm (@var{A})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ -@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ -Compute the p-norm of the matrix @var{A}. If the second argument is\n\ -missing, @code{p = 2} is assumed.\n\ -\n\ -If @var{A} is a matrix (or sparse matrix):\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{1}\n\ -1-norm, the largest column sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{2}\n\ -Largest singular value of @var{A}.\n\ -\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@cindex infinity norm\n\ -Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -@cindex Frobenius norm\n\ -Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -@cindex general p-norm\n\ -maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ -@end table\n\ -\n\ -If @var{A} is a vector or a scalar:\n\ -\n\ -@table @asis\n\ -@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ -@code{max (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{-Inf}\n\ -@code{min (abs (@var{A}))}.\n\ -\n\ -@item @var{p} = @code{\"fro\"}\n\ -Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ -\n\ -@item @var{p} = 0\n\ -Hamming norm - the number of nonzero elements.\n\ -\n\ -@item other @var{p}, @code{@var{p} > 1}\n\ -p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ -\n\ -@item other @var{p} @code{@var{p} < 1}\n\ -the p-pseudonorm defined as above.\n\ -@end table\n\ -\n\ -If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ -compute its norm. The result is returned as a column vector.\n\ -Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ -the norms of each column and return a row vector.\n\ -@seealso{cond, svd}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - octave_value x_arg = args(0); - - if (x_arg.ndims () == 2) - { - enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; - if (nargin > 1 && args(nargin-1).is_string ()) - { - std::string str = args(nargin-1).string_value (); - if (str == "cols" || str == "columns") - strflag = sfcols; - else if (str == "rows") - strflag = sfrows; - else if (str == "fro") - strflag = sffrob; - else if (str == "inf") - strflag = sfinf; - else - error ("norm: unrecognized option: %s", str.c_str ()); - // we've handled the last parameter, so act as if it was removed - nargin --; - } - else if (nargin > 1 && ! args(1).is_scalar_type ()) - gripe_wrong_type_arg ("norm", args(1), true); - - if (! error_state) - { - octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); - switch (strflag) - { - case sfmatrix: - retval(0) = xnorm (x_arg, p_arg); - break; - case sfcols: - retval(0) = xcolnorms (x_arg, p_arg); - break; - case sfrows: - retval(0) = xrownorms (x_arg, p_arg); - break; - case sffrob: - retval(0) = xfrobnorm (x_arg); - break; - case sfinf: - retval(0) = xnorm (x_arg, octave_Inf); - break; - } - } - } - else - error ("norm: only valid for 2-D objects"); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = [1, -3, 4, 5, -7]; -%!assert (norm (x,1), 20) -%!assert (norm (x,2), 10) -%!assert (norm (x,3), 8.24257059961711, -4*eps) -%!assert (norm (x,Inf), 7) -%!assert (norm (x,-Inf), 1) -%!assert (norm (x,"inf"), 7) -%!assert (norm (x,"fro"), 10, -eps) -%!assert (norm (x), 10) -%!assert (norm ([1e200, 1]), 1e200) -%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) -%!shared m -%! m = magic (4); -%!assert (norm (m,1), 34) -%!assert (norm (m,2), 34, -eps) -%!assert (norm (m,Inf), 34) -%!assert (norm (m,"inf"), 34) -%!shared m2, flo, fhi -%! m2 = [1,2;3,4]; -%! flo = 1e-300; -%! fhi = 1e+300; -%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) -%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) - -%!shared x -%! x = single ([1, -3, 4, 5, -7]); -%!assert (norm (x,1), single (20)) -%!assert (norm (x,2), single (10)) -%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) -%!assert (norm (x,Inf), single (7)) -%!assert (norm (x,-Inf), single (1)) -%!assert (norm (x,"inf"), single (7)) -%!assert (norm (x,"fro"), single (10), -eps ("single")) -%!assert (norm (x), single (10)) -%!assert (norm (single ([1e200, 1])), single (1e200)) -%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) -%!shared m -%! m = single (magic (4)); -%!assert (norm (m,1), single (34)) -%!assert (norm (m,2), single (34), -eps ("single")) -%!assert (norm (m,Inf), single (34)) -%!assert (norm (m,"inf"), single (34)) -%!shared m2, flo, fhi -%! m2 = single ([1,2;3,4]); -%! flo = single (1e-300); -%! fhi = single (1e+300); -%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) -%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) - -%!test -%! ## Test for norm returning NaN on sparse matrix (bug #30631) -%! A = sparse (2,2); -%! A(2,1) = 1; -%! assert (norm (A), 1); -*/ - -static octave_value -unary_op_defun_body (octave_value::unary_op op, - const octave_value_list& args) -{ - octave_value retval; - if (args.length () == 1) - retval = do_unary_op (op, args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (not, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} not (@var{x})\n\ -Return the logical NOT of @var{x}. This function is equivalent to\n\ -@code{! x}.\n\ -@seealso{and, or, xor}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_not, args); -} - -DEFUN (uplus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uplus (@var{x})\n\ -This function and @w{@xcode{+ x}} are equivalent.\n\ -@seealso{uminus, plus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uplus, args); -} - -DEFUN (uminus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} uminus (@var{x})\n\ -This function and @w{@xcode{- x}} are equivalent.\n\ -@seealso{uplus, minus}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_uminus, args); -} - -DEFUN (transpose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} transpose (@var{x})\n\ -Return the transpose of @var{x}.\n\ -This function and @xcode{x.'} are equivalent.\n\ -@seealso{ctranspose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_transpose, args); -} - -/* -%!assert (2.', 2) -%!assert (2i.', 2i) -%!assert ([1:4].', [1;2;3;4]) -%!assert ([1;2;3;4].', [1:4]) -%!assert ([1,2;3,4].', [1,3;2,4]) -%!assert ([1,2i;3,4].', [1,3;2i,4]) - -%!assert (transpose ([1,2;3,4]), [1,3;2,4]) - -%!assert (single (2).', single (2)) -%!assert (single (2i).', single (2i)) -%!assert (single ([1:4]).', single ([1;2;3;4])) -%!assert (single ([1;2;3;4]).', single ([1:4])) -%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) - -%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) -*/ - -DEFUN (ctranspose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ -Return the complex conjugate transpose of @var{x}.\n\ -This function and @xcode{x'} are equivalent.\n\ -@seealso{transpose}\n\ -@end deftypefn") -{ - return unary_op_defun_body (octave_value::op_hermitian, args); -} - -/* -%!assert (2', 2) -%!assert (2i', -2i) -%!assert ([1:4]', [1;2;3;4]) -%!assert ([1;2;3;4]', [1:4]) -%!assert ([1,2;3,4]', [1,3;2,4]) -%!assert ([1,2i;3,4]', [1,3;-2i,4]) - -%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) - -%!assert (single (2)', single (2)) -%!assert (single (2i)', single (-2i)) -%!assert (single ([1:4])', single ([1;2;3;4])) -%!assert (single ([1;2;3;4])', single ([1:4])) -%!assert (single ([1,2;3,4])', single ([1,3;2,4])) -%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) - -%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) -*/ - -static octave_value -binary_op_defun_body (octave_value::binary_op op, - const octave_value_list& args) -{ - octave_value retval; - - if (args.length () == 2) - retval = do_binary_op (op, args(0), args(1)); - else - print_usage (); - - return retval; -} - -static octave_value -binary_assoc_op_defun_body (octave_value::binary_op op, - octave_value::assign_op aop, - const octave_value_list& args) -{ - octave_value retval; - int nargin = args.length (); - - switch (nargin) - { - case 0: - print_usage (); - break; - case 1: - retval = args(0); - break; - case 2: - retval = do_binary_op (op, args(0), args(1)); - break; - default: - retval = do_binary_op (op, args(0), args(1)); - for (int i = 2; i < nargin; i++) - retval.assign (aop, args(i)); - break; - } - - return retval; -} - -DEFUN (plus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ -This function and @w{@xcode{x + y}} are equivalent.\n\ -If more arguments are given, the summation is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 + x2) + x3) + @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{minus, uplus}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_add, - octave_value::op_add_eq, args); -} - -DEFUN (minus, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ -This function and @w{@xcode{x - y}} are equivalent.\n\ -@seealso{plus, uminus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_sub, args); -} - -DEFUN (mtimes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ -Return the matrix multiplication product of inputs.\n\ -This function and @w{@xcode{x * y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 * x2) * x3) * @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_mul, - octave_value::op_mul_eq, args); -} - -DEFUN (mrdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ -Return the matrix right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x / y}} are equivalent.\n\ -@seealso{mldivide, rdivide, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_div, args); -} - -DEFUN (mpower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ -Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ -This function and @w{@xcode{x ^ y}} are equivalent.\n\ -@seealso{power, mtimes, plus, minus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_pow, args); -} - -DEFUN (mldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ -Return the matrix left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ -@seealso{mrdivide, ldivide, rdivide}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ldiv, args); -} - -DEFUN (lt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x < y}}.\n\ -@seealso{le, eq, ge, gt, ne}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_lt, args); -} - -DEFUN (le, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x <= y}}.\n\ -@seealso{eq, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_le, args); -} - -DEFUN (eq, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ -Return true if the two inputs are equal.\n\ -This function is equivalent to @w{@code{x == y}}.\n\ -@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_eq, args); -} - -DEFUN (ge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x >= y}}.\n\ -@seealso{le, eq, gt, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ge, args); -} - -DEFUN (gt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x > y}}.\n\ -@seealso{le, eq, ge, ne, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_gt, args); -} - -DEFUN (ne, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ -Return true if the two inputs are not equal.\n\ -This function is equivalent to @w{@code{x != y}}.\n\ -@seealso{eq, isequal, le, ge, lt}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_ne, args); -} - -DEFUN (times, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ -Return the element-by-element multiplication product of inputs.\n\ -This function and @w{@xcode{x .* y}} are equivalent.\n\ -If more arguments are given, the multiplication is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{mtimes, rdivide}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_mul, - octave_value::op_el_mul_eq, args); -} - -DEFUN (rdivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ -Return the element-by-element right division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x ./ y}} are equivalent.\n\ -@seealso{ldivide, mrdivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_div, args); -} - -DEFUN (power, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ -Return the element-by-element operation of @var{x} raised to the\n\ -@var{y} power. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -\n\ -This function and @w{@xcode{x .^ y}} are equivalent.\n\ -@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_pow, args); -} - -DEFUN (ldivide, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ -Return the element-by-element left division of @var{x} and @var{y}.\n\ -This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ -@seealso{rdivide, mldivide, times, plus}\n\ -@end deftypefn") -{ - return binary_op_defun_body (octave_value::op_el_ldiv, args); -} - -DEFUN (and, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical AND of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x & y}}.\n\ -If more arguments are given, the logical and is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 & x2) & x3) & @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{or, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_and, - octave_value::op_el_and_eq, args); -} - -DEFUN (or, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ -@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ -Return the logical OR of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x | y}}.\n\ -If more arguments are given, the logical or is applied\n\ -cumulatively from left to right:\n\ -\n\ -@example\n\ -(@dots{}((x1 | x2) | x3) | @dots{})\n\ -@end example\n\ -\n\ -At least one argument is required.\n\ -@seealso{and, not, xor}\n\ -@end deftypefn") -{ - return binary_assoc_op_defun_body (octave_value::op_el_or, - octave_value::op_el_or_eq, args); -} - -static double tic_toc_timestamp = -1.0; - -DEFUN (tic, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tic ()\n\ -@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ -@deftypefnx {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -Set or check a wall-clock timer. Calling @code{tic} without an\n\ -output argument sets the internal timer state. Subsequent calls\n\ -to @code{toc} return the number of seconds since the timer was set.\n\ -For example,\n\ -\n\ -@example\n\ -@group\n\ -tic ();\n\ -# many computations later@dots{}\n\ -elapsed_time = toc ();\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{elapsed_time} to the number of seconds since\n\ -the most recent call to the function @code{tic}.\n\ -\n\ -If called with one output argument, @code{tic} returns a scalar\n\ -of type @code{uint64} that may be later passed to @code{toc}.\n\ -\n\ -@example\n\ -@group\n\ -id = tic; sleep (5); toc (id)\n\ - @result{} 5.0010\n\ -@end group\n\ -@end example\n\ -\n\ -Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ -\n\ -If you are more interested in the CPU time that your process used, you\n\ -should use the @code{cputime} function instead. The @code{tic} and\n\ -@code{toc} functions report the actual wall clock time that elapsed\n\ -between the calls. This may include time spent processing other jobs or\n\ -doing nothing at all.\n\ -@seealso{toc, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - - octave_time now; - - double tmp = now.double_value (); - - if (nargout > 0) - { - double ip = 0.0; - double frac = modf (tmp, &ip); - uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); - microsecs += CLOCKS_PER_SEC * static_cast (ip); - retval = octave_uint64 (microsecs); - } - else - tic_toc_timestamp = tmp; - - return retval; -} - -DEFUN (toc, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} toc ()\n\ -@deftypefnx {Built-in Function} {} toc (@var{id})\n\ -@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ -@seealso{tic, cputime}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - double start_time = tic_toc_timestamp; - - if (nargin > 1) - print_usage (); - else - { - if (nargin == 1) - { - octave_uint64 id = args(0).uint64_scalar_value (); - - if (! error_state) - { - uint64_t val = id.value (); - - start_time - = (static_cast (val / CLOCKS_PER_SEC) - + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); - - // FIXME -- should we also check to see whether the start - // time is after the beginning of this Octave session? - } - else - error ("toc: invalid ID"); - } - - if (! error_state) - { - if (start_time < 0) - error ("toc called before timer set"); - else - { - octave_time now; - - double tmp = now.double_value () - start_time; - - if (nargout > 0) - retval = tmp; - else - octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; - } - } - } - - return retval; -} - -/* -%!shared id -%! id = tic (); -%!assert (isa (id, "uint64")) -%!assert (isa (toc (id), "double")) -*/ - -DEFUN (cputime, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ -Return the CPU time used by your Octave session. The first output is\n\ -the total time spent executing your process and is equal to the sum of\n\ -second and third outputs, which are the number of CPU seconds spent\n\ -executing in user mode and the number of CPU seconds spent executing in\n\ -system mode, respectively. If your system does not have a way to report\n\ -CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ -Note that because Octave used some CPU time to start, it is reasonable\n\ -to check to see if @code{cputime} works by checking to see if the total\n\ -CPU time used is nonzero.\n\ -@seealso{tic, toc}\n\ -@end deftypefn") -{ - octave_value_list retval; - int nargin = args.length (); - double usr = 0.0; - double sys = 0.0; - - if (nargin != 0) - warning ("tic: ignoring extra arguments"); - -#if defined (HAVE_GETRUSAGE) - - struct rusage ru; - - getrusage (RUSAGE_SELF, &ru); - - usr = static_cast (ru.ru_utime.tv_sec) + - static_cast (ru.ru_utime.tv_usec) * 1e-6; - - sys = static_cast (ru.ru_stime.tv_sec) + - static_cast (ru.ru_stime.tv_usec) * 1e-6; - -#else - - struct tms t; - - times (&t); - - unsigned long ticks; - unsigned long seconds; - unsigned long fraction; - - ticks = t.tms_utime + t.tms_cutime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - usr = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - - ticks = t.tms_stime + t.tms_cstime; - fraction = ticks % CLOCKS_PER_SEC; - seconds = ticks / CLOCKS_PER_SEC; - - sys = static_cast (seconds) + static_cast(fraction) / - static_cast(CLOCKS_PER_SEC); - -#endif - - retval(2) = sys; - retval(1) = usr; - retval(0) = sys + usr; - - return retval; -} - -DEFUN (sort, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ -@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ -Return a copy of @var{x} with the elements arranged in increasing\n\ -order. For matrices, @code{sort} orders the elements within columns\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} 1 1\n\ - 2 2\n\ - 3 3\n\ -@end group\n\ -@end example\n\ -\n\ -If the optional argument @var{dim} is given, then the matrix is sorted\n\ -along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ -defines the order in which the values will be sorted. Valid values of\n\ -@code{mode} are \"ascend\" or \"descend\".\n\ -\n\ -The @code{sort} function may also be used to produce a matrix\n\ -containing the original row indices of the elements in the sorted\n\ -matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ - @result{} s = 1 1\n\ - 2 2\n\ - 3 3\n\ - @result{} i = 1 3\n\ - 2 1\n\ - 3 2\n\ -@end group\n\ -@end example\n\ -\n\ -For equal elements, the indices are such that equal elements are listed\n\ -in the order in which they appeared in the original list.\n\ -\n\ -Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ -and for any ties by phase angle (@code{angle (z)}). For example:\n\ -\n\ -@example\n\ -@group\n\ -sort ([1+i; 1; 1-i])\n\ - @result{} 1 + 0i\n\ - 1 - 1i\n\ - 1 + 1i\n\ -@end group\n\ -@end example\n\ -\n\ -NaN values are treated as being greater than any other value and are sorted\n\ -to the end of the list.\n\ -\n\ -The @code{sort} function may also be used to sort strings and cell arrays\n\ -of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ -lowercase 'a') of the strings is used.\n\ -\n\ -The algorithm used in @code{sort} is optimized for the sorting of partially\n\ -ordered lists.\n\ -@seealso{sortrows, issorted}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool return_idx = nargout > 1; - - octave_value arg = args(0); - - int dim = 0; - if (nargin > 1) - { - if (args(1).is_string ()) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - else - dim = args(1).nint_value () - 1; - } - - if (nargin > 2) - { - if (args(1).is_string ()) - { - print_usage (); - return retval; - } - - if (! args(2).is_string ()) - { - error ("sort: MODE must be a string"); - return retval; - } - std::string mode = args(2).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("sort: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - const dim_vector dv = arg.dims (); - if (nargin == 1 || args(1).is_string ()) - { - // Find first non singleton dimension - dim = dv.first_non_singleton (); - } - else - { - if (dim < 0) - { - error ("sort: DIM must be a valid dimension"); - return retval; - } - } - - if (return_idx) - { - retval.resize (2); - - Array sidx; - - retval(0) = arg.sort (sidx, dim, smode); - retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. - } - else - retval(0) = arg.sort (dim, smode); - - return retval; -} - -/* -## Double -%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1), 1) - -%!test -%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); -%! assert (v, [-1, 1, 1, Inf, NaN]); -%! assert (i, [3, 2, 5, 4, 1]); - -## Complex -%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) -%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) -%!assert (sort (1i), 1i) - -%!test -%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); -%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Single -%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1)), single (1)) - -%!test -%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); -%! assert (v, single ([-1, 1, 1, Inf, NaN])); -%! assert (i, [3, 2, 5, 4, 1]); - -## Single Complex -%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) -%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) -%!assert (sort (single (1i)), single (1i)) - -%!test -%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); -%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); -%! assert (i, [5, 2, 6, 3, 4, 1]); - -## Bool -%!assert (sort ([true, false, true, false]), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) -%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) -%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) -%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) -%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) -%!assert (sort (true), true) - -%!test -%! [v, i] = sort ([true, false, true, false]); -%! assert (v, [false, false, true, true]); -%! assert (i, [2, 4, 1, 3]); - -## Sparse Double -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) -%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Complex -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) -%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) - -%!shared a -%! a = randn (10, 10); -%! a(a < 0) = 0; -%! a = 1i * a; -%!assert (sort (sparse (a)), sparse (sort (a))) -%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) -%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) -%!test -%! [v, i] = sort (a); -%! [vs, is] = sort (sparse (a)); -%! assert (vs, sparse (v)); -%! assert (is, i); - -## Sparse Bool -%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) -%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) -%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) -%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) - -%!test -%! [v, i] = sort (sparse ([true, false, true, false])); -%! assert (v, sparse ([false, false, true, true])); -%! assert (i, [2, 4, 1, 3]); - -## Cell string array -%!shared a, b, c -%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; -%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; -%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; -%!assert (sort (a), b) -%!assert (sort (a, 1), a) -%!assert (sort (a, 2), b) -%!assert (sort (a, 3), a) -%!assert (sort (a, "ascend"), b) -%!assert (sort (a, 2, "ascend"), b) -%!assert (sort (a, "descend"), c) -%!assert (sort (a, 2, "descend"), c) - -%!test -%! [v, i] = sort (a); -%! assert (i, [1, 4, 2, 5, 3]); - -%!error sort () -%!error sort (1, 2, 3, 4) -*/ - -// Sort the rows of the matrix @var{a} according to the order -// specified by @var{mode}, which can either be `ascend' or `descend' -// and return the index vector corresponding to the sort order. -// -// This function does not yet support sparse matrices. - -DEFUN (__sort_rows_idx__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - sortmode smode = ASCENDING; - - if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) - { - print_usage (); - return retval; - } - - if (nargin > 1) - { - std::string mode = args(1).string_value (); - if (mode == "ascend") - smode = ASCENDING; - else if (mode == "descend") - smode = DESCENDING; - else - { - error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); - return retval; - } - } - - octave_value arg = args(0); - - if (arg.is_sparse_type ()) - error ("__sort_rows_idx__: sparse matrices not yet supported"); - if (arg.ndims () == 2) - { - Array idx = arg.sort_rows_idx (smode); - - retval = octave_value (idx, true, true); - } - else - error ("__sort_rows_idx__: needs a 2-dimensional object"); - - return retval; -} - -static sortmode -get_sort_mode_option (const octave_value& arg, const char *argn) -{ - // FIXME -- we initialize to UNSORTED here to avoid a GCC warning - // about possibly using sortmode uninitialized. - // FIXME -- shouldn't these modes be scoped inside a class? - sortmode smode = UNSORTED; - - std::string mode = arg.string_value (); - - if (error_state) - error ("issorted: expecting %s argument to be a character string", argn); - else if (mode == "ascending") - smode = ASCENDING; - else if (mode == "descending") - smode = DESCENDING; - else if (mode == "either") - smode = UNSORTED; - else - error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); - - return smode; -} - -DEFUN (issorted, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issorted (@var{a})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ -@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ -Return true if the array is sorted according to @var{mode}, which\n\ -may be either \"ascending\", \"descending\", or \"either\". By default,\n\ - @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ -@code{sort}.\n\ -\n\ -If the optional argument \"rows\" is supplied, check whether\n\ -the array is sorted by rows as output by the function @code{sortrows}\n\ -(with no options).\n\ -\n\ -This function does not support sparse matrices.\n\ -@seealso{sort, sortrows}\n\ -@end deftypefn\n") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - bool by_rows = false; - - sortmode smode = ASCENDING; - - if (nargin > 1) - { - octave_value mode_arg; - - if (nargin == 3) - smode = get_sort_mode_option (args(2), "third"); - - std::string tmp = args(1).string_value (); - - if (! error_state) - { - if (tmp == "rows") - by_rows = true; - else - smode = get_sort_mode_option (args(1), "second"); - } - else - error ("expecting second argument to be character string"); - - if (error_state) - return retval; - } - - octave_value arg = args(0); - - if (by_rows) - { - if (arg.is_sparse_type ()) - error ("issorted: sparse matrices not yet supported"); - if (arg.ndims () == 2) - retval = arg.is_sorted_rows (smode) != UNSORTED; - else - error ("issorted: A must be a 2-dimensional object"); - } - else - { - if (arg.dims ().is_vector ()) - retval = args(0).is_sorted (smode) != UNSORTED; - else - error ("issorted: needs a vector"); - } - - return retval; -} - -/* -%!shared sm, um, sv, uv -%! sm = [1, 2; 3, 4]; -%! um = [3, 1; 2, 4]; -%! sv = [1, 2, 3, 4]; -%! uv = [2, 1, 4, 3]; -%!assert (issorted (sm, "rows")) -%!assert (!issorted (um, "rows")) -%!assert (issorted (sv)) -%!assert (!issorted (uv)) -%!assert (issorted (sv')) -%!assert (!issorted (uv')) -%!assert (issorted (sm, "rows", "ascending")) -%!assert (!issorted (um, "rows", "ascending")) -%!assert (issorted (sv, "ascending")) -%!assert (!issorted (uv, "ascending")) -%!assert (issorted (sv', "ascending")) -%!assert (!issorted (uv', "ascending")) -%!assert (!issorted (sm, "rows", "descending")) -%!assert (issorted (flipud (sm), "rows", "descending")) -%!assert (!issorted (sv, "descending")) -%!assert (issorted (fliplr (sv), "descending")) -%!assert (!issorted (sv', "descending")) -%!assert (issorted (fliplr (sv)', "descending")) -%!assert (!issorted (um, "rows", "either")) -%!assert (!issorted (uv, "either")) -%!assert (issorted (sm, "rows", "either")) -%!assert (issorted (flipud (sm), "rows", "either")) -%!assert (issorted (sv, "either")) -%!assert (issorted (fliplr (sv), "either")) -%!assert (issorted (sv', "either")) -%!assert (issorted (fliplr (sv)', "either")) -*/ - -DEFUN (nth_element, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ -@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ -Select the n-th smallest element of a vector, using the ordering defined by\n\ -@code{sort}. In other words, the result is equivalent to\n\ -@code{sort(@var{x})(@var{n})}.\n\ -@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ -or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ -If @var{x} is an array, @code{nth_element} operates along the dimension\n\ -defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ -not given.\n\ -\n\ -nth_element encapsulates the C++ standard library algorithms nth_element and\n\ -partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ -where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ -@w{@code{K = length (@var{n})}}.\n\ -This function is intended for cases where the ratio K/M is small; otherwise,\n\ -it may be better to use @code{sort}.\n\ -@seealso{sort, min, max}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_value argx = args(0); - - int dim = -1; - if (nargin == 3) - { - dim = args(2).int_value (true) - 1; - if (dim < 0) - error ("nth_element: DIM must be a valid dimension"); - } - if (dim < 0) - dim = argx.dims ().first_non_singleton (); - - idx_vector n = args(1).index_vector (); - - if (error_state) - return retval; - - switch (argx.builtin_type ()) - { - case btyp_double: - retval = argx.array_value ().nth_element (n, dim); - break; - case btyp_float: - retval = argx.float_array_value ().nth_element (n, dim); - break; - case btyp_complex: - retval = argx.complex_array_value ().nth_element (n, dim); - break; - case btyp_float_complex: - retval = argx.float_complex_array_value ().nth_element (n, dim); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = argx.X ## _array_value ().nth_element (n, dim); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - default: - if (argx.is_cellstr ()) - retval = argx.cellstr_value ().nth_element (n, dim); - else - gripe_wrong_type_arg ("nth_element", argx); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_sum (const idx_vector& idx, const NDT& vals, - octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), T ()); - - if (vals.numel () == 1) - retval.idx_add (idx, vals (0)); - else if (vals.numel () == idx.length (n)) - retval.idx_add (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -DEFUN (__accumarray_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 3) - n = args(2).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - if (vals.is_range ()) - { - Range r = vals.range_value (); - if (r.inc () == 0) - vals = r.base (); - } - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.float_array_value (), n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumarray_sum (idx, vals.complex_array_value (), n); - else - retval = do_accumarray_sum (idx, vals.array_value (), n); - } - else - gripe_wrong_type_arg ("accumarray", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_accumarray_minmax (const idx_vector& idx, const NDT& vals, - octave_idx_type n, bool ismin, - const typename NDT::element_type& zero_val) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumarray: index out of range"); - - NDT retval (dim_vector (n, 1), zero_val); - - // Pick minimizer or maximizer. - void (MArray::*op) (const idx_vector&, const MArray&) = - ismin ? (&MArray::idx_min) : (&MArray::idx_max); - - octave_idx_type l = idx.length (n); - if (vals.numel () == 1) - (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); - else if (vals.numel () == l) - (retval.*op) (idx, vals); - else - error ("accumarray: dimensions mismatch"); - - return retval; -} - -static octave_value_list -do_accumarray_minmax_fun (const octave_value_list& args, - bool ismin) -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1), zero = args (2); - - switch (vals.builtin_type ()) - { - case btyp_double: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.double_value ()); - break; - case btyp_float: - retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, - zero.float_value ()); - break; - case btyp_complex: - retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, - zero.complex_value ()); - break; - case btyp_float_complex: - retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, - zero.float_complex_value ()); - break; -#define MAKE_INT_BRANCH(X) \ - case btyp_ ## X: \ - retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ - zero.X ## _scalar_value ()); \ - break - - MAKE_INT_BRANCH (int8); - MAKE_INT_BRANCH (int16); - MAKE_INT_BRANCH (int32); - MAKE_INT_BRANCH (int64); - MAKE_INT_BRANCH (uint8); - MAKE_INT_BRANCH (uint16); - MAKE_INT_BRANCH (uint32); - MAKE_INT_BRANCH (uint64); -#undef MAKE_INT_BRANCH - case btyp_bool: - retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, - zero.bool_value ()); - break; - default: - gripe_wrong_type_arg ("accumarray", vals); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (__accumarray_min__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, true); -} - -DEFUN (__accumarray_max__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return do_accumarray_minmax_fun (args, false); -} - -template -static NDT -do_accumdim_sum (const idx_vector& idx, const NDT& vals, - int dim = -1, octave_idx_type n = -1) -{ - typedef typename NDT::element_type T; - if (n < 0) - n = idx.extent (0); - else if (idx.extent (n) > n) - error ("accumdim: index out of range"); - - dim_vector vals_dim = vals.dims (), rdv = vals_dim; - - if (dim < 0) - dim = vals.dims ().first_non_singleton (); - else if (dim >= rdv.length ()) - rdv.resize (dim+1, 1); - - rdv(dim) = n; - - NDT retval (rdv, T ()); - - if (idx.length () != vals_dim(dim)) - error ("accumdim: dimension mismatch"); - - retval.idx_add_nd (idx, vals, dim); - - return retval; -} - -DEFUN (__accumdim_sum__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) - { - idx_vector idx = args(0).index_vector (); - int dim = -1; - if (nargin >= 3) - dim = args(2).int_value () - 1; - - octave_idx_type n = -1; - if (nargin == 4) - n = args(3).idx_type_value (true); - - if (! error_state) - { - octave_value vals = args(1); - - if (vals.is_single_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); - } - else if (vals.is_numeric_type () || vals.is_bool_type ()) - { - if (vals.is_complex_type ()) - retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); - else - retval = do_accumdim_sum (idx, vals.array_value (), dim, n); - } - else - gripe_wrong_type_arg ("accumdim", vals); - } - } - else - print_usage (); - - return retval; -} - -template -static NDT -do_merge (const Array& mask, - const NDT& tval, const NDT& fval) -{ - typedef typename NDT::element_type T; - dim_vector dv = mask.dims (); - NDT retval (dv); - - bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; - - if ((! tscl && tval.dims () != dv) - || (! fscl && fval.dims () != dv)) - error ("merge: MASK, TVAL, and FVAL dimensions must match"); - else - { - T *rv = retval.fortran_vec (); - octave_idx_type n = retval.numel (); - - const T *tv = tval.data (), *fv = fval.data (); - const bool *mv = mask.data (); - - if (tscl) - { - if (fscl) - { - T ts = tv[0], fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fs; - } - else - { - T ts = tv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? ts : fv[i]; - } - } - else - { - if (fscl) - { - T fs = fv[0]; - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fs; - } - else - { - for (octave_idx_type i = 0; i < n; i++) - rv[i] = mv[i] ? tv[i] : fv[i]; - } - } - } - - return retval; -} - -#define MAKE_INT_BRANCH(INTX) \ - else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ - { \ - retval = do_merge (mask, \ - tval.INTX ## _array_value (), \ - fval.INTX ## _array_value ()); \ - } - -DEFUN (merge, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ -@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ -Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ -value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ -arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ -array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ -cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ -is true, otherwise @var{fval} is returned.\n\ -\n\ -In the array mask case, both @var{tval} and @var{fval} must be either\n\ -scalars or arrays with dimensions equal to @var{mask}. The result is\n\ -constructed as follows:\n\ -\n\ -@example\n\ -@group\n\ -result(mask) = tval(mask);\n\ -result(! mask) = fval(! mask);\n\ -@end group\n\ -@end example\n\ -\n\ -@var{mask} can also be arbitrary numeric type, in which case\n\ -it is first converted to logical.\n\ -@seealso{logical, diff}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) - { - octave_value mask_val = args(0); - - if (mask_val.is_scalar_type ()) - retval = mask_val.is_true () ? args(1) : args(2); - else - { - boolNDArray mask = mask_val.bool_array_value (); - octave_value tval = args(1), fval = args(2); - if (tval.is_double_type () && fval.is_double_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.complex_array_value (), - fval.complex_array_value ()); - else - retval = do_merge (mask, - tval.array_value (), - fval.array_value ()); - } - else if (tval.is_single_type () && fval.is_single_type ()) - { - if (tval.is_complex_type () || fval.is_complex_type ()) - retval = do_merge (mask, - tval.float_complex_array_value (), - fval.float_complex_array_value ()); - else - retval = do_merge (mask, - tval.float_array_value (), - fval.float_array_value ()); - } - else if (tval.is_string () && fval.is_string ()) - { - bool sq_string = tval.is_sq_string () || fval.is_sq_string (); - retval = octave_value (do_merge (mask, - tval.char_array_value (), - fval.char_array_value ()), - sq_string ? '\'' : '"'); - } - else if (tval.is_cell () && fval.is_cell ()) - { - retval = do_merge (mask, - tval.cell_value (), - fval.cell_value ()); - } - - MAKE_INT_BRANCH (int8) - MAKE_INT_BRANCH (int16) - MAKE_INT_BRANCH (int32) - MAKE_INT_BRANCH (int64) - MAKE_INT_BRANCH (uint8) - MAKE_INT_BRANCH (uint16) - MAKE_INT_BRANCH (uint32) - MAKE_INT_BRANCH (uint64) - - else - error ("merge: cannot merge %s with %s with array mask", - tval.class_name ().c_str (), - fval.class_name ().c_str ()); - } - } - else - print_usage (); - - return retval; -} - -DEFALIAS (ifelse, merge); - -#undef MAKE_INT_BRANCH - -template -static SparseT -do_sparse_diff (const SparseT& array, octave_idx_type order, - int dim) -{ - SparseT retval = array; - if (dim == 1) - { - octave_idx_type k = retval.columns (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); - assert (retval.columns () == k-1); - order--; - k--; - } - } - else - { - octave_idx_type k = retval.rows (); - while (order > 0 && k > 0) - { - idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); - retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); - assert (retval.rows () == k-1); - order--; - k--; - } - } - - return retval; -} - -static octave_value -do_diff (const octave_value& array, octave_idx_type order, - int dim = -1) -{ - octave_value retval; - - const dim_vector& dv = array.dims (); - if (dim == -1) - { - dim = array.dims ().first_non_singleton (); - - // Bother Matlab. This behavior is really wicked. - if (dv(dim) <= order) - { - if (dv(dim) == 1) - retval = array.resize (dim_vector (0, 0)); - else - { - retval = array; - while (order > 0) - { - if (dim == dv.length ()) - { - retval = do_diff (array, order, dim - 1); - order = 0; - } - else if (dv(dim) == 1) - dim++; - else - { - retval = do_diff (array, dv(dim) - 1, dim); - order -= dv(dim) - 1; - dim++; - } - } - } - - return retval; - } - } - - if (array.is_integer_type ()) - { - if (array.is_int8_type ()) - retval = array.int8_array_value ().diff (order, dim); - else if (array.is_int16_type ()) - retval = array.int16_array_value ().diff (order, dim); - else if (array.is_int32_type ()) - retval = array.int32_array_value ().diff (order, dim); - else if (array.is_int64_type ()) - retval = array.int64_array_value ().diff (order, dim); - else if (array.is_uint8_type ()) - retval = array.uint8_array_value ().diff (order, dim); - else if (array.is_uint16_type ()) - retval = array.uint16_array_value ().diff (order, dim); - else if (array.is_uint32_type ()) - retval = array.uint32_array_value ().diff (order, dim); - else if (array.is_uint64_type ()) - retval = array.uint64_array_value ().diff (order, dim); - else - panic_impossible (); - } - else if (array.is_sparse_type ()) - { - if (array.is_complex_type ()) - retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); - else - retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); - } - else if (array.is_single_type ()) - { - if (array.is_complex_type ()) - retval = array.float_complex_array_value ().diff (order, dim); - else - retval = array.float_array_value ().diff (order, dim); - } - else - { - if (array.is_complex_type ()) - retval = array.complex_array_value ().diff (order, dim); - else - retval = array.array_value ().diff (order, dim); - } - - return retval; -} - -DEFUN (diff, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} diff (@var{x})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ -@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ -If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ -vector of first differences\n\ -@tex\n\ - $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ -@end tex\n\ -@ifnottex\n\ - @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ -@end ifnottex\n\ -\n\ -If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ -differences along the first non-singleton dimension.\n\ -\n\ -The second argument is optional. If supplied, @code{diff (@var{x},\n\ -@var{k})}, where @var{k} is a non-negative integer, returns the\n\ -@var{k}-th differences. It is possible that @var{k} is larger than\n\ -the first non-singleton dimension of the matrix. In this case,\n\ -@code{diff} continues to take the differences along the next\n\ -non-singleton dimension.\n\ -\n\ -The dimension along which to take the difference can be explicitly\n\ -stated with the optional variable @var{dim}. In this case the\n\ -@var{k}-th order differences are calculated along this dimension.\n\ -In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ -an empty matrix is returned.\n\ -@seealso{sort, merge}\n\ -@end deftypefn") -{ - int nargin = args.length (); - octave_value retval; - - if (nargin < 1 || nargin > 3) - print_usage (); - else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) - error ("diff: X must be numeric or logical"); - - if (! error_state) - { - int dim = -1; - octave_idx_type order = 1; - if (nargin > 1) - { - if (args(1).is_scalar_type ()) - order = args(1).idx_type_value (true, false); - else if (! args(1).is_zero_by_zero ()) - error ("order K must be a scalar or []"); - if (! error_state && order < 0) - error ("order K must be non-negative"); - } - - if (nargin > 2) - { - dim = args(2).int_value (true, false); - if (! error_state && (dim < 1 || dim > args(0).ndims ())) - error ("DIM must be a valid dimension"); - else - dim -= 1; - } - - if (! error_state) - retval = do_diff (args(0), order, dim); - } - - return retval; -} - -/* -%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) -%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) -%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) -%!assert (isempty (diff (1))) - -%!error diff () -%!error diff (1, 2, 3, 4) -%!error diff ("foo") -%!error diff ([1, 2; 3, 4], -1) -*/ - -template -static Array -do_repelems (const Array& src, const Array& rep) -{ - Array retval; - - assert (rep.ndims () == 2 && rep.rows () == 2); - - octave_idx_type n = rep.columns (), l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - if (k < 0) - { - error ("repelems: second row must contain non-negative numbers"); - return retval; - } - - l += k; - } - - retval.clear (1, l); - T *dest = retval.fortran_vec (); - l = 0; - for (octave_idx_type i = 0; i < n; i++) - { - octave_idx_type k = rep(1, i); - std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); - dest += k; - } - - return retval; -} - -DEFUN (repelems, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ -Construct a vector of repeated elements from @var{x}. @var{r}\n\ -is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ -how often to repeat each element.\n\ -\n\ -Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ -The corresponding entry in the second row, @var{r}(2,j), specifies\n\ -the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ -imagined to be stacked on top of each other for purposes of the selection\n\ -index. A row vector is always returned.\n\ -\n\ -Conceptually the result is calculated as follows:\n\ -\n\ -@example\n\ -@group\n\ -y = [];\n\ -for i = 1:columns (@var{r})\n\ - y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{repmat, cat}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - octave_value x = args(0); - - const Matrix rm = args(1).matrix_value (); - if (error_state) - return retval; - else if (rm.rows () != 2 || rm.ndims () != 2) - { - error ("repelems: R must be a matrix with two rows"); - return retval; - } - else - { - NoAlias< Array > r (rm.dims ()); - - for (octave_idx_type i = 0; i < rm.numel (); i++) - { - octave_idx_type rx = rm(i); - if (static_cast (rx) != rm(i)) - { - error ("repelems: R must be a matrix of integers"); - return retval; - } - - r(i) = rx; - } - - switch (x.builtin_type ()) - { -#define BTYP_BRANCH(X, EX) \ - case btyp_ ## X: \ - retval = do_repelems (x.EX ## _value (), r); \ - break - - BTYP_BRANCH (double, array); - BTYP_BRANCH (float, float_array); - BTYP_BRANCH (complex, complex_array); - BTYP_BRANCH (float_complex, float_complex_array); - BTYP_BRANCH (bool, bool_array); - BTYP_BRANCH (char, char_array); - - BTYP_BRANCH (int8, int8_array); - BTYP_BRANCH (int16, int16_array); - BTYP_BRANCH (int32, int32_array); - BTYP_BRANCH (int64, int64_array); - BTYP_BRANCH (uint8, uint8_array); - BTYP_BRANCH (uint16, uint16_array); - BTYP_BRANCH (uint32, uint32_array); - BTYP_BRANCH (uint64, uint64_array); - - BTYP_BRANCH (cell, cell); - //BTYP_BRANCH (struct, map);//FIXME -#undef BTYP_BRANCH - - default: - gripe_wrong_type_arg ("repelems", x); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (base64_encode, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} base64_encode (@var{x})\n\ -Encode a double matrix or array @var{x} into the base64 format string\n\ -@var{s}.\n\ -\n\ -@strong{Warning:} Encoding different numeric types, such as single or\n\ -integer, is not currently supported. Any non-double input will be converted\n\ -to type double before encoding.\n\ -@seealso{base64_decode}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - const Array in = args(0).array_value (); - if (! error_state) - { - const char* inc = reinterpret_cast (in.data ()); - size_t inlen = in.numel () * sizeof (double) / sizeof (char); - char* out; - size_t outlen = base64_encode_alloc (inc, inlen, &out); - - if (! out && outlen == 0 && inlen != 0) - error ("base64_encode: input array too large"); - else if (! out) - error ("base64_encode: memory allocation error"); - else - retval(0) = octave_value (out); - } - } - - return retval; -} - -/* -%!assert (base64_encode (single (pi)), "AAAAYPshCUA=") -%!assert (base64_encode (uint8 (pi)), base64_encode (double (uint8 (pi)))) - -%!error base64_encode () -%!error base64_encode (1,2) -%!error base64_encode ("A string") -*/ - -DEFUN (base64_decode, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{x} =} base64_decode (@var{s})\n\ -@deftypefnx {Built-in Function} {@var{x} =} base64_decode (@var{s}, @var{dims})\n\ -Decode the double matrix or array @var{x} from the base64 format string\n\ -@var{s}. The optional input parameter @var{dims} should be a vector\n\ -containing the dimensions of the decoded array.\n\ -@seealso{base64_encode}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2) - print_usage (); - else - { - dim_vector new_dims; - Array res; - - if (nargin > 1) - { - const Array new_size = - args(1).octave_idx_type_vector_value (); - if (! error_state) - { - new_dims = dim_vector::alloc (new_size.length ()); - for (octave_idx_type i = 0; i < new_size.length (); i++) - new_dims(i) = new_size(i); - } - } - - const std::string in = args(0).string_value (); - - if (! error_state) - { - const char *inc = &(in[0]); - char *out; - size_t inlen = in.length (), outlen; - - bool ok = base64_decode_alloc (inc, inlen, &out, &outlen); - - if (! ok) - error ("base64_decode: input was not valid base64"); - else if (! out) - error ("base64_decode: memory allocation error"); - else - { - if ((outlen % (sizeof (double) / sizeof (char))) != 0) - error ("base64_decode: incorrect input size"); - else - { - octave_idx_type l; - l = (outlen * sizeof (char)) / sizeof (double); - res.resize1 (l); - double *dout = reinterpret_cast (out); - std::copy (dout, dout + l, res.fortran_vec ()); - - if (nargin > 1) - retval(0) = octave_value (res).reshape (new_dims); - else - retval(0) = octave_value (res); - } - } - } - } - - return retval; -} - -/* -%!assert (base64_decode (base64_encode (pi)), pi) -%! -%!test -%! in = randn (10); -%! outv = base64_decode (base64_encode (in)); -%! outm = base64_decode (base64_encode (in), size (in)); -%! assert (outv, in(:).'); -%! assert (outm, in); - -%!error base64_decode () -%!error base64_decode (1,2,3) -%!error base64_decode (1, "this is not a valid set of dimensions") -%!error base64_decode (1) -%!error base64_decode ("AQ=") -%!error base64_decode ("AQ==") -*/ diff -r 069c552587a0 -r 959953dba519 src/data.h --- a/src/data.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,34 +0,0 @@ -/* - -Copyright (C) 2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_data_h) -#define octave_data_h 1 - -#include - -class octave_value; -class octave_value_list; - -extern OCTINTERP_API octave_value -do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); - -#endif diff -r 069c552587a0 -r 959953dba519 src/debug.cc --- a/src/debug.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1268 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp -Copyright (C) 2007-2009 John Swensen - -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 3 of the License, 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, see -. - -*/ -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include -#include - -#include "file-stat.h" -#include "singleton-cleanup.h" - -#include "defun.h" -#include "error.h" -#include "help.h" -#include "input.h" -#include "pager.h" -#include "oct-obj.h" -#include "utils.h" -#include "parse.h" -#include "symtab.h" -#include "gripes.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "ov-fcn.h" -#include "ov-struct.h" -#include "pt-pr-code.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -#include "debug.h" - -// Initialize the singleton object -bp_table *bp_table::instance = 0; - -static std::string -snarf_file (const std::string& fname) -{ - std::string retval; - - file_stat fs (fname); - - if (fs) - { - size_t sz = fs.size (); - - std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); - - if (file) - { - std::string buf (sz+1, 0); - - file.read (&buf[0], sz+1); - - if (file.eof ()) - { - // Expected to read the entire file. - - retval = buf; - } - else - error ("error reading file %s", fname.c_str ()); - } - } - - return retval; -} - -static std::deque -get_line_offsets (const std::string& buf) -{ - // This could maybe be smarter. Is deque the right thing to use - // here? - - std::deque offsets; - - offsets.push_back (0); - - size_t len = buf.length (); - - for (size_t i = 0; i < len; i++) - { - char c = buf[i]; - - if (c == '\r' && ++i < len) - { - c = buf[i]; - - if (c == '\n') - offsets.push_back (i+1); - else - offsets.push_back (i); - } - else if (c == '\n') - offsets.push_back (i+1); - } - - offsets.push_back (len); - - return offsets; -} - -std::string -get_file_line (const std::string& fname, size_t line) -{ - std::string retval; - - static std::string last_fname; - - static std::string buf; - - static std::deque offsets; - - if (fname != last_fname) - { - buf = snarf_file (fname); - - offsets = get_line_offsets (buf); - } - - if (line > 0) - line--; - - if (line < offsets.size () - 1) - { - size_t bol = offsets[line]; - size_t eol = offsets[line+1]; - - while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) - eol--; - - retval = buf.substr (bol, eol - bol); - } - - return retval; -} - -// Return a pointer to the user-defined function FNAME. If FNAME is -// empty, search backward for the first user-defined function in the -// current call stack. - -static octave_user_code * -get_user_code (const std::string& fname = std::string ()) -{ - octave_user_code *dbg_fcn = 0; - - if (fname.empty ()) - dbg_fcn = octave_call_stack::caller_user_code (); - else - { - octave_value fcn = symbol_table::find_function (fname); - - if (fcn.is_defined () && fcn.is_user_code ()) - dbg_fcn = fcn.user_code_value (); - } - - return dbg_fcn; -} - -static void -parse_dbfunction_params (const char *who, const octave_value_list& args, - std::string& symbol_name, bp_table::intmap& lines) -{ - int nargin = args.length (); - int idx = 0; - int list_idx = 0; - symbol_name = std::string (); - lines = bp_table::intmap (); - - if (args.length () == 0) - return; - - // If we are already in a debugging function. - if (octave_call_stack::caller_user_code ()) - { - idx = 0; - symbol_name = get_user_code ()->name (); - } - else if (args(0).is_map ()) - { - // Problem because parse_dbfunction_params() can only pass out a - // single function - } - else if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - if (error_state) - return; - idx = 1; - } - else - error ("%s: invalid parameter specified", who); - - for (int i = idx; i < nargin; i++ ) - { - if (args(i).is_string ()) - { - int line = atoi (args(i).string_value ().c_str ()); - if (error_state) - break; - lines[list_idx++] = line; - } - else if (args(i).is_map ()) - octave_stdout << who << ": accepting a struct" << std::endl; - else - { - const NDArray arg = args(i).array_value (); - - if (error_state) - break; - - for (octave_idx_type j = 0; j < arg.nelem (); j++) - { - int line = static_cast (arg.elem (j)); - if (error_state) - break; - lines[list_idx++] = line; - } - - if (error_state) - break; - } - } -} - -bool -bp_table::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new bp_table (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create breakpoint table!"); - retval = false; - } - - return retval; -} - -bp_table::intmap -bp_table::do_add_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - intmap retval; - - octave_idx_type len = line.size (); - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - for (int i = 0; i < len; i++) - { - const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - - retval[i] = cmds->set_breakpoint (lineno); - - if (retval[i] != 0) - { - bp_set.insert (fname); - } - } - } - } - } - else - error ("add_breakpoint: unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - - -int -bp_table::do_remove_breakpoint (const std::string& fname, - const bp_table::intmap& line) -{ - int retval = 0; - - octave_idx_type len = line.size (); - - if (len == 0) - { - intmap results = remove_all_breakpoints_in_file (fname); - retval = results.size (); - } - else - { - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - octave_value_list results = cmds->list_breakpoints (); - - if (results.length () > 0) - { - for (int i = 0; i < len; i++) - { - const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - cmds->delete_breakpoint (p->second); - } - - results = cmds->list_breakpoints (); - - bp_set_iterator it = bp_set.find (fname); - if (results.length () == 0 && it != bp_set.end ()) - bp_set.erase (it); - - } - - retval = results.length (); - } - } - else - error ("remove_breakpoint: unable to find the requested function\n"); - } - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - - -bp_table::intmap -bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent) -{ - intmap retval; - - octave_user_code *dbg_fcn = get_user_code (fname); - - if (dbg_fcn) - { - tree_statement_list *cmds = dbg_fcn->body (); - - if (cmds) - { - octave_value_list bkpts = cmds->list_breakpoints (); - - for (int i = 0; i < bkpts.length (); i++) - { - int lineno = static_cast (bkpts(i).int_value ()); - cmds->delete_breakpoint (lineno); - retval[i] = lineno; - } - - bp_set_iterator it = bp_set.find (fname); - if (it != bp_set.end ()) - bp_set.erase (it); - - } - } - else if (! silent) - error ("remove_all_breakpoint_in_file: " - "unable to find the requested function\n"); - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; - - return retval; -} - -void -bp_table::do_remove_all_breakpoints (void) -{ - for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - remove_all_breakpoints_in_file (*it); - - - tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; -} - -std::string -do_find_bkpt_list (octave_value_list slist, - std::string match) -{ - std::string retval; - - for (int i = 0; i < slist.length (); i++) - { - if (slist (i).string_value () == match) - { - retval = slist(i).string_value (); - break; - } - } - - return retval; -} - - -bp_table::fname_line_map -bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) -{ - fname_line_map retval; - - for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) - { - if (fname_list.length () == 0 - || do_find_bkpt_list (fname_list, *it) != "") - { - octave_user_code *f = get_user_code (*it); - - if (f) - { - tree_statement_list *cmds = f->body (); - - if (cmds) - { - octave_value_list bkpts = cmds->list_breakpoints (); - octave_idx_type len = bkpts.length (); - - if (len > 0) - { - bp_table::intmap bkpts_vec; - - for (int i = 0; i < len; i++) - bkpts_vec[i] = bkpts (i).double_value (); - - std::string symbol_name = f->name (); - - retval[symbol_name] = bkpts_vec; - } - } - } - } - } - - return retval; -} - -static octave_value -intmap_to_ov (const bp_table::intmap& line) -{ - int idx = 0; - - NDArray retval (dim_vector (1, line.size ())); - - for (size_t i = 0; i < line.size (); i++) - { - bp_table::const_intmap_iterator p = line.find (i); - - if (p != line.end ()) - { - int lineno = p->second; - retval(idx++) = lineno; - } - } - - retval.resize (dim_vector (1, idx)); - - return retval; -} - -DEFUN (dbstop, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line}, @dots{})\n\ -Set a breakpoint in function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this should be left out and only the line should be given.\n\ -\n\ -@item line\n\ -Line number where the breakpoint should be set. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called with a single argument @var{func}, the breakpoint\n\ -is set at the first executable line in the named function.\n\ -\n\ -The optional output @var{rline} is the real line number where the\n\ -breakpoint was set. This can differ from specified line if\n\ -the line is not executable. For example, if a breakpoint attempted on a\n\ -blank line then Octave will set the real breakpoint at the\n\ -next executable line.\n\ -@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ -@end deftypefn") -{ - bp_table::intmap retval; - std::string symbol_name; - bp_table::intmap lines; - - parse_dbfunction_params ("dbstop", args, symbol_name, lines); - - if (lines.size () == 0) - lines[0] = 1; - - if (! error_state) - retval = bp_table::add_breakpoint (symbol_name, lines); - - return intmap_to_ov (retval); -} - -DEFUN (dbclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ -Delete a breakpoint in the function @var{func}.\n\ -\n\ -Arguments are\n\ -\n\ -@table @var\n\ -@item func\n\ -Function name as a string variable. When already in debug\n\ -mode this should be left out and only the line should be given.\n\ -\n\ -@item line\n\ -Line number from which to remove a breakpoint. Multiple\n\ -lines may be given as separate arguments or as a vector.\n\ -@end table\n\ -\n\ -When called without a line number specification all breakpoints\n\ -in the named function are cleared.\n\ -\n\ -If the requested line is not a breakpoint no action is performed.\n\ -@seealso{dbstop, dbstatus, dbwhere}\n\ -@end deftypefn") -{ - octave_value retval; - std::string symbol_name = ""; - bp_table::intmap lines; - - parse_dbfunction_params ("dbclear", args, symbol_name, lines); - - if (! error_state) - bp_table::remove_breakpoint (symbol_name, lines); - - return retval; -} - -DEFUN (dbstatus, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ -@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ -Report the location of active breakpoints.\n\ -\n\ -When called with no input or output arguments, print the list of\n\ -all functions with breakpoints and the line numbers where those\n\ -breakpoints are set.\n\ -If a function name @var{func} is specified then only report breakpoints\n\ -for the named function.\n\ -\n\ -The optional return argument @var{brk_list} is a struct array with the\n\ -following fields.\n\ -\n\ -@table @asis\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item line\n\ -A line number, or vector of line numbers, with a breakpoint.\n\ -@end table\n\ -\n\ -@seealso{dbclear, dbwhere}\n\ -@end deftypefn") -{ - octave_map retval; - int nargin = args.length (); - octave_value_list fcn_list; - bp_table::fname_line_map bp_list; - std::string symbol_name; - - if (nargin != 0 && nargin != 1) - { - error ("dbstatus: only zero or one arguments accepted\n"); - return octave_value (); - } - - if (nargin == 1) - { - if (args(0).is_string ()) - { - symbol_name = args(0).string_value (); - fcn_list(0) = symbol_name; - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - else - gripe_wrong_type_arg ("dbstatus", args(0)); - } - else - { - octave_user_code *dbg_fcn = get_user_code (); - if (dbg_fcn) - { - symbol_name = dbg_fcn->name (); - fcn_list(0) = symbol_name; - } - - bp_list = bp_table::get_breakpoint_list (fcn_list); - } - - if (nargout == 0) - { - // Print out the breakpoint information. - - for (bp_table::fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - bp_table::intmap m = it->second; - - size_t nel = m.size (); - - octave_stdout << "breakpoint in " << it->first; - if (nel > 1) - octave_stdout << " at lines "; - else - octave_stdout << " at line "; - - for (size_t j = 0; j < nel; j++) - octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); - - if (nel > 0) - octave_stdout << std::endl; - } - return octave_value (); - } - else - { - // Fill in an array for return. - - int i = 0; - Cell names (dim_vector (bp_list.size (), 1)); - Cell file (dim_vector (bp_list.size (), 1)); - Cell line (dim_vector (bp_list.size (), 1)); - - for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); - it != bp_list.end (); it++) - { - names(i) = it->first; - line(i) = intmap_to_ov (it->second); - file(i) = do_which (it->first); - i++; - } - - retval.assign ("name", names); - retval.assign ("file", file); - retval.assign ("line", line); - - return octave_value (retval); - } -} - -DEFUN (dbwhere, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbwhere ()\n\ -In debugging mode, report the current file and line number where\n\ -execution is stopped.\n\ -@seealso{dbstatus, dbcont, dbstep, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - octave_user_code *dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - bool have_file = true; - - std::string name = dbg_fcn->fcn_file_name (); - - if (name.empty ()) - { - have_file = false; - - name = dbg_fcn->name (); - } - - octave_stdout << "stopped in " << name << " at "; - - int l = octave_call_stack::caller_user_code_line (); - - if (l > 0) - { - octave_stdout << " line " << l << std::endl; - - if (have_file) - { - std::string line = get_file_line (name, l); - - if (! line.empty ()) - octave_stdout << l << ": " << line << std::endl; - } - } - else - octave_stdout << " " << std::endl; - } - else - error ("dbwhere: must be inside a user function to use dbwhere\n"); - - return retval; -} - -// Copied and modified from the do_type command in help.cc -// Maybe we could share some code? -void -do_dbtype (std::ostream& os, const std::string& name, int start, int end) -{ - std::string ff = fcn_file_in_path (name); - - if (! ff.empty ()) - { - std::ifstream fs (ff.c_str (), std::ios::in); - - if (fs) - { - char ch; - int line = 1; - - if (line >= start && line <= end) - os << line << "\t"; - - while (fs.get (ch)) - { - if (line >= start && line <= end) - { - os << ch; - } - - if (ch == '\n') - { - line++; - if (line >= start && line <= end) - os << line << "\t"; - } - } - } - else - os << "dbtype: unable to open `" << ff << "' for reading!\n"; - } - else - os << "dbtype: unknown function " << name << "\n"; - - os.flush (); -} - -DEFUN (dbtype, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbtype ()\n\ -@deftypefnx {Built-in Function} {} dbtype (\"startl:endl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"startl:end\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:endl\")\n\ -@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:end\")\n\ -When in debugging mode and called with no arguments, list the script file\n\ -being debugged with line numbers. An optional range specification,\n\ -specified as a string, can be used to list only a portion of the file.\n\ -The special keyword \"end\" is a valid line number specification.\n\ -\n\ -When called with the name of a function, list that script file\n\ -with line numbers.\n\ -@seealso{dbstatus, dbstop}\n\ -@end deftypefn") -{ - octave_value retval; - octave_user_code *dbg_fcn; - - int nargin = args.length (); - string_vector argv = args.make_argv ("dbtype"); - - if (! error_state) - { - switch (nargin) - { - case 0: // dbtype - dbg_fcn = get_user_code (); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); - else - error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); - break; - - case 1: // (dbtype func) || (dbtype start:end) - { - std::string arg = argv[1]; - - size_t ind = arg.find (':'); - - if (ind != std::string::npos) // (dbtype start:end) - { - dbg_fcn = get_user_code (); - - if (dbg_fcn) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - int start, end; - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = INT_MAX; - else - end = atoi (end_str.c_str ()); - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - } - else // (dbtype func) - { - dbg_fcn = get_user_code (arg); - - if (dbg_fcn) - do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); - else - error ("dbtype: function <%s> not found\n", arg.c_str ()); - } - } - break; - - case 2: // (dbtype func start:end) , (dbtype func start) - dbg_fcn = get_user_code (argv[1]); - - if (dbg_fcn) - { - std::string arg = argv[2]; - int start, end; - size_t ind = arg.find (':'); - - if (ind != std::string::npos) - { - std::string start_str = arg.substr (0, ind); - std::string end_str = arg.substr (ind + 1); - - start = atoi (start_str.c_str ()); - if (end_str == "end") - end = INT_MAX; - else - end = atoi (end_str.c_str ()); - } - else - { - start = atoi (arg.c_str ()); - end = start; - } - - if (std::min (start, end) <= 0) - error ("dbtype: start and end lines must be >= 1\n"); - - if (start <= end) - do_dbtype (octave_stdout, dbg_fcn->name (), start, end); - else - error ("dbtype: start line must be less than end line\n"); - } - else - error ("dbtype: function <%s> not found\n", argv[1].c_str ()); - - break; - - default: - error ("dbtype: expecting zero, one, or two arguments\n"); - } - } - - return retval; -} - -static octave_value_list -do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) -{ - octave_value_list retval; - - unwind_protect frame; - - octave_idx_type curr_frame = -1; - - size_t nskip = 0; - - if (args.length () == 1) - { - int n = 0; - - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - - if (n > 0) - nskip = n; - else - error ("dbstack: N must be a non-negative integer"); - } - - if (! error_state) - { - octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); - - if (nargout == 0) - { - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - os << "stopped in:\n\n"; - - Cell names = stk.contents ("name"); - Cell files = stk.contents ("file"); - Cell lines = stk.contents ("line"); - - bool show_top_level = true; - - size_t max_name_len = 0; - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - - max_name_len = std::max (name.length (), max_name_len); - } - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - std::string name = names(i).string_value (); - std::string file = files(i).string_value (); - int line = lines(i).int_value (); - - if (show_top_level && i == curr_frame) - show_top_level = false; - - os << (i == curr_frame ? " --> " : " ") - << std::setw (max_name_len) << name - << " at line " << line - << " [" << file << "]" - << std::endl; - } - - if (show_top_level) - os << " --> top level" << std::endl; - } - } - else - { - retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; - retval(0) = stk; - } - } - - return retval; -} - -// A function that can be easily called from a debugger print the Octave -// stack. This can be useful for finding what line of code the -// interpreter is currently executing when the debugger is stopped in -// some C++ function, for example. - -void -show_octave_dbstack (void) -{ - do_dbstack (octave_value_list (), 0, std::cerr); -} - -DEFUN (dbstack, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbstack ()\n\ -@deftypefnx {Built-in Function} {} dbstack (@var{n})\n\ -@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ -Display or return current debugging function stack information.\n\ -With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ -\n\ -The optional return argument @var{stack} is a struct array with the\n\ -following fields:\n\ -\n\ -@table @asis\n\ -@item file\n\ -The name of the m-file where the function code is located.\n\ -\n\ -@item name\n\ -The name of the function with a breakpoint.\n\ -\n\ -@item line\n\ -The line number of an active breakpoint.\n\ -\n\ -@item column\n\ -The column number of the line where the breakpoint begins.\n\ -\n\ -@item scope\n\ -Undocumented.\n\ -\n\ -@item context\n\ -Undocumented.\n\ -@end table\n\ -\n\ -The return argument @var{idx} specifies which element of the @var{stack}\n\ -struct array is currently active.\n\ -@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ -@end deftypefn") -{ - return do_dbstack (args, nargout, octave_stdout); -} - -static void -do_dbupdown (const octave_value_list& args, const std::string& who) -{ - int n = 1; - - if (args.length () == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - n = atoi (s_arg.c_str ()); - } - else - n = args(0).int_value (); - } - - if (! error_state) - { - if (who == "dbup") - n = -n; - - if (! octave_call_stack::goto_frame_relative (n, true)) - error ("%s: invalid stack frame", who.c_str ()); - } -} - -DEFUN (dbup, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbup\n\ -@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ -In debugging mode, move up the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move up one frame.\n\ -@seealso{dbstack, dbdown}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbup"); - - return retval; -} - -DEFUN (dbdown, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dbdown\n\ -@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ -In debugging mode, move down the execution stack @var{n} frames.\n\ -If @var{n} is omitted, move down one frame.\n\ -@seealso{dbstack, dbup}\n\ -@end deftypefn") -{ - octave_value retval; - - do_dbupdown (args, "dbdown"); - - return retval; -} - -DEFUN (dbstep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbstep\n\ -@deftypefnx {Command} {} dbstep @var{n}\n\ -@deftypefnx {Command} {} dbstep in\n\ -@deftypefnx {Command} {} dbstep out\n\ -@deftypefnx {Command} {} dbnext @dots{}\n\ -In debugging mode, execute the next @var{n} lines of code.\n\ -If @var{n} is omitted, execute the next single line of code.\n\ -If the next line of code is itself defined in terms of an m-file remain in\n\ -the existing function.\n\ -\n\ -Using @code{dbstep in} will cause execution of the next line to step into\n\ -any m-files defined on the next line. Using @code{dbstep out} will cause\n\ -execution to continue until the current function returns.\n\ -\n\ -@code{dbnext} is an alias for @code{dbstep}.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - int nargin = args.length (); - - if (nargin > 1) - print_usage (); - else if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - if (arg == "in") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -1; - } - else if (arg == "out") - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = -2; - } - else - { - int n = atoi (arg.c_str ()); - - if (n > 0) - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = n; - } - else - error ("dbstep: invalid argument"); - } - } - } - else - error ("dbstep: input argument must be a character string"); - } - else - { - Vdebugging = false; - - tree_evaluator::dbstep_flag = 1; - } - } - else - error ("dbstep: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFALIAS (dbnext, dbstep); - -DEFUN (dbcont, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbcont\n\ -Leave command-line debugging mode and continue code execution normally.\n\ -@seealso{dbstep, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - } - else - print_usage (); - } - else - error ("dbcont: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (dbquit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbquit\n\ -Quit debugging mode immediately without further code execution and\n\ -return to the Octave prompt.\n\ -@seealso{dbcont, dbstep}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length () == 0) - { - Vdebugging = false; - - tree_evaluator::reset_debug_state (); - - octave_throw_interrupt_exception (); - } - else - print_usage (); - } - else - error ("dbquit: can only be called in debug mode"); - - return octave_value_list (); -} - -DEFUN (isdebugmode, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isdebugmode ()\n\ -Return true if in debugging mode, otherwise false.\n\ -@seealso{dbwhere, dbstack, dbstatus}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Vdebugging; - else - print_usage (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/debug.h --- a/src/debug.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,134 +0,0 @@ -/* - -Copyright (C) 2001-2012 Ben Sapp - -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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_debug_h) -#define octave_debug_h 1 - -#include -#include -#include "ov.h" -#include "dRowVector.h" - -class octave_value_list; -class octave_user_code; - -// Interface to breakpoints,. - -class -OCTINTERP_API -bp_table -{ -private: - - bp_table (void) : bp_set () { } - - ~bp_table (void) { } - -public: - - typedef std::map intmap; - - typedef intmap::const_iterator const_intmap_iterator; - typedef intmap::iterator intmap_iterator; - - typedef std::map fname_line_map; - - typedef fname_line_map::const_iterator const_fname_line_map_iterator; - typedef fname_line_map::iterator fname_line_map_iterator; - - static bool instance_ok (void); - - // Add a breakpoint at the nearest executable line. - static intmap add_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_add_breakpoint (fname, lines) : intmap (); - } - - // Remove a breakpoint from a line in file. - static int remove_breakpoint (const std::string& fname = "", - const intmap& lines = intmap ()) - { - return instance_ok () - ? instance->do_remove_breakpoint (fname, lines) : 0; - } - - // Remove all the breakpoints in a specified file. - static intmap remove_all_breakpoints_in_file (const std::string& fname, - bool silent = false) - { - return instance_ok () - ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); - } - - // Remove all the breakpoints registered with octave. - static void remove_all_breakpoints (void) - { - if (instance_ok ()) - instance->do_remove_all_breakpoints (); - } - - // Return all breakpoints. Each element of the map is a vector - // containing the breakpoints corresponding to a given function name. - static fname_line_map - get_breakpoint_list (const octave_value_list& fname_list) - { - return instance_ok () - ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); - } - - static bool - have_breakpoints (void) - { - return instance_ok () ? instance->do_have_breakpoints () : 0; - } - -private: - - typedef std::set::const_iterator const_bp_set_iterator; - typedef std::set::iterator bp_set_iterator; - - // Set of function names containing at least one breakpoint. - std::set bp_set; - - static bp_table *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - intmap do_add_breakpoint (const std::string& fname, const intmap& lines); - - int do_remove_breakpoint (const std::string&, const intmap& lines); - - intmap do_remove_all_breakpoints_in_file (const std::string& fname, - bool silent); - - void do_remove_all_breakpoints (void); - - fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); - - bool do_have_breakpoints (void) { return (! bp_set.empty ()); } -}; - -std::string get_file_line (const std::string& fname, size_t line); - -#endif diff -r 069c552587a0 -r 959953dba519 src/defaults.cc --- a/src/defaults.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,557 +0,0 @@ -/* - -Copyright (C) 1996-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include - -#include -#include - -#include "dir-ops.h" -#include "oct-env.h" -#include "file-stat.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "file-ops.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" -#include - -std::string Voctave_home; - -std::string Vbin_dir; -std::string Vinfo_dir; -std::string Vdata_dir; -std::string Vlibexec_dir; -std::string Varch_lib_dir; -std::string Vlocal_arch_lib_dir; -std::string Vlocal_api_arch_lib_dir; -std::string Vlocal_ver_arch_lib_dir; - -std::string Vlocal_ver_oct_file_dir; -std::string Vlocal_api_oct_file_dir; -std::string Vlocal_oct_file_dir; - -std::string Vlocal_ver_fcn_file_dir; -std::string Vlocal_api_fcn_file_dir; -std::string Vlocal_fcn_file_dir; - -std::string Voct_file_dir; -std::string Vfcn_file_dir; - -std::string Vimage_dir; - -// The path that will be searched for programs that we execute. -// (--exec-path path) -static std::string VEXEC_PATH; - -// Name of the editor to be invoked by the edit_history command. -std::string VEDITOR; - -static std::string VIMAGE_PATH; - -std::string Vlocal_site_defaults_file; -std::string Vsite_defaults_file; - -std::string -subst_octave_home (const std::string& s) -{ - std::string retval; - - std::string prefix = OCTAVE_PREFIX; - - retval = s; - - if (Voctave_home != prefix) - { - octave_idx_type len = prefix.length (); - - if (s.substr (0, len) == prefix) - retval.replace (0, len, Voctave_home); - } - - if (file_ops::dir_sep_char () != '/') - std::replace (retval.begin (), retval.end (), '/', - file_ops::dir_sep_char ()); - - return retval; -} - -static void -set_octave_home (void) -{ - std::string oh = octave_env::getenv ("OCTAVE_HOME"); - - Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; -} - -static void -set_default_info_dir (void) -{ - Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); -} - -static void -set_default_data_dir (void) -{ - Vdata_dir = subst_octave_home (OCTAVE_DATADIR); -} - -static void -set_default_libexec_dir (void) -{ - Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); -} - -static void -set_default_arch_lib_dir (void) -{ - Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); -} - -static void -set_default_local_arch_lib_dir (void) -{ - Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); -} - -static void -set_default_local_api_arch_lib_dir (void) -{ - Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); -} - -static void -set_default_local_ver_arch_lib_dir (void) -{ - Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); -} - -static void -set_default_local_ver_oct_file_dir (void) -{ - Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); -} - -static void -set_default_local_api_oct_file_dir (void) -{ - Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); -} - -static void -set_default_local_oct_file_dir (void) -{ - Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); -} - -static void -set_default_local_ver_fcn_file_dir (void) -{ - Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); -} - -static void -set_default_local_api_fcn_file_dir (void) -{ - Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); -} - -static void -set_default_local_fcn_file_dir (void) -{ - Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); -} - -static void -set_default_fcn_file_dir (void) -{ - Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); -} - -static void -set_default_image_dir (void) -{ - Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); -} - -static void -set_default_oct_file_dir (void) -{ - Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); -} - -static void -set_default_bin_dir (void) -{ - Vbin_dir = subst_octave_home (OCTAVE_BINDIR); -} - -void -set_exec_path (const std::string& path_arg) -{ - std::string tpath = path_arg; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); - - if (tpath.empty ()) - tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () - + Vlocal_arch_lib_dir + dir_path::path_sep_str () - + Varch_lib_dir + dir_path::path_sep_str () - + Vbin_dir; - - VEXEC_PATH = tpath; - - // FIXME -- should we really be modifying PATH in the environment? - // The way things are now, Octave will ignore directories set in the - // PATH with calls like - // - // setenv ("PATH", "/my/path"); - // - // To fix this, I think Octave should be searching the combination of - // PATH and EXEC_PATH for programs that it executes instead of setting - // the PATH in the environment and relying on the shell to do the - // searching. - - // This is static so that even if set_exec_path is called more than - // once, shell_path is the original PATH from the environment, - // before we start modifying it. - static std::string shell_path = octave_env::getenv ("PATH"); - - if (! shell_path.empty ()) - tpath = shell_path + dir_path::path_sep_str () + tpath; - - octave_env::putenv ("PATH", tpath); -} - -void -set_image_path (const std::string& path) -{ - VIMAGE_PATH = "."; - - std::string tpath = path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; - - tpath = genpath (Vimage_dir, ""); - - if (! tpath.empty ()) - VIMAGE_PATH += dir_path::path_sep_str () + tpath; -} - -static void -set_default_doc_cache_file (void) -{ - std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); - - Vdoc_cache_file = env_file.empty () ? def_file : env_file; -} - -static void -set_default_texi_macros_file (void) -{ - std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); - - std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); - - Vtexi_macros_file = env_file.empty () ? def_file : env_file; -} - -static void -set_default_info_file (void) -{ - std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); - - std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); - - Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; -} - -static void -set_default_info_prog (void) -{ - std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); - - if (oct_info_prog.empty ()) - Vinfo_program = "info"; - else - Vinfo_program = std::string (oct_info_prog); -} - -static void -set_default_editor (void) -{ - VEDITOR = "emacs"; - - std::string env_editor = octave_env::getenv ("EDITOR"); - - if (! env_editor.empty ()) - VEDITOR = env_editor; -} - -static void -set_local_site_defaults_file (void) -{ - std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); - - if (lsf.empty ()) - { - Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); - Vlocal_site_defaults_file.append ("/octaverc"); - } - else - Vlocal_site_defaults_file = lsf; -} - -static void -set_site_defaults_file (void) -{ - std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); - - if (sf.empty ()) - { - Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); - Vsite_defaults_file.append ("/octaverc"); - } - else - Vsite_defaults_file = sf; -} - -void -install_defaults (void) -{ - // OCTAVE_HOME must be set first! - - set_octave_home (); - - set_default_info_dir (); - - set_default_data_dir (); - - set_default_libexec_dir (); - - set_default_arch_lib_dir (); - - set_default_local_ver_arch_lib_dir (); - set_default_local_api_arch_lib_dir (); - set_default_local_arch_lib_dir (); - - set_default_local_ver_oct_file_dir (); - set_default_local_api_oct_file_dir (); - set_default_local_oct_file_dir (); - - set_default_local_ver_fcn_file_dir (); - set_default_local_api_fcn_file_dir (); - set_default_local_fcn_file_dir (); - - set_default_fcn_file_dir (); - set_default_oct_file_dir (); - - set_default_image_dir (); - - set_default_bin_dir (); - - set_exec_path (); - - set_image_path (); - - set_default_doc_cache_file (); - - set_default_texi_macros_file (); - - set_default_info_file (); - - set_default_info_prog (); - - set_default_editor (); - - set_local_site_defaults_file (); - - set_site_defaults_file (); -} - -DEFUN (EDITOR, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the editor to\n\ -use with the @code{edit_history} command. The default value is taken from\n\ -the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ -environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ -@code{\"emacs\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); -} - -/* -%!test -%! orig_val = EDITOR (); -%! old_val = EDITOR ("X"); -%! assert (orig_val, old_val); -%! assert (EDITOR (), "X"); -%! EDITOR (orig_val); -%! assert (EDITOR (), orig_val); - -%!error (EDITOR (1, 2)) -*/ - -DEFUN (EXEC_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories to append to the shell PATH when executing external\n\ -programs. The initial value of is taken from the environment variable\n\ -@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ -the command line argument @option{--exec-path PATH}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); - - if (args.length () > 0) - set_exec_path (VEXEC_PATH); - - return retval; -} - -/* -%!test -%! orig_val = EXEC_PATH (); -%! old_val = EXEC_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (EXEC_PATH (), "X"); -%! EXEC_PATH (orig_val); -%! assert (EXEC_PATH (), orig_val); - -%!error (EXEC_PATH (1, 2)) -*/ - -DEFUN (IMAGE_PATH, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies a colon separated\n\ -list of directories in which to search for image files.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); -} - -/* -%!test -%! orig_val = IMAGE_PATH (); -%! old_val = IMAGE_PATH ("X"); -%! assert (orig_val, old_val); -%! assert (IMAGE_PATH (), "X"); -%! IMAGE_PATH (orig_val); -%! assert (IMAGE_PATH (), orig_val); - -%!error (IMAGE_PATH (1, 2)) -*/ - -DEFUN (OCTAVE_HOME, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ -Return the name of the top-level Octave installation directory.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = Voctave_home; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_HOME ())) -%!error OCTAVE_HOME (1) -*/ - -DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ -Return the version number of Octave, as a string.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = OCTAVE_VERSION; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (OCTAVE_VERSION ())) -%!error OCTAVE_VERSION (1) -*/ diff -r 069c552587a0 -r 959953dba519 src/defaults.in.h --- a/src/defaults.in.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,218 +0,0 @@ -// defaults.h.in -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_defaults_h) -#define octave_defaults_h 1 - -#include - -#include "pathsearch.h" - -#ifndef OCTAVE_CANONICAL_HOST_TYPE -#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% -#endif - -#ifndef OCTAVE_DEFAULT_PAGER -#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% -#endif - -#ifndef OCTAVE_ARCHLIBDIR -#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% -#endif - -#ifndef OCTAVE_BINDIR -#define OCTAVE_BINDIR %OCTAVE_BINDIR% -#endif - -#ifndef OCTAVE_DATADIR -#define OCTAVE_DATADIR %OCTAVE_DATADIR% -#endif - -#ifndef OCTAVE_DATAROOTDIR -#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% -#endif - -#ifndef OCTAVE_DOC_CACHE_FILE -#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% -#endif - -#ifndef OCTAVE_TEXI_MACROS_FILE -#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% -#endif - -#ifndef OCTAVE_EXEC_PREFIX -#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% -#endif - -#ifndef OCTAVE_FCNFILEDIR -#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% -#endif - -#ifndef OCTAVE_IMAGEDIR -#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% -#endif - -#ifndef OCTAVE_INCLUDEDIR -#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% -#endif - -#ifndef OCTAVE_INFODIR -#define OCTAVE_INFODIR %OCTAVE_INFODIR% -#endif - -#ifndef OCTAVE_INFOFILE -#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% -#endif - -#ifndef OCTAVE_LIBDIR -#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LIBEXECDIR -#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% -#endif - -#ifndef OCTAVE_LOCALAPIFCNFILEDIR -#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIOCTFILEDIR -#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALARCHLIBDIR -#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALFCNFILEDIR -#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALOCTFILEDIR -#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% -#endif - -#ifndef OCTAVE_LOCALSTARTUPFILEDIR -#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% -#endif - -#ifndef OCTAVE_LOCALAPIARCHLIBDIR -#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERARCHLIBDIR -#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% -#endif - -#ifndef OCTAVE_LOCALVERFCNFILEDIR -#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% -#endif - -#ifndef OCTAVE_LOCALVEROCTFILEDIR -#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% -#endif - -#ifndef OCTAVE_MAN1DIR -#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% -#endif - -#ifndef OCTAVE_MAN1EXT -#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% -#endif - -#ifndef OCTAVE_MANDIR -#define OCTAVE_MANDIR %OCTAVE_MANDIR% -#endif - -#ifndef OCTAVE_OCTFILEDIR -#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% -#endif - -#ifndef OCTAVE_OCTETCDIR -#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% -#endif - -#ifndef OCTAVE_OCTINCLUDEDIR -#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% -#endif - -#ifndef OCTAVE_OCTLIBDIR -#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% -#endif - -#ifndef OCTAVE_PREFIX -#define OCTAVE_PREFIX %OCTAVE_PREFIX% -#endif - -#ifndef OCTAVE_STARTUPFILEDIR -#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% -#endif - -#ifndef OCTAVE_RELEASE -#define OCTAVE_RELEASE %OCTAVE_RELEASE% -#endif - -extern std::string Voctave_home; - -extern std::string Vbin_dir; -extern std::string Vinfo_dir; -extern std::string Vdata_dir; -extern std::string Vlibexec_dir; -extern std::string Varch_lib_dir; -extern std::string Vlocal_arch_lib_dir; -extern std::string Vlocal_ver_arch_lib_dir; - -extern std::string Vlocal_ver_oct_file_dir; -extern std::string Vlocal_api_oct_file_dir; -extern std::string Vlocal_oct_file_dir; - -extern std::string Vlocal_ver_fcn_file_dir; -extern std::string Vlocal_api_fcn_file_dir; -extern std::string Vlocal_fcn_file_dir; - -extern std::string Voct_file_dir; -extern std::string Vfcn_file_dir; - -extern std::string Vimage_dir; - -// Name of the editor to be invoked by the edit_history command. -extern std::string VEDITOR; - -extern std::string Vlocal_site_defaults_file; -extern std::string Vsite_defaults_file; - -// Name of the FFTW wisdom program. -extern OCTINTERP_API std::string Vfftw_wisdom_program; - -extern std::string subst_octave_home (const std::string&); - -extern void install_defaults (void); - -extern void set_exec_path (const std::string& path = std::string ()); -extern void set_image_path (const std::string& path = std::string ()); - -#endif diff -r 069c552587a0 -r 959953dba519 src/defun.cc --- a/src/defun.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,200 +0,0 @@ -/* - -Copyright (C) 1996-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "defun.h" -#include "dynamic-ld.h" -#include "error.h" -#include "help.h" -#include "ov.h" -#include "ov-builtin.h" -#include "ov-dld-fcn.h" -#include "ov-fcn.h" -#include "ov-mex-fcn.h" -#include "ov-usr-fcn.h" -#include "oct-obj.h" -#include "oct-lvalue.h" -#include "pager.h" -#include "symtab.h" -#include "toplev.h" -#include "variables.h" -#include "parse.h" - -// Print the usage part of the doc string of FCN (user-defined or DEFUN). -void -print_usage (void) -{ - const octave_function *cur = octave_call_stack::current (); - if (cur) - print_usage (cur->name ()); - else - error ("print_usage: invalid function"); -} - -void -print_usage (const std::string& name) -{ - feval ("print_usage", octave_value (name), 0); -} - -void -check_version (const std::string& version, const std::string& fcn) -{ - if (version != OCTAVE_API_VERSION) - { - error ("API version %s found in .oct file function `%s'\n" - " does not match the running Octave (API version %s)\n" - " this can lead to incorrect results or other failures\n" - " you can fix this problem by recompiling this .oct file", - version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); - } -} - -// Install variables and functions in the symbol tables. - -void -install_builtin_function (octave_builtin::fcn f, const std::string& name, - const std::string& file, const std::string& doc, - bool /* can_hide_function -- not yet implemented */) -{ - octave_value fcn (new octave_builtin (f, name, file, doc)); - - symbol_table::install_built_in_function (name, fcn); -} - -void -install_dld_function (octave_dld_function::fcn f, const std::string& name, - const octave_shlib& shl, const std::string& doc, - bool relative) -{ - octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -install_mex_function (void *fptr, bool fmex, const std::string& name, - const octave_shlib& shl, bool relative) -{ - octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); - - if (relative) - fcn->mark_relative (); - - octave_value fval (fcn); - - symbol_table::install_built_in_function (name, fval); -} - -void -alias_builtin (const std::string& alias, const std::string& name) -{ - symbol_table::alias_built_in_function (alias, name); -} - -octave_shlib -get_current_shlib (void) -{ - octave_shlib retval; - - octave_function *curr_fcn = octave_call_stack::current (); - if (curr_fcn) - { - if (curr_fcn->is_dld_function ()) - { - octave_dld_function *dld = dynamic_cast (curr_fcn); - retval = dld->get_shlib (); - } - else if (curr_fcn->is_mex_function ()) - { - octave_mex_function *mex = dynamic_cast (curr_fcn); - retval = mex->get_shlib (); - } - } - - return retval; -} - -bool defun_isargout (int nargout, int iout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (iout >= std::max (nargout, 1)) - return false; - else if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end (); p++) - { - if (k == iout) - return ! p->is_black_hole (); - k += p->numel (); - if (k > iout) - break; - } - - return true; - } - else - return true; -} - -void defun_isargout (int nargout, int nout, bool *isargout) -{ - const std::list *lvalue_list = octave_builtin::curr_lvalue_list; - if (lvalue_list) - { - int k = 0; - for (std::list::const_iterator p = lvalue_list->begin (); - p != lvalue_list->end () && k < nout; p++) - { - if (p->is_black_hole ()) - isargout[k++] = false; - else - { - int l = std::min (k + p->numel (), - static_cast (nout)); - while (k < l) - isargout[k++] = true; - } - } - } - else - for (int i = 0; i < nout; i++) - isargout[i] = true; - - for (int i = std::max (nargout, 1); i < nout; i++) - isargout[i] = false; -} - diff -r 069c552587a0 -r 959953dba519 src/defun.h --- a/src/defun.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,66 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_defun_h) -#define octave_defun_h 1 - -#if defined (octave_defun_dld_h) -#error defun.h and defun-dld.h both included in same file! -#endif - -#include "defun-int.h" - -// Define a builtin function. -// -// name is the name of the function, unqouted. -// -// args_name is the name of the octave_value_list variable used to pass -// the argument list to this function. -// -// nargout_name is the name of the int variable used to pass the -// number of output arguments this function is expected to produce. -// -// doc is the simple help text for the function. - -#define DEFUN(name, args_name, nargout_name, doc) \ - DEFUN_INTERNAL (name, args_name, nargout_name, doc) - -// This one can be used when `name' cannot be used directly (if it is -// already defined as a macro). In that case, name is already a -// quoted string, and the internal name of the function must be passed -// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). - -#define DEFUNX(name, fname, args_name, nargout_name, doc) \ - DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) - -// This is a function with a name that can't be hidden by a variable. -#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ - DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) - -// Make alias another name for the existing function name. This macro -// must be used in the same file where name is defined, after the -// definition for name. - -#define DEFALIAS(alias, name) \ - DEFALIAS_INTERNAL (alias, name) - -#endif diff -r 069c552587a0 -r 959953dba519 src/dirfns.cc --- a/src/dirfns.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,783 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "dir-ops.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means we ask for confirmation before recursively removing a -// directory tree. -static bool Vconfirm_recursive_rmdir = true; - -// The time we last time we changed directories. -octave_time Vlast_chdir_time = 0.0; - -static int -octave_change_to_directory (const std::string& newdir) -{ - int cd_ok = octave_env::chdir (file_ops::tilde_expand (newdir)); - - if (cd_ok) - { - Vlast_chdir_time.stamp (); - - // FIXME -- should this be handled as a list of functions - // to call so users can add their own chdir handlers? - - load_path::update (); - } - else - error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); - - return cd_ok; -} - -DEFUN (cd, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} cd dir\n\ -@deftypefnx {Command} {} chdir dir\n\ -Change the current working directory to @var{dir}. If @var{dir} is\n\ -omitted, the current directory is changed to the user's home\n\ -directory. For example,\n\ -\n\ -@example\n\ -cd ~/octave\n\ -@end example\n\ -\n\ -@noindent\n\ -changes the current working directory to @file{~/octave}. If the\n\ -directory does not exist, an error message is printed and the working\n\ -directory is not changed.\n\ -@seealso{mkdir, rmdir, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("cd"); - - if (error_state) - return retval; - - if (argc > 1) - { - std::string dirname = argv[1]; - - if (dirname.length () > 0 - && ! octave_change_to_directory (dirname)) - { - return retval; - } - } - else - { - // Behave like Unixy shells for "cd" by itself, but be Matlab - // compatible if doing "current_dir = cd". - - if (nargout == 0) - { - std::string home_dir = octave_env::get_home_directory (); - - if (home_dir.empty () || ! octave_change_to_directory (home_dir)) - return retval; - } - else - retval = octave_value (octave_env::get_current_directory ()); - } - - return retval; -} - -DEFALIAS (chdir, cd); - -DEFUN (pwd, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pwd ()\n\ -Return the current working directory.\n\ -@seealso{dir, ls}\n\ -@end deftypefn") -{ - return octave_value (octave_env::get_current_directory ()); -} - -DEFUN (readdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ -Return names of the files in the directory @var{dir} as a cell array of\n\ -strings. If an error occurs, return an empty cell array in @var{files}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir, glob}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = Cell (); - - if (args.length () == 1) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readdir", args(0)); - else - { - dir_entry dir (dirname); - - if (dir) - { - string_vector dirlist = dir.read (); - retval(1) = 0.0; - retval(0) = Cell (dirlist.sort ()); - } - else - { - retval(2) = dir.error (); - } - } - } - else - print_usage (); - - return retval; -} - -// FIXME -- should maybe also allow second arg to specify -// mode? OTOH, that might cause trouble with compatibility later... - -DEFUNX ("mkdir", Fmkdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ -Create a directory named @var{dir} in the directory @var{parent}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -@seealso{rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - std::string dirname; - - if (nargin == 2) - { - std::string parent = args(0).string_value (); - std::string dir = args(1).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - else - dirname = file_ops::concat (parent, dir); - } - else if (nargin == 1) - { - dirname = args(0).string_value (); - - if (error_state) - { - gripe_wrong_type_arg ("mkdir", args(0)); - return retval; - } - } - - if (nargin == 1 || nargin == 2) - { - std::string msg; - - dirname = file_ops::tilde_expand (dirname); - - file_stat fs (dirname); - - if (fs && fs.is_dir ()) - { - // For compatibility with Matlab, we return true when the - // directory already exists. - - retval(2) = "mkdir"; - retval(1) = "directory exists"; - retval(0) = true; - } - else - { - int status = octave_mkdir (dirname, 0777, msg); - - if (status < 0) - { - retval(2) = "mkdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rmdir", Frmdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ -Remove the directory named @var{dir}.\n\ -\n\ -If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ -character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ -system-dependent error message, and @var{msgid} contains a unique\n\ -message identifier.\n\ -\n\ -If the optional second parameter is supplied with value @code{\"s\"},\n\ -recursively remove all subdirectories as well.\n\ -@seealso{mkdir, confirm_recursive_rmdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string dirname = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rmdir", args(0)); - else - { - std::string fulldir = file_ops::tilde_expand (dirname); - int status = -1; - std::string msg; - - if (nargin == 2) - { - if (args(1).string_value () == "s") - { - bool doit = true; - - if (interactive && Vconfirm_recursive_rmdir) - { - std::string prompt - = "remove entire contents of " + fulldir + "? "; - - doit = octave_yes_or_no (prompt); - } - - if (doit) - status = octave_recursive_rmdir (fulldir, msg); - } - else - error ("rmdir: expecting second argument to be \"s\""); - } - else - status = octave_rmdir (fulldir, msg); - - if (status < 0) - { - retval(2) = "rmdir"; - retval(1) = msg; - } - else - retval(0) = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("link", Flink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ -Create a new link (also known as a hard link) to an existing file.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("link", args(1)); - else - { - std::string msg; - - int status = octave_link (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("symlink", Fsymlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ -Create a symbolic link @var{new} which contains the string @var{old}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, readlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("symlink", args(1)); - else - { - std::string msg; - - int status = octave_symlink (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("readlink", Freadlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ -Read the value of the symbolic link @var{symlink}.\n\ -\n\ -If successful, @var{result} contains the contents of the symbolic link\n\ -@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{link, symlink}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = -1.0; - retval(0) = std::string (); - - if (args.length () == 1) - { - std::string symlink = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("readlink", args(0)); - else - { - std::string result; - std::string msg; - - int status = octave_readlink (symlink, result, msg); - - if (status < 0) - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("rename", Frename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ -Change the name of file @var{old} to @var{new}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{ls, dir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1.0; - - if (args.length () == 2) - { - std::string from = args(0).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(0)); - else - { - std::string to = args(1).string_value (); - - if (error_state) - gripe_wrong_type_arg ("rename", args(1)); - else - { - std::string msg; - - int status = octave_rename (from, to, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (glob, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ -Given an array of pattern strings (as a char array or a cell array) in\n\ -@var{pattern}, return a cell array of file names that match any of\n\ -them, or an empty cell array if no patterns match. The pattern strings are\n\ -interpreted as filename globbing patterns (as they are used by Unix shells).\n\ -Within a pattern\n\ -\n\ -@table @code\n\ -@itemx *\n\ -matches any string, including the null string,\n\ -@itemx ?\n\ -matches any single character, and\n\ -\n\ -@item [@dots{}]\n\ -matches any of the enclosed characters.\n\ -@end table\n\ -\n\ -Tilde expansion\n\ -is performed on each of the patterns before looking for matching file\n\ -names. For example:\n\ -\n\ -@example\n\ -ls\n\ - @result{}\n\ - file1 file2 file3 myfile1 myfile1b\n\ -glob (\"*file1\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = myfile1\n\ - @}\n\ -glob (\"myfile?\")\n\ - @result{}\n\ - @{\n\ - [1,1] = myfile1\n\ - @}\n\ -glob (\"file[12]\")\n\ - @result{}\n\ - @{\n\ - [1,1] = file1\n\ - [2,1] = file2\n\ - @}\n\ -@end example\n\ -@seealso{ls, dir, readdir}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - string_vector pat = args(0).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("glob", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = Cell (pattern.glob ()); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! tmpdir = tmpnam; -%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; -%! if (mkdir (tmpdir)) -%! cwd = pwd; -%! cd (tmpdir); -%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) -%! a = 0; -%! for n = 1:5 -%! save (filename{n}, "a"); -%! endfor -%! else -%! rmdir (tmpdir); -%! error ("Couldn't change to temporary dir"); -%! endif -%! else -%! error ("Couldn't create temporary directory"); -%! endif -%! result1 = glob ("*file1"); -%! result2 = glob ("myfile?"); -%! result3 = glob ("file[12]"); -%! for n = 1:5 -%! delete (filename{n}); -%! endfor -%! cd (cwd); -%! rmdir (tmpdir); -%! assert (result1, {"file1"; "myfile1"}); -%! assert (result2, {"myfile1"}); -%! assert (result3, {"file1"; "file2"}); -*/ - -DEFUNX ("fnmatch", Ffnmatch, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ -Return 1 or zero for each element of @var{string} that matches any of\n\ -the elements of the string array @var{pattern}, using the rules of\n\ -filename pattern matching. For example:\n\ -\n\ -@example\n\ -@group\n\ -fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ - @result{} [ 1; 1; 0 ]\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - string_vector pat = args(0).all_strings (); - string_vector str = args(1).all_strings (); - - if (error_state) - gripe_wrong_type_arg ("fnmatch", args(0)); - else - { - glob_match pattern (file_ops::tilde_expand (pat)); - - retval = pattern.match (str); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (filesep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} filesep ()\n\ -@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ -Return the system-dependent character used to separate directory names.\n\ -\n\ -If \"all\" is given, the function returns all valid file separators in\n\ -the form of a string. The list of file separators is system-dependent.\n\ -It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ -@samp{\\} (forward and backward slashes) under Windows.\n\ -@seealso{pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = file_ops::dir_sep_str (); - else if (args.length () == 1) - { - std::string s = args(0).string_value (); - - if (! error_state) - { - if (s == "all") - retval = file_ops::dir_sep_chars (); - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - gripe_wrong_type_arg ("filesep", args(0)); - } - else - print_usage (); - - return retval; -} - -DEFUN (pathsep, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ -Query or set the character used to separate directories in a path.\n\ -@seealso{filesep}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = dir_path::path_sep_str (); - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - dir_path::path_sep_char (sval[0]); - break; - - case 0: - dir_path::path_sep_char ('\0'); - break; - - default: - error ("pathsep: argument must be a single character"); - break; - } - } - else - error ("pathsep: argument must be a single character"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -DEFUN (confirm_recursive_rmdir, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will ask for confirmation before recursively removing a directory tree.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); -} diff -r 069c552587a0 -r 959953dba519 src/dirfns.h --- a/src/dirfns.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_dirfns_h) -#define octave_dirfns_h 1 - -#include - -#include - -#include "oct-time.h" - -extern std::string polite_directory_format (const std::string&); -extern std::string base_pathname (const std::string&); -extern std::string make_absolute (const std::string&, const std::string&); -extern std::string get_working_directory (const std::string&); - -// The time we last time we changed directories. -extern octave_time Vlast_chdir_time; - -#endif diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__delaunayn__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__delaunayn__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,229 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +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 3 of the License, 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, see +. + +*/ + +/* + 16. July 2000 - Kai Habel: first release + + 25. September 2002 - Changes by Rafael Laboissiere + + * Added Qbb option to normalize the input and avoid crashes in Octave. + * delaunayn accepts now a second (optional) argument that must be a string + containing extra options to the qhull command. + * Fixed doc string. The dimension of the result matrix is [m, dim+1], and + not [n, dim-1]. + + 6. June 2006: Changes by Alexander Barth + + * triangulate non-simplicial facets + * allow options to be specified as cell array of strings + * change the default options (for compatibility with matlab) +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "__delaunayn__.oct 2007-08-21"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (__delaunayn__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ +Undocumented internal function.\n\ +@end deftypefn") + +{ + octave_value_list retval; + +#if defined (HAVE_QHULL) + + retval(0) = 0.0; + + int nargin = args.length (); + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + + Matrix p (args(0).matrix_value ()); + const octave_idx_type dim = p.columns (); + const octave_idx_type n = p.rows (); + + // Default options + std::string options; + if (dim <= 3) + options = "Qt Qbb Qc Qz"; + else + options = "Qt Qbb Qc Qx"; + + if (nargin == 2) + { + if (args(1).is_string ()) + options = args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) + { + options = ""; + Array tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; + } + else + { + error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); + return retval; + } + } + + if (n > dim + 1) + { + p = p.transpose (); + double *pt_array = p.fortran_vec (); + boolT ismalloc = false; + + // Qhull flags argument is not const char* + OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length ()); + + sprintf (flags, "qhull d %s", options.c_str ()); + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("__delaunayn__: unable to create temporary file for output"); + return retval; + } + + int exitcode = qh_new_qhull (dim, n, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) + { + // triangulate non-simplicial facets + qh_triangulate (); + + facetT *facet; + vertexT *vertex, **vertexp; + octave_idx_type nf = 0, i = 0; + + FORALLfacets + { + if (! facet->upperdelaunay) + nf++; + + // Double check. Non-simplicial facets will cause segfault below + if (! facet->simplicial) + { + error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); + exitcode = 1; + break; + } + } + + if (! exitcode) + { + Matrix simpl (nf, dim+1); + + FORALLfacets + { + if (! facet->upperdelaunay) + { + octave_idx_type j = 0; + + FOREACHvertex_ (facet->vertices) + { + simpl(i, j++) = 1 + qh_pointid(vertex->point); + } + i++; + } + } + + retval(0) = simpl; + } + } + else + error ("__delaunayn__: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); + } + else if (n == dim + 1) + { + // one should check if nx points span a simplex + // I will look at this later. + RowVector vec (n); + for (octave_idx_type i = 0; i < n; i++) + vec(i) = i + 1.0; + + retval(0) = vec; + } + +#else + error ("__delaunayn__: not available in this version of Octave"); +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__dsearchn__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__dsearchn__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,115 @@ +/* + +Copyright (C) 2007-2012 David Bateman + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-math.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" + +DEFUN_DLD (__dsearchn__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{idx}, @var{d}] =} dsearch (@var{x}, @var{xi})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 2) + { + print_usage (); + return retval; + } + + Matrix x = args(0).matrix_value ().transpose (); + Matrix xi = args(1).matrix_value ().transpose (); + + if (! error_state) + { + if (x.rows () != xi.rows () || x.columns () < 1) + error ("__dsearch__: number of rows of X and XI must match"); + else + { + octave_idx_type n = x.rows (); + octave_idx_type nx = x.columns (); + octave_idx_type nxi = xi.columns (); + + ColumnVector idx (nxi); + double *pidx = idx.fortran_vec (); + ColumnVector dist (nxi); + double *pdist = dist.fortran_vec (); + +#define DIST(dd, y, yi, m) \ + dd = 0.; \ + for (octave_idx_type k = 0; k < m; k++) \ + { \ + double yd = y[k] - yi[k]; \ + dd += yd * yd; \ + } \ + dd = sqrt (dd); + + const double *pxi = xi.fortran_vec (); + for (octave_idx_type i = 0; i < nxi; i++) + { + double d0; + const double *px = x.fortran_vec (); + DIST(d0, px, pxi, n); + *pidx = 1.; + for (octave_idx_type j = 1; j < nx; j++) + { + px += n; + double d; + DIST (d, px, pxi, n); + if (d < d0) + { + d0 = d; + *pidx = static_cast(j + 1); + } + OCTAVE_QUIT; + } + + *pdist++ = d0; + pidx++; + pxi += n; + } + + retval(1) = dist; + retval(0) = idx; + } + } + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__fltk_uigetfile__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__fltk_uigetfile__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 2010-2012 Kai Habel + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#if defined (HAVE_FLTK) + +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + +#include +#include + +// FLTK headers may include X11/X.h which defines Complex, and that +// conflicts with Octave's Complex typedef. We don't need the X11 +// Complex definition in this file, so remove it before including Octave +// headers which may require Octave's Complex typedef. +#undef Complex + +#include "defun-dld.h" +#include "file-ops.h" + +DEFUN_DLD (__fltk_uigetfile__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __fltk_uigetfile__ (@dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + // Expected argument list: + // + // args(0) ... FileFilter in fltk format + // args(1) ... Title + // args(2) ... Default Filename + // args(3) ... PostionValue [x,y] + // args(4) ... SelectValue "on"/"off"/"dir"/"create" + + octave_value_list retval (3, octave_value (0)); + + std::string file_filter = args(0).string_value (); + std::string title = args(1).string_value (); + std::string default_name = args(2).string_value (); + Matrix pos = args(3).matrix_value (); + + int multi_type = Fl_File_Chooser::SINGLE; + std::string flabel = "Filename:"; + + std::string multi = args(4).string_value (); + if (multi == "on") + multi_type = Fl_File_Chooser::MULTI; + else if (multi == "dir") + { + multi_type = Fl_File_Chooser::DIRECTORY; + flabel = "Directory:"; + } + else if (multi == "create") + multi_type = Fl_File_Chooser::CREATE; + + Fl_File_Chooser::filename_label = flabel.c_str (); + + Fl_File_Chooser fc (default_name.c_str (), file_filter.c_str (), + multi_type, title.c_str ()); + + fc.preview (0); + + if (multi_type == Fl_File_Chooser::CREATE) + fc.ok_label ("Save"); + + fc.show (); + + while (fc.shown ()) + Fl::wait (); + + if (fc.value ()) + { + int file_count = fc.count (); + std::string fname; + + //fltk uses forward slash even for windows + std::string sep = "/"; + std::size_t idx; + + if (file_count == 1 && multi_type != Fl_File_Chooser::DIRECTORY) + { + fname = fc.value (); + idx = fname.find_last_of (sep); + retval(0) = fname.substr (idx + 1); + } + else + { + Cell file_cell = Cell (file_count, 1); + for (octave_idx_type n = 1; n <= file_count; n++) + { + fname = fc.value (n); + idx = fname.find_last_of (sep); + file_cell(n - 1) = fname.substr (idx + 1); + } + retval(0) = file_cell; + } + + if (multi_type == Fl_File_Chooser::DIRECTORY) + retval(0) = std::string (fc.value ()); + else + { + retval(1) = std::string (fc.directory ()) + sep; + retval(2) = fc.filter_value () + 1; + } + } + + fc.hide (); + Fl::flush (); + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#endif diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__glpk__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__glpk__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,861 @@ +/* + +Copyright (C) 2005-2012 Nicolo' Giorgetti + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-ieee.h" + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "pager.h" + +#if defined (HAVE_GLPK) + +extern "C" +{ +#if defined (HAVE_GLPK_GLPK_H) +#include +#else +#include +#endif + +#if 0 +#ifdef GLPK_PRE_4_14 + +#ifndef _GLPLIB_H +#include +#endif +#ifndef lib_set_fault_hook +#define lib_set_fault_hook lib_fault_hook +#endif +#ifndef lib_set_print_hook +#define lib_set_print_hook lib_print_hook +#endif + +#else + +void _glp_lib_print_hook (int (*func)(void *info, char *buf), void *info); +void _glp_lib_fault_hook (int (*func)(void *info, char *buf), void *info); + +#endif +#endif +} + +#define NIntP 17 +#define NRealP 10 + +int lpxIntParam[NIntP] = { + 0, + 1, + 0, + 1, + 0, + -1, + 0, + 200, + 1, + 2, + 0, + 1, + 0, + 0, + 2, + 2, + 1 +}; + +int IParam[NIntP] = { + LPX_K_MSGLEV, + LPX_K_SCALE, + LPX_K_DUAL, + LPX_K_PRICE, + LPX_K_ROUND, + LPX_K_ITLIM, + LPX_K_ITCNT, + LPX_K_OUTFRQ, + LPX_K_MPSINFO, + LPX_K_MPSOBJ, + LPX_K_MPSORIG, + LPX_K_MPSWIDE, + LPX_K_MPSFREE, + LPX_K_MPSSKIP, + LPX_K_BRANCH, + LPX_K_BTRACK, + LPX_K_PRESOL +}; + + +double lpxRealParam[NRealP] = { + 0.07, + 1e-7, + 1e-7, + 1e-9, + -DBL_MAX, + DBL_MAX, + -1.0, + 0.0, + 1e-6, + 1e-7 +}; + +int RParam[NRealP] = { + LPX_K_RELAX, + LPX_K_TOLBND, + LPX_K_TOLDJ, + LPX_K_TOLPIV, + LPX_K_OBJLL, + LPX_K_OBJUL, + LPX_K_TMLIM, + LPX_K_OUTDLY, + LPX_K_TOLINT, + LPX_K_TOLOBJ +}; + +static jmp_buf mark; //-- Address for long jump to jump to + +#if 0 +int +glpk_fault_hook (void * /* info */, char *msg) +{ + error ("CRITICAL ERROR in GLPK: %s", msg); + longjmp (mark, -1); +} + +int +glpk_print_hook (void * /* info */, char *msg) +{ + message (0, "%s", msg); + return 1; +} +#endif + +int +glpk (int sense, int n, int m, double *c, int nz, int *rn, int *cn, + double *a, double *b, char *ctype, int *freeLB, double *lb, + int *freeUB, double *ub, int *vartype, int isMIP, int lpsolver, + int save_pb, double *xmin, double *fmin, double *status, + double *lambda, double *redcosts, double *time, double *mem) +{ + int errnum; + int typx = 0; + int method; + + clock_t t_start = clock (); + +#if 0 +#ifdef GLPK_PRE_4_14 + lib_set_fault_hook (0, glpk_fault_hook); +#else + _glp_lib_fault_hook (glpk_fault_hook, 0); +#endif + + if (lpxIntParam[0] > 1) +#ifdef GLPK_PRE_4_14 + lib_set_print_hook (0, glpk_print_hook); +#else + _glp_lib_print_hook (glpk_print_hook, 0); +#endif +#endif + + LPX *lp = lpx_create_prob (); + + + //-- Set the sense of optimization + if (sense == 1) + lpx_set_obj_dir (lp, LPX_MIN); + else + lpx_set_obj_dir (lp, LPX_MAX); + + //-- If the problem has integer structural variables switch to MIP + if (isMIP) + lpx_set_class (lp, LPX_MIP); + + lpx_add_cols (lp, n); + for (int i = 0; i < n; i++) + { + //-- Define type of the structural variables + if (! freeLB[i] && ! freeUB[i]) + { + if (lb[i] != ub[i]) + lpx_set_col_bnds (lp, i+1, LPX_DB, lb[i], ub[i]); + else + lpx_set_col_bnds (lp, i+1, LPX_FX, lb[i], ub[i]); + } + else + { + if (! freeLB[i] && freeUB[i]) + lpx_set_col_bnds (lp, i+1, LPX_LO, lb[i], ub[i]); + else + { + if (freeLB[i] && ! freeUB[i]) + lpx_set_col_bnds (lp, i+1, LPX_UP, lb[i], ub[i]); + else + lpx_set_col_bnds (lp, i+1, LPX_FR, lb[i], ub[i]); + } + } + + // -- Set the objective coefficient of the corresponding + // -- structural variable. No constant term is assumed. + lpx_set_obj_coef(lp,i+1,c[i]); + + if (isMIP) + lpx_set_col_kind (lp, i+1, vartype[i]); + } + + lpx_add_rows (lp, m); + + for (int i = 0; i < m; i++) + { + /* If the i-th row has no lower bound (types F,U), the + corrispondent parameter will be ignored. + If the i-th row has no upper bound (types F,L), the corrispondent + parameter will be ignored. + If the i-th row is of S type, the i-th LB is used, but + the i-th UB is ignored. + */ + + switch (ctype[i]) + { + case 'F': + typx = LPX_FR; + break; + + case 'U': + typx = LPX_UP; + break; + + case 'L': + typx = LPX_LO; + break; + + case 'S': + typx = LPX_FX; + break; + + case 'D': + typx = LPX_DB; + break; + } + + lpx_set_row_bnds (lp, i+1, typx, b[i], b[i]); + + } + + lpx_load_matrix (lp, nz, rn, cn, a); + + if (save_pb) + { + static char tmp[] = "outpb.lp"; + if (lpx_write_cpxlp (lp, tmp) != 0) + { + error ("__glpk__: unable to write problem"); + longjmp (mark, -1); + } + } + + //-- scale the problem data (if required) + //-- if (scale && (!presol || method == 1)) lpx_scale_prob (lp); + //-- LPX_K_SCALE=IParam[1] LPX_K_PRESOL=IParam[16] + if (lpxIntParam[1] && (! lpxIntParam[16] || lpsolver != 1)) + lpx_scale_prob (lp); + + //-- build advanced initial basis (if required) + if (lpsolver == 1 && ! lpxIntParam[16]) + lpx_adv_basis (lp); + + for (int i = 0; i < NIntP; i++) + lpx_set_int_parm (lp, IParam[i], lpxIntParam[i]); + + for (int i = 0; i < NRealP; i++) + lpx_set_real_parm (lp, RParam[i], lpxRealParam[i]); + + if (lpsolver == 1) + method = 'S'; + else + method = 'T'; + + switch (method) + { + case 'S': + { + if (isMIP) + { + method = 'I'; + errnum = lpx_simplex (lp); + errnum = lpx_integer (lp); + } + else + errnum = lpx_simplex (lp); + } + break; + + case 'T': + errnum = lpx_interior (lp); + break; + + default: + break; +#if 0 +#ifdef GLPK_PRE_4_14 + insist (method != method); +#else + static char tmp[] = "method != method"; + glpk_fault_hook (0, tmp); +#endif +#endif + } + + /* errnum assumes the following results: + errnum = 0 <=> No errors + errnum = 1 <=> Iteration limit exceeded. + errnum = 2 <=> Numerical problems with basis matrix. + */ + if (errnum == LPX_E_OK) + { + if (isMIP) + { + *status = lpx_mip_status (lp); + *fmin = lpx_mip_obj_val (lp); + } + else + { + if (lpsolver == 1) + { + *status = lpx_get_status (lp); + *fmin = lpx_get_obj_val (lp); + } + else + { + *status = lpx_ipt_status (lp); + *fmin = lpx_ipt_obj_val (lp); + } + } + + if (isMIP) + { + for (int i = 0; i < n; i++) + xmin[i] = lpx_mip_col_val (lp, i+1); + } + else + { + /* Primal values */ + for (int i = 0; i < n; i++) + { + if (lpsolver == 1) + xmin[i] = lpx_get_col_prim (lp, i+1); + else + xmin[i] = lpx_ipt_col_prim (lp, i+1); + } + + /* Dual values */ + for (int i = 0; i < m; i++) + { + if (lpsolver == 1) + lambda[i] = lpx_get_row_dual (lp, i+1); + else + lambda[i] = lpx_ipt_row_dual (lp, i+1); + } + + /* Reduced costs */ + for (int i = 0; i < lpx_get_num_cols (lp); i++) + { + if (lpsolver == 1) + redcosts[i] = lpx_get_col_dual (lp, i+1); + else + redcosts[i] = lpx_ipt_col_dual (lp, i+1); + } + } + + *time = (clock () - t_start) / CLOCKS_PER_SEC; + +#ifdef GLPK_PRE_4_14 + *mem = (lib_env_ptr () -> mem_tpeak); +#else + *mem = 0; +#endif + + lpx_delete_prob (lp); + return 0; + } + + lpx_delete_prob (lp); + + *status = errnum; + + return errnum; +} + +#endif + +#define OCTAVE_GLPK_GET_REAL_PARAM(NAME, IDX) \ + do \ + { \ + octave_value tmp = PARAM.getfield (NAME); \ + \ + if (tmp.is_defined ()) \ + { \ + if (! tmp.is_empty ()) \ + { \ + lpxRealParam[IDX] = tmp.scalar_value (); \ + \ + if (error_state) \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + else \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + } \ + while (0) + +#define OCTAVE_GLPK_GET_INT_PARAM(NAME, VAL) \ + do \ + { \ + octave_value tmp = PARAM.getfield (NAME); \ + \ + if (tmp.is_defined ()) \ + { \ + if (! tmp.is_empty ()) \ + { \ + VAL = tmp.int_value (); \ + \ + if (error_state) \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + else \ + { \ + error ("glpk: invalid value in PARAM." NAME); \ + return retval; \ + } \ + } \ + } \ + while (0) + +DEFUN_DLD (__glpk__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{values}] =} __glpk__ (@var{args})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + // The list of values to return. See the declaration in oct-obj.h + octave_value_list retval; + +#if defined (HAVE_GLPK) + + int nrhs = args.length (); + + if (nrhs != 9) + { + print_usage (); + return retval; + } + + //-- 1nd Input. A column array containing the objective function + //-- coefficients. + volatile int mrowsc = args(0).rows (); + + Matrix C (args(0).matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of C"); + return retval; + } + + double *c = C.fortran_vec (); + Array rn; + Array cn; + ColumnVector a; + volatile int mrowsA; + volatile int nz = 0; + + //-- 2nd Input. A matrix containing the constraints coefficients. + // If matrix A is NOT a sparse matrix + if (args(1).is_sparse_type ()) + { + SparseMatrix A = args(1).sparse_matrix_value (); // get the sparse matrix + + if (error_state) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + mrowsA = A.rows (); + octave_idx_type Anc = A.cols (); + octave_idx_type Anz = A.nnz (); + rn.resize (dim_vector (Anz+1, 1)); + cn.resize (dim_vector (Anz+1, 1)); + a.resize (Anz+1, 0.0); + + if (Anc != mrowsc) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + for (octave_idx_type j = 0; j < Anc; j++) + for (octave_idx_type i = A.cidx (j); i < A.cidx (j+1); i++) + { + nz++; + rn(nz) = A.ridx (i) + 1; + cn(nz) = j + 1; + a(nz) = A.data(i); + } + } + else + { + Matrix A (args(1).matrix_value ()); // get the matrix + + if (error_state) + { + error ("__glpk__: invalid value of A"); + return retval; + } + + mrowsA = A.rows (); + rn.resize (dim_vector (mrowsA*mrowsc+1, 1)); + cn.resize (dim_vector (mrowsA*mrowsc+1, 1)); + a.resize (mrowsA*mrowsc+1, 0.0); + + for (int i = 0; i < mrowsA; i++) + { + for (int j = 0; j < mrowsc; j++) + { + if (A(i,j) != 0) + { + nz++; + rn(nz) = i + 1; + cn(nz) = j + 1; + a(nz) = A(i,j); + } + } + } + + } + + //-- 3rd Input. A column array containing the right-hand side value + // for each constraint in the constraint matrix. + Matrix B (args(2).matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of B"); + return retval; + } + + double *b = B.fortran_vec (); + + //-- 4th Input. An array of length mrowsc containing the lower + //-- bound on each of the variables. + Matrix LB (args(3).matrix_value ()); + + if (error_state || LB.length () < mrowsc) + { + error ("__glpk__: invalid value of LB"); + return retval; + } + + double *lb = LB.fortran_vec (); + + //-- LB argument, default: Free + Array freeLB (dim_vector (mrowsc, 1)); + for (int i = 0; i < mrowsc; i++) + { + if (xisinf (lb[i])) + { + freeLB(i) = 1; + lb[i] = -octave_Inf; + } + else + freeLB(i) = 0; + } + + //-- 5th Input. An array of at least length numcols containing the upper + //-- bound on each of the variables. + Matrix UB (args(4).matrix_value ()); + + if (error_state || UB.length () < mrowsc) + { + error ("__glpk__: invalid value of UB"); + return retval; + } + + double *ub = UB.fortran_vec (); + + Array freeUB (dim_vector (mrowsc, 1)); + for (int i = 0; i < mrowsc; i++) + { + if (xisinf (ub[i])) + { + freeUB(i) = 1; + ub[i] = octave_Inf; + } + else + freeUB(i) = 0; + } + + //-- 6th Input. A column array containing the sense of each constraint + //-- in the constraint matrix. + charMatrix CTYPE (args(5).char_matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of CTYPE"); + return retval; + } + + char *ctype = CTYPE.fortran_vec (); + + //-- 7th Input. A column array containing the types of the variables. + charMatrix VTYPE (args(6).char_matrix_value ()); + + if (error_state) + { + error ("__glpk__: invalid value of VARTYPE"); + return retval; + } + + Array vartype (dim_vector (mrowsc, 1)); + volatile int isMIP = 0; + for (int i = 0; i < mrowsc ; i++) + { + if (VTYPE(i,0) == 'I') + { + isMIP = 1; + vartype(i) = LPX_IV; + } + else + vartype(i) = LPX_CV; + } + + //-- 8th Input. Sense of optimization. + volatile int sense; + double SENSE = args(7).scalar_value (); + + if (error_state) + { + error ("__glpk__: invalid value of SENSE"); + return retval; + } + + if (SENSE >= 0) + sense = 1; + else + sense = -1; + + //-- 9th Input. A structure containing the control parameters. + octave_scalar_map PARAM = args(8).scalar_map_value (); + + if (error_state) + { + error ("__glpk__: invalid value of PARAM"); + return retval; + } + + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + //-- Integer parameters + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + //-- Level of messages output by the solver + OCTAVE_GLPK_GET_INT_PARAM ("msglev", lpxIntParam[0]); + if (lpxIntParam[0] < 0 || lpxIntParam[0] > 3) + { + error ("__glpk__: PARAM.msglev must be 0 (no output [default]) or 1 (error messages only) or 2 (normal output) or 3 (full output)"); + return retval; + } + + //-- scaling option + OCTAVE_GLPK_GET_INT_PARAM ("scale", lpxIntParam[1]); + if (lpxIntParam[1] < 0 || lpxIntParam[1] > 2) + { + error ("__glpk__: PARAM.scale must be 0 (no scaling) or 1 (equilibration scaling [default]) or 2 (geometric mean scaling)"); + return retval; + } + + //-- Dual dimplex option + OCTAVE_GLPK_GET_INT_PARAM ("dual", lpxIntParam[2]); + if (lpxIntParam[2] < 0 || lpxIntParam[2] > 1) + { + error ("__glpk__: PARAM.dual must be 0 (do NOT use dual simplex [default]) or 1 (use dual simplex)"); + return retval; + } + + //-- Pricing option + OCTAVE_GLPK_GET_INT_PARAM ("price", lpxIntParam[3]); + if (lpxIntParam[3] < 0 || lpxIntParam[3] > 1) + { + error ("__glpk__: PARAM.price must be 0 (textbook pricing) or 1 (steepest edge pricing [default])"); + return retval; + } + + //-- Solution rounding option + OCTAVE_GLPK_GET_INT_PARAM ("round", lpxIntParam[4]); + if (lpxIntParam[4] < 0 || lpxIntParam[4] > 1) + { + error ("__glpk__: PARAM.round must be 0 (report all primal and dual values [default]) or 1 (replace tiny primal and dual values by exact zero)"); + return retval; + } + + //-- Simplex iterations limit + OCTAVE_GLPK_GET_INT_PARAM ("itlim", lpxIntParam[5]); + + //-- Simplex iterations count + OCTAVE_GLPK_GET_INT_PARAM ("itcnt", lpxIntParam[6]); + + //-- Output frequency, in iterations + OCTAVE_GLPK_GET_INT_PARAM ("outfrq", lpxIntParam[7]); + + //-- Branching heuristic option + OCTAVE_GLPK_GET_INT_PARAM ("branch", lpxIntParam[14]); + if (lpxIntParam[14] < 0 || lpxIntParam[14] > 2) + { + error ("__glpk__: PARAM.branch must be (MIP only) 0 (branch on first variable) or 1 (branch on last variable) or 2 (branch using a heuristic by Driebeck and Tomlin [default]"); + return retval; + } + + //-- Backtracking heuristic option + OCTAVE_GLPK_GET_INT_PARAM ("btrack", lpxIntParam[15]); + if (lpxIntParam[15] < 0 || lpxIntParam[15] > 2) + { + error ("__glpk__: PARAM.btrack must be (MIP only) 0 (depth first search) or 1 (breadth first search) or 2 (backtrack using the best projection heuristic [default]"); + return retval; + } + + //-- Presolver option + OCTAVE_GLPK_GET_INT_PARAM ("presol", lpxIntParam[16]); + if (lpxIntParam[16] < 0 || lpxIntParam[16] > 1) + { + error ("__glpk__: PARAM.presol must be 0 (do NOT use LP presolver) or 1 (use LP presolver [default])"); + return retval; + } + + //-- LPsolver option + volatile int lpsolver = 1; + OCTAVE_GLPK_GET_INT_PARAM ("lpsolver", lpsolver); + if (lpsolver < 1 || lpsolver > 2) + { + error ("__glpk__: PARAM.lpsolver must be 1 (simplex method) or 2 (interior point method)"); + return retval; + } + + //-- Save option + volatile int save_pb = 0; + OCTAVE_GLPK_GET_INT_PARAM ("save", save_pb); + save_pb = save_pb != 0; + + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + //-- Real parameters + //-- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + //-- Ratio test option + OCTAVE_GLPK_GET_REAL_PARAM ("relax", 0); + + //-- Relative tolerance used to check if the current basic solution + //-- is primal feasible + OCTAVE_GLPK_GET_REAL_PARAM ("tolbnd", 1); + + //-- Absolute tolerance used to check if the current basic solution + //-- is dual feasible + OCTAVE_GLPK_GET_REAL_PARAM ("toldj", 2); + + //-- Relative tolerance used to choose eligible pivotal elements of + //-- the simplex table in the ratio test + OCTAVE_GLPK_GET_REAL_PARAM ("tolpiv", 3); + + OCTAVE_GLPK_GET_REAL_PARAM ("objll", 4); + + OCTAVE_GLPK_GET_REAL_PARAM ("objul", 5); + + OCTAVE_GLPK_GET_REAL_PARAM ("tmlim", 6); + + OCTAVE_GLPK_GET_REAL_PARAM ("outdly", 7); + + OCTAVE_GLPK_GET_REAL_PARAM ("tolint", 8); + + OCTAVE_GLPK_GET_REAL_PARAM ("tolobj", 9); + + //-- Assign pointers to the output parameters + ColumnVector xmin (mrowsc, octave_NA); + double fmin = octave_NA; + double status; + ColumnVector lambda (mrowsA, octave_NA); + ColumnVector redcosts (mrowsc, octave_NA); + double time; + double mem; + + int jmpret = setjmp (mark); + + if (jmpret == 0) + glpk (sense, mrowsc, mrowsA, c, nz, rn.fortran_vec (), + cn.fortran_vec (), a.fortran_vec (), b, ctype, + freeLB.fortran_vec (), lb, freeUB.fortran_vec (), ub, + vartype.fortran_vec (), isMIP, lpsolver, save_pb, + xmin.fortran_vec (), &fmin, &status, lambda.fortran_vec (), + redcosts.fortran_vec (), &time, &mem); + + octave_scalar_map extra; + + if (! isMIP) + { + extra.assign ("lambda", lambda); + extra.assign ("redcosts", redcosts); + } + + extra.assign ("time", time); + extra.assign ("mem", mem); + + retval(3) = extra; + retval(2) = status; + retval(1) = fmin; + retval(0) = xmin; + +#else + + gripe_not_supported ("glpk"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__init_fltk__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__init_fltk__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2129 @@ +/* + +Copyright (C) 2007-2012 Shai Ayal + +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 3 of the License, 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, see +. + +*/ + +/* + +To initialize: + + graphics_toolkit ("fltk"); + plot (randn (1e3, 1)); + +*/ + +// PKG_ADD: register_graphics_toolkit ("fltk"); + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" + +#if defined (HAVE_FLTK) + +#include +#include +#include +#include + +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +// FLTK headers may include X11/X.h which defines Complex, and that +// conflicts with Octave's Complex typedef. We don't need the X11 +// Complex definition in this file, so remove it before including Octave +// headers which may require Octave's Complex typedef. +#undef Complex + +#include "cmd-edit.h" +#include "lo-ieee.h" + +#include "file-ops.h" +#include "gl-render.h" +#include "gl2ps-renderer.h" +#include "graphics.h" +#include "parse.h" +#include "sysdep.h" +#include "toplev.h" +#include "variables.h" + +#define FLTK_GRAPHICS_TOOLKIT_NAME "fltk" + +// Give FLTK no more than 0.01 sec to do its stuff. +static double fltk_maxtime = 1e-2; + +const char* help_text = "\ +Keyboard Shortcuts\n\ +a - autoscale\n\ +p - pan/zoom\n\ +r - rotate\n\ +g - toggle grid\n\ +\n\ +Mouse\n\ +left drag - pan\n\ +mouse wheel - zoom\n\ +right drag - rectangle zoom\n\ +left double click - autoscale\n\ +"; + +class OpenGL_fltk : public Fl_Gl_Window +{ +public: + OpenGL_fltk (int xx, int yy, int ww, int hh, double num) + : Fl_Gl_Window (xx, yy, ww, hh, 0), number (num), renderer (), + in_zoom (false), zoom_box (), print_mode (false) + { + // Ask for double buffering and a depth buffer. + mode (FL_DEPTH | FL_DOUBLE); + } + + ~OpenGL_fltk (void) { } + + void zoom (bool z) + { + in_zoom = z; + if (! in_zoom) + hide_overlay (); + } + + bool zoom (void) { return in_zoom; } + void set_zoom_box (const Matrix& zb) { zoom_box = zb; } + + void print (const std::string& cmd, const std::string& term) + { + print_mode = true; + print_cmd = cmd; + print_term = term; + } + + void resize (int xx, int yy, int ww, int hh) + { + Fl_Gl_Window::resize (xx, yy, ww, hh); + setup_viewport (ww, hh); + redraw (); + } + + bool renumber (double new_number) + { + bool retval = false; + + if (number != new_number) + { + number = new_number; + retval = true; + } + + return retval; + } + +private: + double number; + opengl_renderer renderer; + bool in_zoom; + // (x1,y1,x2,y2) + Matrix zoom_box; + + bool print_mode; + std::string print_cmd; + std::string print_term; + + void setup_viewport (int ww, int hh) + { + glMatrixMode (GL_PROJECTION); + glLoadIdentity (); + glViewport (0, 0, ww, hh); + } + + void draw (void) + { + if (! valid ()) + { + valid (1); + setup_viewport (w (), h ()); + } + + if (print_mode) + { + FILE *fp = octave_popen (print_cmd.c_str (), "w"); + glps_renderer rend (fp, print_term); + + rend.draw (gh_manager::get_object (number)); + + octave_pclose (fp); + print_mode = false; + } + else + { + renderer.draw (gh_manager::get_object (number)); + + if (zoom ()) + overlay (); + } + } + + void zoom_box_vertex (void) + { + glVertex2d (zoom_box(0), h () - zoom_box(1)); + glVertex2d (zoom_box(0), h () - zoom_box(3)); + glVertex2d (zoom_box(2), h () - zoom_box(3)); + glVertex2d (zoom_box(2), h () - zoom_box(1)); + glVertex2d (zoom_box(0), h () - zoom_box(1)); + } + + void overlay (void) + { + glPushMatrix (); + + glMatrixMode (GL_MODELVIEW); + glLoadIdentity (); + + glMatrixMode (GL_PROJECTION); + glLoadIdentity (); + gluOrtho2D (0.0, w (), 0.0, h ()); + + glPushAttrib (GL_DEPTH_BUFFER_BIT | GL_CURRENT_BIT); + glDisable (GL_DEPTH_TEST); + + glBegin (GL_POLYGON); + glColor4f (0.45, 0.62, 0.81, 0.1); + zoom_box_vertex (); + glEnd (); + + glBegin (GL_LINE_STRIP); + glLineWidth (1.5); + glColor4f (0.45, 0.62, 0.81, 0.9); + zoom_box_vertex (); + glEnd (); + + glPopAttrib (); + glPopMatrix (); + } + + int handle (int event) + { + int retval = Fl_Gl_Window::handle (event); + + switch (event) + { + case FL_ENTER: + window ()->cursor (FL_CURSOR_CROSS); + return 1; + + case FL_LEAVE: + window ()->cursor (FL_CURSOR_DEFAULT); + return 1; + } + + return retval; + } +}; + +// Parameter controlling how fast we zoom when using the scrool wheel. +static double wheel_zoom_speed = 0.05; +// Parameter controlling the GUI mode. +static enum { pan_zoom, rotate_zoom, none } gui_mode; + +void script_cb (Fl_Widget*, void* data) + { + static_cast (data)->execute_callback (); + } + + +class fltk_uimenu +{ +public: + fltk_uimenu (int xx, int yy, int ww, int hh) + { + menubar = new + Fl_Menu_Bar (xx, yy, ww, hh); + } + + int items_to_show (void) + { + //returns the number of visible menu items + int len = menubar->size (); + int n = 0; + for (int t = 0; t < len; t++ ) + { + const Fl_Menu_Item *m = static_cast (&(menubar->menu ()[t])); + if ((m->label () != NULL) && m->visible ()) + n++; + } + + return n; + } + + void show (void) + { + menubar->show (); + } + + void hide (void) + { + menubar->hide (); + } + + bool is_visible (void) + { + return menubar->visible (); + } + + int find_index_by_name (const std::string& findname) + { + // This function is derived from Greg Ercolano's function + // int GetIndexByName(...), see: + // http://seriss.com/people/erco/fltk/#Menu_ChangeLabel + // He agreed via PM that it can be included in octave using GPLv3 + // Kai Habel (14.10.2010) + + std::string menupath; + for (int t = 0; t < menubar->size (); t++ ) + { + Fl_Menu_Item *m = const_cast (&(menubar->menu ()[t])); + if (m->submenu ()) + { + // item has submenu + if (!menupath.empty ()) + menupath += "/"; + menupath += m->label (); + + if (menupath.compare (findname) == 0 ) + return (t); + } + else + { + // End of submenu? Pop back one level. + if (m->label () == NULL) + { + std::size_t idx = menupath.find_last_of ("/"); + if (idx != std::string::npos) + menupath.erase (idx); + else + menupath.clear (); + continue; + } + // Menu item? + std::string itempath = menupath; + if (!itempath.empty ()) + itempath += "/"; + itempath += m->label (); + + if (itempath.compare (findname) == 0) + return (t); + } + } + return (-1); + } + + Matrix find_uimenu_children (uimenu::properties& uimenup) const + { + Matrix uimenu_childs = uimenup.get_all_children (); + Matrix retval = do_find_uimenu_children (uimenu_childs); + return retval; + } + + Matrix find_uimenu_children (figure::properties& figp) const + { + Matrix uimenu_childs = figp.get_all_children (); + Matrix retval = do_find_uimenu_children (uimenu_childs); + return retval; + } + + Matrix do_find_uimenu_children (Matrix uimenu_childs) const + { + octave_idx_type k = 0; + + + Matrix pos = Matrix (uimenu_childs.numel (), 1); + + for (octave_idx_type ii = 0; ii < uimenu_childs.numel (); ii++) + { + graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); + + if (kidgo.valid_object () && kidgo.isa ("uimenu")) + { + uimenu_childs(k) = uimenu_childs(ii); + pos(k++) = + dynamic_cast (kidgo.get_properties ()).get_position (); + } + } + + uimenu_childs.resize (k, 1); + pos.resize (k, 1); + Matrix retval = Matrix (k, 1); + // Don't know if this is the best method to sort. + // Can we avoid the for loop? + Array sidx = pos.sort_rows_idx (DESCENDING); + for (octave_idx_type ii = 0; ii < k; ii++) + retval(ii) = uimenu_childs (sidx(ii)); + + return retval; + } + + void delete_entry (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + int idx = find_index_by_name (fltk_label.c_str ()); + + if (idx >= 0) + menubar->remove (idx); + } + + void update_accelerator (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + std::string acc = uimenup.get_accelerator (); + if (acc.length () > 0) + { + int key = FL_CTRL + acc[0]; + item->shortcut (key); + } + } + } + } + + void update_callback (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (!uimenup.get_callback ().is_empty ()) + item->callback (static_cast (script_cb), + static_cast (&uimenup)); + else + item->callback (NULL, static_cast (0)); + } + } + } + + void update_enable (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (uimenup.is_enable ()) + item->activate (); + else + item->deactivate (); + } + } + } + + void update_foregroundcolor (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + Matrix rgb = uimenup.get_foregroundcolor_rgb (); + + uchar r = static_cast (gnulib::floor (rgb (0) * 255)); + uchar g = static_cast (gnulib::floor (rgb (1) * 255)); + uchar b = static_cast (gnulib::floor (rgb (2) * 255)); + + item->labelcolor (fl_rgb_color (r, g, b)); + } + } + } + + void update_seperator (const uimenu::properties& uimenup) + { + // Matlab places the separator before the current + // menu entry, while fltk places it after. So we need to find + // the previous item in this menu/submenu. (Kai) + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + int itemflags = 0, idx; + int curr_idx = find_index_by_name (fltk_label.c_str ()); + + for (idx = curr_idx - 1; idx >= 0; idx--) + { + Fl_Menu_Item* item = const_cast (&menubar->menu () [idx]); + itemflags = item->flags; + if (item->label () != NULL) + break; + } + + if (idx >= 0 && idx < menubar->size ()) + { + if (uimenup.is_separator ()) + { + if (idx >= 0 && !(itemflags & FL_SUBMENU)) + menubar->mode (idx, itemflags | FL_MENU_DIVIDER); + } + else + menubar->mode (idx, itemflags & (~FL_MENU_DIVIDER)); + } + } + } + + void update_visible (uimenu::properties& uimenup) + { + std::string fltk_label = uimenup.get_fltk_label (); + if (!fltk_label.empty ()) + { + Fl_Menu_Item* item + = const_cast (menubar->find_item (fltk_label.c_str ())); + if (item != NULL) + { + if (uimenup.is_visible ()) + item->show (); + else + item->hide (); + } + } + } + + void add_entry (uimenu::properties& uimenup) + { + + std::string fltk_label = uimenup.get_fltk_label (); + + if (!fltk_label.empty ()) + { + bool item_added = false; + do + { + const Fl_Menu_Item* item + = menubar->find_item (fltk_label.c_str ()); + + if (item == NULL) + { + Matrix uimenu_ch = find_uimenu_children (uimenup); + int len = uimenu_ch.numel (); + int flags = 0; + if (len > 0) + flags = FL_SUBMENU; + if (len == 0 && uimenup.is_checked ()) + flags += FL_MENU_TOGGLE + FL_MENU_VALUE; + menubar->add (fltk_label.c_str (), 0, 0, 0, flags); + item_added = true; + } + else + { + //avoid duplicate menulabels + std::size_t idx1 = fltk_label.find_last_of ("("); + std::size_t idx2 = fltk_label.find_last_of (")"); + int len = idx2 - idx1; + int val = 1; + if (len > 0) + { + std::string valstr = fltk_label.substr (idx1 + 1, len - 1); + fltk_label.erase (idx1, len + 1); + val = atoi (valstr.c_str ()); + if (val > 0 && val < 99) + val++; + } + std::ostringstream valstream; + valstream << val; + fltk_label += "(" + valstream.str () + ")"; + } + } + while (!item_added); + uimenup.set_fltk_label (fltk_label); + } + } + + void add_to_menu (uimenu::properties& uimenup) + { + Matrix kids = find_uimenu_children (uimenup); + int len = kids.length (); + std::string fltk_label = uimenup.get_fltk_label (); + + add_entry (uimenup); + update_foregroundcolor (uimenup); + update_callback (uimenup); + update_accelerator (uimenup); + update_enable (uimenup); + update_visible (uimenup); + update_seperator (uimenup); + + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + if (kgo.valid_object ()) + { + uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); + add_to_menu (kprop); + } + } + } + + void add_to_menu (figure::properties& figp) + { + Matrix kids = find_uimenu_children (figp); + int len = kids.length (); + menubar->clear (); + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + + if (kgo.valid_object ()) + { + uimenu::properties& kprop = dynamic_cast (kgo.get_properties ()); + add_to_menu (kprop); + } + } + } + + template + void remove_from_menu (T_prop& prop) + { + Matrix kids; + std::string type = prop.get_type (); + kids = find_uimenu_children (prop); + int len = kids.length (); + + for (octave_idx_type ii = 0; ii < len; ii++) + { + graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); + + if (kgo.valid_object ()) + { + uimenu::properties kprop = dynamic_cast (kgo.get_properties ()); + remove_from_menu (kprop); + } + } + + if (type.compare ("uimenu") == 0) + delete_entry (dynamic_cast (prop)); + else if (type.compare ("figure") == 0) + menubar->clear (); + } + + ~fltk_uimenu (void) + { + delete menubar; + } + +private: + + // No copying! + + fltk_uimenu (const fltk_uimenu&); + + fltk_uimenu operator = (const fltk_uimenu&); + + Fl_Menu_Bar* menubar; +}; + +class plot_window : public Fl_Window +{ + friend class fltk_uimenu; +public: + plot_window (int xx, int yy, int ww, int hh, figure::properties& xfp) + : Fl_Window (xx, yy, ww, hh, "octave"), window_label (), shift (0), + ndim (2), fp (xfp), canvas (0), autoscale (0), togglegrid (0), + panzoom (0), rotate (0), help (0), status (0), + ax_obj (), pos_x (0), pos_y (0) + { + callback (window_close, static_cast (this)); + size_range (4*status_h, 2*status_h); + + // FIXME: The function below is only available in FLTK >= 1.3 + // At some point support for FLTK 1.1 will be dropped in Octave. + // At that point this function should be uncommented. + // The current solution is to call xclass() before show() for each window. + // Set WM_CLASS which allows window managers to properly group related + // windows. Otherwise, the class is just "FLTK" + //default_xclass ("Octave"); + + begin (); + { + + canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); + + uimenu = new fltk_uimenu (0, 0, ww, menu_h); + uimenu->hide (); + + bottom = new Fl_Box (0, hh - status_h, ww, status_h); + bottom->box (FL_FLAT_BOX); + + ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); + + autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); + autoscale->callback (button_callback, static_cast (this)); + autoscale->tooltip ("Autoscale"); + + togglegrid = new Fl_Button (status_h, hh - status_h, status_h, + status_h, "G"); + togglegrid->callback (button_callback, static_cast (this)); + togglegrid->tooltip ("Toggle Grid"); + + panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, + status_h, "P"); + panzoom->callback (button_callback, static_cast (this)); + panzoom->tooltip ("Mouse Pan/Zoom"); + + rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, + status_h, "R"); + rotate->callback (button_callback, static_cast (this)); + rotate->tooltip ("Mouse Rotate"); + + if (ndim == 2) + rotate->deactivate (); + + help = new Fl_Button (4 * status_h, hh - status_h, status_h, + status_h, "?"); + help->callback (button_callback, static_cast (this)); + help->tooltip ("Help"); + + status = new Fl_Output (5 * status_h, hh - status_h, + ww > 2*status_h ? ww - status_h : 0, + status_h, ""); + + status->textcolor (FL_BLACK); + status->color (FL_GRAY); + status->textfont (FL_COURIER); + status->textsize (10); + status->box (FL_ENGRAVED_BOX); + + // This allows us to have a valid OpenGL context right away. + canvas->mode (FL_DEPTH | FL_DOUBLE ); + if (fp.is_visible ()) + { + // FIXME: This code should be removed when Octave drops support + // for FLTK 1.1. Search for default_xclass in this file to find + // code that should be uncommented to take its place. + // + // Set WM_CLASS which allows window managers to properly group + // related windows. Otherwise, the class is just "FLTK" + xclass ("Octave"); + show (); + if (fp.get_currentaxes ().ok ()) + show_canvas (); + else + hide_canvas (); + } + } + end (); + + status->show (); + autoscale->show (); + togglegrid->show (); + panzoom->show (); + rotate->show (); + + set_name (); + resizable (canvas); + gui_mode = (ndim == 3 ? rotate_zoom : pan_zoom); + uimenu->add_to_menu (fp); + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); + } + + ~plot_window (void) + { + canvas->hide (); + status->hide (); + uimenu->hide (); + this->hide (); + } + + double number (void) { return fp.get___myhandle__ ().value (); } + + void renumber (double new_number) + { + if (canvas) + { + if (canvas->renumber (new_number)) + mark_modified (); + } + else + error ("unable to renumber figure"); + } + + void print (const std::string& cmd, const std::string& term) + { + canvas->print (cmd, term); + + // Print immediately so the output file will exist when the drawnow + // command is done. + mark_modified (); + Fl::wait (fltk_maxtime); + } + + void show_menubar (void) + { + if (!uimenu->is_visible ()) + { + canvas->resize (canvas->x (), + canvas->y () + menu_h, + canvas->w (), + canvas->h () - menu_h); + uimenu->show (); + mark_modified (); + } + } + + void hide_menubar (void) + { + if (uimenu->is_visible ()) + { + canvas->resize (canvas->x (), + canvas->y () - menu_h, + canvas->w (), + canvas->h () + menu_h); + uimenu->hide (); + mark_modified (); + } + } + + void uimenu_update (const graphics_handle& gh, int id) + { + graphics_object uimenu_obj = gh_manager::get_object (gh); + + if (uimenu_obj.valid_object () && uimenu_obj.isa ("uimenu")) + { + uimenu::properties& uimenup = + dynamic_cast (uimenu_obj.get_properties ()); + std::string fltk_label = uimenup.get_fltk_label (); + graphics_object fig = uimenu_obj.get_ancestor ("figure"); + figure::properties& figp = + dynamic_cast (fig.get_properties ()); + + switch (id) + { + case base_properties::ID_BEINGDELETED: + uimenu->remove_from_menu (uimenup); + break; + + case base_properties::ID_VISIBLE: + uimenu->update_visible (uimenup); + break; + + case uimenu::properties::ID_ACCELERATOR: + uimenu->update_accelerator (uimenup); + break; + + case uimenu::properties::ID_CALLBACK: + uimenu->update_callback (uimenup); + break; + + case uimenu::properties::ID_CHECKED: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_ENABLE: + uimenu->update_enable (uimenup); + break; + + case uimenu::properties::ID_FOREGROUNDCOLOR: + uimenu->update_foregroundcolor (uimenup); + break; + + case uimenu::properties::ID_LABEL: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_POSITION: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_SEPARATOR: + uimenu->update_seperator (uimenup); + break; + } + + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); + + mark_modified (); + } + } + + void show_canvas (void) + { + if (fp.is_visible ()) + { + canvas->show (); + canvas->make_current (); + } + } + + void hide_canvas (void) + { + canvas->hide (); + } + + void mark_modified (void) + { + damage (FL_DAMAGE_ALL); + canvas->damage (FL_DAMAGE_ALL); + ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); + + if (ndim == 3) + rotate->activate (); + else if (ndim == 2 && gui_mode == rotate_zoom) + { + rotate->deactivate (); + gui_mode = pan_zoom; + } + } + + void set_name (void) + { + window_label = fp.get_title (); + label (window_label.c_str ()); + } + +private: + + // No copying! + + plot_window (const plot_window&); + + plot_window& operator = (const plot_window&); + + // window name -- this must exists for the duration of the window's + // life + std::string window_label; + + // Mod keys status + int shift; + + // Number of dimensions, 2 or 3. + int ndim; + + // Figure properties. + figure::properties& fp; + + // Status area height. + static const int status_h = 20; + + // Menu height + static const int menu_h = 20; + + // Window callback. + static void window_close (Fl_Widget*, void* data) + { + octave_value_list args; + args(0) = static_cast (data)->number (); + feval ("close", args); + } + + // Button callbacks. + static void button_callback (Fl_Widget* ww, void* data) + { + static_cast (data)->button_press (ww, data); + } + + void button_press (Fl_Widget* widg, void*) + { + if (widg == autoscale) + axis_auto (); + + if (widg == togglegrid) + toggle_grid (); + + if (widg == panzoom) + gui_mode = pan_zoom; + + if (widg == rotate && ndim == 3) + gui_mode = rotate_zoom; + + if (widg == help) + fl_message ("%s", help_text); + } + + fltk_uimenu* uimenu; + OpenGL_fltk* canvas; + Fl_Box* bottom; + Fl_Button* autoscale; + Fl_Button* togglegrid; + Fl_Button* panzoom; + Fl_Button* rotate; + Fl_Button* help; + Fl_Output* status; + graphics_object ax_obj; + int pos_x; + int pos_y; + + void axis_auto (void) + { + octave_value_list args; + args(0) = fp.get_currentaxes ().as_octave_value (); + args(1) = "auto"; + feval ("axis", args); + mark_modified (); + } + + void toggle_grid (void) + { + octave_value_list args; + if (fp.get_currentaxes ().ok ()) + args(0) = fp.get_currentaxes ().as_octave_value (); + + feval ("grid", args); + mark_modified (); + } + + void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, + double& yy) const + { + pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); + } + + void pixel2pos (graphics_object ax, int px, int py, double& xx, + double& yy) const + { + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + ColumnVector pp = ap.pixel2coord (px, py); + xx = pp(0); + yy = pp(1); + } + } + + graphics_handle pixel2axes_or_ca (int px, int py ) + { + Matrix kids = fp.get_children (); + int len = kids.length (); + + for (int k = 0; k < len; k++) + { + graphics_handle hnd = gh_manager::lookup (kids(k)); + + if (hnd.ok ()) + { + graphics_object kid = gh_manager::get_object (hnd); + + if (kid.valid_object () && kid.isa ("axes")) + { + Matrix bb = kid.get_properties ().get_boundingbox (true); + + if (bb(0) <= px && px < (bb(0)+bb(2)) + && bb(1) <= py && py < (bb(1)+bb(3))) + { + return hnd; + } + } + } + } + return fp.get_currentaxes (); + } + + void pixel2status (const graphics_handle& ax, int px0, int py0, + int px1 = -1, int py1 = -1) + { + pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); + } + + void pixel2status (graphics_object ax, int px0, int py0, + int px1 = -1, int py1 = -1) + { + double x0, y0, x1, y1; + std::stringstream cbuf; + cbuf.precision (4); + cbuf.width (6); + pixel2pos (ax, px0, py0, x0, y0); + cbuf << "[" << x0 << ", " << y0 << "]"; + if (px1 >= 0) + { + pixel2pos (ax, px1, py1, x1, y1); + cbuf << " -> ["<< x1 << ", " << y1 << "]"; + } + + status->value (cbuf.str ().c_str ()); + status->redraw (); + } + + void view2status (graphics_object ax) + { + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + std::stringstream cbuf; + cbuf.precision (4); + cbuf.width (6); + Matrix v (1,2,0); + v = ap.get ("view").matrix_value (); + cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; + + status->value (cbuf.str ().c_str ()); + status->redraw (); + } + } + + void set_currentpoint (int px, int py) + { + if (!fp.is_beingdeleted ()) + { + Matrix pos (1,2,0); + pos(0) = px; + pos(1) = h () - status_h - menu_h - py; + fp.set_currentpoint (pos); + } + } + + void set_axes_currentpoint (graphics_object ax, int px, int py) + { + if (ax.valid_object ()) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + + double xx, yy; + pixel2pos (ax, px, py, xx, yy); + + Matrix pos (2,3,0); + pos(0,0) = xx; + pos(1,0) = yy; + pos(0,1) = xx; + pos(1,1) = yy; + + ap.set_currentpoint (pos); + } + } + + int key2shift (int key) + { + if (key == FL_Shift_L || key == FL_Shift_R) + return FL_SHIFT; + + if (key == FL_Control_L || key == FL_Control_R) + return FL_CTRL; + + if (key == FL_Alt_L || key == FL_Alt_R) + return FL_ALT; + + if (key == FL_Meta_L || key == FL_Meta_R) + return FL_META; + + return 0; + } + + int key2ascii (int key) + { + if (key < 256) return key; + if (key == FL_Tab) return '\t'; + if (key == FL_Enter) return 0x0a; + if (key == FL_BackSpace) return 0x08; + if (key == FL_Escape) return 0x1b; + + return 0; + } + + Cell modifier2cell () + { + string_vector mod; + + if (shift & FL_SHIFT) + mod.append (std::string ("shift")); + if (shift & FL_CTRL) + mod.append (std::string ("control")); + if (shift & FL_ALT || shift & FL_META) + mod.append (std::string ("alt")); + + return Cell (mod); + } + + void resize (int xx,int yy,int ww,int hh) + { + Fl_Window::resize (xx, yy, ww, hh); + + Matrix pos (1,4,0); + pos(0) = xx; + pos(1) = yy; + pos(2) = ww; + pos(3) = hh - status_h - menu_h; + + fp.set_boundingbox (pos, true); + } + + void draw (void) + { + Matrix pos = fp.get_boundingbox (true); + Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); + + return Fl_Window::draw (); + } + + int handle (int event) + { + graphics_handle gh; + + graphics_object fig = gh_manager::get_object (fp.get___myhandle__ ()); + int retval = Fl_Window::handle (event); + + // We only handle events which are in the canvas area. + if (!Fl::event_inside (canvas)) + return retval; + + if (!fp.is_beingdeleted ()) + { + switch (event) + { + case FL_KEYDOWN: + { + int key = Fl::event_key (); + + shift |= key2shift (key); + int key_a = key2ascii (key); + if (key_a && fp.get_keypressfcn ().is_defined ()) + { + Octave_map evt; + evt.assign ("Character", octave_value (key_a)); + evt.assign ("Key", octave_value (std::tolower (key_a))); + evt.assign ("Modifier", octave_value (modifier2cell ())); + fp.execute_keypressfcn (evt); + } + switch (key) + { + case 'a': + case 'A': + axis_auto (); + break; + + case 'g': + case 'G': + toggle_grid (); + break; + + case 'p': + case 'P': + gui_mode = pan_zoom; + break; + + case 'r': + case 'R': + gui_mode = rotate_zoom; + break; + } + } + break; + + case FL_KEYUP: + { + int key = Fl::event_key (); + + shift &= (~key2shift (key)); + int key_a = key2ascii (key); + if (key_a && fp.get_keyreleasefcn ().is_defined ()) + { + Octave_map evt; + evt.assign ("Character", octave_value (key_a)); + evt.assign ("Key", octave_value (std::tolower (key_a))); + evt.assign ("Modifier", octave_value (modifier2cell ())); + fp.execute_keyreleasefcn (evt); + } + } + break; + + case FL_MOVE: + pixel2status (pixel2axes_or_ca (Fl::event_x (), Fl::event_y ()), + Fl::event_x (), Fl::event_y ()); + break; + + case FL_PUSH: + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); + + set_currentpoint (Fl::event_x (), Fl::event_y ()); + + gh = pixel2axes_or_ca (pos_x, pos_y); + + if (gh.ok ()) + { + ax_obj = gh_manager::get_object (gh); + set_axes_currentpoint (ax_obj, pos_x, pos_y); + } + + fp.execute_windowbuttondownfcn (); + + if (Fl::event_button () == 1 || Fl::event_button () == 3) + return 1; + + break; + + case FL_DRAG: + if (fp.get_windowbuttonmotionfcn ().is_defined ()) + { + set_currentpoint (Fl::event_x (), Fl::event_y ()); + fp.execute_windowbuttonmotionfcn (); + } + + if (Fl::event_button () == 1) + { + if (ax_obj && ax_obj.isa ("axes")) + { + if (gui_mode == pan_zoom) + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); + else + view2status (ax_obj); + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + + double x0, y0, x1, y1; + Matrix pos = fp.get_boundingbox (true); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + pixel2pos (ax_obj, Fl::event_x (), Fl::event_y (), x1, y1); + + if (gui_mode == pan_zoom) + ap.translate_view (x0, x1, y0, y1); + else if (gui_mode == rotate_zoom) + { + double daz, del; + daz = (Fl::event_x () - pos_x) / pos(2) * 360; + del = (Fl::event_y () - pos_y) / pos(3) * 360; + ap.rotate_view (del, daz); + } + + pos_x = Fl::event_x (); + pos_y = Fl::event_y (); + mark_modified (); + } + return 1; + } + else if (Fl::event_button () == 3) + { + pixel2status (ax_obj, pos_x, pos_y, + Fl::event_x (), Fl::event_y ()); + Matrix zoom_box (1,4,0); + zoom_box (0) = pos_x; + zoom_box (1) = pos_y; + zoom_box (2) = Fl::event_x (); + zoom_box (3) = Fl::event_y (); + canvas->set_zoom_box (zoom_box); + canvas->zoom (true); + canvas->redraw (); + } + + break; + + case FL_MOUSEWHEEL: + { + graphics_object ax = + gh_manager::get_object (pixel2axes_or_ca (Fl::event_x (), + Fl::event_y ())); + if (ax && ax.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax.get_properties ()); + + // Determine if we're zooming in or out. + const double factor = + (Fl::event_dy () > 0) ? 1.0 + wheel_zoom_speed : 1.0 - wheel_zoom_speed; + + // Get the point we're zooming about. + double x1, y1; + pixel2pos (ax, Fl::event_x (), Fl::event_y (), x1, y1); + + ap.zoom_about_point (x1, y1, factor, false); + mark_modified (); + } + } + return 1; + + case FL_RELEASE: + if (fp.get_windowbuttonupfcn ().is_defined ()) + { + set_currentpoint (Fl::event_x (), Fl::event_y ()); + fp.execute_windowbuttonupfcn (); + } + + if (Fl::event_button () == 1) + { + if ( Fl::event_clicks () == 1) + { + if (ax_obj && ax_obj.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + ap.set_xlimmode ("auto"); + ap.set_ylimmode ("auto"); + ap.set_zlimmode ("auto"); + mark_modified (); + } + } + } + if (Fl::event_button () == 3) + { + // End of drag -- zoom. + if (canvas->zoom ()) + { + canvas->zoom (false); + double x0,y0,x1,y1; + if (ax_obj && ax_obj.isa ("axes")) + { + axes::properties& ap = + dynamic_cast (ax_obj.get_properties ()); + pixel2pos (ax_obj, pos_x, pos_y, x0, y0); + int pos_x1 = Fl::event_x (); + int pos_y1 = Fl::event_y (); + pixel2pos (ax_obj, pos_x1, pos_y1, x1, y1); + Matrix xl (1,2,0); + Matrix yl (1,2,0); + int dx = abs (pos_x - pos_x1); + int dy = abs (pos_y - pos_y1); + // Smallest zoom box must be 4 pixels square + if ((dx > 4) && (dy > 4)) + { + if (x0 < x1) + { + xl(0) = x0; + xl(1) = x1; + } + else + { + xl(0) = x1; + xl(1) = x0; + } + if (y0 < y1) + { + yl(0) = y0; + yl(1) = y1; + } + else + { + yl(0) = y1; + yl(1) = y0; + } + ap.zoom (xl, yl); + } + mark_modified (); + } + } + } + break; + } + } + + return retval; + } +}; + +class figure_manager +{ +public: + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + instance = new figure_manager (); + + if (! instance) + { + ::error ("unable to create figure_manager object!"); + + retval = false; + } + + return retval; + } + + ~figure_manager (void) + { + close_all (); + } + + static void close_all (void) + { + if (instance_ok ()) + instance->do_close_all (); + } + + static void new_window (figure::properties& fp) + { + if (instance_ok ()) + instance->do_new_window (fp); + } + + static void delete_window (int idx) + { + if (instance_ok ()) + instance->do_delete_window (idx); + } + + static void delete_window (const std::string& idx_str) + { + delete_window (str2idx (idx_str)); + } + + static void renumber_figure (const std::string& idx_str, double new_number) + { + if (instance_ok ()) + instance->do_renumber_figure (str2idx (idx_str), new_number); + } + + static void toggle_window_visibility (int idx, bool is_visible) + { + if (instance_ok ()) + instance->do_toggle_window_visibility (idx, is_visible); + } + + static void toggle_window_visibility (const std::string& idx_str, + bool is_visible) + { + toggle_window_visibility (str2idx (idx_str), is_visible); + } + + static void mark_modified (int idx) + { + if (instance_ok ()) + instance->do_mark_modified (idx); + } + + static void mark_modified (const graphics_handle& gh) + { + mark_modified (hnd2idx (gh)); + } + + static void set_name (int idx) + { + if (instance_ok ()) + instance->do_set_name (idx); + } + + static void set_name (const std::string& idx_str) + { + set_name (str2idx (idx_str)); + } + + static Matrix get_size (int idx) + { + return instance_ok () ? instance->do_get_size (idx) : Matrix (); + } + + static Matrix get_size (const graphics_handle& gh) + { + return get_size (hnd2idx (gh)); + } + + static void print (const graphics_handle& gh, const std::string& cmd, + const std::string& term) + { + if (instance_ok ()) + instance->do_print (hnd2idx (gh), cmd, term); + } + + static void uimenu_update (const graphics_handle& figh, + const graphics_handle& uimenuh, int id) + { + if (instance_ok ()) + instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); + } + + static void update_canvas (const graphics_handle& gh, + const graphics_handle& ca) + { + if (instance_ok ()) + instance->do_update_canvas (hnd2idx (gh), ca); + } + + static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) + { + if (instance_ok ()) + instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); + } + + static void toggle_menubar_visibility (const std::string& fig_idx_str, + bool menubar_is_figure) + { + toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); + } + +private: + + static figure_manager *instance; + + figure_manager (void) { } + + // No copying! + figure_manager (const figure_manager&); + figure_manager& operator = (const figure_manager&); + + // Singelton -- hide all of the above. + + static int curr_index; + typedef std::map window_map; + typedef window_map::iterator wm_iterator;; + window_map windows; + + static std::string fltk_idx_header; + + void do_close_all (void) + { + wm_iterator win; + for (win = windows.begin (); win != windows.end (); win++) + delete win->second; + windows.clear (); + } + + void do_new_window (figure::properties& fp) + { + int idx = figprops2idx (fp); + + if (idx >= 0 && windows.find (idx) == windows.end ()) + { + Matrix pos = fp.get_boundingbox (true); + + int x = pos(0); + int y = pos(1); + int w = pos(2); + int h = pos(3); + + idx2figprops (curr_index, fp); + + windows[curr_index++] = new plot_window (x, y, w, h, fp); + } + } + + void do_delete_window (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + delete win->second; + windows.erase (win); + } + } + + void do_renumber_figure (int idx, double new_number) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->renumber (new_number); + } + + void do_toggle_window_visibility (int idx, bool is_visible) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + if (is_visible) + win->second->show (); + else + win->second->hide (); + + win->second->redraw (); + } + } + + void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) + { + wm_iterator win = windows.find (fig_idx); + + if (win != windows.end ()) + { + if (menubar_is_figure) + win->second->show_menubar (); + else + win->second->hide_menubar (); + + win->second->redraw (); + } + } + + void do_mark_modified (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->mark_modified (); + } + + void do_set_name (int idx) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->set_name (); + } + + Matrix do_get_size (int idx) + { + Matrix sz (1, 2, 0.0); + + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + sz(0) = win->second->w (); + sz(1) = win->second->h (); + } + + return sz; + } + + void do_print (int idx, const std::string& cmd, const std::string& term) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->print (cmd, term); + } + + void do_uimenu_update (int idx, const graphics_handle& gh, int id) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->uimenu_update (gh, id); + } + + void do_update_canvas (int idx, const graphics_handle& ca) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + { + if (ca.ok ()) + win->second->show_canvas (); + else + win->second->hide_canvas (); + } + } + + static int str2idx (const caseless_str& clstr) + { + int ind; + if (clstr.find (fltk_idx_header,0) == 0) + { + std::istringstream istr (clstr.substr (fltk_idx_header.size ())); + if (istr >> ind) + return ind; + } + error ("figure_manager: could not recognize fltk index"); + return -1; + } + + void idx2figprops (int idx, figure::properties& fp) + { + std::ostringstream ind_str; + ind_str << fltk_idx_header << idx; + fp.set___plot_stream__ (ind_str.str ()); + } + + static int figprops2idx (const figure::properties& fp) + { + if (fp.get___graphics_toolkit__ () == FLTK_GRAPHICS_TOOLKIT_NAME) + { + octave_value ps = fp.get___plot_stream__ (); + if (ps.is_string ()) + return str2idx (ps.string_value ()); + else + return 0; + } + error ("figure_manager: figure is not fltk"); + return -1; + } + + static int hnd2idx (double h) + { + graphics_object fobj = gh_manager::get_object (h); + if (fobj && fobj.isa ("figure")) + { + figure::properties& fp = + dynamic_cast (fobj.get_properties ()); + return figprops2idx (fp); + } + error ("figure_manager: H (= %g) is not a figure", h); + return -1; + } + + static int hnd2idx (const graphics_handle& fh) + { + return hnd2idx (fh.value ()); + } +}; + +figure_manager *figure_manager::instance = 0; + +std::string figure_manager::fltk_idx_header="fltk index="; +int figure_manager::curr_index = 1; + +static bool toolkit_loaded = false; + +static int +__fltk_redraw__ (void) +{ + if (toolkit_loaded) + { + // We scan all figures and add those which use FLTK. + graphics_object obj = gh_manager::get_object (0); + if (obj && obj.isa ("root")) + { + base_properties& props = obj.get_properties (); + Matrix children = props.get_all_children (); + + for (octave_idx_type n = 0; n < children.numel (); n++) + { + graphics_object fobj = gh_manager::get_object (children (n)); + if (fobj && fobj.isa ("figure")) + { + figure::properties& fp = + dynamic_cast (fobj.get_properties ()); + if (fp.get___graphics_toolkit__ () + == FLTK_GRAPHICS_TOOLKIT_NAME) + figure_manager::new_window (fp); + } + } + } + + // it seems that we have to call Fl::check twice to get everything drawn + Fl::check (); + Fl::check (); + } + + return 0; +} + +class fltk_graphics_toolkit : public base_graphics_toolkit +{ +public: + fltk_graphics_toolkit (void) + : base_graphics_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME) { } + + ~fltk_graphics_toolkit (void) { } + + bool is_valid (void) const { return true; } + + bool initialize (const graphics_object& go) + { return go.isa ("figure"); } + + void finalize (const graphics_object& go) + { + if (go.isa ("figure")) + { + octave_value ov = go.get (caseless_str ("__plot_stream__")); + + if (! ov.is_empty ()) + figure_manager::delete_window (ov.string_value ()); + } + } + + void uimenu_set_fltk_label (graphics_object uimenu_obj) + { + if (uimenu_obj.valid_object ()) + { + uimenu::properties& uimenup = + dynamic_cast (uimenu_obj.get_properties ()); + std::string fltk_label = uimenup.get_label (); + graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); + if (go.isa ("uimenu")) + fltk_label = dynamic_cast (go.get_properties ()).get_fltk_label () + + "/" + + fltk_label; + else if (go.isa ("figure")) + ; + else + error ("unexpected parent object\n"); + + uimenup.set_fltk_label (fltk_label); + } + } + + void update (const graphics_object& go, int id) + { + if (go.isa ("figure")) + { + octave_value ov = go.get (caseless_str ("__plot_stream__")); + + if (! ov.is_empty ()) + { + const figure::properties& fp = + dynamic_cast (go.get_properties ()); + + switch (id) + { + case base_properties::ID_VISIBLE: + figure_manager::toggle_window_visibility + (ov.string_value (), fp.is_visible ()); + break; + + case figure::properties::ID_MENUBAR: + figure_manager::toggle_menubar_visibility + (ov.string_value (), fp.menubar_is ("figure")); + break; + + case figure::properties::ID_CURRENTAXES: + figure_manager::update_canvas + (go.get_handle (), fp.get_currentaxes ()); + break; + + case figure::properties::ID_NAME: + case figure::properties::ID_NUMBERTITLE: + figure_manager::set_name (ov.string_value ()); + break; + + case figure::properties::ID_INTEGERHANDLE: + { + std::string tmp = ov.string_value (); + graphics_handle gh = fp.get___myhandle__ (); + figure_manager::renumber_figure (tmp, gh.value ()); + figure_manager::set_name (tmp); + } + break; + } + } + } + else if (go.isa ("uimenu")) + { + if (id == uimenu::properties::ID_LABEL) + uimenu_set_fltk_label (go); + + graphics_object fig = go.get_ancestor ("figure"); + figure_manager::uimenu_update (fig.get_handle (), go.get_handle (), id); + } + } + + void redraw_figure (const graphics_object& go) const + { + figure_manager::mark_modified (go.get_handle ()); + + __fltk_redraw__ (); + } + + void print_figure (const graphics_object& go, + const std::string& term, + const std::string& file_cmd, bool /*mono*/, + const std::string& /*debug_file*/) const + { + figure_manager::print (go.get_handle (), file_cmd, term); + redraw_figure (go); + } + + Matrix get_canvas_size (const graphics_handle& fh) const + { + return figure_manager::get_size (fh); + } + + double get_screen_resolution (void) const + { + // FLTK doesn't give this info. + return 72.0; + } + + Matrix get_screen_size (void) const + { + Matrix sz (1, 2, 0.0); + sz(0) = Fl::w (); + sz(1) = Fl::h (); + return sz; + } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_fltk__"); + + figure_manager::close_all (); + gtk_manager::unload_toolkit (FLTK_GRAPHICS_TOOLKIT_NAME); + toolkit_loaded = false; + + octave_value_list args; + args(0) = "__fltk_redraw__"; + feval ("remove_input_event_hook", args, 0); + + // FIXME ??? + Fl::wait (fltk_maxtime); + } + } +}; + +// Initialize the fltk graphics toolkit. + +DEFUN_DLD (__init_fltk__, , , "") +{ + if (! toolkit_loaded) + { + mlock (); + + graphics_toolkit tk (new fltk_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + toolkit_loaded = true; + + octave_value_list args; + args(0) = "__fltk_redraw__"; + feval ("add_input_event_hook", args, 0); + } + + octave_value retval; + return retval; +} + +DEFUN_DLD (__fltk_redraw__, , , "") +{ + __fltk_redraw__ (); + + return octave_value (); +} + +DEFUN_DLD (__fltk_maxtime__, args, ,"") +{ + octave_value retval = fltk_maxtime; + + if (args.length () == 1) + { + if (args(0).is_real_scalar ()) + fltk_maxtime = args(0).double_value (); + else + error ("argument must be a real scalar"); + } + + return retval; +} + +#endif + +// FIXME -- This function should be abstracted and made potentially +// available to all graphics toolkits. This suggests putting it in +// graphics.cc as is done for drawnow() and having the master +// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same +// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), +// just changing function names and docstrings. + +DEFUN_DLD (mouse_wheel_zoom, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{speed} =} mouse_wheel_zoom ()\n\ +@deftypefnx {Built-in Function} {} mouse_wheel_zoom (@var{speed})\n\ +Query or set the mouse wheel zoom factor.\n\ +\n\ +This function is currently implemented only for the FLTK graphics toolkit.\n\ +@seealso{gui_mode}\n\ +@end deftypefn") +{ +#if defined (HAVE_FLTK) + octave_value retval = wheel_zoom_speed; + + if (args.length () == 1) + { + if (args(0).is_real_scalar ()) + wheel_zoom_speed = args(0).double_value (); + else + error ("mouse_wheel_zoom: SPEED must be a real scalar"); + } + + return retval; +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif +} + +DEFUN_DLD (gui_mode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{mode} =} gui_mode ()\n\ +@deftypefnx {Built-in Function} {} gui_mode (@var{mode})\n\ +Query or set the GUI mode for the current graphics toolkit.\n\ +The @var{mode} argument can be one of the following strings:\n\ +\n\ +@table @asis\n\ +@item '2d'\n\ +Allows panning and zooming of current axes.\n\ +\n\ +@item '3d'\n\ +Allows rotating and zooming of current axes.\n\ +\n\ +@item 'none'\n\ +Mouse inputs have no effect.\n\ +@end table\n\ +\n\ +This function is currently implemented only for the FLTK graphics toolkit.\n\ +@seealso{mouse_wheel_zoom}\n\ +@end deftypefn") +{ +#if defined (HAVE_FLTK) + caseless_str mode_str; + + if (gui_mode == pan_zoom) + mode_str = "2d"; + else if (gui_mode == rotate_zoom) + mode_str = "3d"; + else + mode_str = "none"; + + bool failed = false; + + if (args.length () == 1) + { + if (args(0).is_string ()) + { + mode_str = args(0).string_value (); + + if (mode_str.compare ("2d")) + gui_mode = pan_zoom; + else if (mode_str.compare ("3d")) + gui_mode = rotate_zoom; + else if (mode_str.compare ("none")) + gui_mode = none; + else + failed = true; + } + else + failed = true; + } + + if (failed) + error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); + + return octave_value (mode_str); +#else + error ("mouse_wheel_zoom: not available without OpenGL and FLTK libraries"); + return octave_value (); +#endif +} + diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__init_gnuplot__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__init_gnuplot__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,193 @@ +/* + +Copyright (C) 2007-2012 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 3 of the License, 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, see +. + +*/ + +/* + +To initialize: + + graphics_toolkit ("gnuplot"); + plot (randn (1e3, 1)); + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" +#include "graphics.h" +#include "parse.h" +#include "variables.h" + +// PKG_ADD: register_graphics_toolkit ("gnuplot"); + +static bool toolkit_loaded = false; + +class gnuplot_graphics_toolkit : public base_graphics_toolkit +{ +public: + gnuplot_graphics_toolkit (void) + : base_graphics_toolkit ("gnuplot") { } + + ~gnuplot_graphics_toolkit (void) { } + + bool is_valid (void) const { return true; } + + bool initialize (const graphics_object& go) + { + return go.isa ("figure"); + } + + void finalize (const graphics_object& go) + { + if (go.isa ("figure")) + { + const figure::properties& props = + dynamic_cast (go.get_properties ()); + + send_quit (props.get___plot_stream__ ()); + } + } + + void update (const graphics_object& go, int id) + { + if (go.isa ("figure")) + { + graphics_object obj (go); + + figure::properties& props = + dynamic_cast (obj.get_properties ()); + + switch (id) + { + case base_properties::ID_VISIBLE: + if (! props.is_visible ()) + { + send_quit (props.get___plot_stream__ ()); + props.set___plot_stream__ (Matrix ()); + props.set___enhanced__ (false); + } + break; + } + } + } + + void redraw_figure (const graphics_object& go) const + { + octave_value_list args; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file) const + { + octave_value_list args; + if (! debug_file.empty ()) + args(4) = debug_file; + args(3) = mono; + args(2) = file; + args(1) = term; + args(0) = go.get_handle ().as_octave_value (); + feval ("__gnuplot_drawnow__", args); + } + + Matrix get_canvas_size (const graphics_handle&) const + { + Matrix sz (1, 2, 0.0); + return sz; + } + + double get_screen_resolution (void) const + { return 72.0; } + + Matrix get_screen_size (void) const + { return Matrix (1, 2, 0.0); } + + void close (void) + { + if (toolkit_loaded) + { + munlock ("__init_gnuplot__"); + + gtk_manager::unload_toolkit ("gnuplot"); + + toolkit_loaded = false; + } + } + +private: + + void send_quit (const octave_value& pstream) const + { + if (! pstream.is_empty ()) + { + octave_value_list args; + Matrix fids = pstream.matrix_value (); + + if (! error_state) + { + args(1) = "\nquit;\n"; + args(0) = fids(0); + feval ("fputs", args); + + args.resize (1); + feval ("fflush", args); + feval ("pclose", args); + + if (fids.numel () > 1) + { + args(0) = fids(1); + feval ("pclose", args); + + if (fids.numel () > 2) + { + args(0) = fids(2); + feval ("waitpid", args); + } + } + } + } + } +}; + +// Initialize the fltk graphics toolkit. + +DEFUN_DLD (__init_gnuplot__, , , "") +{ + octave_value retval; + + if (! toolkit_loaded) + { + mlock (); + + graphics_toolkit tk (new gnuplot_graphics_toolkit ()); + gtk_manager::load_toolkit (tk); + + toolkit_loaded = true; + } + + return retval; +} + diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__magick_read__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__magick_read__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1216 @@ +/* + +Copyright (C) 2002-2012 Andy Adler +Copyright (C) 2008 Thomas L. Scofield +Copyright (C) 2010 David Grundberg + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" + +#include "defun-dld.h" +#include "error.h" +#include "ov-struct.h" + +#ifdef HAVE_MAGICK + +#include +#include + +octave_value_list +read_indexed_images (std::vector& imvec, + const Array& frameidx, bool wantalpha) +{ + octave_value_list output; + + int rows = imvec[0].baseRows (); + int columns = imvec[0].baseColumns (); + int nframes = frameidx.length (); + + dim_vector idim = dim_vector (); + idim.resize (4); + idim(0) = rows; + idim(1) = columns; + idim(2) = 1; + idim(3) = nframes; + + Array idx (dim_vector (4, 1)); + + Magick::ImageType type = imvec[0].type (); + + unsigned int mapsize = imvec[0].colorMapSize (); + unsigned int i = mapsize; + unsigned int depth = 0; + while (i >>= 1) + depth++; + i = 0; + depth--; + while (depth >>= 1) + i++; + depth = 1 << i; + + switch (depth) + { + case 1: + case 2: + case 4: + case 8: + { + uint8NDArray im = uint8NDArray (idim); + + idx(2) = 0; + for (int frame = 0; frame < nframes; frame++) + { + imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + const Magick::IndexPacket *pix + = imvec[frameidx(frame)].getConstIndexes (); + + i = 0; + idx(3) = frame; + + for (int y = 0; y < rows; y++) + { + idx(0) = y; + for (int x = 0; x < columns; x++) + { + idx(1) = x; + im(idx) = static_cast (pix[i++]); + } + } + } + + output(0) = octave_value (im); + } + break; + + case 16: + { + uint16NDArray im = uint16NDArray (idim); + + idx(2) = 0; + for (int frame = 0; frame < nframes; frame++) + { + imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + const Magick::IndexPacket *pix + = imvec[frameidx(frame)].getConstIndexes (); + + i = 0; + idx(3) = frame; + + for (int y = 0; y < rows; y++) + { + idx(0) = y; + for (int x = 0; x < columns; x++) + { + idx(1) = x; + im(idx) = static_cast (pix[i++]); + } + } + } + + output(0) = octave_value (im); + } + break; + + default: + error ("__magic_read__: index depths greater than 16-bit are not supported"); + return octave_value_list (); + } + + Matrix map = Matrix (mapsize, 3); + Matrix alpha; + + switch (type) + { + case Magick::PaletteMatteType: +#if 0 + warning ("palettematte"); + Matrix map (mapsize, 3); + Matrix alpha (mapsize, 1); + for (i = 0; i < mapsize; i++) + { + warning ("%d", i); + Magick::ColorRGB c = imvec[0].colorMap (i); + map(i,0) = c.red (); + map(i,1) = c.green (); + map(i,2) = c.blue (); + alpha(i,1) = c.alpha (); + } + break; +#endif + + case Magick::PaletteType: + alpha = Matrix (0, 0); + for (i = 0; i < mapsize; i++) + { + Magick::ColorRGB c = imvec[0].colorMap (i); + map(i,0) = c.red (); + map(i,1) = c.green (); + map(i,2) = c.blue (); + } + break; + + default: + error ("__magick_read__: unsupported indexed image type"); + return octave_value_list (); + } + + if (wantalpha) + output(2) = alpha; + + output(1) = map; + + return output; +} + +template +octave_value_list +read_images (const std::vector& imvec, + const Array& frameidx, unsigned int depth) +{ + typedef typename T::element_type P; + + octave_value_list retval (3, Matrix ()); + + T im; + + int rows = imvec[0].baseRows (); + int columns = imvec[0].baseColumns (); + int nframes = frameidx.length (); + + dim_vector idim = dim_vector (); + idim.resize (4); + idim(0) = rows; + idim(1) = columns; + idim(2) = 1; + idim(3) = nframes; + + Magick::ImageType type = imvec[0].type (); + const int divisor = ((uint64_t (1) << QuantumDepth) - 1) / + ((uint64_t (1) << depth) - 1); + + switch (type) + { + case Magick::BilevelType: + case Magick::GrayscaleType: + { + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + pix++; + rbuf += rows; + } + rbuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::GrayscaleMatteType: + { + idim(2) = 2; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *obuf = vec + rows * columns; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *obuf = pix->opacity / divisor; + pix++; + rbuf += rows; + obuf += rows; + } + rbuf -= rows * columns - 1; + obuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::PaletteType: + case Magick::TrueColorType: + { + idim(2) = 3; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *gbuf = vec + rows * columns; + P *bbuf = vec + rows * columns * 2; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *gbuf = pix->green / divisor; + *bbuf = pix->blue / divisor; + pix++; + rbuf += rows; + gbuf += rows; + bbuf += rows; + } + rbuf -= rows * columns - 1; + gbuf -= rows * columns - 1; + bbuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + case Magick::PaletteMatteType: + case Magick::TrueColorMatteType: + case Magick::ColorSeparationType: + { + idim(2) = 4; + im = T (idim); + P *vec = im.fortran_vec (); + + for (int frame = 0; frame < nframes; frame++) + { + const Magick::PixelPacket *pix + = imvec[frameidx(frame)].getConstPixels (0, 0, columns, rows); + + P *rbuf = vec; + P *gbuf = vec + rows * columns; + P *bbuf = vec + rows * columns * 2; + P *obuf = vec + rows * columns * 3; + for (int y = 0; y < rows; y++) + { + for (int x = 0; x < columns; x++) + { + *rbuf = pix->red / divisor; + *gbuf = pix->green / divisor; + *bbuf = pix->blue / divisor; + *obuf = pix->opacity / divisor; + pix++; + rbuf += rows; + gbuf += rows; + bbuf += rows; + obuf += rows; + } + rbuf -= rows * columns - 1; + gbuf -= rows * columns - 1; + bbuf -= rows * columns - 1; + obuf -= rows * columns - 1; + } + + // Next frame. + vec += rows * columns * idim(2); + } + } + break; + + default: + error ("__magick_read__: undefined ImageMagick image type"); + return retval; + } + + retval(0) = im; + + return retval; +} + +#endif + +static void +maybe_initialize_magick (void) +{ +#ifdef HAVE_MAGICK + + static bool initialized = false; + + if (! initialized) + { + // Save the locale as GraphicsMagick might change this (depending on version) + const char *static_locale = setlocale (LC_ALL, NULL); + const std::string locale (static_locale); + + std::string program_name = octave_env::get_program_invocation_name (); + + Magick::InitializeMagick (program_name.c_str ()); + + // Restore locale from before GraphicsMagick initialisation + setlocale (LC_ALL, locale.c_str ()); + + if (QuantumDepth < 32) + warning ("your version of %s limits images to %d bits per pixel", + MagickPackageName, QuantumDepth); + + initialized = true; + } +#endif +} + +DEFUN_DLD (__magick_read__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} {@var{m} =} __magick_read__ (@var{fname}, @var{index})\n\ +@deftypefnx {Function File} {[@var{m}, @var{colormap}] =} __magick_read__ (@var{fname}, @var{index})\n\ +@deftypefnx {Function File} {[@var{m}, @var{colormap}, @var{alpha}] =} __magick_read__ (@var{fname}, @var{index})\n\ +Read images with ImageMagick++. In general you should not be using this\n\ +function. Instead use @code{imread}.\n\ +@seealso{imread}\n\ +@end deftypefn") +{ + octave_value_list output; + +#ifdef HAVE_MAGICK + + maybe_initialize_magick (); + + if (args.length () > 3 || args.length () < 1 || ! args(0).is_string () + || nargout > 3) + { + print_usage (); + return output; + } + + Array frameidx; + bool all_frames = false; + + if (args.length () == 2 && args(1).is_real_type ()) + frameidx = args(1).int_vector_value (); + else if (args.length () == 3 && args(1).is_string () + && args(1).string_value () == "frames") + { + if (args(2).is_string () && args(2).string_value () == "all") + all_frames = true; + else if (args(2).is_real_type ()) + frameidx = args(2).int_vector_value (); + } + else + { + frameidx = Array (dim_vector (1, 1)); + frameidx(0) = 1; + } + + std::vector imvec; + + try + { + // Read a file into vector of image objects + Magick::readImages (&imvec, args(0).string_value ()); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + return output; + } + + int nframes = imvec.size (); + if (all_frames) + { + frameidx = Array (dim_vector (1, nframes)); + for (int i = 0; i < frameidx.length (); i++) + frameidx(i) = i; + } + else + { + for (int i = 0; i < frameidx.length (); i++) + { + frameidx(i) = frameidx(i) - 1; + + if (frameidx(i) >= nframes || frameidx(i) < 0) + { + error ("__magick_read__: invalid INDEX vector"); + return output; + } + } + } + + Magick::ClassType klass = imvec[0].classType (); + + if (klass == Magick::PseudoClass && nargout > 1) + output = read_indexed_images (imvec, frameidx, (nargout == 3)); + else + { + unsigned int depth = imvec[0].modulusDepth (); + if (depth > 1) + { + --depth; + int i = 1; + while (depth >>= 1) + i++; + depth = 1 << i; + } + + switch (depth) + { + case 1: + output = read_images (imvec, frameidx, depth); + break; + + case 2: + case 4: + case 8: + output = read_images (imvec, frameidx, depth) ; + break; + + case 16: + output = read_images (imvec, frameidx, depth); + break; + + case 32: + case 64: + default: + error ("__magick_read__: image depths greater than 16-bit are not supported"); + } + } +#else + + error ("imread: image reading capabilities were disabled when Octave was compiled"); + +#endif + + return output; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#ifdef HAVE_MAGICK + +static void +jpg_settings (std::vector& imvec, + const Octave_map& options, + bool) +{ + bool something_set = false; + + // Quality setting + octave_value result; + Octave_map::const_iterator p; + bool found_it = false; + + for (p = options.begin (); p != options.end (); p++) + { + if (options.key (p) == "Quality") + { + found_it = true; + result = options.contents (p).elem (0); + break; + } + } + + if (found_it && (! result.is_empty ())) + { + something_set = true; + + if (result.is_real_type ()) + { + int qlev = result.int_value (); + + if (qlev < 0 || qlev > 100) + warning ("warning: Quality setting invalid--use default of 75"); + else + { + for (size_t fnum = 0; fnum < imvec.size (); fnum++) + imvec[fnum].quality (static_cast(qlev)); + } + } + else + warning ("warning: Quality setting invalid--use default of 75"); + } + + // Other settings go here + + if (! something_set) + warning ("__magick_write__ warning: all write parameters ignored"); +} + +static void +encode_bool_image (std::vector& imvec, const octave_value& img) +{ + unsigned int nframes = 1; + boolNDArray m = img.bool_array_value (); + + dim_vector dsizes = m.dims (); + if (dsizes.length () == 4) + nframes = dsizes(3); + + Array idx (dim_vector (dsizes.length (), 1)); + + octave_idx_type rows = m.rows (); + octave_idx_type columns = m.columns (); + + for (unsigned int ii = 0; ii < nframes; ii++) + { + Magick::Image im (Magick::Geometry (columns, rows), "black"); + im.classType (Magick::DirectClass); + im.depth (1); + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x = 0; x < rows; x++) + { + if (nframes > 1) + { + idx(2) = 0; + idx(3) = ii; + } + + idx(0) = x; + + if (m(idx)) + im.pixelColor (y, x, "white"); + } + } + + im.quantizeColorSpace (Magick::GRAYColorspace); + im.quantizeColors (2); + im.quantize (); + + imvec.push_back (im); + } +} + +template +static void +encode_uint_image (std::vector& imvec, + const octave_value& img, + bool has_map) +{ + unsigned int bitdepth = 0; + T m; + + if (img.is_uint8_type ()) + { + bitdepth = 8; + m = img.uint8_array_value (); + } + else if (img.is_uint16_type ()) + { + bitdepth = 16; + m = img.uint16_array_value (); + } + else + error ("__magick_write__: invalid image class"); + + dim_vector dsizes = m.dims (); + unsigned int nframes = 1; + if (dsizes.length () == 4) + nframes = dsizes(3); + + bool is_color = ((dsizes.length () > 2) && (dsizes(2) > 2)); + bool has_alpha = (dsizes.length () > 2 && (dsizes(2) == 2 || dsizes(2) == 4)); + + Array idx (dim_vector (dsizes.length (), 1)); + octave_idx_type rows = m.rows (); + octave_idx_type columns = m.columns (); + + unsigned int div_factor = (1 << bitdepth) - 1; + + for (unsigned int ii = 0; ii < nframes; ii++) + { + Magick::Image im (Magick::Geometry (columns, rows), "black"); + + im.depth (bitdepth); + + if (has_map) + im.classType (Magick::PseudoClass); + else + im.classType (Magick::DirectClass); + + if (is_color) + { + if (has_alpha) + im.type (Magick::TrueColorMatteType); + else + im.type (Magick::TrueColorType); + + Magick::ColorRGB c; + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x = 0; x < rows; x++) + { + idx(0) = x; + + if (nframes > 1) + idx(3) = ii; + + idx(2) = 0; + c.red (static_cast(m(idx)) / div_factor); + + idx(2) = 1; + c.green (static_cast(m(idx)) / div_factor); + + idx(2) = 2; + c.blue (static_cast(m(idx)) / div_factor); + + if (has_alpha) + { + idx(2) = 3; + c.alpha (static_cast(m(idx)) / div_factor); + } + + im.pixelColor (y, x, c); + } + } + } + else + { + if (has_alpha) + im.type (Magick::GrayscaleMatteType); + else + im.type (Magick::GrayscaleType); + + Magick::ColorGray c; + + for (int y = 0; y < columns; y++) + { + idx(1) = y; + + for (int x=0; x < rows; x++) + { + idx(0) = x; + + if (nframes > 1) + { + idx(2) = 0; + idx(3) = ii; + } + + if (has_alpha) + { + idx(2) = 1; + c.alpha (static_cast(m(idx)) / div_factor); + idx(2) = 0; + } + + c.shade (static_cast(m(idx)) / div_factor); + + im.pixelColor (y, x, c); + } + } + + im.quantizeColorSpace (Magick::GRAYColorspace); + im.quantizeColors (1 << bitdepth); + im.quantize (); + } + + imvec.push_back (im); + } +} + +static void +encode_map (std::vector& imvec, const NDArray& cmap) +{ + unsigned int mapsize = cmap.dim1 (); + + for (size_t fnum = 0; fnum < imvec.size (); fnum++) + { + imvec[fnum].colorMapSize (mapsize); + imvec[fnum].type (Magick::PaletteType); + } + + for (unsigned int ii = 0; ii < mapsize; ii++) + { + Magick::ColorRGB c (cmap(ii,0), cmap(ii,1), cmap(ii,2)); + + // FIXME -- is this case needed? + if (cmap.dim2 () == 4) + c.alpha (cmap(ii,3)); + + try + { + for_each (imvec.begin (), imvec.end (), + Magick::colorMapImage (ii, c)); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + } + } +} + +static void +write_image (const std::string& filename, const std::string& fmt, + const octave_value& img, + const octave_value& map = octave_value (), + const octave_value& params = octave_value ()) +{ + std::vector imvec; + + bool has_map = map.is_defined (); + + if (has_map) + { + error ("__magick_write__: direct saving of indexed images not currently supported; use ind2rgb and save converted image"); + return; + } + + if (img.is_bool_type ()) + encode_bool_image (imvec, img); + else if (img.is_uint8_type ()) + encode_uint_image (imvec, img, has_map); + else if (img.is_uint16_type ()) + encode_uint_image (imvec, img, has_map); + else + error ("__magick_write__: image type not supported"); + + if (! error_state && has_map) + { + NDArray cmap = map.array_value (); + + if (! error_state) + encode_map (imvec, cmap); + } + + if (! error_state && params.is_defined ()) + { + Octave_map options = params.map_value (); + + // Insert calls here to handle parameters for various image formats + if (fmt == "jpg" || fmt == "jpeg") + jpg_settings (imvec, options, has_map); + else + warning ("warning: your parameter(s) currently not supported"); + } + + try + { + Magick::writeImages (imvec.begin (), imvec.end (), fmt + ":" + filename); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + } +} + +#endif + +DEFUN_DLD (__magick_write__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img})\n\ +@deftypefnx {Function File} {} __magick_write__ (@var{fname}, @var{fmt}, @var{img}, @var{map})\n\ +Write images with ImageMagick++. In general you should not be using this\n\ +function. Instead use @code{imwrite}.\n\ +@seealso{imread}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_MAGICK + maybe_initialize_magick (); + + int nargin = args.length (); + + if (nargin > 2) + { + std::string filename = args(0).string_value (); + + if (! error_state) + { + std::string fmt = args(1).string_value (); + + if (! error_state) + { + if (nargin > 4) + write_image (filename, fmt, args(2), args(3), args(4)); + else if (nargin > 3) + if (args(3).is_real_type ()) + write_image (filename, fmt, args(2), args(3)); + else + write_image (filename, fmt, args(2), octave_value (), args(3)); + else + write_image (filename, fmt, args(2)); + } + else + error ("__magick_write__: FMT must be string"); + } + else + error ("__magick_write__: FNAME must be a string"); + } + else + print_usage (); +#else + + error ("__magick_write__: not available in this version of Octave"); + +#endif + +return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#ifdef HAVE_MAGICK + +template +static octave_value +magick_to_octave_value (const T magick) +{ + return octave_value (magick); +} + +static octave_value +magick_to_octave_value (const Magick::EndianType magick) +{ + switch (magick) + { + case Magick::LSBEndian: + return octave_value ("little-endian"); + + case Magick::MSBEndian: + return octave_value ("big-endian"); + + default: + return octave_value ("undefined"); + } +} + +static octave_value +magick_to_octave_value (const Magick::ResolutionType magick) +{ + switch (magick) + { + case Magick::PixelsPerInchResolution: + return octave_value ("pixels per inch"); + + case Magick::PixelsPerCentimeterResolution: + return octave_value ("pixels per centimeter"); + + default: + return octave_value ("undefined"); + } +} + +static octave_value +magick_to_octave_value (const Magick::ImageType magick) +{ + switch (magick) + { + case Magick::BilevelType: + case Magick::GrayscaleType: + case Magick::GrayscaleMatteType: + return octave_value ("grayscale"); + + case Magick::PaletteType: + case Magick::PaletteMatteType: + return octave_value ("indexed"); + + case Magick::TrueColorType: + case Magick::TrueColorMatteType: + case Magick::ColorSeparationType: + return octave_value ("truecolor"); + + default: + return octave_value ("undefined"); + } +} + +// We put this in a try-block because GraphicsMagick will throw +// exceptions if a parameter isn't present in the current image. +#define GET_PARAM(NAME, OUTNAME) \ + try \ + { \ + info.contents (OUTNAME)(frame,0) = magick_to_octave_value (im.NAME ()); \ + } \ + catch (Magick::Warning& w) \ + { \ + } + +#endif + +DEFUN_DLD (__magick_finfo__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __magick_finfo__ (@var{fname})\n\ +Read image information with GraphicsMagick++. In general you should\n\ +not be using this function. Instead use @code{imfinfo}.\n\ +@seealso{imfinfo, imread}\n\ +@end deftypefn") +{ + octave_value retval; + +#ifdef HAVE_MAGICK + + maybe_initialize_magick (); + + if (args.length () < 1 || ! args (0).is_string ()) + { + print_usage (); + return retval; + } + + const std::string filename = args (0).string_value (); + + try + { + // Read the file. + std::vector imvec; + Magick::readImages (&imvec, args(0).string_value ()); + int nframes = imvec.size (); + + // Create the right size for the output. + + static const char *fields[] = + { + "Filename", + "FileModDate", + "FileSize", + "Height", + "Width", + "BitDepth", + "Format", + "LongFormat", + "XResolution", + "YResolution", + "TotalColors", + "TileName", + "AnimationDelay", + "AnimationIterations", + "ByteOrder", + "Gamma", + "Matte", + "ModulusDepth", + "Quality", + "QuantizeColors", + "ResolutionUnits", + "ColorType", + "View", + 0 + }; + + Octave_map info (string_vector (fields), dim_vector (nframes, 1)); + + file_stat fs (filename); + + std::string filetime; + + if (fs) + { + octave_localtime mtime = fs.mtime (); + + filetime = mtime.strftime ("%e-%b-%Y %H:%M:%S"); + } + else + { + std::string msg = fs.error (); + + error ("imfinfo: error reading `%s': %s", + filename.c_str (), msg.c_str ()); + + return retval; + } + + // For each frame in the image (some images contain multiple + // layers, each to be treated like a separate image). + for (int frame = 0; frame < nframes; frame++) + { + Magick::Image im = imvec[frame]; + + // Add file name and timestamp. + info.contents ("Filename")(frame,0) = filename; + info.contents ("FileModDate")(frame,0) = filetime; + + // Annoying CamelCase naming is for Matlab compatibility. + GET_PARAM (fileSize, "FileSize") + GET_PARAM (rows, "Height") + GET_PARAM (columns, "Width") + GET_PARAM (depth, "BitDepth") + GET_PARAM (magick, "Format") + GET_PARAM (format, "LongFormat") + GET_PARAM (xResolution, "XResolution") + GET_PARAM (yResolution, "YResolution") + GET_PARAM (totalColors, "TotalColors") + GET_PARAM (tileName, "TileName") + GET_PARAM (animationDelay, "AnimationDelay") + GET_PARAM (animationIterations, "AnimationIterations") + GET_PARAM (endian, "ByteOrder") + GET_PARAM (gamma, "Gamma") + GET_PARAM (matte, "Matte") + GET_PARAM (modulusDepth, "ModulusDepth") + GET_PARAM (quality, "Quality") + GET_PARAM (quantizeColors, "QuantizeColors") + GET_PARAM (resolutionUnits, "ResolutionUnits") + GET_PARAM (type, "ColorType") + GET_PARAM (view, "View") + } + + retval = octave_value (info); + } + catch (Magick::Warning& w) + { + warning ("Magick++ warning: %s", w.what ()); + } + catch (Magick::ErrorCoder& e) + { + warning ("Magick++ coder error: %s", e.what ()); + } + catch (Magick::Exception& e) + { + error ("Magick++ exception: %s", e.what ()); + return retval; + } + +#else + + error ("imfinfo: not available in this version of Octave"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ + +#undef GET_PARAM + +// Determine the file formats supported by GraphicsMagick. This is +// called once at the beginning of imread or imwrite to determine +// exactly which file formats are supported, so error messages can be +// displayed properly. + +DEFUN_DLD (__magick_format_list__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} __magick_format_list__ (@var{formats})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + +#ifdef HAVE_MAGICK + maybe_initialize_magick (); + + std::list accepted_formats; + + if (args.length () == 1) + { + Cell c = args (0).cell_value (); + + if (! error_state) + { + for (octave_idx_type i = 0; i < c.nelem (); i++) + { + try + { + std::string fmt = c.elem (i).string_value (); + + Magick::CoderInfo info(fmt); + + if (info.isReadable () && info.isWritable ()) + accepted_formats.push_back (fmt); + } + catch (Magick::Exception& e) + { + // Do nothing: exception here are simply missing formats. + } + } + } + else + error ("__magick_format_list__: expecting a cell array of image format names"); + } + else + print_usage (); + + retval = Cell (accepted_formats); + +#else + + error ("__magick_format_list__: not available in this version of Octave"); + +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/__voronoi__.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/__voronoi__.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,334 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +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 3 of the License, 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, see +. + +*/ + +/* +20. Augiust 2000 - Kai Habel: first release +*/ + +/* +2003-12-14 Rafael Laboissiere +Added optional second argument to pass options to the underlying +qhull command +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include + +#include "lo-ieee.h" + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "__voronoi__.oct 2007-07-24"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (__voronoi__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{caller}, @var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + std::string caller = args(0).string_value (); + +#if defined (HAVE_QHULL) + + retval(0) = 0.0; + + int nargin = args.length (); + if (nargin < 2 || nargin > 3) + { + print_usage (); + return retval; + } + + Matrix points = args(1).matrix_value (); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); + + std::string options; + + if (dim <= 4) + options = " Qbb"; + else + options = " Qbb Qx"; + + if (nargin == 3) + { + octave_value opt_arg = args(2); + + if (opt_arg.is_string ()) + options = " " + opt_arg.string_value (); + else if (opt_arg.is_empty ()) + ; // Use default options. + else if (opt_arg.is_cellstr ()) + { + options = ""; + + Array tmp = opt_arg.cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else + { + error ("%s: OPTIONS must be a string, cell array of strings, or empty", + caller.c_str ()); + return retval; + } + } + + boolT ismalloc = false; + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("__voronoi__: unable to create temporary file for output"); + return retval; + } + + // qh_new_qhull command and points arguments are not const... + + std::string cmd = "qhull v" + options; + + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); + + strcpy (cmd_str, cmd.c_str ()); + + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) + { + // Calling findgood_all provides the number of Voronoi vertices + // (sets qh num_good). + + qh_findgood_all (qh facet_list); + + octave_idx_type num_voronoi_regions + = qh num_vertices - qh_setsize (qh del_vertices); + + octave_idx_type num_voronoi_vertices = qh num_good; + + // Find the voronoi centers for all facets. + + qh_setvoronoi_all (); + + facetT *facet; + vertexT *vertex; + octave_idx_type k; + + // Find the number of Voronoi vertices for each Voronoi cell and + // store them in NI so we can use them later to set the dimensions + // of the RowVector objects used to collect them. + + FORALLfacets + { + facet->seen = false; + } + + OCTAVE_LOCAL_BUFFER (octave_idx_type, ni, num_voronoi_regions); + for (octave_idx_type i = 0; i < num_voronoi_regions; i++) + ni[i] = 0; + + k = 0; + + FORALLvertices + { + if (qh hull_dim == 3) + qh_order_vertexneighbors (vertex); + + bool infinity_seen = false; + + facetT *neighbor, **neighborp; + + FOREACHneighbor_ (vertex) + { + if (neighbor->upperdelaunay) + { + if (! infinity_seen) + { + infinity_seen = true; + ni[k]++; + } + } + else + { + neighbor->seen = true; + ni[k]++; + } + } + + k++; + } + + // If Qhull finds fewer regions than points, we will pad the end + // of the at_inf and C arrays so that they always contain at least + // as many elements as the given points array. + + // FIXME -- is it possible (or does it make sense) for + // num_voronoi_regions to ever be larger than num_points? + + octave_idx_type nr = (num_points > num_voronoi_regions + ? num_points : num_voronoi_regions); + + boolMatrix at_inf (nr, 1, false); + + // The list of Voronoi vertices. The first element is always + // Inf. + Matrix F (num_voronoi_vertices+1, dim); + + for (octave_idx_type d = 0; d < dim; d++) + F(0,d) = octave_Inf; + + // The cell array of vectors of indices into F that represent the + // vertices of the Voronoi regions (cells). + + Cell C (nr, 1); + + // Now loop through the list of vertices again and store the + // coordinates of the Voronoi vertices and the lists of indices + // for the cells. + + FORALLfacets + { + facet->seen = false; + } + + octave_idx_type i = 0; + k = 0; + + FORALLvertices + { + if (qh hull_dim == 3) + qh_order_vertexneighbors (vertex); + + bool infinity_seen = false; + + octave_idx_type idx = qh_pointid (vertex->point); + + octave_idx_type num_vertices = ni[k++]; + + // Qhull seems to sometimes produces regions with a single + // vertex. Is that a bug? How can a region have just one + // vertex? Let's skip it. + + if (num_vertices == 1) + continue; + + RowVector facet_list (num_vertices); + + octave_idx_type m = 0; + + facetT *neighbor, **neighborp; + + FOREACHneighbor_(vertex) + { + if (neighbor->upperdelaunay) + { + if (! infinity_seen) + { + infinity_seen = true; + facet_list(m++) = 1; + at_inf(idx) = true; + } + } + else + { + if (! neighbor->seen) + { + i++; + for (octave_idx_type d = 0; d < dim; d++) + F(i,d) = neighbor->center[d]; + + neighbor->seen = true; + neighbor->visitid = i; + } + + facet_list(m++) = neighbor->visitid + 1; + } + } + + C(idx) = facet_list; + } + + retval(2) = at_inf; + retval(1) = C; + retval(0) = F; + } + else + error ("%s: qhull failed", caller.c_str ()); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("%s: qhull did not free %d bytes of long memory (%d pieces)", + caller.c_str (), totlong, curlong); + +#else + error ("%s: not available in this version of Octave", caller.c_str ()); +#endif + + return retval; +} + +/* +## No test needed for internal helper function. +%!assert (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/amd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/amd.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,206 @@ +/* + +Copyright (C) 2008-2012 David Bateman + +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 3 of the License, 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, see +. + +*/ + +// This is the octave interface to amd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-map.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define AMD_NAME(name) amd_l ## name +#else +#define AMD_NAME(name) amd ## name +#endif + +DEFUN_DLD (amd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} amd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} amd (@var{S}, @var{opts})\n\ +\n\ +Return the approximate minimum degree permutation of a matrix. This\n\ +permutation such that the Cholesky@tie{}factorization of @code{@var{S}\n\ +(@var{p}, @var{p})} tends to be sparser than the Cholesky@tie{}factorization\n\ +of @var{S} itself. @code{amd} is typically faster than @code{symamd} but\n\ +serves a similar purpose.\n\ +\n\ +The optional parameter @var{opts} is a structure that controls the\n\ +behavior of @code{amd}. The fields of the structure are\n\ +\n\ +@table @asis\n\ +@item @var{opts}.dense\n\ +Determines what @code{amd} considers to be a dense row or column of the\n\ +input matrix. Rows or columns with more than @code{max(16, (dense *\n\ +sqrt (@var{n})} entries, where @var{n} is the order of the matrix @var{S},\n\ +are ignored by @code{amd} during the calculation of the permutation\n\ +The value of dense must be a positive scalar and its default value is 10.0\n\ +\n\ +@item @var{opts}.aggressive\n\ +If this value is a non zero scalar, then @code{amd} performs aggressive\n\ +absorption. The default is not to perform aggressive absorption.\n\ +@end table\n\ +\n\ +The author of the code itself is Timothy A. Davis\n\ +@email{davis@@cise.ufl.edu}, University of Florida (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/amd}).\n\ +@seealso{symamd, colamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_AMD + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage (); + else + { + octave_idx_type n_row, n_col; + const octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (!error_state && n_row != n_col) + error ("amd: matrix S must be square"); + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (double, Control, AMD_CONTROL); + AMD_NAME (_defaults) (Control) ; + if (nargin > 1) + { + octave_scalar_map arg1 = args(1).scalar_map_value (); + + if (!error_state) + { + octave_value tmp; + + tmp = arg1.getfield ("dense"); + if (tmp.is_defined ()) + Control[AMD_DENSE] = tmp.double_value (); + + tmp = arg1.getfield ("aggressive"); + if (tmp.is_defined ()) + Control[AMD_AGGRESSIVE] = tmp.double_value (); + } + else + error ("amd: OPTS argument must be a scalar structure"); + } + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, P, n_col); + Matrix xinfo (AMD_INFO, 1); + double *Info = xinfo.fortran_vec (); + + // FIXME -- how can we manage the memory allocation of + // amd in a cleaner manner? + amd_malloc = malloc; + amd_free = free; + amd_calloc = calloc; + amd_realloc = realloc; + amd_printf = printf; + + octave_idx_type result = AMD_NAME (_order) (n_col, cidx, ridx, P, + Control, Info); + + switch (result) + { + case AMD_OUT_OF_MEMORY: + error ("amd: out of memory"); + break; + case AMD_INVALID: + error ("amd: matrix S is corrupted"); + break; + default: + { + if (nargout > 1) + retval(1) = xinfo; + + Matrix Pout (1, n_col); + for (octave_idx_type i = 0; i < n_col; i++) + Pout.xelem (i) = P[i] + 1; + + retval(0) = Pout; + } + } + } + } + } +#else + + error ("amd: not available in this version of Octave"); + +#endif + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/ccolamd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/ccolamd.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,583 @@ +/* + +Copyright (C) 2005-2012 David Bateman + +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 3 of the License, 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, see +. + +*/ + +// This is the octave interface to ccolamd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define CCOLAMD_NAME(name) ccolamd_l ## name +#define CSYMAMD_NAME(name) csymamd_l ## name +#else +#define CCOLAMD_NAME(name) ccolamd ## name +#define CSYMAMD_NAME(name) csymamd ## name +#endif + +DEFUN_DLD (ccolamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} ccolamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {@var{p} =} ccolamd (@var{S}, @var{knobs}, @var{cmember})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} ccolamd (@dots{})\n\ +\n\ +Constrained column approximate minimum degree permutation.\n\ +@code{@var{p} = ccolamd (@var{S})} returns the column approximate minimum\n\ +degree permutation vector for the sparse matrix @var{S}. For a non-symmetric\n\ +matrix\n\ +@var{S},\n\ +@code{@var{S}(:, @var{p})} tends to have sparser LU@tie{}factors than\n\ +@var{S}. @code{chol (@var{S}(:, @var{p})' * @var{S}(:, @var{p}))} also\n\ +tends to be sparser than @code{chol (@var{S}' * @var{S})}. @code{@var{p} =\n\ +ccolamd (@var{S}, 1)} optimizes the ordering for @code{lu (@var{S}(:,\n\ +@var{p}))}. The ordering is followed by a column elimination tree\n\ +post-ordering.\n\ +\n\ +@var{knobs} is an optional 1-element to 5-element input vector, with a\n\ +default value of @code{[0 10 10 1 0]} if not present or empty. Entries not\n\ +present are set to their defaults.\n\ +\n\ +@table @code\n\ +@item @var{knobs}(1)\n\ +if nonzero, the ordering is optimized for @code{lu (S(:, p))}. It will be a\n\ +poor ordering for @code{chol (@var{S}(:, @var{p})' * @var{S}(:,\n\ +@var{p}))}. This is the most important knob for ccolamd.\n\ +\n\ +@item @var{knobs}(2)\n\ +if @var{S} is m-by-n, rows with more than @code{max (16, @var{knobs}(2) *\n\ +sqrt (n))} entries are ignored.\n\ +\n\ +@item @var{knobs}(3)\n\ +columns with more than @code{max (16, @var{knobs}(3) * sqrt (min (@var{m},\n\ +@var{n})))} entries are ignored and ordered last in the output permutation\n\ +(subject to the cmember constraints).\n\ +\n\ +@item @var{knobs}(4)\n\ +if nonzero, aggressive absorption is performed.\n\ +\n\ +@item @var{knobs}(5)\n\ +if nonzero, statistics and knobs are printed.\n\ +\n\ +@end table\n\ +\n\ +@var{cmember} is an optional vector of length @math{n}. It defines the\n\ +constraints on the column ordering. If @code{@var{cmember}(j) = @var{c}},\n\ +then column @var{j} is in constraint set @var{c} (@var{c} must be in the\n\ +range 1 to\n\ +n). In the output permutation @var{p}, all columns in set 1 appear\n\ +first, followed by all columns in set 2, and so on. @code{@var{cmember} =\n\ +ones (1,n)} if not present or empty.\n\ +@code{ccolamd (@var{S}, [], 1 : n)} returns @code{1 : n}\n\ +\n\ +@code{@var{p} = ccolamd (@var{S})} is about the same as\n\ +@code{@var{p} = colamd (@var{S})}. @var{knobs} and its default values\n\ +differ. @code{colamd} always does aggressive absorption, and it finds an\n\ +ordering suitable for both @code{lu (@var{S}(:, @var{p}))} and @code{chol\n\ +(@var{S}(:, @var{p})' * @var{S}(:, @var{p}))}; it cannot optimize its\n\ +ordering for @code{lu (@var{S}(:, @var{p}))} to the extent that\n\ +@code{ccolamd (@var{S}, 1)} can.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1 : 3)}. @code{@var{stats}(1)} and\n\ +@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ +ignored by @sc{ccolamd} and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by @sc{ccolamd}\n\ +(roughly of size @code{2.2 * nnz (@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ +integers).\n\ +\n\ +@code{@var{stats}(4 : 7)} provide information if CCOLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8 : 20)} is always zero in\n\ +the current version of @sc{ccolamd} (reserved for future use).\n\ +\n\ +The authors of the code itself are S. Larimore, T. Davis (Univ. of Florida)\n\ +and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ +by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ +and a grant from Sandia National Lab. See\n\ +@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ +colamd, symamd, and other related orderings.\n\ +@seealso{colamd, csymamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_CCOLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 3) + usage ("ccolamd: incorrect number of input and/or output arguments"); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); + CCOLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin > 1) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[CCOLAMD_LU] = (User_knobs(0) != 0); + if (nel_User_knobs > 1) + knobs[CCOLAMD_DENSE_ROW] = User_knobs(1); + if (nel_User_knobs > 2) + knobs[CCOLAMD_DENSE_COL] = User_knobs(2); + if (nel_User_knobs > 3) + knobs[CCOLAMD_AGGRESSIVE] = (User_knobs(3) != 0); + if (nel_User_knobs > 4) + spumoni = (User_knobs(4) != 0); + + // print knob settings if spumoni is set + if (spumoni) + { + octave_stdout << "\nccolamd version " << CCOLAMD_MAIN_VERSION << "." + << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE + << ":\nknobs(1): " << User_knobs(0) << ", order for "; + if (knobs[CCOLAMD_LU] != 0) + octave_stdout << "lu (A)\n"; + else + octave_stdout << "chol (A'*A)\n"; + + if (knobs[CCOLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(2): " << User_knobs(1) + << ", rows with > max (16," + << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(2): " << User_knobs(1) + << ", no dense rows removed\n"; + + if (knobs[CCOLAMD_DENSE_COL] >= 0) + octave_stdout << "knobs(3): " << User_knobs(2) + << ", cols with > max (16," + << knobs[CCOLAMD_DENSE_COL] << "*sqrt (size(A)))" + << " entries removed\n"; + else + octave_stdout << "knobs(3): " << User_knobs(2) + << ", no dense columns removed\n"; + + if (knobs[CCOLAMD_AGGRESSIVE] != 0) + octave_stdout << "knobs(4): " << User_knobs(3) + << ", aggressive absorption: yes"; + else + octave_stdout << "knobs(4): " << User_knobs(3) + << ", aggressive absorption: no"; + + octave_stdout << "knobs(5): " << User_knobs(4) + << ", statistics and knobs printed\n"; + } + } + + octave_idx_type n_row, n_col, nnz; + octave_idx_type *ridx, *cidx; + SparseComplexMatrix scm; + SparseMatrix sm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0). sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + nnz = scm.nnz (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + // Allocate workspace for ccolamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); + for (octave_idx_type i = 0; i < n_col+1; i++) + p[i] = cidx[i]; + + octave_idx_type Alen = CCOLAMD_NAME (_recommended) (nnz, n_row, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); + for (octave_idx_type i = 0; i < nnz; i++) + A[i] = ridx[i]; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); + + if (nargin > 2) + { + NDArray in_cmember = args(2).array_value (); + octave_idx_type cslen = in_cmember.length (); + OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); + for (octave_idx_type i = 0; i < cslen; i++) + // convert cmember from 1-based to 0-based + cmember[i] = static_cast(in_cmember(i) - 1); + + if (cslen != n_col) + error ("ccolamd: CMEMBER must be of length equal to #cols of A"); + else + // Order the columns (destroys A) + if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, cmember)) + { + CCOLAMD_NAME (_report) (stats) ; + error ("ccolamd: internal error!"); + return retval; + } + } + else + { + // Order the columns (destroys A) + if (! CCOLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats, 0)) + { + CCOLAMD_NAME (_report) (stats) ; + error ("ccolamd: internal error!"); + return retval; + } + } + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = p[i] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + CCOLAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + } + +#else + + error ("ccolamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (csymamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} csymamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {@var{p} =} csymamd (@var{S}, @var{knobs}, @var{cmember})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} csymamd (@dots{})\n\ +\n\ +For a symmetric positive definite matrix @var{S}, returns the permutation\n\ +vector @var{p} such that @code{@var{S}(@var{p},@var{p})} tends to have a\n\ +sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{csymamd} works\n\ +well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ +to be symmetric; only the strictly lower triangular part is referenced.\n\ +@var{S} must be square. The ordering is followed by an elimination tree\n\ +post-ordering.\n\ +\n\ +@var{knobs} is an optional 1-element to 3-element input vector, with a\n\ +default value of @code{[10 1 0]} if present or empty. Entries not\n\ +present are set to their defaults.\n\ +\n\ +@table @code\n\ +@item @var{knobs}(1)\n\ +If @var{S} is n-by-n, then rows and columns with more than\n\ +@code{max(16,@var{knobs}(1)*sqrt(n))} entries are ignored, and ordered\n\ +last in the output permutation (subject to the cmember constraints).\n\ +\n\ +@item @var{knobs}(2)\n\ +If nonzero, aggressive absorption is performed.\n\ +\n\ +@item @var{knobs}(3)\n\ +If nonzero, statistics and knobs are printed.\n\ +\n\ +@end table\n\ +\n\ +@var{cmember} is an optional vector of length n. It defines the constraints\n\ +on the ordering. If @code{@var{cmember}(j) = @var{S}}, then row/column j is\n\ +in constraint set @var{c} (@var{c} must be in the range 1 to n). In the\n\ +output permutation @var{p}, rows/columns in set 1 appear first, followed\n\ +by all rows/columns in set 2, and so on. @code{@var{cmember} = ones (1,n)}\n\ +if not present or empty. @code{csymamd (@var{S},[],1:n)} returns @code{1:n}.\n\ +\n\ +@code{@var{p} = csymamd (@var{S})} is about the same as @code{@var{p} =\n\ +symamd (@var{S})}. @var{knobs} and its default values differ.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if CCOLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ +the current version of @sc{ccolamd} (reserved for future use).\n\ +\n\ +The authors of the code itself are S. Larimore, T. Davis (Uni of Florida)\n\ +and S. Rajamanickam in collaboration with J. Bilbert and E. Ng. Supported\n\ +by the National Science Foundation (DMS-9504974, DMS-9803599, CCR-0203270),\n\ +and a grant from Sandia National Lab. See\n\ +@url{http://www.cise.ufl.edu/research/sparse} for ccolamd, csymamd, amd,\n\ +colamd, symamd, and other related orderings.\n\ +@seealso{symamd, ccolamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#if HAVE_CCOLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 3) + usage ("ccolamd: incorrect number of input and/or output arguments"); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, CCOLAMD_KNOBS); + CCOLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin > 1) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[CCOLAMD_DENSE_ROW] = User_knobs(0); + if (nel_User_knobs > 0) + knobs[CCOLAMD_AGGRESSIVE] = User_knobs(1); + if (nel_User_knobs > 1) + spumoni = static_cast (User_knobs(2)); + + // print knob settings if spumoni is set + if (spumoni) + { + octave_stdout << "\ncsymamd version " << CCOLAMD_MAIN_VERSION << "." + << CCOLAMD_SUB_VERSION << ", " << CCOLAMD_DATE << "\n"; + + if (knobs[CCOLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(1): " << User_knobs(0) + << ", rows/cols with > max (16," + << knobs[CCOLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(1): " << User_knobs(0) + << ", no dense rows/cols removed\n"; + + if (knobs[CCOLAMD_AGGRESSIVE] != 0) + octave_stdout << "knobs(2): " << User_knobs(1) + << ", aggressive absorption: yes"; + else + octave_stdout << "knobs(2): " << User_knobs(1) + << ", aggressive absorption: no"; + + + octave_stdout << "knobs(3): " << User_knobs(2) + << ", statistics and knobs printed\n"; + } + } + + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (n_row != n_col) + { + error ("csymamd: matrix S must be square"); + return retval; + } + + // Allocate workspace for symamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, CCOLAMD_STATS); + + if (nargin > 2) + { + NDArray in_cmember = args(2).array_value (); + octave_idx_type cslen = in_cmember.length (); + OCTAVE_LOCAL_BUFFER (octave_idx_type, cmember, cslen); + for (octave_idx_type i = 0; i < cslen; i++) + // convert cmember from 1-based to 0-based + cmember[i] = static_cast(in_cmember(i) - 1); + + if (cslen != n_col) + error ("csymamd: CMEMBER must be of length equal to #cols of A"); + else + if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, + &calloc, &free, cmember, -1)) + { + CSYMAMD_NAME (_report) (stats) ; + error ("csymamd: internal error!") ; + return retval; + } + } + else + { + if (!CSYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, + &calloc, &free, 0, -1)) + { + CSYMAMD_NAME (_report) (stats) ; + error ("csymamd: internal error!") ; + return retval; + } + } + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = perm[i] + 1; + + retval(0) = out_perm; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + + // print stats if spumoni > 0 + if (spumoni > 0) + CSYMAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, CCOLAMD_STATS)); + for (octave_idx_type i = 0 ; i < CCOLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (CCOLAMD_INFO1) ++ ; + out_stats (CCOLAMD_INFO2) ++ ; + } + } + +#else + + error ("csymamd: not available in this version of Octave"); + +#endif + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/chol.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/chol.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1385 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2008-2009 Jaroslav Hajek +Copyright (C) 2008-2009 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "CmplxCHOL.h" +#include "dbleCHOL.h" +#include "fCmplxCHOL.h" +#include "floatCHOL.h" +#include "SparseCmplxCHOL.h" +#include "SparsedbleCHOL.h" +#include "oct-spparms.h" +#include "sparse-util.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +template +static octave_value +get_chol_r (const CHOLT& fact) +{ + return octave_value (fact.chol_matrix (), + MatrixType (MatrixType::Upper)); +} + +template +static octave_value +get_chol_l (const CHOLT& fact) +{ + return octave_value (fact.chol_matrix ().transpose (), + MatrixType (MatrixType::Lower)); +} + +DEFUN_DLD (chol, args, nargout, +"-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R} =} chol (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}] =} chol (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{R}, @var{p}, @var{Q}] =} chol (@var{S}, \"vector\")\n\ +@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"lower\")\n\ +@deftypefnx {Loadable Function} {[@var{L}, @dots{}] =} chol (@dots{}, \"upper\")\n\ +@cindex Cholesky factorization\n\ +Compute the Cholesky@tie{}factor, @var{R}, of the symmetric positive definite\n\ +matrix @var{A}, where\n\ +@tex\n\ +$ R^T R = A $.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{A}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +Called with one output argument @code{chol} fails if @var{A} or @var{S} is\n\ +not positive definite. With two or more output arguments @var{p} flags\n\ +whether the matrix was positive definite and @code{chol} does not fail. A\n\ +zero value indicated that the matrix was positive definite and the @var{R}\n\ +gives the factorization, and @var{p} will have a positive value otherwise.\n\ +\n\ +If called with 3 outputs then a sparsity preserving row/column permutation\n\ +is applied to @var{A} prior to the factorization. That is @var{R}\n\ +is the factorization of @code{@var{A}(@var{Q},@var{Q})} such that\n\ +@tex\n\ +$ R^T R = Q^T A Q$.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{Q}' * @var{A} * @var{Q}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +The sparsity preserving permutation is generally returned as a matrix.\n\ +However, given the flag \"vector\", @var{Q} will be returned as a vector\n\ +such that\n\ +@tex\n\ +$ R^T R = A (Q, Q)$.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{R}' * @var{R} = @var{A}(@var{Q}, @var{Q}).\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +Called with either a sparse or full matrix and using the \"lower\" flag,\n\ +@code{chol} returns the lower triangular factorization such that\n\ +@tex\n\ +$ L L^T = A $.\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +@var{L} * @var{L}' = @var{A}.\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +\n\ +For full matrices, if the \"lower\" flag is set only the lower triangular\n\ +part of the matrix is used for the factorization, otherwise the upper\n\ +triangular part is used.\n\ +\n\ +In general the lower triangular factorization is significantly faster for\n\ +sparse matrices.\n\ +@seealso{cholinv, chol2inv}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + bool LLt = false; + bool vecout = false; + + if (nargin < 1 || nargin > 3 || nargout > 3 + || (! args(0).is_sparse_type () && nargout > 2)) + { + print_usage (); + return retval; + } + + int n = 1; + while (n < nargin && ! error_state) + { + std::string tmp = args(n++).string_value (); + + if (! error_state ) + { + if (tmp.compare ("vector") == 0) + vecout = true; + else if (tmp.compare ("lower") == 0) + // FIXME currently the option "lower" is handled by transposing the + // matrix, factorizing it with the lapack function DPOTRF ('U', ...) + // and finally transposing the factor. It would be more efficient to use + // DPOTRF ('L', ...) in this case. + LLt = true; + else if (tmp.compare ("upper") == 0) + LLt = false; + else + error ("chol: unexpected second or third input"); + } + else + error ("chol: expecting trailing string arguments"); + } + + if (! error_state) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + bool natural = (nargout != 3); + + int arg_is_empty = empty_arg ("chol", nr, nc); + + if (arg_is_empty < 0) + return retval; + if (arg_is_empty > 0) + return octave_value (Matrix ()); + + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix m = arg.sparse_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseCHOL fact (m, info, natural); + if (nargout == 3) + { + if (vecout) + retval(2) = fact.perm (); + else + retval(2) = fact.Q (); + } + + if (nargout > 1 || info == 0) + { + retval(1) = fact.P (); + if (LLt) + retval(0) = fact.L (); + else + retval(0) = fact.R (); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix m = arg.sparse_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseComplexCHOL fact (m, info, natural); + + if (nargout == 3) + { + if (vecout) + retval(2) = fact.perm (); + else + retval(2) = fact.Q (); + } + + if (nargout > 1 || info == 0) + { + retval(1) = fact.P (); + if (LLt) + retval(0) = fact.L (); + else + retval(0) = fact.R (); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + FloatCHOL fact; + if (LLt) + fact = FloatCHOL (m.transpose (), info); + else + fact = FloatCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + FloatComplexCHOL fact; + if (LLt) + fact = FloatComplexCHOL (m.transpose (), info); + else + fact = FloatComplexCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + CHOL fact; + if (LLt) + fact = CHOL (m.transpose (), info); + else + fact = CHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + + ComplexCHOL fact; + if (LLt) + fact = ComplexCHOL (m.transpose (), info); + else + fact = ComplexCHOL (m, info); + + if (nargout == 2 || info == 0) + { + retval(1) = info; + if (LLt) + retval(0) = get_chol_l (fact); + else + retval(0) = get_chol_r (fact); + } + else + error ("chol: input matrix must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + } + + return retval; +} + +/* +%!assert (chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)) +%!assert (chol (single ([2, 1; 1, 1])), single ([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps ("single"))) + +%!error chol () +%!error chol ([1, 2; 3, 4]) +%!error chol ([1, 2; 3, 4; 5, 6]) +%!error chol (1, 2) +*/ + +DEFUN_DLD (cholinv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} cholinv (@var{A})\n\ +Use the Cholesky@tie{}factorization to compute the inverse of the\n\ +symmetric positive definite matrix @var{A}.\n\ +@seealso{chol, chol2inv, inv}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else + { + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix m = arg.sparse_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix m = arg.sparse_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + SparseComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("cholinv", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + FloatCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + FloatComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + octave_idx_type info; + CHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + octave_idx_type info; + ComplexCHOL chol (m, info); + if (info == 0) + retval = chol.inverse (); + else + error ("cholinv: A must be positive definite"); + } + } + else + gripe_wrong_type_arg ("chol", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!shared A, Ainv +%! A = [2,0.2;0.2,1]; +%! Ainv = inv (A); +%!test +%! Ainv1 = cholinv (A); +%! assert (norm (Ainv-Ainv1), 0, 1e-10); +%!testif HAVE_CHOLMOD +%! Ainv2 = inv (sparse (A)); +%! assert (norm (Ainv-Ainv2), 0, 1e-10); +%!testif HAVE_CHOLMOD +%! Ainv3 = cholinv (sparse (A)); +%! assert (norm (Ainv-Ainv3), 0, 1e-10); +*/ + +DEFUN_DLD (chol2inv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} chol2inv (@var{U})\n\ +Invert a symmetric, positive definite square matrix from its Cholesky\n\ +decomposition, @var{U}. Note that @var{U} should be an upper-triangular\n\ +matrix with positive diagonal elements. @code{chol2inv (@var{U})}\n\ +provides @code{inv (@var{U}'*@var{U})} but it is much faster than\n\ +using @code{inv}.\n\ +@seealso{chol, cholinv, inv}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else + { + if (arg.is_sparse_type ()) + { + if (arg.is_real_type ()) + { + SparseMatrix r = arg.sparse_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + SparseComplexMatrix r = arg.sparse_complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + } + else if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix r = arg.float_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix r = arg.float_complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + + } + else + { + if (arg.is_real_type ()) + { + Matrix r = arg.matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else if (arg.is_complex_type ()) + { + ComplexMatrix r = arg.complex_matrix_value (); + + if (! error_state) + retval = chol2inv (r); + } + else + gripe_wrong_type_arg ("chol2inv", arg); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN_DLD (cholupdate, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{R1}, @var{info}] =} cholupdate (@var{R}, @var{u}, @var{op})\n\ +Update or downdate a Cholesky@tie{}factorization. Given an upper triangular\n\ +matrix @var{R} and a column vector @var{u}, attempt to determine another\n\ +upper triangular matrix @var{R1} such that\n\ +\n\ +@itemize @bullet\n\ +@item\n\ +@var{R1}'*@var{R1} = @var{R}'*@var{R} + @var{u}*@var{u}'\n\ +if @var{op} is \"+\"\n\ +\n\ +@item\n\ +@var{R1}'*@var{R1} = @var{R}'*@var{R} - @var{u}*@var{u}'\n\ +if @var{op} is \"-\"\n\ +@end itemize\n\ +\n\ +If @var{op} is \"-\", @var{info} is set to\n\ +\n\ +@itemize\n\ +@item 0 if the downdate was successful,\n\ +\n\ +@item 1 if @var{R}'*@var{R} - @var{u}*@var{u}' is not positive definite,\n\ +\n\ +@item 2 if @var{R} is singular.\n\ +@end itemize\n\ +\n\ +If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ +@seealso{chol, qrupdate}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin > 3 || nargin < 2) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argu = args(1); + + if (argr.is_numeric_type () && argu.is_numeric_type () + && (nargin < 3 || args(2).is_string ())) + { + octave_idx_type n = argr.rows (); + + std::string op = (nargin < 3) ? "+" : args(2).string_value (); + + bool down = op == "-"; + + if (down || op == "+") + if (argr.columns () == n && argu.rows () == n && argu.columns () == 1) + { + int err = 0; + if (argr.is_single_type () || argu.is_single_type ()) + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + FloatColumnVector u = argu.float_column_vector_value (); + + FloatCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexColumnVector u = argu.float_complex_column_vector_value (); + + FloatComplexCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + ColumnVector u = argu.column_vector_value (); + + CHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + ComplexColumnVector u = argu.complex_column_vector_value (); + + ComplexCHOL fact; + fact.set (R); + + if (down) + err = fact.downdate (u); + else + fact.update (u); + + retval(0) = get_chol_r (fact); + } + } + + if (nargout > 1) + retval(1) = err; + else if (err == 1) + error ("cholupdate: downdate violates positiveness"); + else if (err == 2) + error ("cholupdate: singular matrix"); + } + else + error ("cholupdate: dimension mismatch between R and U"); + else + error ("cholupdate: OP must be \"+\" or \"-\""); + } + else + print_usage (); + + return retval; +} + +/* +%!shared A, u, Ac, uc +%! A = [ 0.436997 -0.131721 0.124120 -0.061673 ; +%! -0.131721 0.738529 0.019851 -0.140295 ; +%! 0.124120 0.019851 0.354879 -0.059472 ; +%! -0.061673 -0.140295 -0.059472 0.600939 ]; +%! +%! u = [ 0.98950 ; +%! 0.39844 ; +%! 0.63484 ; +%! 0.13351 ]; +%! Ac = [ 0.5585528 + 0.0000000i -0.1662088 - 0.0315341i 0.0107873 + 0.0236411i -0.0276775 - 0.0186073i ; +%! -0.1662088 + 0.0315341i 0.6760061 + 0.0000000i 0.0011452 - 0.0475528i 0.0145967 + 0.0247641i ; +%! 0.0107873 - 0.0236411i 0.0011452 + 0.0475528i 0.6263149 - 0.0000000i -0.1585837 - 0.0719763i ; +%! -0.0276775 + 0.0186073i 0.0145967 - 0.0247641i -0.1585837 + 0.0719763i 0.6034234 - 0.0000000i ]; +%! +%! uc = [ 0.54267 + 0.91519i ; +%! 0.99647 + 0.43141i ; +%! 0.83760 + 0.68977i ; +%! 0.39160 + 0.90378i ]; + +%!test +%! R = chol (A); +%! R1 = cholupdate (R, u); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - u*u', Inf) < 1e1*eps); +%! +%! R1 = cholupdate (R1, u, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! R1 = cholupdate (R, uc); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - uc*uc', Inf) < 1e1*eps); +%! +%! R1 = cholupdate (R1, uc, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! R1 = cholupdate (R, single (u)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (u*u'), Inf) < 1e1*eps ("single")); +%! +%! R1 = cholupdate (R1, single (u), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! R1 = cholupdate (R, single (uc)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (uc*uc'), Inf) < 1e1*eps ("single")); +%! +%! R1 = cholupdate (R1, single (uc), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); +*/ + +DEFUN_DLD (cholinsert, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} cholinsert (@var{R}, @var{j}, @var{u})\n\ +@deftypefnx {Loadable Function} {[@var{R1}, @var{info}] =} cholinsert (@var{R}, @var{j}, @var{u})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of\n\ +@var{A1}, where @w{A1(p,p) = A}, @w{A1(:,j) = A1(j,:)' = u} and\n\ +@w{p = [1:j-1,j+1:n+1]}. @w{u(j)} should be positive.\n\ +On return, @var{info} is set to\n\ +\n\ +@itemize\n\ +@item 0 if the insertion was successful,\n\ +\n\ +@item 1 if @var{A1} is not positive definite,\n\ +\n\ +@item 2 if @var{R} is singular.\n\ +@end itemize\n\ +\n\ +If @var{info} is not present, an error message is printed in cases 1 and 2.\n\ +@seealso{chol, cholupdate, choldelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 3) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argj = args(1); + octave_value argu = args(2); + + if (argr.is_numeric_type () && argu.is_numeric_type () + && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n && argu.rows () == n+1 && argu.columns () == 1) + { + if (j > 0 && j <= n+1) + { + int err = 0; + if (argr.is_single_type () || argu.is_single_type ()) + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + FloatColumnVector u = argu.float_column_vector_value (); + + FloatCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexColumnVector u = argu.float_complex_column_vector_value (); + + FloatComplexCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type () && argu.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + ColumnVector u = argu.column_vector_value (); + + CHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + ComplexColumnVector u = argu.complex_column_vector_value (); + + ComplexCHOL fact; + fact.set (R); + err = fact.insert_sym (u, j-1); + + retval(0) = get_chol_r (fact); + } + } + + if (nargout > 1) + retval(1) = err; + else if (err == 1) + error ("cholinsert: insertion violates positiveness"); + else if (err == 2) + error ("cholinsert: singular matrix"); + else if (err == 3) + error ("cholinsert: diagonal element must be real"); + } + else + error ("cholinsert: index J out of range"); + } + else + error ("cholinsert: dimension mismatch between R and U"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! u2 = [ 0.35080 ; +%! 0.63930 ; +%! 3.31057 ; +%! -0.13825 ; +%! 0.45266 ]; +%! +%! R = chol (A); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps); + +%!test +%! u2 = [ 0.35080 + 0.04298i; +%! 0.63930 + 0.23778i; +%! 3.31057 + 0.00000i; +%! -0.13825 + 0.19879i; +%! 0.45266 + 0.50020i]; +%! +%! R = chol (Ac); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - Ac, Inf) < 1e1*eps); + +%!test +%! u2 = single ([ 0.35080 ; +%! 0.63930 ; +%! 3.31057 ; +%! -0.13825 ; +%! 0.45266 ]); +%! +%! R = chol (single (A)); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps ("single")); + +%!test +%! u2 = single ([ 0.35080 + 0.04298i; +%! 0.63930 + 0.23778i; +%! 3.31057 + 0.00000i; +%! -0.13825 + 0.19879i; +%! 0.45266 + 0.50020i]); +%! +%! R = chol (single (Ac)); +%! +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - single (Ac), Inf) < 2e1*eps ("single")); + +%!test +%! cu = chol (triu (A), "upper"); +%! cl = chol (tril (A), "lower"); +%! assert (cu, cl', eps); + +%!test +%! cca = chol (Ac); +%! +%! ccal = chol (Ac, "lower"); +%! ccal2 = chol (tril (Ac), "lower"); +%! +%! ccau = chol (Ac, "upper"); +%! ccau2 = chol (triu (Ac), "upper"); +%! +%! assert (cca'*cca, Ac, eps); +%! assert (ccau'*ccau, Ac, eps); +%! assert (ccau2'*ccau2, Ac, eps); +%! +%! assert (cca, ccal', eps); +%! assert (cca, ccau, eps); +%! assert (cca, ccal2', eps); +%! assert (cca, ccau2, eps); + +%!test +%! cca = chol (single (Ac)); +%! +%! ccal = chol (single (Ac), "lower"); +%! ccal2 = chol (tril (single (Ac)), "lower"); +%! +%! ccau = chol (single (Ac), "upper"); +%! ccau2 = chol (triu (single (Ac)), "upper"); +%! +%! assert (cca'*cca, single (Ac), eps ("single")); +%! assert (ccau'*ccau, single (Ac), eps ("single")); +%! assert (ccau2'*ccau2, single (Ac), eps ("single")); +%! +%! assert (cca, ccal', eps ("single")); +%! assert (cca, ccau, eps ("single")); +%! assert (cca, ccal2', eps ("single")); +%! assert (cca, ccau2, eps ("single")); + +%!test +%! a = [12, 2, 3, 4; +%! 2, 14, 5, 3; +%! 3, 5, 16, 6; +%! 4, 3, 6, 16]; +%! +%! b = [0, 1, 2, 3; +%! -1, 0, 1, 2; +%! -2, -1, 0, 1; +%! -3, -2, -1, 0]; +%! +%! ca = a + i*b; +%! +%! cca = chol (ca); +%! +%! ccal = chol (ca, "lower"); +%! ccal2 = chol (tril (ca), "lower"); +%! +%! ccau = chol (ca, "upper"); +%! ccau2 = chol (triu (ca), "upper"); +%! +%! assert (cca'*cca, ca, 16*eps); +%! assert (ccau'*ccau, ca, 16*eps); +%! assert (ccau2'*ccau2, ca, 16*eps); +%! +%! assert (cca, ccal', 16*eps); +%! assert (cca, ccau, 16*eps); +%! assert (cca, ccal2', 16*eps); +%! assert (cca, ccau2, 16*eps); +*/ + +DEFUN_DLD (choldelete, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} choldelete (@var{R}, @var{j})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of @w{A(p,p)}, where\n\ +@w{p = [1:j-1,j+1:n+1]}.\n\ +@seealso{chol, cholupdate, cholinsert}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 2) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argj = args(1); + + if (argr.is_numeric_type () && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n) + { + if (j > 0 && j <= n) + { + if (argr.is_single_type ()) + { + if (argr.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + + FloatCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + + CHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexCHOL fact; + fact.set (R); + fact.delete_sym (j-1); + + retval(0) = get_chol_r (fact); + } + } + } + else + error ("choldelete: index J out of range"); + } + else + error ("choldelete: matrix R must be square"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! R = chol (A); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R,j); +%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +*/ + +DEFUN_DLD (cholshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{R1} =} cholshift (@var{R}, @var{i}, @var{j})\n\ +Given a Cholesky@tie{}factorization of a real symmetric or complex Hermitian\n\ +positive definite matrix @w{@var{A} = @var{R}'*@var{R}}, @var{R}@tie{}upper\n\ +triangular, return the Cholesky@tie{}factorization of\n\ +@w{@var{A}(p,p)}, where @w{p} is the permutation @*\n\ +@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ + or @*\n\ +@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ +\n\ +@seealso{chol, cholinsert, choldelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + + octave_value_list retval; + + if (nargin != 3) + { + print_usage (); + return retval; + } + + octave_value argr = args(0); + octave_value argi = args(1); + octave_value argj = args(2); + + if (argr.is_numeric_type () && argi.is_real_scalar () && argj.is_real_scalar ()) + { + octave_idx_type n = argr.rows (); + octave_idx_type i = argi.scalar_value (); + octave_idx_type j = argj.scalar_value (); + + if (argr.columns () == n) + { + if (j > 0 && j <= n+1 && i > 0 && i <= n+1) + { + + if (argr.is_single_type () && argi.is_single_type () && + argj.is_single_type ()) + { + if (argr.is_real_type ()) + { + // real case + FloatMatrix R = argr.float_matrix_value (); + + FloatCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + } + else + { + if (argr.is_real_type ()) + { + // real case + Matrix R = argr.matrix_value (); + + CHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + else + { + // complex case + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexCHOL fact; + fact.set (R); + fact.shift_sym (i-1, j-1); + + retval(0) = get_chol_r (fact); + } + } + } + else + error ("cholshift: index I or J is out of range"); + } + else + error ("cholshift: R must be a square matrix"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! R = chol (A); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1) - R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (Ac); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/colamd.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/colamd.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,768 @@ +/* + +Copyright (C) 2004-2012 David Bateman +Copyright (C) 1998-2004 Andy Adler + +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 3 of the License, 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, see +. + +*/ + +// This is the octave interface to colamd, which bore the copyright given +// in the help of the functions. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include "ov.h" +#include "defun-dld.h" +#include "pager.h" +#include "ov-re-mat.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" + +#include "oct-sparse.h" +#include "oct-locbuf.h" + +#ifdef IDX_TYPE_LONG +#define COLAMD_NAME(name) colamd_l ## name +#define SYMAMD_NAME(name) symamd_l ## name +#else +#define COLAMD_NAME(name) colamd ## name +#define SYMAMD_NAME(name) symamd ## name +#endif + +// The symmetric column elimination tree code take from the Davis LDL code. +// Copyright given elsewhere in this file. +static void +symetree (const octave_idx_type *ridx, const octave_idx_type *cidx, + octave_idx_type *Parent, octave_idx_type *P, octave_idx_type n) +{ + OCTAVE_LOCAL_BUFFER (octave_idx_type, Flag, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Pinv, (P ? n : 0)); + if (P) + // If P is present then compute Pinv, the inverse of P + for (octave_idx_type k = 0 ; k < n ; k++) + Pinv[P[k]] = k ; + + for (octave_idx_type k = 0 ; k < n ; k++) + { + // L(k,:) pattern: all nodes reachable in etree from nz in A(0:k-1,k) + Parent[k] = n ; // parent of k is not yet known + Flag[k] = k ; // mark node k as visited + octave_idx_type kk = (P) ? (P[k]) : (k) ; // kth original, or permuted, column + octave_idx_type p2 = cidx[kk+1] ; + for (octave_idx_type p = cidx[kk] ; p < p2 ; p++) + { + // A (i,k) is nonzero (original or permuted A) + octave_idx_type i = (Pinv) ? (Pinv[ridx[p]]) : (ridx[p]) ; + if (i < k) + { + // follow path from i to root of etree, stop at flagged node + for ( ; Flag[i] != k ; i = Parent[i]) + { + // find parent of i if not yet determined + if (Parent[i] == n) + Parent[i] = k ; + Flag[i] = k ; // mark i as visited + } + } + } + } +} + +// The elimination tree post-ordering code below is taken from SuperLU +static inline octave_idx_type +make_set (octave_idx_type i, octave_idx_type *pp) +{ + pp[i] = i; + return i; +} + +static inline octave_idx_type +link (octave_idx_type s, octave_idx_type t, octave_idx_type *pp) +{ + pp[s] = t; + return t; +} + +static inline octave_idx_type +find (octave_idx_type i, octave_idx_type *pp) +{ + register octave_idx_type p, gp; + + p = pp[i]; + gp = pp[p]; + + while (gp != p) + { + pp[i] = gp; + i = gp; + p = pp[i]; + gp = pp[p]; + } + + return p; +} + +static octave_idx_type +etdfs (octave_idx_type v, octave_idx_type *first_kid, + octave_idx_type *next_kid, octave_idx_type *post, + octave_idx_type postnum) +{ + for (octave_idx_type w = first_kid[v]; w != -1; w = next_kid[w]) + postnum = etdfs (w, first_kid, next_kid, post, postnum); + + post[postnum++] = v; + + return postnum; +} + +static void +tree_postorder (octave_idx_type n, octave_idx_type *parent, + octave_idx_type *post) +{ + // Allocate storage for working arrays and results + OCTAVE_LOCAL_BUFFER (octave_idx_type, first_kid, n+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, next_kid, n+1); + + // Set up structure describing children + for (octave_idx_type v = 0; v <= n; first_kid[v++] = -1) + /* do nothing */; + + for (octave_idx_type v = n-1; v >= 0; v--) + { + octave_idx_type dad = parent[v]; + next_kid[v] = first_kid[dad]; + first_kid[dad] = v; + } + + // Depth-first search from dummy root vertex #n + etdfs (n, first_kid, next_kid, post, 0); +} + +static void +coletree (const octave_idx_type *ridx, const octave_idx_type *colbeg, + octave_idx_type *colend, octave_idx_type *parent, + octave_idx_type nr, octave_idx_type nc) +{ + OCTAVE_LOCAL_BUFFER (octave_idx_type, root, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, pp, nc); + OCTAVE_LOCAL_BUFFER (octave_idx_type, firstcol, nr); + + // Compute firstcol[row] = first nonzero column in row + for (octave_idx_type row = 0; row < nr; firstcol[row++] = nc) + /* do nothing */; + + for (octave_idx_type col = 0; col < nc; col++) + for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) + { + octave_idx_type row = ridx[p]; + if (firstcol[row] > col) + firstcol[row] = col; + } + + // Compute etree by Liu's algorithm for symmetric matrices, + // except use (firstcol[r],c) in place of an edge (r,c) of A. + // Thus each row clique in A'*A is replaced by a star + // centered at its first vertex, which has the same fill. + for (octave_idx_type col = 0; col < nc; col++) + { + octave_idx_type cset = make_set (col, pp); + root[cset] = col; + parent[col] = nc; + for (octave_idx_type p = colbeg[col]; p < colend[col]; p++) + { + octave_idx_type row = firstcol[ridx[p]]; + if (row >= col) + continue; + octave_idx_type rset = find (row, pp); + octave_idx_type rroot = root[rset]; + if (rroot != col) + { + parent[rroot] = col; + cset = link (cset, rset, pp); + root[cset] = col; + } + } + } +} + +DEFUN_DLD (colamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} colamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} colamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} colamd (@var{S}, @var{knobs})\n\ +\n\ +Column approximate minimum degree permutation.\n\ +@code{@var{p} = colamd (@var{S})} returns the column approximate minimum\n\ +degree permutation vector for the sparse matrix @var{S}. For a\n\ +non-symmetric matrix @var{S}, @code{@var{S}(:,@var{p})} tends to have\n\ +sparser LU@tie{}factors than @var{S}. The Cholesky@tie{}factorization of\n\ +@code{@var{S}(:,@var{p})' * @var{S}(:,@var{p})} also tends to be sparser\n\ +than that of @code{@var{S}' * @var{S}}.\n\ +\n\ +@var{knobs} is an optional one- to three-element input vector. If @var{S} is\n\ +m-by-n, then rows with more than @code{max(16,@var{knobs}(1)*sqrt(n))}\n\ +entries are ignored. Columns with more than\n\ +@code{max (16,@var{knobs}(2)*sqrt(min(m,n)))} entries are removed prior to\n\ +ordering, and ordered last in the output permutation @var{p}. Only\n\ +completely dense rows or columns are removed if @code{@var{knobs}(1)} and\n\ +@code{@var{knobs}(2)} are < 0, respectively. If @code{@var{knobs}(3)} is\n\ +nonzero, @var{stats} and @var{knobs} are printed. The default is\n\ +@code{@var{knobs} = [10 10 0]}. Note that @var{knobs} differs from earlier\n\ +versions of colamd.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1)} and\n\ +@code{@var{stats}(2)} are the number of dense or empty rows and columns\n\ +ignored by @sc{colamd} and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by @sc{colamd}\n\ +(roughly of size @code{2.2 * nnz(@var{S}) + 4 * @var{m} + 7 * @var{n}}\n\ +integers).\n\ +\n\ +Octave built-in functions are intended to generate valid sparse matrices,\n\ +with no duplicate entries, with ascending row indices of the nonzeros\n\ +in each column, with a non-negative number of entries in each column (!)\n\ +and so on. If a matrix is invalid, then @sc{colamd} may or may not be able\n\ +to continue. If there are duplicate entries (a row index appears two or\n\ +more times in the same column) or if the row indices in a column are out\n\ +of order, then @sc{colamd} can correct these errors by ignoring the duplicate\n\ +entries and sorting each column of its internal copy of the matrix\n\ +@var{S} (the input matrix @var{S} is not repaired, however). If a matrix\n\ +is invalid in other ways then @sc{colamd} cannot continue, an error message\n\ +is printed, and no output arguments (@var{p} or @var{stats}) are returned.\n\ +@sc{colamd} is thus a simple way to check a sparse matrix to see if it's\n\ +valid.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if COLAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats}(4)} is zero, or 1 if\n\ +invalid. @code{@var{stats}(5)} is the rightmost column index that is\n\ +unsorted or contains duplicate entries, or zero if no such column exists.\n\ +@code{@var{stats}(6)} is the last seen duplicate or out-of-order row\n\ +index in the column index given by @code{@var{stats}(5)}, or zero if no\n\ +such row index exists. @code{@var{stats}(7)} is the number of duplicate\n\ +or out-of-order row indices. @code{@var{stats}(8:20)} is always zero in\n\ +the current version of @sc{colamd} (reserved for future use).\n\ +\n\ +The ordering is followed by a column elimination tree post-ordering.\n\ +\n\ +The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ +Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ +developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ +Ng, Oak Ridge National Laboratory. (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ +@seealso{colperm, symamd, ccolamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_COLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); + COLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin == 2) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[COLAMD_DENSE_ROW] = User_knobs(0); + if (nel_User_knobs > 1) + knobs[COLAMD_DENSE_COL] = User_knobs(1) ; + if (nel_User_knobs > 2) + spumoni = static_cast (User_knobs(2)); + + // print knob settings if spumoni is set + if (spumoni) + { + + octave_stdout << "\ncolamd version " << COLAMD_MAIN_VERSION << "." + << COLAMD_SUB_VERSION << ", " << COLAMD_DATE << ":\n"; + + if (knobs[COLAMD_DENSE_ROW] >= 0) + octave_stdout << "knobs(1): " << User_knobs (0) + << ", rows with > max (16," + << knobs[COLAMD_DENSE_ROW] << "*sqrt (size(A,2)))" + << " entries removed\n"; + else + octave_stdout << "knobs(1): " << User_knobs (0) + << ", only completely dense rows removed\n"; + + if (knobs[COLAMD_DENSE_COL] >= 0) + octave_stdout << "knobs(2): " << User_knobs (1) + << ", cols with > max (16," + << knobs[COLAMD_DENSE_COL] << "*sqrt (size(A)))" + << " entries removed\n"; + else + octave_stdout << "knobs(2): " << User_knobs (1) + << ", only completely dense columns removed\n"; + + octave_stdout << "knobs(3): " << User_knobs (2) + << ", statistics and knobs printed\n"; + + } + } + + octave_idx_type n_row, n_col, nnz; + octave_idx_type *ridx, *cidx; + SparseComplexMatrix scm; + SparseMatrix sm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0). sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + nnz = scm.nnz (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + nnz = sm.nnz (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + // Allocate workspace for colamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, p, n_col+1); + for (octave_idx_type i = 0; i < n_col+1; i++) + p[i] = cidx[i]; + + octave_idx_type Alen = COLAMD_NAME (_recommended) (nnz, n_row, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, A, Alen); + for (octave_idx_type i = 0; i < nnz; i++) + A[i] = ridx[i]; + + // Order the columns (destroys A) + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); + if (! COLAMD_NAME () (n_row, n_col, Alen, A, p, knobs, stats)) + { + COLAMD_NAME (_report) (stats) ; + error ("colamd: internal error!"); + return retval; + } + + // column elimination tree post-ordering (reuse variables) + OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + + for (octave_idx_type i = 0; i < n_col; i++) + { + colbeg[i] = cidx[p[i]]; + colend[i] = cidx[p[i]+1]; + } + + coletree (ridx, colbeg, colend, etree, n_row, n_col); + + // Calculate the tree post-ordering + tree_postorder (n_col, etree, colbeg); + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = p[colbeg[i]] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + COLAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, COLAMD_STATS)); + for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (COLAMD_INFO1) ++ ; + out_stats (COLAMD_INFO2) ++ ; + } + } + +#else + + error ("colamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (symamd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} symamd (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} symamd (@var{S}, @var{knobs})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{stats}] =} symamd (@var{S}, @var{knobs})\n\ +\n\ +For a symmetric positive definite matrix @var{S}, returns the permutation\n\ +vector p such that @code{@var{S}(@var{p}, @var{p})} tends to have a\n\ +sparser Cholesky@tie{}factor than @var{S}. Sometimes @code{symamd} works\n\ +well for symmetric indefinite matrices too. The matrix @var{S} is assumed\n\ +to be symmetric; only the strictly lower triangular part is referenced.\n\ +@var{S} must be square.\n\ +\n\ +@var{knobs} is an optional one- to two-element input vector. If @var{S} is\n\ +n-by-n, then rows and columns with more than\n\ +@code{max (16,@var{knobs}(1)*sqrt(n))} entries are removed prior to ordering,\n\ +and ordered last in the output permutation @var{p}. No rows/columns are\n\ +removed if @code{@var{knobs}(1) < 0}. If @code{@var{knobs} (2)} is nonzero,\n\ +@code{stats} and @var{knobs} are printed. The default is @code{@var{knobs}\n\ += [10 0]}. Note that @var{knobs} differs from earlier versions of symamd.\n\ +\n\ +@var{stats} is an optional 20-element output vector that provides data\n\ +about the ordering and the validity of the input matrix @var{S}. Ordering\n\ +statistics are in @code{@var{stats}(1:3)}. @code{@var{stats}(1) =\n\ +@var{stats}(2)} is the number of dense or empty rows and columns\n\ +ignored by SYMAMD and @code{@var{stats}(3)} is the number of garbage\n\ +collections performed on the internal data structure used by SYMAMD\n\ +(roughly of size @code{8.4 * nnz (tril (@var{S}, -1)) + 9 * @var{n}}\n\ +integers).\n\ +\n\ +Octave built-in functions are intended to generate valid sparse matrices,\n\ +with no duplicate entries, with ascending row indices of the nonzeros\n\ +in each column, with a non-negative number of entries in each column (!)\n\ +and so on. If a matrix is invalid, then SYMAMD may or may not be able\n\ +to continue. If there are duplicate entries (a row index appears two or\n\ +more times in the same column) or if the row indices in a column are out\n\ +of order, then SYMAMD can correct these errors by ignoring the duplicate\n\ +entries and sorting each column of its internal copy of the matrix S (the\n\ +input matrix S is not repaired, however). If a matrix is invalid in\n\ +other ways then SYMAMD cannot continue, an error message is printed, and\n\ +no output arguments (@var{p} or @var{stats}) are returned. SYMAMD is\n\ +thus a simple way to check a sparse matrix to see if it's valid.\n\ +\n\ +@code{@var{stats}(4:7)} provide information if SYMAMD was able to\n\ +continue. The matrix is OK if @code{@var{stats} (4)} is zero, or 1\n\ +if invalid. @code{@var{stats}(5)} is the rightmost column index that\n\ +is unsorted or contains duplicate entries, or zero if no such column\n\ +exists. @code{@var{stats}(6)} is the last seen duplicate or out-of-order\n\ +row index in the column index given by @code{@var{stats}(5)}, or zero\n\ +if no such row index exists. @code{@var{stats}(7)} is the number of\n\ +duplicate or out-of-order row indices. @code{@var{stats}(8:20)} is\n\ +always zero in the current version of SYMAMD (reserved for future use).\n\ +\n\ +The ordering is followed by a column elimination tree post-ordering.\n\ +\n\ +The authors of the code itself are Stefan I. Larimore and Timothy A.\n\ +Davis @email{davis@@cise.ufl.edu}, University of Florida. The algorithm was\n\ +developed in collaboration with John Gilbert, Xerox PARC, and Esmond\n\ +Ng, Oak Ridge National Laboratory. (see\n\ +@url{http://www.cise.ufl.edu/research/sparse/colamd})\n\ +@seealso{colperm, colamd}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_COLAMD + + int nargin = args.length (); + int spumoni = 0; + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + // Get knobs + OCTAVE_LOCAL_BUFFER (double, knobs, COLAMD_KNOBS); + COLAMD_NAME (_set_defaults) (knobs); + + // Check for user-passed knobs + if (nargin == 2) + { + NDArray User_knobs = args(1).array_value (); + int nel_User_knobs = User_knobs.length (); + + if (nel_User_knobs > 0) + knobs[COLAMD_DENSE_ROW] = User_knobs(COLAMD_DENSE_ROW); + if (nel_User_knobs > 1) + spumoni = static_cast (User_knobs (1)); + } + + // print knob settings if spumoni is set + if (spumoni > 0) + octave_stdout << "symamd: dense row/col fraction: " + << knobs[COLAMD_DENSE_ROW] << std::endl; + + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + } + else + { + if (args(0).is_complex_type ()) + sm = SparseMatrix (real (args(0).complex_matrix_value ())); + else + sm = SparseMatrix (args(0).matrix_value ()); + + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + if (n_row != n_col) + { + error ("symamd: matrix S must be square"); + return retval; + } + + // Allocate workspace for symamd + OCTAVE_LOCAL_BUFFER (octave_idx_type, perm, n_col+1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, stats, COLAMD_STATS); + if (!SYMAMD_NAME () (n_col, ridx, cidx, perm, knobs, stats, &calloc, &free)) + { + SYMAMD_NAME (_report) (stats) ; + error ("symamd: internal error!") ; + return retval; + } + + // column elimination tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + symetree (ridx, cidx, etree, perm, n_col); + + // Calculate the tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); + tree_postorder (n_col, etree, post); + + // return the permutation vector + NDArray out_perm (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + out_perm(i) = perm[post[i]] + 1; + + retval(0) = out_perm; + + // print stats if spumoni > 0 + if (spumoni > 0) + SYMAMD_NAME (_report) (stats) ; + + // Return the stats vector + if (nargout == 2) + { + NDArray out_stats (dim_vector (1, COLAMD_STATS)); + for (octave_idx_type i = 0 ; i < COLAMD_STATS ; i++) + out_stats(i) = stats[i] ; + retval(1) = out_stats; + + // fix stats (5) and (6), for 1-based information on + // jumbled matrix. note that this correction doesn't + // occur if symamd returns FALSE + out_stats (COLAMD_INFO1) ++ ; + out_stats (COLAMD_INFO2) ++ ; + } + } + +#else + + error ("symamd: not available in this version of Octave"); + +#endif + + return retval; +} + +DEFUN_DLD (etree, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} etree (@var{S})\n\ +@deftypefnx {Loadable Function} {@var{p} =} etree (@var{S}, @var{typ})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{q}] =} etree (@var{S}, @var{typ})\n\ +\n\ +Return the elimination tree for the matrix @var{S}. By default @var{S}\n\ +is assumed to be symmetric and the symmetric elimination tree is\n\ +returned. The argument @var{typ} controls whether a symmetric or\n\ +column elimination tree is returned. Valid values of @var{typ} are\n\ +\"sym\" or \"col\", for symmetric or column elimination tree respectively\n\ +\n\ +Called with a second argument, @code{etree} also returns the postorder\n\ +permutations on the tree.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargout > 2 || nargin < 1 || nargin > 2) + print_usage (); + else + { + octave_idx_type n_row, n_col; + octave_idx_type *ridx, *cidx; + bool is_sym = true; + SparseMatrix sm; + SparseComplexMatrix scm; + + if (args(0).is_sparse_type ()) + { + if (args(0).is_complex_type ()) + { + scm = args(0).sparse_complex_matrix_value (); + n_row = scm.rows (); + n_col = scm.cols (); + ridx = scm.xridx (); + cidx = scm.xcidx (); + } + else + { + sm = args(0).sparse_matrix_value (); + n_row = sm.rows (); + n_col = sm.cols (); + ridx = sm.xridx (); + cidx = sm.xcidx (); + } + + } + else + { + error ("etree: S must be a sparse matrix"); + return retval; + } + + if (nargin == 2) + { + if (args(1).is_string ()) + { + std::string str = args(1).string_value (); + if (str.find ("C") == 0 || str.find ("c") == 0) + is_sym = false; + } + else + { + error ("etree: TYP must be a string"); + return retval; + } + } + + // column elimination tree post-ordering (reuse variables) + OCTAVE_LOCAL_BUFFER (octave_idx_type, etree, n_col + 1); + + if (is_sym) + { + if (n_row != n_col) + { + error ("etree: S is marked as symmetric, but is not square"); + return retval; + } + + symetree (ridx, cidx, etree, 0, n_col); + } + else + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, colbeg, n_col); + OCTAVE_LOCAL_BUFFER (octave_idx_type, colend, n_col); + + for (octave_idx_type i = 0; i < n_col; i++) + { + colbeg[i] = cidx[i]; + colend[i] = cidx[i+1]; + } + + coletree (ridx, colbeg, colend, etree, n_row, n_col); + } + + NDArray tree (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + // We flag a root with n_col while Matlab does it with zero + // Convert for matlab compatiable output + if (etree[i] == n_col) + tree(i) = 0; + else + tree(i) = etree[i] + 1; + + retval(0) = tree; + + if (nargout == 2) + { + // Calculate the tree post-ordering + OCTAVE_LOCAL_BUFFER (octave_idx_type, post, n_col + 1); + tree_postorder (n_col, etree, post); + + NDArray postorder (dim_vector (1, n_col)); + for (octave_idx_type i = 0; i < n_col; i++) + postorder(i) = post[i] + 1; + + retval(1) = postorder; + } + } + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/config-module.awk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/config-module.awk Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,77 @@ +BEGIN { + FS = "|"; + nfiles = 0; + + print "## DO NOT EDIT -- generated from module-files by config-module.awk"; + print "" + print "EXTRA_DIST += \\" + print " dldfcn/config-module.sh \\" + print " dldfcn/config-module.awk \\" + print " dldfcn/module-files \\" + print " dldfcn/oct-qhull.h" + print "" +} +/^#.*/ { next; } +{ + nfiles++; + files[nfiles] = $1; + cppflags[nfiles] = $2; + ldflags[nfiles] = $3; + libraries[nfiles] = $4; +} END { + sep = " \\\n"; + print "DLDFCN_SRC = \\"; + for (i = 1; i <= nfiles; i++) { + if (i == nfiles) + sep = "\n"; + printf (" dldfcn/%s%s", files[i], sep); + } + print ""; + + sep = " \\\n"; + print "DLDFCN_LIBS = $(DLDFCN_SRC:.cc=.la)"; + print ""; + print "if AMCOND_ENABLE_DYNAMIC_LINKING"; + print ""; + print "octlib_LTLIBRARIES += $(DLDFCN_LIBS)"; + print ""; + print "## Use stamp files to avoid problems with checking timestamps"; + print "## of symbolic links"; + print ""; + for (i = 1; i <= nfiles; i++) { + basename = files[i]; + sub (/\.cc$/, "", basename); + printf ("dldfcn/$(am__leading_dot)%s.oct-stamp: dldfcn/%s.la\n", basename, basename); + print "\trm -f $(<:.la=.oct)"; + print "\tla=$( $dld_dir/module.mk-t + +$move_if_change $dld_dir/module.mk-t $dld_dir/module.mk diff -r 069c552587a0 -r 959953dba519 src/dldfcn/convhulln.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/convhulln.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,316 @@ +/* + +Copyright (C) 2000-2012 Kai Habel + +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 3 of the License, 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, see +. + +*/ + +/* +29. July 2000 - Kai Habel: first release +2002-04-22 Paul Kienzle +* Use warning(...) function rather than writing to cerr +2006-05-01 Tom Holroyd +* add support for consistent winding in all dimensions; output is +* guaranteed to be simplicial. +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "Cell.h" +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "parse.h" +#include "unwind-prot.h" + +#if defined (HAVE_QHULL) +# include "oct-qhull.h" +# if defined (NEED_QHULL_VERSION) +char qh_version[] = "convhulln.oct 2007-07-24"; +# endif +#endif + +static void +close_fcn (FILE *f) +{ + gnulib::fclose (f); +} + +DEFUN_DLD (convhulln, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ +Compute the convex hull of the set of points @var{pts} which is a matrix\n\ +of size [n, dim] containing n points in a space of dimension dim.\n\ +The hull @var{h} is an index vector into the set of points and specifies\n\ +which points form the enclosing hull.\n\ +\n\ +An optional second argument, which must be a string or cell array of strings,\n\ +contains options passed to the underlying qhull command.\n\ +See the documentation for the Qhull library for details\n\ +@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ +The default options depend on the dimension of the input:\n\ +\n\ +@itemize\n\ +@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ +\n\ +@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ +@end itemize\n\ +\n\ +If @var{options} is not present or @code{[]} then the default arguments are\n\ +used. Otherwise, @var{options} replaces the default argument list.\n\ +To append user options to the defaults it is necessary to repeat the\n\ +default arguments in @var{options}. Use a null string to pass no arguments.\n\ +\n\ +If the second output @var{v} is requested the volume of the enclosing\n\ +convex hull is calculated.\n\n\ +@seealso{convhull, delaunayn, voronoin}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#if defined (HAVE_QHULL) + + int nargin = args.length (); + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + + Matrix points (args(0).matrix_value ()); + const octave_idx_type dim = points.columns (); + const octave_idx_type num_points = points.rows (); + + points = points.transpose (); + + std::string options; + + if (dim <= 4) + options = " Qt"; + else + options = " Qt Qx"; + + if (nargin == 2) + { + if (args(1).is_string ()) + options = " " + args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options. + else if (args(1).is_cellstr ()) + { + options = ""; + + Array tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else + { + error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); + return retval; + } + } + + boolT ismalloc = false; + + unwind_protect frame; + + // Replace the outfile pointer with stdout for debugging information. +#if defined (OCTAVE_HAVE_WINDOWS_FILESYSTEM) && ! defined (OCTAVE_HAVE_POSIX_FILESYSTEM) + FILE *outfile = gnulib::fopen ("NUL", "w"); +#else + FILE *outfile = gnulib::fopen ("/dev/null", "w"); +#endif + FILE *errfile = stderr; + + if (outfile) + frame.add_fcn (close_fcn, outfile); + else + { + error ("convhulln: unable to create temporary file for output"); + return retval; + } + + // qh_new_qhull command and points arguments are not const... + + std::string cmd = "qhull" + options; + + OCTAVE_LOCAL_BUFFER (char, cmd_str, cmd.length () + 1); + + strcpy (cmd_str, cmd.c_str ()); + + int exitcode = qh_new_qhull (dim, num_points, points.fortran_vec (), + ismalloc, cmd_str, outfile, errfile); + if (! exitcode) + { + bool nonsimp_seen = false; + + octave_idx_type nf = qh num_facets; + + Matrix idx (nf, dim + 1); + + facetT *facet; + + octave_idx_type i = 0; + + FORALLfacets + { + octave_idx_type j = 0; + + if (! nonsimp_seen && ! facet->simplicial) + { + nonsimp_seen = true; + + if (cmd.find ("QJ") != std::string::npos) + { + // Should never happen with QJ. + error ("convhulln: qhull failed: option 'QJ' returned non-simplicial facet"); + return retval; + } + } + + if (dim == 3) + { + setT *vertices = qh_facet3vertex (facet); + + vertexT *vertex, **vertexp; + + FOREACHvertex_ (vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + + qh_settempfree (&vertices); + } + else + { + if (facet->toporient ^ qh_ORIENTclock) + { + vertexT *vertex, **vertexp; + + FOREACHvertex_ (facet->vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + } + else + { + vertexT *vertex, **vertexp; + + FOREACHvertexreverse12_ (facet->vertices) + idx(i, j++) = 1 + qh_pointid(vertex->point); + } + } + if (j < dim) + warning ("convhulln: facet %d only has %d vertices", i, j); + + i++; + } + + // Remove extra dimension if all facets were simplicial. + + if (! nonsimp_seen) + idx.resize (nf, dim, 0.0); + + if (nargout == 2) + { + // Calculate volume of convex hull, taken from qhull src/geom2.c. + + realT area; + realT dist; + + FORALLfacets + { + if (! facet->normal) + continue; + + if (facet->upperdelaunay && qh ATinfinity) + continue; + + facet->f.area = area = qh_facetarea (facet); + facet->isarea = True; + + if (qh DELAUNAY) + { + if (facet->upperdelaunay == qh UPPERdelaunay) + qh totarea += area; + } + else + { + qh totarea += area; + qh_distplane (qh interior_point, facet, &dist); + qh totvol += -dist * area/ qh hull_dim; + } + } + + retval(1) = octave_value (qh totvol); + } + + retval(0) = idx; + } + else + error ("convhulln: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("convhulln: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); + +#else + error ("convhulln: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "Qt"); +%! assert (size (h), [12 3]); +%! h = sortrows (sort (h, 2), [1:3]); +%! assert (h, [1 2 4; 1 2 6; 1 4 8; 1 5 6; 1 5 8; 2 3 4; 2 3 7; 2 6 7; 3 4 7; 4 7 8; 5 6 7; 5 7 8]); +%! assert (v, 1, 10*eps); +%! [h2, v2] = convhulln (cube); % Test defaut option = "Qt" +%! assert (size (h2), size (h)); +%! h2 = sortrows (sort (h2, 2), [1:3]); +%! assert (h2, h); +%! assert (v2, v, 10*eps); + +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "QJ"); +%! assert (size (h), [12 3]); +%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); +%! assert (v, 1.0, 1e6*eps); + +%!testif HAVE_QHULL +%! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; +%! [h, v] = convhulln (tetrahedron); +%! h = sortrows (sort (h, 2), [1 2 3]); +%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); +%! assert (v, 8/3, 10*eps); +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/dmperm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/dmperm.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,229 @@ +/* + +Copyright (C) 2005-2012 David Bateman +Copyright (C) 1998-2005 Andy Adler + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +#include "oct-sparse.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "SparseQR.h" +#include "SparseCmplxQR.h" + +#ifdef IDX_TYPE_LONG +#define CXSPARSE_NAME(name) cs_dl ## name +#else +#define CXSPARSE_NAME(name) cs_di ## name +#endif + +static RowVector +put_int (octave_idx_type *p, octave_idx_type n) +{ + RowVector ret (n); + for (octave_idx_type i = 0; i < n; i++) + ret.xelem (i) = p[i] + 1; + return ret; +} + +#if HAVE_CXSPARSE +static octave_value_list +dmperm_internal (bool rank, const octave_value arg, int nargout) +{ + octave_value_list retval; + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + SparseMatrix m; + SparseComplexMatrix cm; + CXSPARSE_NAME () csm; + csm.m = nr; + csm.n = nc; + csm.x = 0; + csm.nz = -1; + + if (arg.is_real_type ()) + { + m = arg.sparse_matrix_value (); + csm.nzmax = m.nnz (); + csm.p = m.xcidx (); + csm.i = m.xridx (); + } + else + { + cm = arg.sparse_complex_matrix_value (); + csm.nzmax = cm.nnz (); + csm.p = cm.xcidx (); + csm.i = cm.xridx (); + } + + if (!error_state) + { + if (nargout <= 1 || rank) + { +#if defined(CS_VER) && (CS_VER >= 2) + octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm, 0); +#else + octave_idx_type *jmatch = CXSPARSE_NAME (_maxtrans) (&csm); +#endif + if (rank) + { + octave_idx_type r = 0; + for (octave_idx_type i = 0; i < nc; i++) + if (jmatch[nr+i] >= 0) + r++; + retval(0) = static_cast(r); + } + else + retval(0) = put_int (jmatch + nr, nc); + CXSPARSE_NAME (_free) (jmatch); + } + else + { +#if defined(CS_VER) && (CS_VER >= 2) + CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm, 0); +#else + CXSPARSE_NAME (d) *dm = CXSPARSE_NAME(_dmperm) (&csm); +#endif + + //retval(5) = put_int (dm->rr, 5); + //retval(4) = put_int (dm->cc, 5); +#if defined(CS_VER) && (CS_VER >= 2) + retval(3) = put_int (dm->s, dm->nb+1); + retval(2) = put_int (dm->r, dm->nb+1); + retval(1) = put_int (dm->q, nc); + retval(0) = put_int (dm->p, nr); +#else + retval(3) = put_int (dm->S, dm->nb+1); + retval(2) = put_int (dm->R, dm->nb+1); + retval(1) = put_int (dm->Q, nc); + retval(0) = put_int (dm->P, nr); +#endif + CXSPARSE_NAME (_dfree) (dm); + } + } + return retval; +} +#endif + +DEFUN_DLD (dmperm, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} dmperm (@var{S})\n\ +@deftypefnx {Loadable Function} {[@var{p}, @var{q}, @var{r}, @var{S}] =} dmperm (@var{S})\n\ +\n\ +@cindex Dulmage-Mendelsohn decomposition\n\ +Perform a Dulmage-Mendelsohn permutation of the sparse matrix @var{S}.\n\ +With a single output argument @code{dmperm} performs the row permutations\n\ +@var{p} such that @code{@var{S}(@var{p},:)} has no zero elements on the\n\ +diagonal.\n\ +\n\ +Called with two or more output arguments, returns the row and column\n\ +permutations, such that @code{@var{S}(@var{p}, @var{q})} is in block\n\ +triangular form. The values of @var{r} and @var{S} define the boundaries\n\ +of the blocks. If @var{S} is square then @code{@var{r} == @var{S}}.\n\ +\n\ +The method used is described in: A. Pothen & C.-J. Fan. @cite{Computing the\n\ +Block Triangular Form of a Sparse Matrix}. ACM Trans. Math. Software,\n\ +16(4):303-324, 1990.\n\ +@seealso{colamd, ccolamd}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 1) + { + print_usage (); + return retval; + } + +#if HAVE_CXSPARSE + retval = dmperm_internal (false, args(0), nargout); +#else + error ("dmperm: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_CXSPARSE +%! n = 20; +%! a = speye (n,n); +%! a = a(randperm (n),:); +%! assert (a(dmperm (a),:), speye (n)); + +%!testif HAVE_CXSPARSE +%! n = 20; +%! d = 0.2; +%! a = tril (sprandn (n,n,d), -1) + speye (n,n); +%! a = a(randperm (n), randperm (n)); +%! [p,q,r,s] = dmperm (a); +%! assert (tril (a(p,q), -1), sparse (n, n)); +*/ + +DEFUN_DLD (sprank, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} sprank (@var{S})\n\ +@cindex structural rank\n\ +\n\ +Calculate the structural rank of the sparse matrix @var{S}. Note that\n\ +only the structure of the matrix is used in this calculation based on\n\ +a Dulmage-Mendelsohn permutation to block triangular form. As such the\n\ +numerical rank of the matrix @var{S} is bounded by\n\ +@code{sprank (@var{S}) >= rank (@var{S})}. Ignoring floating point errors\n\ +@code{sprank (@var{S}) == rank (@var{S})}.\n\ +@seealso{dmperm}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value_list retval; + + if (nargin != 1) + { + print_usage (); + return retval; + } + +#if HAVE_CXSPARSE + retval = dmperm_internal (true, args(0), nargout); +#else + error ("sprank: not available in this version of Octave"); +#endif + + return retval; +} + +/* +%!testif HAVE_CXSPARSE +%! assert (sprank (speye (20)), 20) +%!testif HAVE_CXSPARSE +%! assert (sprank ([1,0,2,0;2,0,4,0]), 2) + +%!error sprank (1,2) +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/eigs.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/eigs.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1521 @@ +/* + +Copyright (C) 2005-2012 David Bateman + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "quit.h" +#include "variables.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-map.h" +#include "pager.h" +#include "unwind-prot.h" + +#include "eigs-base.cc" + +// Global pointer for user defined function. +static octave_function *eigs_fcn = 0; + +// Have we warned about imaginary values returned from user function? +static bool warned_imaginary = false; + +// Is this a recursive call? +static int call_depth = 0; + +ColumnVector +eigs_func (const ColumnVector &x, int &eigs_error) +{ + ColumnVector retval; + octave_value_list args; + args(0) = x; + + if (eigs_fcn) + { + octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + return retval; + } + + if (tmp.length () && tmp(0).is_defined ()) + { + if (! warned_imaginary && tmp(0).is_complex_type ()) + { + warning ("eigs: ignoring imaginary part returned from user-supplied function"); + warned_imaginary = true; + } + + retval = ColumnVector (tmp(0).vector_value ()); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + else + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + + return retval; +} + +ComplexColumnVector +eigs_complex_func (const ComplexColumnVector &x, int &eigs_error) +{ + ComplexColumnVector retval; + octave_value_list args; + args(0) = x; + + if (eigs_fcn) + { + octave_value_list tmp = eigs_fcn->do_multi_index_op (1, args); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + return retval; + } + + if (tmp.length () && tmp(0).is_defined ()) + { + retval = ComplexColumnVector (tmp(0).complex_vector_value ()); + + if (error_state) + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + else + { + eigs_error = 1; + gripe_user_supplied_eval ("eigs"); + } + } + + return retval; +} + +DEFUN_DLD (eigs, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{d} =} eigs (@var{A})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{A}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {@var{d} =} eigs (@var{af}, @var{n}, @var{B}, @var{k}, @var{sigma}, @var{opts})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{A}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}] =} eigs (@var{af}, @var{n}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{A}, @dots{})\n\ +@deftypefnx {Loadable Function} {[@var{V}, @var{d}, @var{flag}] =} eigs (@var{af}, @var{n}, @dots{})\n\ +Calculate a limited number of eigenvalues and eigenvectors of @var{A},\n\ +based on a selection criteria. The number of eigenvalues and eigenvectors to\n\ +calculate is given by @var{k} and defaults to 6.\n\ +\n\ +By default, @code{eigs} solve the equation\n\ +@tex\n\ +$A \\nu = \\lambda \\nu$,\n\ +@end tex\n\ +@ifinfo\n\ +@code{A * v = lambda * v},\n\ +@end ifinfo\n\ +where\n\ +@tex\n\ +$\\lambda$ is a scalar representing one of the eigenvalues, and $\\nu$\n\ +@end tex\n\ +@ifinfo\n\ +@code{lambda} is a scalar representing one of the eigenvalues, and @code{v}\n\ +@end ifinfo\n\ +is the corresponding eigenvector. If given the positive definite matrix\n\ +@var{B} then @code{eigs} solves the general eigenvalue equation\n\ +@tex\n\ +$A \\nu = \\lambda B \\nu$.\n\ +@end tex\n\ +@ifinfo\n\ +@code{A * v = lambda * B * v}.\n\ +@end ifinfo\n\ +\n\ +The argument @var{sigma} determines which eigenvalues are returned.\n\ +@var{sigma} can be either a scalar or a string. When @var{sigma} is a\n\ +scalar, the @var{k} eigenvalues closest to @var{sigma} are returned. If\n\ +@var{sigma} is a string, it must have one of the following values.\n\ +\n\ +@table @asis\n\ +@item \"lm\"\n\ +Largest Magnitude (default).\n\ +\n\ +@item \"sm\"\n\ +Smallest Magnitude.\n\ +\n\ +@item \"la\"\n\ +Largest Algebraic (valid only for real symmetric problems).\n\ +\n\ +@item \"sa\"\n\ +Smallest Algebraic (valid only for real symmetric problems).\n\ +\n\ +@item \"be\"\n\ +Both Ends, with one more from the high-end if @var{k} is odd (valid only for\n\ +real symmetric problems).\n\ +\n\ +@item \"lr\"\n\ +Largest Real part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"sr\"\n\ +Smallest Real part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"li\"\n\ +Largest Imaginary part (valid only for complex or unsymmetric problems).\n\ +\n\ +@item \"si\"\n\ +Smallest Imaginary part (valid only for complex or unsymmetric problems).\n\ +@end table\n\ +\n\ +If @var{opts} is given, it is a structure defining possible options that\n\ +@code{eigs} should use. The fields of the @var{opts} structure are:\n\ +\n\ +@table @code\n\ +@item issym\n\ +If @var{af} is given, then flags whether the function @var{af} defines a\n\ +symmetric problem. It is ignored if @var{A} is given. The default is false.\n\ +\n\ +@item isreal\n\ +If @var{af} is given, then flags whether the function @var{af} defines a\n\ +real problem. It is ignored if @var{A} is given. The default is true.\n\ +\n\ +@item tol\n\ +Defines the required convergence tolerance, calculated as\n\ +@code{tol * norm (A)}. The default is @code{eps}.\n\ +\n\ +@item maxit\n\ +The maximum number of iterations. The default is 300.\n\ +\n\ +@item p\n\ +The number of Lanzcos basis vectors to use. More vectors will result in\n\ +faster convergence, but a greater use of memory. The optimal value of\n\ +@code{p} is problem dependent and should be in the range @var{k} to @var{n}.\n\ +The default value is @code{2 * @var{k}}.\n\ +\n\ +@item v0\n\ +The starting vector for the algorithm. An initial vector close to the\n\ +final vector will speed up convergence. The default is for @sc{arpack}\n\ +to randomly generate a starting vector. If specified, @code{v0} must be\n\ +an @var{n}-by-1 vector where @code{@var{n} = rows (@var{A})}\n\ +\n\ +@item disp\n\ +The level of diagnostic printout (0|1|2). If @code{disp} is 0 then\n\ +diagnostics are disabled. The default value is 0.\n\ +\n\ +@item cholB\n\ +Flag if @code{chol (@var{B})} is passed rather than @var{B}. The default is\n\ +false.\n\ +\n\ +@item permB\n\ +The permutation vector of the Cholesky@tie{}factorization of @var{B} if\n\ +@code{cholB} is true. That is @code{chol (@var{B}(permB, permB))}. The\n\ +default is @code{1:@var{n}}.\n\ +\n\ +@end table\n\ +\n\ +It is also possible to represent @var{A} by a function denoted @var{af}.\n\ +@var{af} must be followed by a scalar argument @var{n} defining the length\n\ +of the vector argument accepted by @var{af}. @var{af} can be\n\ +a function handle, an inline function, or a string. When @var{af} is a\n\ +string it holds the name of the function to use.\n\ +\n\ +@var{af} is a function of the form @code{y = af (x)}\n\ +where the required return value of @var{af} is determined by\n\ +the value of @var{sigma}. The four possible forms are\n\ +\n\ +@table @code\n\ +@item A * x\n\ +if @var{sigma} is not given or is a string other than \"sm\".\n\ +\n\ +@item A \\ x\n\ +if @var{sigma} is 0 or \"sm\".\n\ +\n\ +@item (A - sigma * I) \\ x\n\ +for the standard eigenvalue problem, where @code{I} is the identity matrix of\n\ +the same size as @var{A}.\n\ +\n\ +@item (A - sigma * B) \\ x\n\ +for the general eigenvalue problem.\n\ +@end table\n\ +\n\ +The return arguments of @code{eigs} depend on the number of return arguments\n\ +requested. With a single return argument, a vector @var{d} of length @var{k}\n\ +is returned containing the @var{k} eigenvalues that have been found. With\n\ +two return arguments, @var{V} is a @var{n}-by-@var{k} matrix whose columns\n\ +are the @var{k} eigenvectors corresponding to the returned eigenvalues. The\n\ +eigenvalues themselves are returned in @var{d} in the form of a\n\ +@var{n}-by-@var{k} matrix, where the elements on the diagonal are the\n\ +eigenvalues.\n\ +\n\ +Given a third return argument @var{flag}, @code{eigs} returns the status\n\ +of the convergence. If @var{flag} is 0 then all eigenvalues have converged.\n\ +Any other value indicates a failure to converge.\n\ +\n\ +This function is based on the @sc{arpack} package, written by R. Lehoucq,\n\ +K. Maschhoff, D. Sorensen, and C. Yang. For more information see\n\ +@url{http://www.caam.rice.edu/software/ARPACK/}.\n\ +\n\ +@seealso{eig, svds}\n\ +@end deftypefn") +{ + octave_value_list retval; +#ifdef HAVE_ARPACK + int nargin = args.length (); + std::string fcn_name; + octave_idx_type n = 0; + octave_idx_type k = 6; + Complex sigma = 0.; + double sigmar, sigmai; + bool have_sigma = false; + std::string typ = "LM"; + Matrix amm, bmm, bmt; + ComplexMatrix acm, bcm, bct; + SparseMatrix asmm, bsmm, bsmt; + SparseComplexMatrix ascm, bscm, bsct; + int b_arg = 0; + bool have_b = false; + bool have_a_fun = false; + bool a_is_complex = false; + bool b_is_complex = false; + bool symmetric = false; + bool sym_tested = false; + bool cholB = false; + bool a_is_sparse = false; + ColumnVector permB; + int arg_offset = 0; + double tol = DBL_EPSILON; + int maxit = 300; + int disp = 0; + octave_idx_type p = -1; + ColumnVector resid; + ComplexColumnVector cresid; + octave_idx_type info = 1; + + warned_imaginary = false; + + unwind_protect frame; + + frame.protect_var (call_depth); + call_depth++; + + if (call_depth > 1) + { + error ("eigs: invalid recursive call"); + if (fcn_name.length ()) + clear_function (fcn_name); + return retval; + } + + if (nargin == 0) + print_usage (); + else if (args(0).is_function_handle () || args(0).is_inline_function () + || args(0).is_string ()) + { + if (args(0).is_string ()) + { + std::string name = args(0).string_value (); + std::string fname = "function y = "; + fcn_name = unique_symbol_name ("__eigs_fcn_"); + fname.append (fcn_name); + fname.append ("(x) y = "); + eigs_fcn = extract_function (args(0), "eigs", fcn_name, fname, + "; endfunction"); + } + else + eigs_fcn = args(0).function_value (); + + if (!eigs_fcn) + { + error ("eigs: unknown function"); + return retval; + } + + if (nargin < 2) + { + error ("eigs: incorrect number of arguments"); + return retval; + } + else + { + n = args(1).nint_value (); + arg_offset = 1; + have_a_fun = true; + } + } + else + { + if (args(0).is_complex_type ()) + { + if (args(0).is_sparse_type ()) + { + ascm = (args(0).sparse_complex_matrix_value ()); + a_is_sparse = true; + } + else + acm = (args(0).complex_matrix_value ()); + a_is_complex = true; + symmetric = false; // ARPACK doesn't special case complex symmetric + sym_tested = true; + } + else + { + if (args(0).is_sparse_type ()) + { + asmm = (args(0).sparse_matrix_value ()); + a_is_sparse = true; + } + else + { + amm = (args(0).matrix_value ()); + } + } + + } + + // Note hold off reading B till later to avoid issues of double + // copies of the matrix if B is full/real while A is complex. + if (!error_state && nargin > 1 + arg_offset && + !(args(1 + arg_offset).is_real_scalar ())) + { + if (args(1+arg_offset).is_complex_type ()) + { + b_arg = 1+arg_offset; + have_b = true; + b_is_complex = true; + arg_offset++; + } + else + { + b_arg = 1+arg_offset; + have_b = true; + arg_offset++; + } + } + + if (!error_state && nargin > (1+arg_offset)) + k = args(1+arg_offset).nint_value (); + + if (!error_state && nargin > (2+arg_offset)) + { + if (args(2+arg_offset).is_string ()) + { + typ = args(2+arg_offset).string_value (); + + // Use STL function to convert to upper case + transform (typ.begin (), typ.end (), typ.begin (), toupper); + + sigma = 0.; + } + else + { + sigma = args(2+arg_offset).complex_value (); + + if (! error_state) + have_sigma = true; + else + { + error ("eigs: SIGMA must be a scalar or a string"); + return retval; + } + } + } + + sigmar = std::real (sigma); + sigmai = std::imag (sigma); + + if (!error_state && nargin > (3+arg_offset)) + { + if (args(3+arg_offset).is_map ()) + { + octave_scalar_map map = args(3+arg_offset).scalar_map_value (); + + if (! error_state) + { + octave_value tmp; + + // issym is ignored for complex matrix inputs + tmp = map.getfield ("issym"); + if (tmp.is_defined () && !sym_tested) + { + symmetric = tmp.double_value () != 0.; + sym_tested = true; + } + + // isreal is ignored if A is not a function + tmp = map.getfield ("isreal"); + if (tmp.is_defined () && have_a_fun) + a_is_complex = ! (tmp.double_value () != 0.); + + tmp = map.getfield ("tol"); + if (tmp.is_defined ()) + tol = tmp.double_value (); + + tmp = map.getfield ("maxit"); + if (tmp.is_defined ()) + maxit = tmp.nint_value (); + + tmp = map.getfield ("p"); + if (tmp.is_defined ()) + p = tmp.nint_value (); + + tmp = map.getfield ("v0"); + if (tmp.is_defined ()) + { + if (a_is_complex || b_is_complex) + cresid = ComplexColumnVector (tmp.complex_vector_value ()); + else + resid = ColumnVector (tmp.vector_value ()); + } + + tmp = map.getfield ("disp"); + if (tmp.is_defined ()) + disp = tmp.nint_value (); + + tmp = map.getfield ("cholB"); + if (tmp.is_defined ()) + cholB = tmp.double_value () != 0.; + + tmp = map.getfield ("permB"); + if (tmp.is_defined ()) + permB = ColumnVector (tmp.vector_value ()) - 1.0; + } + else + { + error ("eigs: OPTS argument must be a scalar structure"); + return retval; + } + } + else + { + error ("eigs: OPTS argument must be a structure"); + return retval; + } + } + + if (nargin > (4+arg_offset)) + { + error ("eigs: incorrect number of arguments"); + return retval; + } + + // Test undeclared (no issym) matrix inputs for symmetry + if (!sym_tested && !have_a_fun) + { + if (a_is_sparse) + symmetric = asmm.is_symmetric (); + else + symmetric = amm.is_symmetric (); + } + + if (have_b) + { + if (a_is_complex || b_is_complex) + { + if (a_is_sparse) + bscm = args(b_arg).sparse_complex_matrix_value (); + else + bcm = args(b_arg).complex_matrix_value (); + } + else + { + if (a_is_sparse) + bsmm = args(b_arg).sparse_matrix_value (); + else + bmm = args(b_arg).matrix_value (); + } + } + + // Mode 1 for SM mode seems unstable for some reason. + // Use Mode 3 instead, with sigma = 0. + if (!error_state && !have_sigma && typ == "SM") + have_sigma = true; + + if (!error_state) + { + octave_idx_type nconv; + if (a_is_complex || b_is_complex) + { + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + + if (have_a_fun) + nconv = EigsComplexNonSymmetricFunc + (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrixShift + (ascm, sigma, k, p, info, eig_vec, eig_val, bscm, permB, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsComplexNonSymmetricMatrixShift + (acm, sigma, k, p, info, eig_vec, eig_val, bcm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + else + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrix + (ascm, typ, k, p, info, eig_vec, eig_val, bscm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + nconv = EigsComplexNonSymmetricMatrix + (acm, typ, k, p, info, eig_vec, eig_val, bcm, permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else if (sigmai != 0.) + { + // Promote real problem to a complex one. + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + if (have_a_fun) + nconv = EigsComplexNonSymmetricFunc + (eigs_complex_func, n, typ, sigma, k, p, info, eig_vec, eig_val, + cresid, octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + { + if (a_is_sparse) + nconv = EigsComplexNonSymmetricMatrixShift + (SparseComplexMatrix (asmm), sigma, k, p, info, eig_vec, + eig_val, SparseComplexMatrix (bsmm), permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + else + nconv = EigsComplexNonSymmetricMatrixShift + (ComplexMatrix (amm), sigma, k, p, info, eig_vec, + eig_val, ComplexMatrix (bmm), permB, cresid, + octave_stdout, tol, (nargout > 1), cholB, disp, maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else + { + if (symmetric) + { + Matrix eig_vec; + ColumnVector eig_val; + + if (have_a_fun) + nconv = EigsRealSymmetricFunc + (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsRealSymmetricMatrixShift + (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealSymmetricMatrixShift + (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + else + { + if (a_is_sparse) + nconv = EigsRealSymmetricMatrix + (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealSymmetricMatrix + (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = DiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + else + { + ComplexMatrix eig_vec; + ComplexColumnVector eig_val; + + if (have_a_fun) + nconv = EigsRealNonSymmetricFunc + (eigs_func, n, typ, sigmar, k, p, info, eig_vec, eig_val, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else if (have_sigma) + { + if (a_is_sparse) + nconv = EigsRealNonSymmetricMatrixShift + (asmm, sigmar, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealNonSymmetricMatrixShift + (amm, sigmar, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + else + { + if (a_is_sparse) + nconv = EigsRealNonSymmetricMatrix + (asmm, typ, k, p, info, eig_vec, eig_val, bsmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + else + nconv = EigsRealNonSymmetricMatrix + (amm, typ, k, p, info, eig_vec, eig_val, bmm, permB, + resid, octave_stdout, tol, (nargout > 1), cholB, disp, + maxit); + } + + if (nargout < 2) + retval(0) = eig_val; + else + { + retval(2) = double (info); + retval(1) = ComplexDiagMatrix (eig_val); + retval(0) = eig_vec; + } + } + } + + if (nconv <= 0) + warning ("eigs: None of the %d requested eigenvalues converged", k); + else if (nconv < k) + warning ("eigs: Only %d of the %d requested eigenvalues converged", + nconv, k); + } + + if (! fcn_name.empty ()) + clear_function (fcn_name); +#else + error ("eigs: not available in this version of Octave"); +#endif + + return retval; +} + +/* #### SPARSE MATRIX VERSIONS #### */ + +/* +## Real positive definite tests, n must be even +%!shared n, k, A, d0, d2 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); +%! d0 = eig (A); +%! d2 = sort (d0); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); # initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (d1, d0(end:-1:(end-k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "la"); +%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sa"); +%! assert (d1, d2(1:k), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "be"); +%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1, "be"); +%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (d1, eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! AA = speye (10); +%! fn = @(x) AA * x; +%! opts.issym = 1; opts.isreal = 1; +%! assert (eigs (fn, 10, AA, 3, "lm", opts), [1; 1; 1], 10*eps); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Real unsymmetric tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Complex hermitian tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK, HAVE_CHOLMOD +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* #### FULL MATRIX VERSIONS #### */ + +/* +## Real positive definite tests, n must be even +%!shared n, k, A, d0, d2 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); +%! d0 = eig (A); +%! d2 = sort (d0); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (d1, d0(end:-1:(end-k)),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "la"); +%! assert (d1, d2(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sa"); +%! assert (d1, d2(1:k), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "be"); +%! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1, "be"); +%! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (d1(idx1), d0(idx0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (d1, d0(end:-1:(end-k+1)), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (d1, d0(k:-1:1), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (d1, eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Real unsymmetric tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ + +/* +## Complex hermitian tests +%!shared n, k, A, d0 +%! n = 20; +%! k = 4; +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); +%! d0 = eig (A); +%! [~, idx] = sort (abs (d0)); +%! d0 = d0(idx); +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible +%!testif HAVE_ARPACK +%! d1 = eigs (A, k); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); +%! d2 = d0(idx); +%! assert (real (d1), real (d2(1:k)), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); +%! d2 = d0(idx); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, k, 4.1); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); +%!testif HAVE_ARPACK +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! opts.cholB = true; +%! q = [2:n,1]; +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); +%!testif HAVE_ARPACK +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A * x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) A \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); +%!testif HAVE_ARPACK +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +%!testif HAVE_ARPACK +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); +%! for i=1:k +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); +%! endfor +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/fftw.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/fftw.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,269 @@ +/* + +Copyright (C) 2006-2012 David Bateman + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "oct-fftw.h" + +#include "defun-dld.h" +#include "error.h" +#include "ov.h" + +DEFUN_DLD (fftw, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{method} =} fftw (\"planner\")\n\ +@deftypefnx {Loadable Function} {} fftw (\"planner\", @var{method})\n\ +@deftypefnx {Loadable Function} {@var{wisdom} =} fftw (\"dwisdom\")\n\ +@deftypefnx {Loadable Function} {} fftw (\"dwisdom\", @var{wisdom})\n\ +\n\ +Manage @sc{fftw} wisdom data. Wisdom data can be used to significantly\n\ +accelerate the calculation of the FFTs, but implies an initial cost\n\ +in its calculation. When the @sc{fftw} libraries are initialized, they read\n\ +a system wide wisdom file (typically in @file{/etc/fftw/wisdom}), allowing\n\ +wisdom to be shared between applications other than Octave. Alternatively,\n\ +the @code{fftw} function can be used to import wisdom. For example,\n\ +\n\ +@example\n\ +@var{wisdom} = fftw (\"dwisdom\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will save the existing wisdom used by Octave to the string @var{wisdom}.\n\ +This string can then be saved to a file and restored using the @code{save}\n\ +and @code{load} commands respectively. This existing wisdom can be\n\ +reimported as follows\n\ +\n\ +@example\n\ +fftw (\"dwisdom\", @var{wisdom})\n\ +@end example\n\ +\n\ +If @var{wisdom} is an empty matrix, then the wisdom used is cleared.\n\ +\n\ +During the calculation of Fourier transforms further wisdom is generated.\n\ +The fashion in which this wisdom is generated is also controlled by\n\ +the @code{fftw} function. There are five different manners in which the\n\ +wisdom can be treated:\n\ +\n\ +@table @asis\n\ +@item \"estimate\"\n\ +Specifies that no run-time measurement of the optimal means of\n\ +calculating a particular is performed, and a simple heuristic is used\n\ +to pick a (probably sub-optimal) plan. The advantage of this method is\n\ +that there is little or no overhead in the generation of the plan, which\n\ +is appropriate for a Fourier transform that will be calculated once.\n\ +\n\ +@item \"measure\"\n\ +In this case a range of algorithms to perform the transform is considered\n\ +and the best is selected based on their execution time.\n\ +\n\ +@item \"patient\"\n\ +Similar to \"measure\", but a wider range of algorithms is considered.\n\ +\n\ +@item \"exhaustive\"\n\ +Like \"measure\", but all possible algorithms that may be used to\n\ +treat the transform are considered.\n\ +\n\ +@item \"hybrid\"\n\ +As run-time measurement of the algorithm can be expensive, this is a\n\ +compromise where \"measure\" is used for transforms up to the size of 8192\n\ +and beyond that the \"estimate\" method is used.\n\ +@end table\n\ +\n\ +The default method is \"estimate\". The current method can\n\ +be queried with\n\ +\n\ +@example\n\ +@var{method} = fftw (\"planner\")\n\ +@end example\n\ +\n\ +@noindent\n\ +or set by using\n\ +\n\ +@example\n\ +fftw (\"planner\", @var{method})\n\ +@end example\n\ +\n\ +Note that calculated wisdom will be lost when restarting Octave. However,\n\ +the wisdom data can be reloaded if it is saved to a file as described\n\ +above. Saved wisdom files should not be used on different platforms since\n\ +they will not be efficient and the point of calculating the wisdom is lost.\n\ +@seealso{fft, ifft, fft2, ifft2, fftn, ifftn}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + { + print_usage (); + return retval; + } + +#if defined (HAVE_FFTW) + if (args(0).is_string ()) + { + std::string arg0 = args(0).string_value (); + + if (!error_state) + { + // Use STL function to convert to lower case + std::transform (arg0.begin (), arg0.end (), arg0.begin (), tolower); + + if (nargin == 2) + { + std::string arg1 = args(1).string_value (); + if (!error_state) + { + if (arg0 == "planner") + { + std::transform (arg1.begin (), arg1.end (), + arg1.begin (), tolower); + octave_fftw_planner::FftwMethod meth + = octave_fftw_planner::UNKNOWN; + octave_float_fftw_planner::FftwMethod methf + = octave_float_fftw_planner::UNKNOWN; + + if (arg1 == "estimate") + { + meth = octave_fftw_planner::ESTIMATE; + methf = octave_float_fftw_planner::ESTIMATE; + } + else if (arg1 == "measure") + { + meth = octave_fftw_planner::MEASURE; + methf = octave_float_fftw_planner::MEASURE; + } + else if (arg1 == "patient") + { + meth = octave_fftw_planner::PATIENT; + methf = octave_float_fftw_planner::PATIENT; + } + else if (arg1 == "exhaustive") + { + meth = octave_fftw_planner::EXHAUSTIVE; + methf = octave_float_fftw_planner::EXHAUSTIVE; + } + else if (arg1 == "hybrid") + { + meth = octave_fftw_planner::HYBRID; + methf = octave_float_fftw_planner::HYBRID; + } + else + error ("unrecognized planner METHOD"); + + if (!error_state) + { + meth = octave_fftw_planner::method (meth); + octave_float_fftw_planner::method (methf); + + if (meth == octave_fftw_planner::MEASURE) + retval = octave_value ("measure"); + else if (meth == octave_fftw_planner::PATIENT) + retval = octave_value ("patient"); + else if (meth == octave_fftw_planner::EXHAUSTIVE) + retval = octave_value ("exhaustive"); + else if (meth == octave_fftw_planner::HYBRID) + retval = octave_value ("hybrid"); + else + retval = octave_value ("estimate"); + } + } + else if (arg0 == "dwisdom") + { + char *str = fftw_export_wisdom_to_string (); + + if (arg1.length () < 1) + fftw_forget_wisdom (); + else if (! fftw_import_wisdom_from_string (arg1.c_str ())) + error ("could not import supplied WISDOM"); + + if (!error_state) + retval = octave_value (std::string (str)); + + free (str); + } + else if (arg0 == "swisdom") + { + char *str = fftwf_export_wisdom_to_string (); + + if (arg1.length () < 1) + fftwf_forget_wisdom (); + else if (! fftwf_import_wisdom_from_string (arg1.c_str ())) + error ("could not import supplied WISDOM"); + + if (!error_state) + retval = octave_value (std::string (str)); + + free (str); + } + else + error ("unrecognized argument"); + } + } + else + { + if (arg0 == "planner") + { + octave_fftw_planner::FftwMethod meth = + octave_fftw_planner::method (); + + if (meth == octave_fftw_planner::MEASURE) + retval = octave_value ("measure"); + else if (meth == octave_fftw_planner::PATIENT) + retval = octave_value ("patient"); + else if (meth == octave_fftw_planner::EXHAUSTIVE) + retval = octave_value ("exhaustive"); + else if (meth == octave_fftw_planner::HYBRID) + retval = octave_value ("hybrid"); + else + retval = octave_value ("estimate"); + } + else if (arg0 == "dwisdom") + { + char *str = fftw_export_wisdom_to_string (); + retval = octave_value (std::string (str)); + free (str); + } + else if (arg0 == "swisdom") + { + char *str = fftwf_export_wisdom_to_string (); + retval = octave_value (std::string (str)); + free (str); + } + else + error ("unrecognized argument"); + } + } + } +#else + + warning ("fftw: this copy of Octave was not configured to use the FFTW3 planner"); + +#endif + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/module-files --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/module-files Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,22 @@ +# FILE|CPPFLAGS|LDFLAGS|LIBRARIES +__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +__dsearchn__.cc +__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) +__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__init_gnuplot__.cc +__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) +__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +chol.cc +colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +eigs.cc|$(ARPACK_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(ARPACK_LDFLAGS) $(SPARSE_XLDFLAGS)|$(ARPACK_LIBS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) +fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) +symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +tsearch.cc +urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS) diff -r 069c552587a0 -r 959953dba519 src/dldfcn/oct-qhull.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/oct-qhull.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,60 @@ +/* + +Copyright (C) 2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_oct_qhull_h) +#define octave_oct_qhull_h 1 + +#include + +extern "C" { + +#if defined (HAVE_LIBQHULL_LIBQHULL_H) +# include +# include +# include +# include +# include +#elif defined (HAVE_QHULL_LIBQHULL_H) || defined (HAVE_QHULL_QHULL_H) +# if defined (HAVE_QHULL_LIBQHULL_H) +# include +# else +# include +# endif +# include +# include +# include +# include +#elif defined (HAVE_LIBQHULL_H) || defined (HAVE_QHULL_H) +# if defined (HAVE_LIBQHULL_H) +# include +# else +# include +# endif +# include +# include +# include +# include +#endif + +} + +#endif diff -r 069c552587a0 -r 959953dba519 src/dldfcn/qr.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/qr.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1598 @@ +/* + +Copyright (C) 1996-2012 John W. Eaton +Copyright (C) 2008-2009 Jaroslav Hajek +Copyright (C) 2008-2009 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "CmplxQR.h" +#include "CmplxQRP.h" +#include "dbleQR.h" +#include "dbleQRP.h" +#include "fCmplxQR.h" +#include "fCmplxQRP.h" +#include "floatQR.h" +#include "floatQRP.h" +#include "SparseQR.h" +#include "SparseCmplxQR.h" + + +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +template +static octave_value +get_qr_r (const base_qr& fact) +{ + MT R = fact.R (); + if (R.is_square () && fact.regular ()) + return octave_value (R, MatrixType (MatrixType::Upper)); + else + return R; +} + +// [Q, R] = qr (X): form Q unitary and R upper triangular such +// that Q * R = X +// +// [Q, R] = qr (X, 0): form the economy decomposition such that if X is +// m by n then only the first n columns of Q are +// computed. +// +// [Q, R, P] = qr (X): form QRP factorization of X where +// P is a permutation matrix such that +// A * P = Q * R +// +// [Q, R, P] = qr (X, 0): form the economy decomposition with +// permutation vector P such that Q * R = X (:, P) +// +// qr (X) alone returns the output of the LAPACK routine dgeqrf, such +// that R = triu (qr (X)) + +DEFUN_DLD (qr, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ +@deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ +@cindex QR factorization\n\ +Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ +subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ +\n\ +@example\n\ +[@var{Q}, @var{R}] = qr (@var{A})\n\ +@end example\n\ +\n\ +@noindent\n\ +returns\n\ +\n\ +@example\n\ +@group\n\ +@var{Q} =\n\ +\n\ + -0.31623 -0.94868\n\ + -0.94868 0.31623\n\ +\n\ +@var{R} =\n\ +\n\ + -3.16228 -4.42719\n\ + 0.00000 -0.63246\n\ +@end group\n\ +@end example\n\ +\n\ +The @code{qr} factorization has applications in the solution of least\n\ +squares problems\n\ +@tex\n\ +$$\n\ +\\min_x \\left\\Vert A x - b \\right\\Vert_2\n\ +$$\n\ +@end tex\n\ +@ifnottex\n\ +\n\ +@example\n\ +min norm(A x - b)\n\ +@end example\n\ +\n\ +@end ifnottex\n\ +for overdetermined systems of equations (i.e.,\n\ +@tex\n\ +$A$\n\ +@end tex\n\ +@ifnottex\n\ +@var{A}\n\ +@end ifnottex\n\ + is a tall, thin matrix). The QR@tie{}factorization is\n\ +@tex\n\ +$QR = A$ where $Q$ is an orthogonal matrix and $R$ is upper triangular.\n\ +@end tex\n\ +@ifnottex\n\ +@code{@var{Q} * @var{Q} = @var{A}} where @var{Q} is an orthogonal matrix and\n\ +@var{R} is upper triangular.\n\ +@end ifnottex\n\ +\n\ +If given a second argument of '0', @code{qr} returns an economy-sized\n\ +QR@tie{}factorization, omitting zero rows of @var{R} and the corresponding\n\ +columns of @var{Q}.\n\ +\n\ +If the matrix @var{A} is full, the permuted QR@tie{}factorization\n\ +@code{[@var{Q}, @var{R}, @var{P}] = qr (@var{A})} forms the\n\ +QR@tie{}factorization such that the diagonal entries of @var{R} are\n\ +decreasing in magnitude order. For example, given the matrix @code{a = [1,\n\ +2; 3, 4]},\n\ +\n\ +@example\n\ +[@var{Q}, @var{R}, @var{P}] = qr (@var{A})\n\ +@end example\n\ +\n\ +@noindent\n\ +returns\n\ +\n\ +@example\n\ +@group\n\ +@var{Q} =\n\ +\n\ + -0.44721 -0.89443\n\ + -0.89443 0.44721\n\ +\n\ +@var{R} =\n\ +\n\ + -4.47214 -3.13050\n\ + 0.00000 0.44721\n\ +\n\ +@var{P} =\n\ +\n\ + 0 1\n\ + 1 0\n\ +@end group\n\ +@end example\n\ +\n\ +The permuted @code{qr} factorization @code{[@var{Q}, @var{R}, @var{P}] = qr\n\ +(@var{A})} factorization allows the construction of an orthogonal basis of\n\ +@code{span (A)}.\n\ +\n\ +If the matrix @var{A} is sparse, then compute the sparse\n\ +QR@tie{}factorization of @var{A}, using @sc{CSparse}. As the matrix @var{Q}\n\ +is in general a full matrix, this function returns the @var{Q}-less\n\ +factorization @var{R} of @var{A}, such that @code{@var{R} = chol (@var{A}' *\n\ +@var{A})}.\n\ +\n\ +If the final argument is the scalar @code{0} and the number of rows is\n\ +larger than the number of columns, then an economy factorization is\n\ +returned. That is @var{R} will have only @code{size (@var{A},1)} rows.\n\ +\n\ +If an additional matrix @var{B} is supplied, then @code{qr} returns\n\ +@var{C}, where @code{@var{C} = @var{Q}' * @var{B}}. This allows the\n\ +least squares approximation of @code{@var{A} \\ @var{B}} to be calculated\n\ +as\n\ +\n\ +@example\n\ +@group\n\ +[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ +x = @var{R} \\ @var{C}\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > (args(0).is_sparse_type () ? 3 : 2)) + { + print_usage (); + return retval; + } + + octave_value arg = args(0); + + int arg_is_empty = empty_arg ("qr", arg.rows (), arg.columns ()); + + if (arg_is_empty < 0) + return retval; + + if (arg.is_sparse_type ()) + { + bool economy = false; + bool is_cmplx = false; + int have_b = 0; + + if (arg.is_complex_type ()) + is_cmplx = true; + if (nargin > 1) + { + have_b = 1; + if (args(nargin-1).is_scalar_type ()) + { + int val = args(nargin-1).int_value (); + if (val == 0) + { + economy = true; + have_b = (nargin > 2 ? 2 : 0); + } + } + if (have_b > 0 && args(have_b).is_complex_type ()) + is_cmplx = true; + } + + if (!error_state) + { + if (have_b && nargout < 2) + error ("qr: incorrect number of output arguments"); + else if (is_cmplx) + { + SparseComplexQR q (arg.sparse_complex_matrix_value ()); + if (!error_state) + { + if (have_b > 0) + { + retval(1) = q.R (economy); + retval(0) = q.C (args(have_b).complex_matrix_value ()); + if (arg.rows () < arg.columns ()) + warning ("qr: non minimum norm solution for under-determined problem"); + } + else if (nargout > 1) + { + retval(1) = q.R (economy); + retval(0) = q.Q (); + } + else + retval(0) = q.R (economy); + } + } + else + { + SparseQR q (arg.sparse_matrix_value ()); + if (!error_state) + { + if (have_b > 0) + { + retval(1) = q.R (economy); + retval(0) = q.C (args(have_b).matrix_value ()); + if (args(0).rows () < args(0).columns ()) + warning ("qr: non minimum norm solution for under-determined problem"); + } + else if (nargout > 1) + { + retval(1) = q.R (economy); + retval(0) = q.Q (); + } + else + retval(0) = q.R (economy); + } + } + } + } + else + { + QR::type type = (nargout == 0 || nargout == 1) ? QR::raw + : (nargin == 2 ? QR::economy : QR::std); + + if (arg.is_single_type ()) + { + if (arg.is_real_type ()) + { + FloatMatrix m = arg.float_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + FloatQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + FloatQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + FloatQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else if (arg.is_complex_type ()) + { + FloatComplexMatrix m = arg.float_complex_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + FloatComplexQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + FloatComplexQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + FloatComplexQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + } + else + { + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + QR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + QR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + QRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix m = arg.complex_matrix_value (); + + if (! error_state) + { + switch (nargout) + { + case 0: + case 1: + { + ComplexQR fact (m, type); + retval(0) = fact.R (); + } + break; + + case 2: + { + ComplexQR fact (m, type); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + + default: + { + ComplexQRP fact (m, type); + if (type == QR::economy) + retval(2) = fact.Pvec (); + else + retval(2) = fact.P (); + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + break; + } + } + } + else + gripe_wrong_type_arg ("qr", arg); + } + } + + return retval; +} + +/* +%!test +%! a = [0, 2, 1; 2, 1, 2]; +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps)); +%! assert (qe * re, a, sqrt (eps)); + +%!test +%! a = [0, 2, 1; 2, 1, 2]; +%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps)); +%! assert (qe * re, a(:, pe), sqrt (eps)); + +%!test +%! a = [0, 2; 2, 1; 1, 2]; +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps)); +%! assert (qe * re, a, sqrt (eps)); + +%!test +%! a = [0, 2; 2, 1; 1, 2]; +%! +%! [q, r, p] = qr (a); +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps)); +%! assert (qe * re, a(:, pe), sqrt (eps)); + +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) + +%!function retval = __testqr (q, r, a, p) +%! tol = 100*eps (class (q)); +%! retval = 0; +%! if (nargin == 3) +%! n1 = norm (q*r - a); +%! n2 = norm (q'*q - eye (columns (q))); +%! retval = (n1 < tol && n2 < tol); +%! else +%! n1 = norm (q'*q - eye (columns (q))); +%! retval = (n1 < tol); +%! if (isvector (p)) +%! n2 = norm (q*r - a(:,p)); +%! retval = (retval && n2 < tol); +%! else +%! n2 = norm (q*r - a*p); +%! retval = (retval && n2 < tol); +%! endif +%! endif +%!endfunction + +%!test +%! t = ones (24, 1); +%! j = 1; +%! +%! if (false) # eliminate big matrix tests +%! a = rand (5000, 20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! endif +%! +%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); +%! +%! assert (all (t) && norm (q*r - a) < 5000*eps); + +%!test +%! a = single ([0, 2, 1; 2, 1, 2]); +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2, 1; 2, 1, 2]); +%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2; 2, 1; 1, 2]); +%! +%! [q, r] = qr (a); +%! [qe, re] = qr (a, 0); +%! +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); + +%!test +%! a = single ([0, 2; 2, 1; 1, 2]); +%! +%! [q, r, p] = qr (a); +%! [qe, re, pe] = qr (a, 0); +%! +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); + +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) + +%!test +%! t = ones (24, 1); +%! j = 1; +%! +%! if (false) # eliminate big matrix tests +%! a = rand (5000,20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! endif +%! +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); +%! +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a',p); +%! +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); +%! +%! assert (all (t) && norm (q*r-a) < 5000*eps ("single")); + +## The deactivated tests below can't be tested till rectangular back-subs is +## implemented for sparse matrices. + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_COLAMD +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); +%! a = a(q,q); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%% Test under-determined systems!! +%!#testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r,a'*a,1e-10) + +%!testif HAVE_COLAMD +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); +%! a = a(q,q); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) + +%!testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%% Test under-determined systems!! +%!#testif HAVE_CXSPARSE +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) + +%!error qr (sprandn (10,10,0.2), ones (10,1)) +*/ + +static +bool check_qr_dims (const octave_value& q, const octave_value& r, + bool allow_ecf = false) +{ + octave_idx_type m = q.rows (), k = r.rows (), n = r.columns (); + return ((q.ndims () == 2 && r.ndims () == 2 && k == q.columns ()) + && (m == k || (allow_ecf && k == n && k < m))); +} + +static +bool check_index (const octave_value& i, bool vector_allowed = false) +{ + return ((i.is_real_type () || i.is_integer_type ()) + && (i.is_scalar_type () || vector_allowed)); +} + +DEFUN_DLD (qrupdate, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrupdate (@var{Q}, @var{R}, @var{u}, @var{v})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ +of @w{@var{A} + @var{u}*@var{v}'}, where @var{u} and @var{v} are\n\ +column vectors (rank-1 update) or matrices with equal number of columns\n\ +(rank-k update). Notice that the latter case is done as a sequence of rank-1\n\ +updates; thus, for k large enough, it will be both faster and more accurate\n\ +to recompute the factorization from scratch.\n\ +\n\ +The QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +@seealso{qr, qrinsert, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin != 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argu = args(2); + octave_value argv = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && argu.is_numeric_type () && argv.is_numeric_type ()) + { + if (check_qr_dims (argq, argr, true)) + { + if (argq.is_real_type () + && argr.is_real_type () + && argu.is_real_type () + && argv.is_real_type ()) + { + // all real case + if (argq.is_single_type () + || argr.is_single_type () + || argu.is_single_type () + || argv.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + FloatMatrix u = argu.float_matrix_value (); + FloatMatrix v = argv.float_matrix_value (); + + FloatQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + Matrix u = argu.matrix_value (); + Matrix v = argv.matrix_value (); + + QR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type () + || argu.is_single_type () + || argv.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexMatrix u = argu.float_complex_matrix_value (); + FloatComplexMatrix v = argv.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + ComplexMatrix u = argu.complex_matrix_value (); + ComplexMatrix v = argv.complex_matrix_value (); + + ComplexQR fact (Q, R); + fact.update (u, v); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrupdate: Q and R dimensions don't match"); + } + else + error ("qrupdate: Q, R, U, and V must be numeric"); + + return retval; +} + +/* +%!shared A, u, v, Ac, uc, vc +%! A = [0.091364 0.613038 0.999083; +%! 0.594638 0.425302 0.603537; +%! 0.383594 0.291238 0.085574; +%! 0.265712 0.268003 0.238409; +%! 0.669966 0.743851 0.445057 ]; +%! +%! u = [0.85082; +%! 0.76426; +%! 0.42883; +%! 0.53010; +%! 0.80683 ]; +%! +%! v = [0.98810; +%! 0.24295; +%! 0.43167 ]; +%! +%! Ac = [0.620405 + 0.956953i 0.480013 + 0.048806i 0.402627 + 0.338171i; +%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; +%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; +%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; +%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; +%! +%! uc = [0.20351 + 0.05401i; +%! 0.13141 + 0.43708i; +%! 0.29808 + 0.08789i; +%! 0.69821 + 0.38844i; +%! 0.74871 + 0.25821i ]; +%! +%! vc = [0.85839 + 0.29468i; +%! 0.20820 + 0.93090i; +%! 0.86184 + 0.34689i ]; +%! + +%!test +%! [Q,R] = qr (A); +%! [Q,R] = qrupdate (Q, R, u, v); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - A - u*v'), Inf) < norm (A)*1e1*eps); +%! +%!test +%! [Q,R] = qr (Ac); +%! [Q,R] = qrupdate (Q, R, uc, vc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - Ac - uc*vc'), Inf) < norm (Ac)*1e1*eps); + +%!test +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrupdate (Q, R, single (u), single (v)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (A) - single (u)*single (v)'), Inf) < norm (single (A))*1e1*eps ("single")); +%! +%!test +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrupdate (Q, R, single (uc), single (vc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (Ac) - single (uc)*single (vc)'), Inf) < norm (single (Ac))*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrinsert, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrinsert (@var{Q}, @var{R}, @var{j}, @var{x}, @var{orient})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ +@w{[A(:,1:j-1) x A(:,j:n)]}, where @var{u} is a column vector to be\n\ +inserted into @var{A} (if @var{orient} is @code{\"col\"}), or the\n\ +QR@tie{}factorization of @w{[A(1:j-1,:);x;A(:,j:n)]}, where @var{x}\n\ +is a row vector to be inserted into @var{A} (if @var{orient} is\n\ +@code{\"row\"}).\n\ +\n\ +The default value of @var{orient} is @code{\"col\"}.\n\ +If @var{orient} is @code{\"col\"},\n\ +@var{u} may be a matrix and @var{j} an index vector\n\ +resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ +@w{B(:,@var{j})} gives @var{u} and @w{B(:,@var{j}) = []} gives @var{A}.\n\ +Notice that the latter case is done as a sequence of k insertions;\n\ +thus, for k large enough, it will be both faster and more accurate to\n\ +recompute the factorization from scratch.\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +the QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ +@seealso{qr, qrupdate, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin < 4 || nargin > 5) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argj = args(2); + octave_value argx = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && argx.is_numeric_type () + && (nargin < 5 || args(4).is_string ())) + { + std::string orient = (nargin < 5) ? "col" : args(4).string_value (); + + bool col = orient == "col"; + + if (col || orient == "row") + if (check_qr_dims (argq, argr, col) + && (col || argx.rows () == 1)) + { + if (check_index (argj, col)) + { + MArray j + = argj.octave_idx_type_vector_value (); + + octave_idx_type one = 1; + + if (argq.is_real_type () + && argr.is_real_type () + && argx.is_real_type ()) + { + // real case + if (argq.is_single_type () + || argr.is_single_type () + || argx.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + FloatMatrix x = argx.float_matrix_value (); + + FloatQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + Matrix x = argx.matrix_value (); + + QR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type () + || argx.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + FloatComplexMatrix x = argx.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + ComplexMatrix x = argx.complex_matrix_value (); + + ComplexQR fact (Q, R); + + if (col) + fact.insert_col (x, j-one); + else + fact.insert_row (x.row (0), j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + + } + else + error ("qrinsert: invalid index J"); + } + else + error ("qrinsert: dimension mismatch"); + + else + error ("qrinsert: ORIENT must be \"col\" or \"row\""); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, u); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(:,1:2) u A(:,3)]), Inf) < norm (A)*1e1*eps); +%!test +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, uc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(:,1:2) uc Ac(:,3)]), Inf) < norm (Ac)*1e1*eps); +%!test +%! x = [0.85082 0.76426 0.42883 ]; +%! +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(1:2,:);x;A(3:5,:)]), Inf) < norm (A)*1e1*eps); +%!test +%! x = [0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]; +%! +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(1:2,:);x;Ac(3:5,:)]), Inf) < norm (Ac)*1e1*eps); + +%!test +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, single (u)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(:,1:2) u A(:,3)])), Inf) < norm (single (A))*1e1*eps ("single")); +%!test +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, single (uc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(:,1:2) uc Ac(:,3)])), Inf) < norm (single (Ac))*1e1*eps ("single")); +%!test +%! x = single ([0.85082 0.76426 0.42883 ]); +%! +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(1:2,:);x;A(3:5,:)])), Inf) < norm (single (A))*1e1*eps ("single")); +%!test +%! x = single ([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); +%! +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(1:2,:);x;Ac(3:5,:)])), Inf) < norm (single (Ac))*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrdelete, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrdelete (@var{Q}, @var{R}, @var{j}, @var{orient})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization of\n\ +@w{[A(:,1:j-1) A(:,j+1:n)]}, i.e., @var{A} with one column deleted\n\ +(if @var{orient} is \"col\"), or the QR@tie{}factorization of\n\ +@w{[A(1:j-1,:);A(j+1:n,:)]}, i.e., @var{A} with one row deleted (if\n\ +@var{orient} is \"row\").\n\ +\n\ +The default value of @var{orient} is \"col\".\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +@var{j} may be an index vector\n\ +resulting in the QR@tie{}factorization of a matrix @var{B} such that\n\ +@w{A(:,@var{j}) = []} gives @var{B}.\n\ +Notice that the latter case is done as a sequence of k deletions;\n\ +thus, for k large enough, it will be both faster and more accurate to\n\ +recompute the factorization from scratch.\n\ +\n\ +If @var{orient} is @code{\"col\"},\n\ +the QR@tie{}factorization supplied may be either full\n\ +(Q is square) or economized (R is square).\n\ +\n\ +If @var{orient} is @code{\"row\"}, full factorization is needed.\n\ +@seealso{qr, qrinsert, qrupdate}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin < 3 || nargin > 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argj = args(2); + + if (argq.is_numeric_type () && argr.is_numeric_type () + && (nargin < 4 || args(3).is_string ())) + { + std::string orient = (nargin < 4) ? "col" : args(3).string_value (); + + bool col = orient == "col"; + + if (col || orient == "row") + if (check_qr_dims (argq, argr, col)) + { + if (check_index (argj, col)) + { + MArray j + = argj.octave_idx_type_vector_value (); + + octave_idx_type one = 1; + + if (argq.is_real_type () + && argr.is_real_type ()) + { + // real case + if (argq.is_single_type () + || argr.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + + FloatQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + + QR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + || argr.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexQR fact (Q, R); + + if (col) + fact.delete_col (j-one); + else + fact.delete_row (j(0)-one); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrdelete: invalid index J"); + } + else + error ("qrdelete: dimension mismatch"); + + else + error ("qrdelete: ORIENT must be \"col\" or \"row\""); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! AA = [0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); + +%!test +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1.5e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%!testif HAVE_QRUPDATE +%! # Same test as above but with more precicision +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +*/ + +DEFUN_DLD (qrshift, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{Q1}, @var{R1}] =} qrshift (@var{Q}, @var{R}, @var{i}, @var{j})\n\ +Given a QR@tie{}factorization of a real or complex matrix\n\ +@w{@var{A} = @var{Q}*@var{R}}, @var{Q}@tie{}unitary and\n\ +@var{R}@tie{}upper trapezoidal, return the QR@tie{}factorization\n\ +of @w{@var{A}(:,p)}, where @w{p} is the permutation @*\n\ +@code{p = [1:i-1, shift(i:j, 1), j+1:n]} if @w{@var{i} < @var{j}} @*\n\ + or @*\n\ +@code{p = [1:j-1, shift(j:i,-1), i+1:n]} if @w{@var{j} < @var{i}}. @*\n\ +\n\ +@seealso{qr, qrinsert, qrdelete}\n\ +@end deftypefn") +{ + octave_idx_type nargin = args.length (); + octave_value_list retval; + + if (nargin != 4) + { + print_usage (); + return retval; + } + + octave_value argq = args(0); + octave_value argr = args(1); + octave_value argi = args(2); + octave_value argj = args(3); + + if (argq.is_numeric_type () && argr.is_numeric_type ()) + { + if (check_qr_dims (argq, argr, true)) + { + if (check_index (argi) && check_index (argj)) + { + octave_idx_type i = argi.int_value (); + octave_idx_type j = argj.int_value (); + + if (argq.is_real_type () + && argr.is_real_type ()) + { + // all real case + if (argq.is_single_type () + && argr.is_single_type ()) + { + FloatMatrix Q = argq.float_matrix_value (); + FloatMatrix R = argr.float_matrix_value (); + + FloatQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + Matrix Q = argq.matrix_value (); + Matrix R = argr.matrix_value (); + + QR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + else + { + // complex case + if (argq.is_single_type () + && argr.is_single_type ()) + { + FloatComplexMatrix Q = argq.float_complex_matrix_value (); + FloatComplexMatrix R = argr.float_complex_matrix_value (); + + FloatComplexQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + else + { + ComplexMatrix Q = argq.complex_matrix_value (); + ComplexMatrix R = argr.complex_matrix_value (); + + ComplexQR fact (Q, R); + fact.shift_cols (i-1, j-1); + + retval(1) = get_qr_r (fact); + retval(0) = fact.Q (); + } + } + } + else + error ("qrshift: invalid index I or J"); + } + else + error ("qrshift: dimensions mismatch"); + } + else + error ("qrshift: Q and R must be numeric"); + + return retval; +} + +/* +%!test +%! AA = A.'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%!test +%! AA = Ac.'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); + +%!test +%! AA = single (A).'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single (Ac).'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +%! +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/symbfact.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/symbfact.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,363 @@ +/* + +Copyright (C) 2005-2012 David Bateman +Copyright (C) 1998-2005 Andy Adler + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "SparseCmplxCHOL.h" +#include "SparsedbleCHOL.h" +#include "oct-spparms.h" +#include "sparse-util.h" +#include "oct-locbuf.h" + +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "utils.h" + +DEFUN_DLD (symbfact, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{count}, @var{h}, @var{parent}, @var{post}, @var{r}] =} symbfact (@var{S})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} symbfact (@var{S}, @var{typ}, @var{mode})\n\ +\n\ +Perform a symbolic factorization analysis on the sparse matrix @var{S}.\n\ +Where\n\ +\n\ +@table @var\n\ +@item S\n\ +@var{S} is a complex or real sparse matrix.\n\ +\n\ +@item typ\n\ +Is the type of the factorization and can be one of\n\ +\n\ +@table @samp\n\ +@item sym\n\ +Factorize @var{S}. This is the default.\n\ +\n\ +@item col\n\ +Factorize @code{@var{S}' * @var{S}}.\n\ +\n\ +@item row\n\ +Factorize @xcode{@var{S} * @var{S}'}.\n\ +\n\ +@item lo\n\ +Factorize @xcode{@var{S}'}\n\ +@end table\n\ +\n\ +@item mode\n\ +The default is to return the Cholesky@tie{}factorization for @var{r}, and if\n\ +@var{mode} is 'L', the conjugate transpose of the Cholesky@tie{}factorization\n\ +is returned. The conjugate transpose version is faster and uses less\n\ +memory, but returns the same values for @var{count}, @var{h}, @var{parent}\n\ +and @var{post} outputs.\n\ +@end table\n\ +\n\ +The output variables are\n\ +\n\ +@table @var\n\ +@item count\n\ +The row counts of the Cholesky@tie{}factorization as determined by @var{typ}.\n\ +\n\ +@item h\n\ +The height of the elimination tree.\n\ +\n\ +@item parent\n\ +The elimination tree itself.\n\ +\n\ +@item post\n\ +A sparse boolean matrix whose structure is that of the Cholesky\n\ +factorization as determined by @var{typ}.\n\ +@end table\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + + if (nargin < 1 || nargin > 3 || nargout > 5) + { + print_usage (); + return retval; + } + +#ifdef HAVE_CHOLMOD + + cholmod_common Common; + cholmod_common *cm = &Common; + CHOLMOD_NAME(start) (cm); + + double spu = octave_sparse_params::get_key ("spumoni"); + if (spu == 0.) + { + cm->print = -1; + cm->print_function = 0; + } + else + { + cm->print = static_cast (spu) + 2; + cm->print_function =&SparseCholPrint; + } + + cm->error_handler = &SparseCholError; + cm->complex_divide = CHOLMOD_NAME(divcomplex); + cm->hypotenuse = CHOLMOD_NAME(hypot); + + double dummy; + cholmod_sparse Astore; + cholmod_sparse *A = &Astore; + A->packed = true; + A->sorted = true; + A->nz = 0; +#ifdef IDX_TYPE_LONG + A->itype = CHOLMOD_LONG; +#else + A->itype = CHOLMOD_INT; +#endif + A->dtype = CHOLMOD_DOUBLE; + A->stype = 1; + A->x = &dummy; + + if (args(0).is_real_type ()) + { + const SparseMatrix a = args(0).sparse_matrix_value (); + A->nrow = a.rows (); + A->ncol = a.cols (); + A->p = a.cidx (); + A->i = a.ridx (); + A->nzmax = a.nnz (); + A->xtype = CHOLMOD_REAL; + + if (a.rows () > 0 && a.cols () > 0) + A->x = a.data (); + } + else if (args(0).is_complex_type ()) + { + const SparseComplexMatrix a = args(0).sparse_complex_matrix_value (); + A->nrow = a.rows (); + A->ncol = a.cols (); + A->p = a.cidx (); + A->i = a.ridx (); + A->nzmax = a.nnz (); + A->xtype = CHOLMOD_COMPLEX; + + if (a.rows () > 0 && a.cols () > 0) + A->x = a.data (); + } + else + gripe_wrong_type_arg ("symbfact", args(0)); + + octave_idx_type coletree = false; + octave_idx_type n = A->nrow; + + if (nargin > 1) + { + char ch; + std::string str = args(1).string_value (); + ch = tolower (str.c_str ()[0]); + if (ch == 'r') + A->stype = 0; + else if (ch == 'c') + { + n = A->ncol; + coletree = true; + A->stype = 0; + } + else if (ch == 's') + A->stype = 1; + else if (ch == 's') + A->stype = -1; + else + error ("symbfact: unrecognized TYP in symbolic factorization"); + } + + if (A->stype && A->nrow != A->ncol) + error ("symbfact: S must be a square matrix"); + + if (!error_state) + { + OCTAVE_LOCAL_BUFFER (octave_idx_type, Parent, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Post, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, ColCount, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, First, n); + OCTAVE_LOCAL_BUFFER (octave_idx_type, Level, n); + + cholmod_sparse *F = CHOLMOD_NAME(transpose) (A, 0, cm); + cholmod_sparse *Aup, *Alo; + + if (A->stype == 1 || coletree) + { + Aup = A ; + Alo = F ; + } + else + { + Aup = F ; + Alo = A ; + } + + CHOLMOD_NAME(etree) (Aup, Parent, cm); + + if (cm->status < CHOLMOD_OK) + { + error ("matrix corrupted"); + goto symbfact_error; + } + + if (CHOLMOD_NAME(postorder) (Parent, n, 0, Post, cm) != n) + { + error ("postorder failed"); + goto symbfact_error; + } + + CHOLMOD_NAME(rowcolcounts) (Alo, 0, 0, Parent, Post, 0, + ColCount, First, Level, cm); + + if (cm->status < CHOLMOD_OK) + { + error ("matrix corrupted"); + goto symbfact_error; + } + + if (nargout > 4) + { + cholmod_sparse *A1, *A2; + + if (A->stype == 1) + { + A1 = A; + A2 = 0; + } + else if (A->stype == -1) + { + A1 = F; + A2 = 0; + } + else if (coletree) + { + A1 = F; + A2 = A; + } + else + { + A1 = A; + A2 = F; + } + + // count the total number of entries in L + octave_idx_type lnz = 0 ; + for (octave_idx_type j = 0 ; j < n ; j++) + lnz += ColCount[j]; + + + // allocate the output matrix L (pattern-only) + SparseBoolMatrix L (n, n, lnz); + + // initialize column pointers + lnz = 0; + for (octave_idx_type j = 0 ; j < n ; j++) + { + L.xcidx(j) = lnz; + lnz += ColCount[j]; + } + L.xcidx(n) = lnz; + + + /* create a copy of the column pointers */ + octave_idx_type *W = First; + for (octave_idx_type j = 0 ; j < n ; j++) + W[j] = L.xcidx (j); + + // get workspace for computing one row of L + cholmod_sparse *R = cholmod_allocate_sparse (n, 1, n, false, true, + 0, CHOLMOD_PATTERN, cm); + octave_idx_type *Rp = static_cast(R->p); + octave_idx_type *Ri = static_cast(R->i); + + // compute L one row at a time + for (octave_idx_type k = 0 ; k < n ; k++) + { + // get the kth row of L and store in the columns of L + CHOLMOD_NAME (row_subtree) (A1, A2, k, Parent, R, cm) ; + for (octave_idx_type p = 0 ; p < Rp[1] ; p++) + L.xridx (W[Ri[p]]++) = k ; + + // add the diagonal entry + L.xridx (W[k]++) = k ; + } + + // free workspace + cholmod_free_sparse (&R, cm) ; + + + // transpose L to get R, or leave as is + if (nargin < 3) + L = L.transpose (); + + // fill numerical values of L with one's + for (octave_idx_type p = 0 ; p < lnz ; p++) + L.xdata(p) = true; + + retval(4) = L; + } + + ColumnVector tmp (n); + if (nargout > 3) + { + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = Post[i] + 1; + retval(3) = tmp; + } + + if (nargout > 2) + { + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = Parent[i] + 1; + retval(2) = tmp; + } + + if (nargout > 1) + { + /* compute the elimination tree height */ + octave_idx_type height = 0 ; + for (int i = 0 ; i < n ; i++) + height = (height > Level[i] ? height : Level[i]); + height++ ; + retval(1) = static_cast (height); + } + + for (octave_idx_type i = 0; i < n; i++) + tmp(i) = ColCount[i]; + retval(0) = tmp; + } + + symbfact_error: +#else + error ("symbfact: not available in this version of Octave"); +#endif + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/symrcm.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/symrcm.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,702 @@ +/* + +Copyright (C) 2007-2012 Michael Weitzel + +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 3 of the License, 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, see +. + +*/ + +/* +An implementation of the Reverse Cuthill-McKee algorithm (symrcm) + +The implementation of this algorithm is based in the descriptions found in + +@INPROCEEDINGS{, + author = {E. Cuthill and J. McKee}, + title = {Reducing the Bandwidth of Sparse Symmetric Matrices}, + booktitle = {Proceedings of the 24th ACM National Conference}, + publisher = {Brandon Press}, + pages = {157 -- 172}, + location = {New Jersey}, + year = {1969} +} + +@BOOK{, + author = {Alan George and Joseph W. H. Liu}, + title = {Computer Solution of Large Sparse Positive Definite Systems}, + publisher = {Prentice Hall Series in Computational Mathematics}, + ISBN = {0-13-165274-5}, + year = {1981} +} + +The algorithm represents a heuristic approach to the NP-complete minimum +bandwidth problem. + +Written by Michael Weitzel + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "ov.h" +#include "defun-dld.h" +#include "error.h" +#include "gripes.h" +#include "utils.h" +#include "oct-locbuf.h" + +#include "ov-re-mat.h" +#include "ov-re-sparse.h" +#include "ov-cx-sparse.h" +#include "oct-sparse.h" + +// A node struct for the Cuthill-McKee algorithm +struct CMK_Node +{ + // the node's id (matrix row index) + octave_idx_type id; + // the node's degree + octave_idx_type deg; + // minimal distance to the root of the spanning tree + octave_idx_type dist; +}; + +// A simple queue. +// Queues Q have a fixed maximum size N (rows,cols of the matrix) and are +// stored in an array. qh and qt point to queue head and tail. + +// Enqueue operation (adds a node "o" at the tail) + +inline static void +Q_enq (CMK_Node *Q, octave_idx_type N, octave_idx_type& qt, const CMK_Node& o) +{ + Q[qt] = o; + qt = (qt + 1) % (N + 1); +} + +// Dequeue operation (removes a node from the head) + +inline static CMK_Node +Q_deq (CMK_Node * Q, octave_idx_type N, octave_idx_type& qh) +{ + CMK_Node r = Q[qh]; + qh = (qh + 1) % (N + 1); + return r; +} + +// Predicate (queue empty) +#define Q_empty(Q, N, qh, qt) ((qh) == (qt)) + +// A simple, array-based binary heap (used as a priority queue for nodes) + +// the left descendant of entry i +#define LEFT(i) (((i) << 1) + 1) // = (2*(i)+1) +// the right descendant of entry i +#define RIGHT(i) (((i) << 1) + 2) // = (2*(i)+2) +// the parent of entry i +#define PARENT(i) (((i) - 1) >> 1) // = floor(((i)-1)/2) + +// Builds a min-heap (the root contains the smallest element). A is an array +// with the graph's nodes, i is a starting position, size is the length of A. + +static void +H_heapify_min (CMK_Node *A, octave_idx_type i, octave_idx_type size) +{ + octave_idx_type j = i; + for (;;) + { + octave_idx_type l = LEFT(j); + octave_idx_type r = RIGHT(j); + + octave_idx_type smallest; + if (l < size && A[l].deg < A[j].deg) + smallest = l; + else + smallest = j; + + if (r < size && A[r].deg < A[smallest].deg) + smallest = r; + + if (smallest != j) + { + std::swap (A[j], A[smallest]); + j = smallest; + } + else + break; + } +} + +// Heap operation insert. Running time is O(log(n)) + +static void +H_insert (CMK_Node *H, octave_idx_type& h, const CMK_Node& o) +{ + octave_idx_type i = h++; + + H[i] = o; + + if (i == 0) + return; + do + { + octave_idx_type p = PARENT(i); + if (H[i].deg < H[p].deg) + { + std::swap (H[i], H[p]); + + i = p; + } + else + break; + } + while (i > 0); +} + +// Heap operation remove-min. Removes the smalles element in O(1) and +// reorganizes the heap optionally in O(log(n)) + +inline static CMK_Node +H_remove_min (CMK_Node *H, octave_idx_type& h, int reorg/*=1*/) +{ + CMK_Node r = H[0]; + H[0] = H[--h]; + if (reorg) + H_heapify_min (H, 0, h); + return r; +} + +// Predicate (heap empty) +#define H_empty(H, h) ((h) == 0) + +// Helper function for the Cuthill-McKee algorithm. Tries to determine a +// pseudo-peripheral node of the graph as starting node. + +static octave_idx_type +find_starting_node (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, const octave_idx_type *ridx2, + const octave_idx_type *cidx2, octave_idx_type *D, + octave_idx_type start) +{ + CMK_Node w; + + OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); + boolNDArray btmp (dim_vector (1, N), false); + bool *visit = btmp.fortran_vec (); + + octave_idx_type qh = 0; + octave_idx_type qt = 0; + CMK_Node x; + x.id = start; + x.deg = D[start]; + x.dist = 0; + Q_enq (Q, N, qt, x); + visit[start] = true; + + // distance level + octave_idx_type level = 0; + // current largest "eccentricity" + octave_idx_type max_dist = 0; + + for (;;) + { + while (! Q_empty (Q, N, qh, qt)) + { + CMK_Node v = Q_deq (Q, N, qh); + + if (v.dist > x.dist || (v.id != x.id && v.deg > x.deg)) + x = v; + + octave_idx_type i = v.id; + + // add all unvisited neighbors to the queue + octave_idx_type j1 = cidx[i]; + octave_idx_type j2 = cidx2[i]; + while (j1 < cidx[i+1] || j2 < cidx2[i+1]) + { + OCTAVE_QUIT; + + if (j1 == cidx[i+1]) + { + octave_idx_type r2 = ridx2[j2++]; + if (! visit[r2]) + { + // the distance of node j is dist(i)+1 + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r2] = true; + + if (w.dist > level) + level = w.dist; + } + } + else if (j2 == cidx2[i+1]) + { + octave_idx_type r1 = ridx[j1++]; + if (! visit[r1]) + { + // the distance of node j is dist(i)+1 + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r1] = true; + + if (w.dist > level) + level = w.dist; + } + } + else + { + octave_idx_type r1 = ridx[j1]; + octave_idx_type r2 = ridx2[j2]; + if (r1 <= r2) + { + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r1] = true; + + if (w.dist > level) + level = w.dist; + } + j1++; + if (r1 == r2) + j2++; + } + else + { + if (! visit[r2]) + { + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + Q_enq (Q, N, qt, w); + visit[r2] = true; + + if (w.dist > level) + level = w.dist; + } + j2++; + } + } + } + } // finish of BFS + + if (max_dist < x.dist) + { + max_dist = x.dist; + + for (octave_idx_type i = 0; i < N; i++) + visit[i] = false; + + visit[x.id] = true; + x.dist = 0; + qt = qh = 0; + Q_enq (Q, N, qt, x); + } + else + break; + } + return x.id; +} + +// Calculates the node's degrees. This means counting the non-zero elements +// in the symmetric matrix' rows. This works for non-symmetric matrices +// as well. + +static octave_idx_type +calc_degrees (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, octave_idx_type *D) +{ + octave_idx_type max_deg = 0; + + for (octave_idx_type i = 0; i < N; i++) + D[i] = 0; + + for (octave_idx_type j = 0; j < N; j++) + { + for (octave_idx_type i = cidx[j]; i < cidx[j+1]; i++) + { + OCTAVE_QUIT; + octave_idx_type k = ridx[i]; + // there is a non-zero element (k,j) + D[k]++; + if (D[k] > max_deg) + max_deg = D[k]; + // if there is no element (j,k) there is one in + // the symmetric matrix: + if (k != j) + { + bool found = false; + for (octave_idx_type l = cidx[k]; l < cidx[k + 1]; l++) + { + OCTAVE_QUIT; + + if (ridx[l] == j) + { + found = true; + break; + } + else if (ridx[l] > j) + break; + } + + if (! found) + { + // A(j,k) == 0 + D[j]++; + if (D[j] > max_deg) + max_deg = D[j]; + } + } + } + } + return max_deg; +} + +// Transpose of the structure of a square sparse matrix + +static void +transpose (octave_idx_type N, const octave_idx_type *ridx, + const octave_idx_type *cidx, octave_idx_type *ridx2, + octave_idx_type *cidx2) +{ + octave_idx_type nz = cidx[N]; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, w, N + 1); + for (octave_idx_type i = 0; i < N; i++) + w[i] = 0; + for (octave_idx_type i = 0; i < nz; i++) + w[ridx[i]]++; + nz = 0; + for (octave_idx_type i = 0; i < N; i++) + { + OCTAVE_QUIT; + cidx2[i] = nz; + nz += w[i]; + w[i] = cidx2[i]; + } + cidx2[N] = nz; + w[N] = nz; + + for (octave_idx_type j = 0; j < N; j++) + for (octave_idx_type k = cidx[j]; k < cidx[j + 1]; k++) + { + OCTAVE_QUIT; + octave_idx_type q = w[ridx[k]]++; + ridx2[q] = j; + } +} + +// An implementation of the Cuthill-McKee algorithm. +DEFUN_DLD (symrcm, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{p} =} symrcm (@var{S})\n\ +Return the symmetric reverse Cuthill-McKee permutation of @var{S}.\n\ +@var{p} is a permutation vector such that\n\ +@code{@var{S}(@var{p}, @var{p})} tends to have its diagonal elements\n\ +closer to the diagonal than @var{S}. This is a good preordering for LU\n\ +or Cholesky@tie{}factorization of matrices that come from ``long, skinny''\n\ +problems. It works for both symmetric and asymmetric @var{S}.\n\ +\n\ +The algorithm represents a heuristic approach to the NP-complete\n\ +bandwidth minimization problem. The implementation is based in the\n\ +descriptions found in\n\ +\n\ +E. Cuthill, J. McKee. @cite{Reducing the Bandwidth of Sparse Symmetric\n\ +Matrices}. Proceedings of the 24th ACM National Conference, 157--172\n\ +1969, Brandon Press, New Jersey.\n\ +\n\ +A. George, J.W.H. Liu. @cite{Computer Solution of Large Sparse\n\ +Positive Definite Systems}, Prentice Hall Series in Computational\n\ +Mathematics, ISBN 0-13-165274-5, 1981.\n\ +\n\ +@seealso{colperm, colamd, symamd}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin != 1) + { + print_usage (); + return retval; + } + + octave_value arg = args(0); + + // the parameter of the matrix is converted into a sparse matrix + //(if necessary) + octave_idx_type *cidx; + octave_idx_type *ridx; + SparseMatrix Ar; + SparseComplexMatrix Ac; + + if (arg.is_real_type ()) + { + Ar = arg.sparse_matrix_value (); + // Note cidx/ridx are const, so use xridx and xcidx... + cidx = Ar.xcidx (); + ridx = Ar.xridx (); + } + else + { + Ac = arg.sparse_complex_matrix_value (); + cidx = Ac.xcidx (); + ridx = Ac.xridx (); + } + + if (error_state) + return retval; + + octave_idx_type nr = arg.rows (); + octave_idx_type nc = arg.columns (); + + if (nr != nc) + { + gripe_square_matrix_required ("symrcm"); + return retval; + } + + if (nr == 0 && nc == 0) + return octave_value (NDArray (dim_vector (1, 0))); + + // sizes of the heaps + octave_idx_type s = 0; + + // head- and tail-indices for the queue + octave_idx_type qt = 0, qh = 0; + CMK_Node v, w; + // dimension of the matrix + octave_idx_type N = nr; + + OCTAVE_LOCAL_BUFFER (octave_idx_type, cidx2, N + 1); + OCTAVE_LOCAL_BUFFER (octave_idx_type, ridx2, cidx[N]); + transpose (N, ridx, cidx, ridx2, cidx2); + + // the permutation vector + NDArray P (dim_vector (1, N)); + + // compute the node degrees + OCTAVE_LOCAL_BUFFER (octave_idx_type, D, N); + octave_idx_type max_deg = calc_degrees (N, ridx, cidx, D); + + // if none of the nodes has a degree > 0 (a matrix of zeros) + // the return value corresponds to the identity permutation + if (max_deg == 0) + { + for (octave_idx_type i = 0; i < N; i++) + P(i) = i; + return octave_value (P); + } + + // a heap for the a node's neighbors. The number of neighbors is + // limited by the maximum degree max_deg: + OCTAVE_LOCAL_BUFFER (CMK_Node, S, max_deg); + + // a queue for the BFS. The array is always one element larger than + // the number of entries that are stored. + OCTAVE_LOCAL_BUFFER (CMK_Node, Q, N+1); + + // a counter (for building the permutation) + octave_idx_type c = -1; + + // upper bound for the bandwidth (=quality of solution) + // initialize the bandwidth of the graph with 0. B contains the + // the maximum of the theoretical lower limits of the subgraphs + // bandwidths. + octave_idx_type B = 0; + + // mark all nodes as unvisited; with the exception of the nodes + // that have degree==0 and build a CC of the graph. + + boolNDArray btmp (dim_vector (1, N), false); + bool *visit = btmp.fortran_vec (); + + do + { + // locate an unvisited starting node of the graph + octave_idx_type i; + for (i = 0; i < N; i++) + if (! visit[i]) + break; + + // locate a probably better starting node + v.id = find_starting_node (N, ridx, cidx, ridx2, cidx2, D, i); + + // mark the node as visited and enqueue it (a starting node + // for the BFS). Since the node will be a root of a spanning + // tree, its dist is 0. + v.deg = D[v.id]; + v.dist = 0; + visit[v.id] = true; + Q_enq (Q, N, qt, v); + + // lower bound for the bandwidth of a subgraph + // keep a "level" in the spanning tree (= min. distance to the + // root) for determining the bandwidth of the computed + // permutation P + octave_idx_type Bsub = 0; + // min. dist. to the root is 0 + octave_idx_type level = 0; + // the root is the first/only node on level 0 + octave_idx_type level_N = 1; + + while (! Q_empty (Q, N, qh, qt)) + { + v = Q_deq (Q, N, qh); + i = v.id; + + c++; + + // for computing the inverse permutation P where + // A(inv(P),inv(P)) or P'*A*P is banded + // P(i) = c; + + // for computing permutation P where + // A(P(i),P(j)) or P*A*P' is banded + P(c) = i; + + // put all unvisited neighbors j of node i on the heap + s = 0; + octave_idx_type j1 = cidx[i]; + octave_idx_type j2 = cidx2[i]; + + OCTAVE_QUIT; + while (j1 < cidx[i+1] || j2 < cidx2[i+1]) + { + OCTAVE_QUIT; + if (j1 == cidx[i+1]) + { + octave_idx_type r2 = ridx2[j2++]; + if (! visit[r2]) + { + // the distance of node j is dist(i)+1 + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r2] = true; + } + } + else if (j2 == cidx2[i+1]) + { + octave_idx_type r1 = ridx[j1++]; + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r1] = true; + } + } + else + { + octave_idx_type r1 = ridx[j1]; + octave_idx_type r2 = ridx2[j2]; + if (r1 <= r2) + { + if (! visit[r1]) + { + w.id = r1; + w.deg = D[r1]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r1] = true; + } + j1++; + if (r1 == r2) + j2++; + } + else + { + if (! visit[r2]) + { + w.id = r2; + w.deg = D[r2]; + w.dist = v.dist+1; + H_insert (S, s, w); + visit[r2] = true; + } + j2++; + } + } + } + + // add the neighbors to the queue (sorted by node degree) + while (! H_empty (S, s)) + { + OCTAVE_QUIT; + + // locate a neighbor of i with minimal degree in O(log(N)) + v = H_remove_min (S, s, 1); + + // entered the BFS a new level? + if (v.dist > level) + { + // adjustment of bandwith: + // "[...] the minimum bandwidth that + // can be obtained [...] is the + // maximum number of nodes per level" + if (Bsub < level_N) + Bsub = level_N; + + level = v.dist; + // v is the first node on the new level + level_N = 1; + } + else + { + // there is no new level but another node on + // this level: + level_N++; + } + + // enqueue v in O(1) + Q_enq (Q, N, qt, v); + } + + // synchronize the bandwidth with level_N once again: + if (Bsub < level_N) + Bsub = level_N; + } + // finish of BFS. If there are still unvisited nodes in the graph + // then it is split into CCs. The computed bandwidth is the maximum + // of all subgraphs. Update: + if (Bsub > B) + B = Bsub; + } + // are there any nodes left? + while (c+1 < N); + + // compute the reverse-ordering + s = N / 2 - 1; + for (octave_idx_type i = 0, j = N - 1; i <= s; i++, j--) + std::swap (P.elem (i), P.elem (j)); + + // increment all indices, since Octave is not C + return octave_value (P+1); +} diff -r 069c552587a0 -r 959953dba519 src/dldfcn/tsearch.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/tsearch.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,186 @@ +/* + +Copyright (C) 2002-2012 Andreas Stahel + +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 3 of the License, 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, see +. + +*/ + +// Author: Andreas Stahel + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "lo-ieee.h" +#include "lo-math.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "parse.h" + +inline double max (double a, double b, double c) +{ + if (a < b) + return (b < c ? c : b); + else + return (a < c ? c : a); +} + +inline double min (double a, double b, double c) +{ + if (a > b) + return (b > c ? c : b); + else + return (a > c ? c : a); +} + +#define REF(x,k,i) x(static_cast(elem((k), (i))) - 1) + +// for large data set the algorithm is very slow +// one should presort (how?) either the elements of the points of evaluation +// to cut down the time needed to decide which triangle contains the +// given point + +// e.g., build up a neighbouring triangle structure and use a simplex-like +// method to traverse it + +DEFUN_DLD (tsearch, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{idx} =} tsearch (@var{x}, @var{y}, @var{t}, @var{xi}, @var{yi})\n\ +Search for the enclosing Delaunay convex hull. For @code{@var{t} =\n\ +delaunay (@var{x}, @var{y})}, finds the index in @var{t} containing the\n\ +points @code{(@var{xi}, @var{yi})}. For points outside the convex hull,\n\ +@var{idx} is NaN.\n\ +@seealso{delaunay, delaunayn}\n\ +@end deftypefn") +{ + const double eps=1.0e-12; + + octave_value_list retval; + const int nargin = args.length (); + if (nargin != 5) + { + print_usage (); + return retval; + } + + const ColumnVector x (args(0).vector_value ()); + const ColumnVector y (args(1).vector_value ()); + const Matrix elem (args(2).matrix_value ()); + const ColumnVector xi (args(3).vector_value ()); + const ColumnVector yi (args(4).vector_value ()); + + if (error_state) + return retval; + + const octave_idx_type nelem = elem.rows (); + + ColumnVector minx (nelem); + ColumnVector maxx (nelem); + ColumnVector miny (nelem); + ColumnVector maxy (nelem); + for (octave_idx_type k = 0; k < nelem; k++) + { + minx(k) = min (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) - eps; + maxx(k) = max (REF (x, k, 0), REF (x, k, 1), REF (x, k, 2)) + eps; + miny(k) = min (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) - eps; + maxy(k) = max (REF (y, k, 0), REF (y, k, 1), REF (y, k, 2)) + eps; + } + + const octave_idx_type np = xi.length (); + ColumnVector values (np); + + double x0 = 0.0, y0 = 0.0; + double a11 = 0.0, a12 = 0.0, a21 = 0.0, a22 = 0.0, det = 0.0; + + octave_idx_type k = nelem; // k is a counter of elements + for (octave_idx_type kp = 0; kp < np; kp++) + { + const double xt = xi(kp); + const double yt = yi(kp); + + // check if last triangle contains the next point + if (k < nelem) + { + const double dx1 = xt - x0; + const double dx2 = yt - y0; + const double c1 = (a22 * dx1 - a21 * dx2) / det; + const double c2 = (-a12 * dx1 + a11 * dx2) / det; + if (c1 >= -eps && c2 >= -eps && (c1 + c2) <= (1 + eps)) + { + values(kp) = double(k+1); + continue; + } + } + + // it doesn't, so go through all elements + for (k = 0; k < nelem; k++) + { + OCTAVE_QUIT; + if (xt >= minx(k) && xt <= maxx(k) && yt >= miny(k) && yt <= maxy(k)) + { + // element inside the minimum rectangle: examine it closely + x0 = REF (x, k, 0); + y0 = REF (y, k, 0); + a11 = REF (x, k, 1) - x0; + a12 = REF (y, k, 1) - y0; + a21 = REF (x, k, 2) - x0; + a22 = REF (y, k, 2) - y0; + det = a11 * a22 - a21 * a12; + + // solve the system + const double dx1 = xt - x0; + const double dx2 = yt - y0; + const double c1 = (a22 * dx1 - a21 * dx2) / det; + const double c2 = (-a12 * dx1 + a11 * dx2) / det; + if ((c1 >= -eps) && (c2 >= -eps) && ((c1 + c2) <= (1 + eps))) + { + values(kp) = double(k+1); + break; + } + } //endif # examine this element closely + } //endfor # each element + + if (k == nelem) + values(kp) = lo_ieee_nan_value (); + + } //endfor # kp + + retval(0) = values; + + return retval; +} + +/* +%!shared x, y, tri +%! x = [-1;-1;1]; +%! y = [-1;1;-1]; +%! tri = [1, 2, 3]; +%!assert (tsearch (x,y,tri,-1,-1), 1) +%!assert (tsearch (x,y,tri, 1,-1), 1) +%!assert (tsearch (x,y,tri,-1, 1), 1) +%!assert (tsearch (x,y,tri,-1/3, -1/3), 1) +%!assert (tsearch (x,y,tri, 1, 1), NaN) + +%!error tsearch () +*/ diff -r 069c552587a0 -r 959953dba519 src/dldfcn/urlwrite.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/dldfcn/urlwrite.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1740 @@ +// urlwrite and urlread, a curl front-end for octave +/* + +Copyright (C) 2006-2012 Alexander Barth +Copyright (C) 2009 David Bateman + +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 3 of the License, 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, see +. + +*/ + +// Author: Alexander Barth +// Adapted-By: jwe + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "glob-match.h" + +#include "defun-dld.h" +#include "error.h" +#include "oct-obj.h" +#include "ov-cell.h" +#include "pager.h" +#include "oct-map.h" +#include "oct-refcount.h" +#include "unwind-prot.h" + +#ifdef HAVE_CURL + +#include +#include +#include + +// Backwards compatibility for curl < 7.17.0 +#if LIBCURL_VERSION_NUM < 0x071100 +#define CURLOPT_DIRLISTONLY CURLOPT_FTPLISTONLY +#endif + +static int +write_data (void *buffer, size_t size, size_t nmemb, void *streamp) +{ + std::ostream& stream = *(static_cast (streamp)); + stream.write (static_cast (buffer), size*nmemb); + return (stream.fail () ? 0 : size * nmemb); +} + +static int +read_data (void *buffer, size_t size, size_t nmemb, void *streamp) +{ + std::istream& stream = *(static_cast (streamp)); + stream.read (static_cast (buffer), size*nmemb); + if (stream.eof ()) + return stream.gcount (); + else + return (stream.fail () ? 0 : size * nmemb); +} + +static size_t +throw_away (void *, size_t size, size_t nmemb, void *) +{ + return static_cast(size * nmemb); +} + +class +curl_handle +{ +private: + class + curl_handle_rep + { + public: + curl_handle_rep (void) : count (1), valid (true), ascii (false) + { + curl = curl_easy_init (); + if (!curl) + error ("can not create curl handle"); + } + + ~curl_handle_rep (void) + { + if (curl) + curl_easy_cleanup (curl); + } + + bool is_valid (void) const + { + return valid; + } + + bool perform (bool curlerror) const + { + bool retval = false; + if (!error_state) + { + BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + + errnum = curl_easy_perform (curl); + if (errnum != CURLE_OK) + { + if (curlerror) + error ("%s", curl_easy_strerror (errnum)); + } + else + retval = true; + + END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; + } + return retval; + } + + CURL* handle (void) const + { + return curl; + } + + bool is_ascii (void) const + { + return ascii; + } + + bool is_binary (void) const + { + return !ascii; + } + + octave_refcount count; + std::string host; + bool valid; + bool ascii; + mutable CURLcode errnum; + + private: + CURL *curl; + + // No copying! + + curl_handle_rep (const curl_handle_rep& ov); + + curl_handle_rep& operator = (const curl_handle_rep&); + }; + +public: + +// I'd love to rewrite this as a private method of the curl_handle +// class, but you can't pass the va_list from the wrapper setopt to +// the curl_easy_setopt function. +#define setopt(option, parameter) \ + { \ + CURLcode res = curl_easy_setopt (rep->handle (), option, parameter); \ + if (res != CURLE_OK) \ + error ("%s", curl_easy_strerror (res)); \ + } + + curl_handle (void) : rep (new curl_handle_rep ()) + { + rep->valid = false; + } + + curl_handle (const std::string& _host, const std::string& user, + const std::string& passwd) : + rep (new curl_handle_rep ()) + { + rep->host = _host; + init (user, passwd, std::cin, octave_stdout); + + std::string url = "ftp://" + _host; + setopt (CURLOPT_URL, url.c_str ()); + + // Setup the link, with no transfer + if (!error_state) + perform (); + } + + curl_handle (const std::string& url, const std::string& method, + const Cell& param, std::ostream& os, bool& retval) : + rep (new curl_handle_rep ()) + { + retval = false; + + init ("", "", std::cin, os); + + setopt (CURLOPT_NOBODY, 0); + + // Don't need to store the parameters here as we can't change + // the URL after the handle is created + std::string query_string = form_query_string (param); + + if (method == "get") + { + query_string = url + "?" + query_string; + setopt (CURLOPT_URL, query_string.c_str ()); + } + else if (method == "post") + { + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_POSTFIELDS, query_string.c_str ()); + } + else + setopt (CURLOPT_URL, url.c_str ()); + + if (!error_state) + retval = perform (false); + } + + curl_handle (const curl_handle& h) : rep (h.rep) + { + rep->count++; + } + + ~curl_handle (void) + { + if (--rep->count == 0) + delete rep; + } + + curl_handle& operator = (const curl_handle& h) + { + if (this != &h) + { + if (--rep->count == 0) + delete rep; + + rep = h.rep; + rep->count++; + } + return *this; + } + + bool is_valid (void) const + { + return rep->is_valid (); + } + + std::string lasterror (void) const + { + return std::string (curl_easy_strerror (rep->errnum)); + } + + void set_ostream (std::ostream& os) const + { + setopt (CURLOPT_WRITEDATA, static_cast (&os)); + } + + void set_istream (std::istream& is) const + { + setopt (CURLOPT_READDATA, static_cast (&is)); + } + + void ascii (void) const + { + setopt (CURLOPT_TRANSFERTEXT, 1); + rep->ascii = true; + } + + void binary (void) const + { + setopt (CURLOPT_TRANSFERTEXT, 0); + rep->ascii = false; + } + + bool is_ascii (void) const + { + return rep->is_ascii (); + } + + bool is_binary (void) const + { + return rep->is_binary (); + } + + void cwd (const std::string& path) const + { + struct curl_slist *slist = 0; + std::string cmd = "cwd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void del (const std::string& file) const + { + struct curl_slist *slist = 0; + std::string cmd = "dele " + file; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void rmdir (const std::string& path) const + { + struct curl_slist *slist = 0; + std::string cmd = "rmd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + bool mkdir (const std::string& path, bool curlerror = true) const + { + bool retval = false; + struct curl_slist *slist = 0; + std::string cmd = "mkd " + path; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + retval = perform (curlerror); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + return retval; + } + + void rename (const std::string& oldname, const std::string& newname) const + { + struct curl_slist *slist = 0; + std::string cmd = "rnfr " + oldname; + slist = curl_slist_append (slist, cmd.c_str ()); + cmd = "rnto " + newname; + slist = curl_slist_append (slist, cmd.c_str ()); + setopt (CURLOPT_POSTQUOTE, slist); + if (! error_state) + perform (); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + } + + void put (const std::string& file, std::istream& is) const + { + std::string url = "ftp://" + rep->host + "/" + file; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_UPLOAD, 1); + setopt (CURLOPT_NOBODY, 0); + set_istream (is); + if (! error_state) + perform (); + set_istream (std::cin); + setopt (CURLOPT_NOBODY, 1); + setopt (CURLOPT_UPLOAD, 0); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + void get (const std::string& file, std::ostream& os) const + { + std::string url = "ftp://" + rep->host + "/" + file; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_NOBODY, 0); + set_ostream (os); + if (! error_state) + perform (); + set_ostream (octave_stdout); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + void dir (void) const + { + std::string url = "ftp://" + rep->host + "/"; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_NOBODY, 0); + if (! error_state) + perform (); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + } + + string_vector list (void) const + { + std::ostringstream buf; + std::string url = "ftp://" + rep->host + "/"; + setopt (CURLOPT_WRITEDATA, static_cast (&buf)); + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_DIRLISTONLY, 1); + setopt (CURLOPT_NOBODY, 0); + if (! error_state) + perform (); + setopt (CURLOPT_NOBODY, 1); + url = "ftp://" + rep->host; + setopt (CURLOPT_WRITEDATA, static_cast (&octave_stdout)); + setopt (CURLOPT_DIRLISTONLY, 0); + setopt (CURLOPT_URL, url.c_str ()); + + // Count number of directory entries + std::string str = buf.str (); + octave_idx_type n = 0; + size_t pos = 0; + while (true) + { + pos = str.find_first_of ('\n', pos); + if (pos == std::string::npos) + break; + pos++; + n++; + } + string_vector retval (n); + pos = 0; + for (octave_idx_type i = 0; i < n; i++) + { + size_t newpos = str.find_first_of ('\n', pos); + if (newpos == std::string::npos) + break; + + retval(i) = str.substr(pos, newpos - pos); + pos = newpos + 1; + } + return retval; + } + + void get_fileinfo (const std::string& filename, double& filesize, + time_t& filetime, bool& fileisdir) const + { + std::string path = pwd (); + + std::string url = "ftp://" + rep->host + "/" + path + "/" + filename; + setopt (CURLOPT_URL, url.c_str ()); + setopt (CURLOPT_FILETIME, 1); + setopt (CURLOPT_HEADERFUNCTION, throw_away); + setopt (CURLOPT_WRITEFUNCTION, throw_away); + + // FIXME + // The MDTM command fails for a directory on the servers I tested + // so this is a means of testing for directories. It also means + // I can't get the date of directories! + if (! error_state) + { + if (! perform (false)) + { + fileisdir = true; + filetime = -1; + filesize = 0; + } + else + { + fileisdir = false; + time_t ft; + curl_easy_getinfo (rep->handle (), CURLINFO_FILETIME, &ft); + filetime = ft; + double fs; + curl_easy_getinfo (rep->handle (), + CURLINFO_CONTENT_LENGTH_DOWNLOAD, &fs); + filesize = fs; + } + } + + setopt (CURLOPT_WRITEFUNCTION, write_data); + setopt (CURLOPT_HEADERFUNCTION, 0); + setopt (CURLOPT_FILETIME, 0); + url = "ftp://" + rep->host; + setopt (CURLOPT_URL, url.c_str ()); + + // The MDTM command seems to reset the path to the root with the + // servers I tested with, so cd again into the correct path. Make + // the path absolute so that this will work even with servers that + // don't end up in the root after an MDTM command. + cwd ("/" + path); + } + + std::string pwd (void) const + { + struct curl_slist *slist = 0; + std::string retval; + std::ostringstream buf; + + slist = curl_slist_append (slist, "pwd"); + setopt (CURLOPT_POSTQUOTE, slist); + setopt (CURLOPT_HEADERFUNCTION, write_data); + setopt (CURLOPT_WRITEHEADER, static_cast(&buf)); + + if (! error_state) + { + perform (); + retval = buf.str (); + + // Can I assume that the path is alway in "" on the last line + size_t pos2 = retval.rfind ('"'); + size_t pos1 = retval.rfind ('"', pos2 - 1); + retval = retval.substr (pos1 + 1, pos2 - pos1 - 1); + } + setopt (CURLOPT_HEADERFUNCTION, 0); + setopt (CURLOPT_WRITEHEADER, 0); + setopt (CURLOPT_POSTQUOTE, 0); + curl_slist_free_all (slist); + + return retval; + } + + bool perform (bool curlerror = true) const + { + return rep->perform (curlerror); + } + +private: + curl_handle_rep *rep; + + std::string form_query_string (const Cell& param) + { + std::ostringstream query; + + for (int i = 0; i < param.numel (); i += 2) + { + std::string name = param(i).string_value (); + std::string text = param(i+1).string_value (); + + // Encode strings. + char *enc_name = curl_easy_escape (rep->handle (), name.c_str (), + name.length ()); + char *enc_text = curl_easy_escape (rep->handle (), text.c_str (), + text.length ()); + + query << enc_name << "=" << enc_text; + + curl_free (enc_name); + curl_free (enc_text); + + if (i < param.numel ()-1) + query << "&"; + } + + query.flush (); + + return query.str (); + } + + void init (const std::string& user, const std::string& passwd, + std::istream& is, std::ostream& os) + { + // No data transfer by default + setopt (CURLOPT_NOBODY, 1); + + // Set the username and password + std::string userpwd = user; + if (! passwd.empty ()) + userpwd += ":" + passwd; + if (! userpwd.empty ()) + setopt (CURLOPT_USERPWD, userpwd.c_str ()); + + // Define our callback to get called when there's data to be written. + setopt (CURLOPT_WRITEFUNCTION, write_data); + + // Set a pointer to our struct to pass to the callback. + setopt (CURLOPT_WRITEDATA, static_cast (&os)); + + // Define our callback to get called when there's data to be read + setopt (CURLOPT_READFUNCTION, read_data); + + // Set a pointer to our struct to pass to the callback. + setopt (CURLOPT_READDATA, static_cast (&is)); + + // Follow redirects. + setopt (CURLOPT_FOLLOWLOCATION, true); + + // Don't use EPSV since connecting to sites that don't support it + // will hang for some time (3 minutes?) before moving on to try PASV + // instead. + setopt (CURLOPT_FTP_USE_EPSV, false); + + setopt (CURLOPT_NOPROGRESS, true); + setopt (CURLOPT_FAILONERROR, true); + + setopt (CURLOPT_POSTQUOTE, 0); + setopt (CURLOPT_QUOTE, 0); + } + +#undef setopt +}; + +class +curl_handles +{ +public: + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + curl_handles (void) : map () + { + curl_global_init (CURL_GLOBAL_DEFAULT); + } + + ~curl_handles (void) + { + // Remove the elements of the map explicitly as they should + // be deleted before the call to curl_global_cleanup + map.erase (begin (), end ()); + + curl_global_cleanup (); + } + + iterator begin (void) { return iterator (map.begin ()); } + const_iterator begin (void) const { return const_iterator (map.begin ()); } + + iterator end (void) { return iterator (map.end ()); } + const_iterator end (void) const { return const_iterator (map.end ()); } + + iterator seek (const std::string& k) { return map.find (k); } + const_iterator seek (const std::string& k) const { return map.find (k); } + + std::string key (const_iterator p) const { return p->first; } + + curl_handle& contents (const std::string& k) + { + return map[k]; + } + + curl_handle contents (const std::string& k) const + { + const_iterator p = seek (k); + return p != end () ? p->second : curl_handle (); + } + + curl_handle& contents (iterator p) + { return p->second; } + + curl_handle contents (const_iterator p) const + { return p->second; } + + void del (const std::string& k) + { + iterator p = map.find (k); + + if (p != map.end ()) + map.erase (p); + } + +private: + std::map map; +}; + +static curl_handles handles; + +static void +cleanup_urlwrite (std::string filename) +{ + octave_unlink (filename); +} + +static void +reset_path (const curl_handle curl) +{ + curl.cwd (".."); +} + +static void +delete_file (std::string file) +{ + octave_unlink (file); +} +#endif + +DEFUN_DLD (urlwrite, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {@var{f} =} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {[@var{f}, @var{success}] =} urlwrite (@var{url}, @var{localfile})\n\ +@deftypefnx {Loadable Function} {[@var{f}, @var{success}, @var{message}] =} urlwrite (@var{url}, @var{localfile})\n\ +Download a remote file specified by its @var{url} and save it as\n\ +@var{localfile}. For example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"ftp://ftp.octave.org/pub/octave/README\",\n\ + \"README.txt\");\n\ +@end group\n\ +@end example\n\ +\n\ +The full path of the downloaded file is returned in @var{f}. The\n\ +variable @var{success} is 1 if the download was successful,\n\ +otherwise it is 0 in which case @var{message} contains an error\n\ +message. If no output argument is specified and an error occurs,\n\ +then the error is signaled through Octave's error handling mechanism.\n\ +\n\ +This function uses libcurl. Curl supports, among others, the HTTP,\n\ +FTP and FILE protocols. Username and password may be specified in\n\ +the URL, for example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"http://username:password@@example.com/file.txt\",\n\ + \"file.txt\");\n\ +@end group\n\ +@end example\n\ +\n\ +GET and POST requests can be specified by @var{method} and @var{param}.\n\ +The parameter @var{method} is either @samp{get} or @samp{post}\n\ +and @var{param} is a cell array of parameter and value pairs.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +urlwrite (\"http://www.google.com/search\", \"search.html\",\n\ + \"get\", @{\"query\", \"octave\"@});\n\ +@end group\n\ +@end example\n\ +@seealso{urlread}\n\ +@end deftypefn") +{ + octave_value_list retval; + +#ifdef HAVE_CURL + + int nargin = args.length (); + + // verify arguments + if (nargin != 2 && nargin != 4) + { + print_usage (); + return retval; + } + + std::string url = args(0).string_value (); + + if (error_state) + { + error ("urlwrite: URL must be a character string"); + return retval; + } + + // name to store the file if download is succesful + std::string filename = args(1).string_value (); + + if (error_state) + { + error ("urlwrite: LOCALFILE must be a character string"); + return retval; + } + + std::string method; + Cell param; // empty cell array + + if (nargin == 4) + { + method = args(2).string_value (); + + if (error_state) + { + error ("urlwrite: METHOD must be \"get\" or \"post\""); + return retval; + } + + if (method != "get" && method != "post") + { + error ("urlwrite: METHOD must be \"get\" or \"post\""); + return retval; + } + + param = args(3).cell_value (); + + if (error_state) + { + error ("urlwrite: parameters (PARAM) for get and post requests must be given as a cell"); + return retval; + } + + + if (param.numel () % 2 == 1 ) + { + error ("urlwrite: number of elements in PARAM must be even"); + return retval; + } + } + + // The file should only be deleted if it doesn't initially exist, we + // create it, and the download fails. We use unwind_protect to do + // it so that the deletion happens no matter how we exit the function. + + file_stat fs (filename); + + std::ofstream ofile (filename.c_str (), std::ios::out | std::ios::binary); + + if (! ofile.is_open ()) + { + error ("urlwrite: unable to open file"); + return retval; + } + + unwind_protect_safe frame; + + frame.add_fcn (cleanup_urlwrite, filename); + + bool ok; + curl_handle curl = curl_handle (url, method, param, ofile, ok); + + ofile.close (); + + if (!error_state) + frame.discard (); + else + frame.run (); + + if (nargout > 0) + { + if (ok) + { + retval(2) = std::string (); + retval(1) = true; + retval(0) = octave_env::make_absolute (filename); + } + else + { + retval(2) = curl.lasterror (); + retval(1) = false; + retval(0) = std::string (); + } + } + + if (nargout < 2 && ! ok) + error ("urlwrite: curl: %s", curl.lasterror ().c_str ()); + +#else + error ("urlwrite: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (urlread, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {@var{s} =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@var{s}, @var{success}] =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@var{s}, @var{success}, @var{message}] =} urlread (@var{url})\n\ +@deftypefnx {Loadable Function} {[@dots{}] =} urlread (@var{url}, @var{method}, @var{param})\n\ +Download a remote file specified by its @var{url} and return its content\n\ +in string @var{s}. For example:\n\ +\n\ +@example\n\ +s = urlread (\"ftp://ftp.octave.org/pub/octave/README\");\n\ +@end example\n\ +\n\ +The variable @var{success} is 1 if the download was successful,\n\ +otherwise it is 0 in which case @var{message} contains an error\n\ +message. If no output argument is specified and an error occurs,\n\ +then the error is signaled through Octave's error handling mechanism.\n\ +\n\ +This function uses libcurl. Curl supports, among others, the HTTP,\n\ +FTP and FILE protocols. Username and password may be specified in the\n\ +URL@. For example:\n\ +\n\ +@example\n\ +s = urlread (\"http://user:password@@example.com/file.txt\");\n\ +@end example\n\ +\n\ +GET and POST requests can be specified by @var{method} and @var{param}.\n\ +The parameter @var{method} is either @samp{get} or @samp{post}\n\ +and @var{param} is a cell array of parameter and value pairs.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +s = urlread (\"http://www.google.com/search\", \"get\",\n\ + @{\"query\", \"octave\"@});\n\ +@end group\n\ +@end example\n\ +@seealso{urlwrite}\n\ +@end deftypefn") +{ + // Octave's return value + octave_value_list retval; + +#ifdef HAVE_CURL + + int nargin = args.length (); + + // verify arguments + if (nargin != 1 && nargin != 3) + { + print_usage (); + return retval; + } + + std::string url = args(0).string_value (); + + if (error_state) + { + error ("urlread: URL must be a character string"); + return retval; + } + + std::string method; + Cell param; // empty cell array + + if (nargin == 3) + { + method = args(1).string_value (); + + if (error_state) + { + error ("urlread: METHOD must be \"get\" or \"post\""); + return retval; + } + + if (method != "get" && method != "post") + { + error ("urlread: METHOD must be \"get\" or \"post\""); + return retval; + } + + param = args(2).cell_value (); + + if (error_state) + { + error ("urlread: parameters (PARAM) for get and post requests must be given as a cell"); + return retval; + } + + if (param.numel () % 2 == 1 ) + { + error ("urlread: number of elements in PARAM must be even"); + return retval; + } + } + + std::ostringstream buf; + + bool ok; + curl_handle curl = curl_handle (url, method, param, buf, ok); + + if (nargout > 0) + { + // Return empty string if no error occured. + retval(2) = ok ? "" : curl.lasterror (); + retval(1) = ok; + retval(0) = buf.str (); + } + + if (nargout < 2 && ! ok) + error ("urlread: curl: %s", curl.lasterror().c_str()); + +#else + error ("urlread: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp__ (@var{handle}, @var{host})\n\ +@deftypefnx {Loadable Function} {} __ftp__ (@var{handle}, @var{host}, @var{username}, @var{password})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + std::string handle; + std::string host; + std::string user = "anonymous"; + std::string passwd = ""; + + if (nargin < 2 || nargin > 4) + error ("incorrect number of arguments"); + else + { + handle = args(0).string_value (); + host = args(1).string_value (); + + if (nargin > 1) + user = args(2).string_value (); + + if (nargin > 2) + passwd = args(3).string_value (); + + if (!error_state) + { + handles.contents (handle) = curl_handle (host, user, passwd); + + if (error_state) + handles.del (handle); + } + } +#else + error ("__ftp__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_pwd__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_pwd__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + octave_value retval; +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_pwd__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + retval = curl.pwd (); + else + error ("__ftp_pwd__: invalid ftp handle"); + } + } +#else + error ("__ftp_pwd__: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp_cwd__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_cwd__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1 && nargin != 2) + error ("__ftp_cwd__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string path = ""; + + if (nargin > 1) + path = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.cwd (path); + else + error ("__ftp_cwd__: invalid ftp handle"); + } + } +#else + error ("__ftp_cwd__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_dir__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_dir__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + octave_value retval; +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_dir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + if (nargout == 0) + curl.dir (); + else + { + string_vector sv = curl.list (); + octave_idx_type n = sv.length (); + if (n == 0) + { + string_vector flds (5); + flds(0) = "name"; + flds(1) = "date"; + flds(2) = "bytes"; + flds(3) = "isdir"; + flds(4) = "datenum"; + retval = octave_map (flds); + } + else + { + octave_map st; + Cell filectime (dim_vector (n, 1)); + Cell filesize (dim_vector (n, 1)); + Cell fileisdir (dim_vector (n, 1)); + Cell filedatenum (dim_vector (n, 1)); + + st.assign ("name", Cell (sv)); + + for (octave_idx_type i = 0; i < n; i++) + { + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + fileisdir (i) = fisdir; + filectime (i) = ctime (&ftime); + filesize (i) = fsize; + filedatenum (i) = double (ftime); + } + st.assign ("date", filectime); + st.assign ("bytes", filesize); + st.assign ("isdir", fileisdir); + st.assign ("datenum", filedatenum); + retval = st; + } + } + } + else + error ("__ftp_dir__: invalid ftp handle"); + } + } +#else + error ("__ftp_dir__: not available in this version of Octave"); +#endif + + return retval; +} + +DEFUN_DLD (__ftp_ascii__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_ascii__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_ascii__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.ascii (); + else + error ("__ftp_ascii__: invalid ftp handle"); + } + } +#else + error ("__ftp_ascii__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_binary__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_binary__ (@var{handle})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_binary__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.binary (); + else + error ("__ftp_binary__: invalid ftp handle"); + } + } +#else + error ("__ftp_binary__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_close__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_close__ (@var{handle})\n\ + Undocumented internal function\n\ + @end deftypefn") + { + #ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_close__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + if (!error_state) + handles.del (handle); + } + #else + error ("__ftp_close__: not available in this version of Octave"); + #endif + + return octave_value (); + } + +DEFUN_DLD (__ftp_mode__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mode__ (@var{handle})\n\ + Undocumented internal function\n\ + @end deftypefn") + { + octave_value retval; + #ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 1) + error ("__ftp_mode__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + retval = (curl.is_ascii () ? "ascii" : "binary"); + else + error ("__ftp_binary__: invalid ftp handle"); + } + } + #else + error ("__ftp_mode__: not available in this version of Octave"); + #endif + + return retval; + } + +DEFUN_DLD (__ftp_delete__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_delete__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_delete__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string file = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.del (file); + else + error ("__ftp_delete__: invalid ftp handle"); + } + } +#else + error ("__ftp_delete__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_rmdir__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_rmdir__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_rmdir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.rmdir (dir); + else + error ("__ftp_rmdir__: invalid ftp handle"); + } + } +#else + error ("__ftp_rmdir__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_mkdir__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mkdir__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_mkdir__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.mkdir (dir); + else + error ("__ftp_mkdir__: invalid ftp handle"); + } + } +#else + error ("__ftp_mkdir__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +DEFUN_DLD (__ftp_rename__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_rename__ (@var{handle}, @var{path})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 3) + error ("__ftp_rename__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string oldname = args(1).string_value (); + std::string newname = args(2).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + curl.rename (oldname, newname); + else + error ("__ftp_rename__: invalid ftp handle"); + } + } +#else + error ("__ftp_rename__: not available in this version of Octave"); +#endif + + return octave_value (); +} + +#ifdef HAVE_CURL +static string_vector +mput_directory (const curl_handle& curl, const std::string& base, + const std::string& dir) +{ + string_vector retval; + + if (! curl.mkdir (dir, false)) + warning ("__ftp_mput__: can not create the remote directory ""%s""", + (base.length () == 0 ? dir : base + + file_ops::dir_sep_str () + dir).c_str ()); + + curl.cwd (dir); + + if (! error_state) + { + unwind_protect_safe frame; + + frame.add_fcn (reset_path, curl); + + std::string realdir = base.length () == 0 ? dir : base + + file_ops::dir_sep_str () + dir; + + dir_entry dirlist (realdir); + + if (dirlist) + { + string_vector files = dirlist.read (); + + for (octave_idx_type i = 0; i < files.length (); i++) + { + std::string file = files (i); + + if (file == "." || file == "..") + continue; + + std::string realfile = realdir + file_ops::dir_sep_str () + file; + file_stat fs (realfile); + + if (! fs.exists ()) + { + error ("__ftp__mput: file ""%s"" does not exist", + realfile.c_str ()); + break; + } + + if (fs.is_dir ()) + { + retval.append (mput_directory (curl, realdir, file)); + + if (error_state) + break; + } + else + { + // FIXME Does ascii mode need to be flagged here? + std::ifstream ifile (realfile.c_str (), std::ios::in | + std::ios::binary); + + if (! ifile.is_open ()) + { + error ("__ftp_mput__: unable to open file ""%s""", + realfile.c_str ()); + break; + } + + curl.put (file, ifile); + + ifile.close (); + + if (error_state) + break; + + retval.append (realfile); + } + } + } + else + error ("__ftp_mput__: can not read the directory ""%s""", + realdir.c_str ()); + } + + return retval; +} +#endif + +DEFUN_DLD (__ftp_mput__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mput__ (@var{handle}, @var{files})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ + string_vector retval; + +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2) + error ("__ftp_mput__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string pat = args(1).string_value (); + + if (!error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + glob_match pattern (file_ops::tilde_expand (pat)); + string_vector files = pattern.glob (); + + for (octave_idx_type i = 0; i < files.length (); i++) + { + std::string file = files (i); + + file_stat fs (file); + + if (! fs.exists ()) + { + error ("__ftp__mput: file does not exist"); + break; + } + + if (fs.is_dir ()) + { + retval.append (mput_directory (curl, "", file)); + if (error_state) + break; + } + else + { + // FIXME Does ascii mode need to be flagged here? + std::ifstream ifile (file.c_str (), std::ios::in | + std::ios::binary); + + if (! ifile.is_open ()) + { + error ("__ftp_mput__: unable to open file"); + break; + } + + curl.put (file, ifile); + + ifile.close (); + + if (error_state) + break; + + retval.append (file); + } + } + } + else + error ("__ftp_mput__: invalid ftp handle"); + } + } +#else + error ("__ftp_mput__: not available in this version of Octave"); +#endif + + return (nargout > 0 ? octave_value (retval) : octave_value ()); +} + +#ifdef HAVE_CURL +static void +getallfiles (const curl_handle& curl, const std::string& dir, + const std::string& target) +{ + std::string sep = file_ops::dir_sep_str (); + file_stat fs (dir); + + if (!fs || !fs.is_dir ()) + { + std::string msg; + int status = octave_mkdir (dir, 0777, msg); + + if (status < 0) + error ("__ftp_mget__: can't create directory %s%s%s. %s", + target.c_str (), sep.c_str (), dir.c_str (), msg.c_str ()); + } + + if (! error_state) + { + curl.cwd (dir); + + if (! error_state) + { + unwind_protect_safe frame; + + frame.add_fcn (reset_path, curl); + + string_vector sv = curl.list (); + + for (octave_idx_type i = 0; i < sv.length (); i++) + { + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + if (fisdir) + getallfiles (curl, sv(i), target + dir + sep); + else + { + std::string realfile = target + dir + sep + sv(i); + std::ofstream ofile (realfile.c_str (), + std::ios::out | + std::ios::binary); + + if (! ofile.is_open ()) + { + error ("__ftp_mget__: unable to open file"); + break; + } + + unwind_protect_safe frame2; + + frame2.add_fcn (delete_file, realfile); + + curl.get (sv(i), ofile); + + ofile.close (); + + if (!error_state) + frame2.discard (); + else + frame2.run (); + } + + if (error_state) + break; + } + } + } +} +#endif + +DEFUN_DLD (__ftp_mget__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {} __ftp_mget__ (@var{handle}, @var{files})\n\ +Undocumented internal function\n\ +@end deftypefn") +{ +#ifdef HAVE_CURL + int nargin = args.length (); + + if (nargin != 2 && nargin != 3) + error ("__ftp_mget__: incorrect number of arguments"); + else + { + std::string handle = args(0).string_value (); + std::string file = args(1).string_value (); + std::string target; + + if (nargin == 3) + target = args(2).string_value () + file_ops::dir_sep_str (); + + if (! error_state) + { + const curl_handle curl = handles.contents (handle); + + if (curl.is_valid ()) + { + string_vector sv = curl.list (); + octave_idx_type n = 0; + glob_match pattern (file); + + for (octave_idx_type i = 0; i < sv.length (); i++) + { + if (pattern.match (sv(i))) + { + n++; + + time_t ftime; + bool fisdir; + double fsize; + + curl.get_fileinfo (sv(i), fsize, ftime, fisdir); + + if (fisdir) + getallfiles (curl, sv(i), target); + else + { + std::ofstream ofile ((target + sv(i)).c_str (), + std::ios::out | + std::ios::binary); + + if (! ofile.is_open ()) + { + error ("__ftp_mget__: unable to open file"); + break; + } + + unwind_protect_safe frame; + + frame.add_fcn (delete_file, target + sv(i)); + + curl.get (sv(i), ofile); + + ofile.close (); + + if (!error_state) + frame.discard (); + else + frame.run (); + } + + if (error_state) + break; + } + } + if (n == 0) + error ("__ftp_mget__: file not found"); + } + } + } +#else + error ("__ftp_mget__: not available in this version of Octave"); +#endif + + return octave_value (); +} diff -r 069c552587a0 -r 959953dba519 src/error.cc --- a/src/error.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1887 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "defun.h" -#include "error.h" -#include "input.h" -#include "pager.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "utils.h" -#include "ov.h" -#include "ov-usr-fcn.h" -#include "pt-pr-code.h" -#include "pt-stmt.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "variables.h" - -// TRUE means that Octave will try to beep obnoxiously before printing -// error messages. -static bool Vbeep_on_error = false; - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -bool Vdebug_on_error = false; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -bool Vdebug_on_warning = false; - -// TRUE means that Octave will try to display a stack trace when a -// warning is encountered. -static bool Vbacktrace_on_warning = false; - -// TRUE means that Octave will print a verbose warning. Currently unused. -static bool Vverbose_warning; - -// TRUE means that Octave will print no warnings, but lastwarn will be -//updated -static bool Vquiet_warning = false; - -// A structure containing (most of) the current state of warnings. -static octave_map warning_options; - -// The text of the last error message. -static std::string Vlast_error_message; - -// The text of the last warning message. -static std::string Vlast_warning_message; - -// The last warning message id. -static std::string Vlast_warning_id; - -// The last error message id. -static std::string Vlast_error_id; - -// The last file in which an error occured -static octave_map Vlast_error_stack; - -// Current error state. -// -// Valid values: -// -// -2: an error has occurred, but don't print any messages. -// -1: an error has occurred, we are printing a traceback -// 0: no error -// 1: an error has occurred -// -int error_state = 0; - -// Current warning state. -// -// Valid values: -// -// 0: no warning -// 1: a warning has occurred -// -int warning_state = 0; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the `unwind_protect' statement. -int buffer_error_messages = 0; - -// TRUE means error messages are turned off. -bool discard_error_messages = false; - -// TRUE means warning messages are turned off. -bool discard_warning_messages = false; - -void -reset_error_handler (void) -{ - error_state = 0; - warning_state = 0; - buffer_error_messages = 0; - discard_error_messages = false; -} - -static void -initialize_warning_options (const std::string& state) -{ - octave_scalar_map initw; - - initw.setfield ("identifier", "all"); - initw.setfield ("state", state); - - warning_options = initw; -} - -static octave_map -initialize_last_error_stack (void) -{ - return octave_call_stack::empty_backtrace (); -} - -// Warning messages are never buffered. - -static void -vwarning (const char *name, const char *id, const char *fmt, va_list args) -{ - if (discard_warning_messages) - return; - - flush_octave_stdout (); - - std::ostringstream output_buf; - - if (name) - output_buf << name << ": "; - - octave_vformat (output_buf, fmt, args); - - output_buf << std::endl; - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::string msg_string = output_buf.str (); - - if (! warning_state) - { - // This is the first warning in a possible series. - - Vlast_warning_id = id; - Vlast_warning_message = msg_string; - } - - if (! Vquiet_warning) - { - octave_diary << msg_string; - - std::cerr << msg_string; - } -} - -static void -verror (bool save_last_error, std::ostream& os, - const char *name, const char *id, const char *fmt, va_list args, - bool with_cfn = false) -{ - if (discard_error_messages) - return; - - if (! buffer_error_messages) - flush_octave_stdout (); - - // FIXME -- we really want to capture the message before it - // has all the formatting goop attached to it. We probably also - // want just the message, not the traceback information. - - std::ostringstream output_buf; - - octave_vformat (output_buf, fmt, args); - - std::string base_msg = output_buf.str (); - - bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; - - std::string msg_string; - - if (to_beep_or_not_to_beep_p) - msg_string = "\a"; - - if (name) - msg_string += std::string (name) + ": "; - - // If with_fcn is specified, we'll attempt to prefix the message with the name - // of the current executing function. But we'll do so only if: - // 1. the name is not empty (anonymous function) - // 2. it is not already there (including the following colon) - if (with_cfn) - { - octave_function *curfcn = octave_call_stack::current (); - if (curfcn) - { - std::string cfn = curfcn->name (); - if (! cfn.empty ()) - { - cfn += ':'; - if (cfn.length () > base_msg.length () - || base_msg.compare (0, cfn.length (), cfn) != 0) - { - msg_string += cfn + ' '; - } - } - } - } - - msg_string += base_msg + "\n"; - - if (! error_state && save_last_error) - { - // This is the first error in a possible series. - - Vlast_error_id = id; - Vlast_error_message = base_msg; - - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - if (fcn) - { - octave_idx_type curr_frame = -1; - - Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); - } - else - Vlast_error_stack = initialize_last_error_stack (); - } - - if (! buffer_error_messages) - { - octave_diary << msg_string; - os << msg_string; - } -} - -// Note that we don't actually print any message if the error string -// is just "" or "\n". This allows error ("") and error ("\n") to -// just set the error state. - -static void -error_1 (std::ostream& os, const char *name, const char *id, - const char *fmt, va_list args, bool with_cfn = false) -{ - if (error_state != -2) - { - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (true, os, name, id, tmp_fmt, args, with_cfn); - delete [] tmp_fmt; - } - - error_state = -2; - } - else - { - verror (true, os, name, id, fmt, args, with_cfn); - - if (! error_state) - error_state = 1; - } - } - } - } - else - panic ("error_1: invalid format"); - } -} - -void -vmessage (const char *name, const char *fmt, va_list args) -{ - verror (false, std::cerr, name, "", fmt, args); -} - -void -message (const char *name, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage (name, fmt, args); - va_end (args); -} - -void -vmessage_with_id (const char *name, const char *id, const char *fmt, - va_list args) -{ - verror (false, std::cerr, name, id, fmt, args); -} - -void -message_with_id (const char *name, const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vmessage_with_id (name, id, fmt, args); - va_end (args); -} - -void -usage_1 (const char *id, const char *fmt, va_list args) -{ - verror (true, std::cerr, "usage", id, fmt, args); - error_state = -1; -} - -void -vusage (const char *fmt, va_list args) -{ - usage_1 ("", fmt, args); -} - -void -usage (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage (fmt, args); - va_end (args); -} - -void -vusage_with_id (const char *id, const char *fmt, va_list args) -{ - usage_1 (id, fmt, args); -} - -void -usage_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vusage_with_id (id, fmt, args); - va_end (args); -} - -static void -pr_where_2 (const char *fmt, va_list args) -{ - if (fmt) - { - if (*fmt) - { - size_t len = strlen (fmt); - - if (len > 0) - { - if (fmt[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_fmt = strsave (fmt); - tmp_fmt[len - 1] = '\0'; - verror (false, std::cerr, 0, "", tmp_fmt, args); - delete [] tmp_fmt; - } - } - else - verror (false, std::cerr, 0, "", fmt, args); - } - } - } - else - panic ("pr_where_2: invalid format"); -} - -static void -pr_where_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - pr_where_2 (fmt, args); - va_end (args); -} - -static void -pr_where (const char *who) -{ - octave_idx_type curr_frame = -1; - - octave_map stk = octave_call_stack::backtrace (0, curr_frame); - - octave_idx_type nframes_to_display = stk.numel (); - - if (nframes_to_display > 0) - { - pr_where_1 ("%s: called from\n", who); - - Cell names = stk.contents ("name"); - Cell lines = stk.contents ("line"); - Cell columns = stk.contents ("column"); - - for (octave_idx_type i = 0; i < nframes_to_display; i++) - { - octave_value name = names(i); - octave_value line = lines(i); - octave_value column = columns(i); - - std::string nm = name.string_value (); - - pr_where_1 (" %s at line %d column %d\n", nm.c_str (), - line.int_value (), column.int_value ()); - } - } -} - -static void -error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) -{ - int init_state = error_state; - - error_1 (std::cerr, "error", id, fmt, args, with_cfn); - - if ((interactive || forced_interactive) - && Vdebug_on_error && init_state == 0 - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_error); - Vdebug_on_error = false; - - error_state = 0; - - pr_where ("error"); - - do_keyboard (octave_value_list ()); - } -} - -void -verror (const char *fmt, va_list args) -{ - error_2 ("", fmt, args); -} - -void -error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror (fmt, args); - va_end (args); -} - -void -verror_with_cfn (const char *fmt, va_list args) -{ - error_2 ("", fmt, args, true); -} - -void -error_with_cfn (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_cfn (fmt, args); - va_end (args); -} - -void -verror_with_id (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args); -} - -void -error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id (id, fmt, args); - va_end (args); -} - -void -verror_with_id_cfn (const char *id, const char *fmt, va_list args) -{ - error_2 (id, fmt, args, true); -} - -void -error_with_id_cfn (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - verror_with_id_cfn (id, fmt, args); - va_end (args); -} - -static int -check_state (const std::string& state) -{ - // -1: not found - // 0: found, "off" - // 1: found, "on" - // 2: found, "error" - - if (state == "off") - return 0; - else if (state == "on") - return 1; - else if (state == "error") - return 2; - else - return -1; -} - -// For given warning ID, return 0 if warnings are disabled, 1 if -// enabled, and 2 if the given ID should be an error instead of a -// warning. - -int -warning_enabled (const std::string& id) -{ - int retval = 0; - - int all_state = -1; - int id_state = -1; - - octave_idx_type nel = warning_options.numel (); - - if (nel > 0) - { - Cell identifier = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - bool all_found = false; - bool id_found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value ov = identifier(i); - std::string ovs = ov.string_value (); - - if (! all_found && ovs == "all") - { - all_state = check_state (state(i).string_value ()); - - if (all_state >= 0) - all_found = true; - } - - if (! id_found && ovs == id) - { - id_state = check_state (state(i).string_value ()); - - if (id_state >= 0) - id_found = true; - } - - if (all_found && id_found) - break; - } - } - - // If "all" is not present, assume warnings are enabled. - if (all_state == -1) - all_state = 1; - - if (all_state == 0) - { - if (id_state >= 0) - retval = id_state; - } - else if (all_state == 1) - { - if (id_state == 0 || id_state == 2) - retval = id_state; - else - retval = all_state; - } - else if (all_state == 2) - { - if (id_state == 0) - retval= id_state; - else - retval = all_state; - } - - return retval; -} - -static void -warning_1 (const char *id, const char *fmt, va_list args) -{ - int warn_opt = warning_enabled (id); - - if (warn_opt == 2) - { - // Handle this warning as an error. - - error_2 (id, fmt, args); - } - else if (warn_opt == 1) - { - vwarning ("warning", id, fmt, args); - - if (! symbol_table::at_top_level () - && Vbacktrace_on_warning - && ! warning_state - && ! discard_warning_messages) - pr_where ("warning"); - - warning_state = 1; - - if ((interactive || forced_interactive) - && Vdebug_on_warning - && octave_call_stack::caller_user_code ()) - { - unwind_protect frame; - frame.protect_var (Vdebug_on_warning); - Vdebug_on_warning = false; - - do_keyboard (octave_value_list ()); - } - } -} - -void -vwarning (const char *fmt, va_list args) -{ - warning_1 ("", fmt, args); -} - -void -warning (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning (fmt, args); - va_end (args); -} - -void -vwarning_with_id (const char *id, const char *fmt, va_list args) -{ - warning_1 (id, fmt, args); -} - -void -warning_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vwarning_with_id (id, fmt, args); - va_end (args); -} - -void -vparse_error (const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, "", fmt, args); -} - -void -parse_error (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error (fmt, args); - va_end (args); -} - -void -vparse_error_with_id (const char *id, const char *fmt, va_list args) -{ - error_1 (std::cerr, 0, id, fmt, args); -} - -void -parse_error_with_id (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - vparse_error_with_id (id, fmt, args); - va_end (args); -} - -void -rethrow_error (const char *id, const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (std::cerr, 0, id, fmt, args); - va_end (args); -} - -void -panic (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - buffer_error_messages = 0; - discard_error_messages = false; - verror (false, std::cerr, "panic", "", fmt, args); - va_end (args); - abort (); -} - -static void -defun_usage_message_1 (const char *fmt, ...) -{ - va_list args; - va_start (args, fmt); - error_1 (octave_stdout, 0, "", fmt, args); - va_end (args); -} - -void -defun_usage_message (const std::string& msg) -{ - defun_usage_message_1 ("%s", msg.c_str ()); -} - -typedef void (*error_fun)(const char *, const char *, ...); - -extern octave_value_list Fsprintf (const octave_value_list&, int); - -static std::string -handle_message (error_fun f, const char *id, const char *msg, - const octave_value_list& args, bool have_fmt) -{ - std::string retval; - - std::string tstr; - - int nargin = args.length (); - - if (nargin > 0) - { - octave_value arg; - - if (have_fmt) - { - octave_value_list tmp = Fsprintf (args, 1); - arg = tmp(0); - } - else - arg = args(0); - - if (arg.is_defined ()) - { - if (arg.is_string ()) - { - tstr = arg.string_value (); - msg = tstr.c_str (); - - if (! msg) - return retval; - } - else if (arg.is_empty ()) - return retval; - } - } - -// Ugh. - - size_t len = strlen (msg); - - if (len > 0) - { - if (msg[len - 1] == '\n') - { - if (len > 1) - { - char *tmp_msg = strsave (msg); - tmp_msg[len - 1] = '\0'; - f (id, "%s\n", tmp_msg); - retval = tmp_msg; - delete [] tmp_msg; - } - } - else - { - f (id, "%s", msg); - retval = msg; - } - } - - return retval; -} - -DEFUN (rethrow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ -Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ -that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ -can also contain a field 'stack' that gives information on the assumed\n\ -location of the error. Typically @var{err} is returned from\n\ -@code{lasterror}.\n\ -@seealso{lasterror, lasterr, error}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - const octave_scalar_map err = args(0).scalar_map_value (); - - if (! error_state) - { - if (err.contains ("message") && err.contains ("identifier")) - { - std::string msg = err.contents ("message").string_value (); - std::string id = err.contents ("identifier").string_value (); - int len = msg.length (); - - std::string file; - std::string nm; - int l = -1; - int c = -1; - - octave_map err_stack = initialize_last_error_stack (); - - if (err.contains ("stack")) - { - err_stack = err.contents ("stack").map_value (); - - if (err_stack.numel () > 0) - { - if (err_stack.contains ("file")) - file = err_stack.contents ("file")(0).string_value (); - - if (err_stack.contains ("name")) - nm = err_stack.contents ("name")(0).string_value (); - - if (err_stack.contains ("line")) - l = err_stack.contents ("line")(0).nint_value (); - - if (err_stack.contains ("column")) - c = err_stack.contents ("column")(0).nint_value (); - } - } - - // Ugh. - char *tmp_msg = strsave (msg.c_str ()); - if (tmp_msg[len-1] == '\n') - { - if (len > 1) - { - tmp_msg[len - 1] = '\0'; - rethrow_error (id.c_str (), "%s\n", tmp_msg); - } - } - else - rethrow_error (id.c_str (), "%s", tmp_msg); - delete [] tmp_msg; - - // FIXME -- is this the right thing to do for - // Vlast_error_stack? Should it be saved and restored - // with unwind_protect? - - Vlast_error_stack = err_stack; - - if (err.contains ("stack")) - { - if (file.empty ()) - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: near line %d, column %d", - l, c); - else - pr_where_1 ("error: near line %d", l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from `%s' near line %d, column %d", - nm.c_str (), l, c); - else - pr_where_1 ("error: called from `%d' near line %d", nm.c_str (), l); - } - } - } - else - { - if (nm.empty ()) - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: in file %s near line %d, column %d", - file.c_str (), l, c); - else - pr_where_1 ("error: in file %s near line %d", file.c_str (), l); - } - } - else - { - if (l > 0) - { - if (c > 0) - pr_where_1 ("error: called from `%s' in file %s near line %d, column %d", - nm.c_str (), file.c_str (), l, c); - else - pr_where_1 ("error: called from `%d' in file %s near line %d", nm.c_str (), file.c_str (), l); - } - } - } - } - } - else - error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); - } - } - return retval; -} - -// Determine whether the first argument to error or warning function -// should be handled as the message identifier or as the format string. - -static bool -maybe_extract_message_id (const std::string& caller, - const octave_value_list& args, - octave_value_list& nargs, - std::string& id) -{ - nargs = args; - id = std::string (); - - int nargin = args.length (); - - bool have_fmt = nargin > 1; - - if (nargin > 0) - { - std::string arg1 = args(0).string_value (); - - if (! error_state) - { - // For compatibility with Matlab, an identifier must contain - // ':', but not at the beginning or the end, and it must not - // contain '%' (even if it is not a valid conversion - // operator) or whitespace. - - if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos - && arg1.find (':') != std::string::npos - && arg1[0] != ':' - && arg1[arg1.length ()-1] != ':') - { - if (nargin > 1) - { - id = arg1; - - nargs.resize (nargin-1); - - for (int i = 1; i < nargin; i++) - nargs(i-1) = args(i); - } - else - nargs(0) = "call to " + caller - + " with message identifier requires message"; - } - } - } - - return have_fmt; -} - -DEFUN (error, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{error: }.\n\ -\n\ -Calling @code{error} also sets Octave's internal error state such that\n\ -control will return to the top level without evaluating any more\n\ -commands. This is useful for aborting from functions or scripts.\n\ -\n\ -If the error message does not end with a new line character, Octave will\n\ -print a traceback of all the function calls leading to the error. For\n\ -example, given the following function definitions:\n\ -\n\ -@example\n\ -@group\n\ -function f () g (); end\n\ -function g () h (); end\n\ -function h () nargin == 1 || error (\"nargin != 1\"); end\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -calling the function @code{f} will result in a list of messages that\n\ -can help you to quickly locate the exact location of the error:\n\ -\n\ -@example\n\ -@group\n\ -f ()\n\ -error: nargin != 1\n\ -error: called from:\n\ -error: error at line -1, column -1\n\ -error: h at line 1, column 27\n\ -error: g at line 1, column 15\n\ -error: f at line 1, column 15\n\ -@end group\n\ -@end example\n\ -\n\ -If the error message ends in a new line character, Octave will print the\n\ -message but will not display any traceback messages as it returns\n\ -control to the top level. For example, modifying the error message\n\ -in the previous example to end in a new line causes Octave to only print\n\ -a single message:\n\ -\n\ -@example\n\ -@group\n\ -function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ -f ()\n\ -error: nargin != 1\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - octave_value_list nargs = args; - - std::string id; - - if (nargin == 0) - print_usage (); - else - { - bool have_fmt = false; - - if (nargin == 1 && args(0).is_map ()) - { - // empty struct is not an error. return and resume calling function. - if (args(0).is_empty ()) - return retval; - - octave_value_list tmp; - - octave_scalar_map m = args(0).scalar_map_value (); - - // empty struct is not an error. return and resume calling function. - if (m.nfields () == 0) - return retval; - - if (m.contains ("message")) - { - octave_value c = m.getfield ("message"); - - if (c.is_string ()) - nargs(0) = c.string_value (); - } - - if (m.contains ("identifier")) - { - octave_value c = m.getfield ("identifier"); - - if (c.is_string ()) - id = c.string_value (); - } - - // FIXME -- also need to handle "stack" field in error - // structure, but that will require some more significant - // surgery on handle_message, error_with_id, etc. - } - else - { - have_fmt = maybe_extract_message_id ("error", args, nargs, id); - - if (error_state) - return retval; - } - - handle_message (error_with_id, id.c_str (), "unspecified error", - nargs, have_fmt); - } - - return retval; -} - -DEFUN (warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ -@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ -@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ -Format the optional arguments under the control of the template string\n\ -@var{template} using the same rules as the @code{printf} family of\n\ -functions (@pxref{Formatted Output}) and print the resulting message\n\ -on the @code{stderr} stream. The message is prefixed by the character\n\ -string @samp{warning: }.\n\ -You should use this function when you want to notify the user\n\ -of an unusual condition, but only when it makes sense for your program\n\ -to go on.\n\ -\n\ -The optional message identifier allows users to enable or disable\n\ -warnings tagged by @var{id}. The special identifier @samp{\"all\"} may\n\ -be used to set the state of all warnings.\n\ -\n\ -If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ -of a particular warning using the identifier @var{id}. If the first\n\ -argument is @samp{\"query\"}, query the state of this warning instead.\n\ -If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ -you set the state of a warning to @samp{\"error\"}, the warning named by\n\ -@var{id} is handled as if it were an error instead. So, for example, the\n\ -following handles all warnings as errors:\n\ -\n\ -@example\n\ -@group\n\ -warning (\"error\");\n\ -@end group\n\ -@end example\n\ -@seealso{warning_ids}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - int argc = nargin + 1; - - bool done = false; - - if (argc > 1 && args.all_strings_p ()) - { - string_vector argv = args.make_argv ("warning"); - - if (! error_state) - { - std::string arg1 = argv(1); - std::string arg2 = "all"; - - if (argc == 3) - arg2 = argv(2); - - if (arg1 == "on" || arg1 == "off" || arg1 == "error") - { - octave_map old_warning_options = warning_options; - - if (arg2 == "all") - { - octave_map tmp; - - Cell id (1, 1); - Cell st (1, 1); - - id(0) = arg2; - st(0) = arg1; - - // Since internal Octave functions are not - // compatible, turning all warnings into errors - // should leave the state of - // Octave:matlab-incompatible alone. - - if (arg1 == "error" - && warning_options.contains ("identifier")) - { - octave_idx_type n = 1; - - Cell tid = warning_options.contents ("identifier"); - Cell tst = warning_options.contents ("state"); - - for (octave_idx_type i = 0; i < tid.numel (); i++) - { - octave_value vid = tid(i); - - if (vid.is_string ()) - { - std::string key = vid.string_value (); - - if (key == "Octave:matlab-incompatible" - || key == "Octave:single-quote-string") - { - id.resize (dim_vector (1, n+1)); - st.resize (dim_vector (1, n+1)); - - id(n) = tid(i); - st(n) = tst(i); - - n++; - } - } - } - } - - tmp.assign ("identifier", id); - tmp.assign ("state", st); - - warning_options = tmp; - - done = true; - } - else if (arg2 == "backtrace") - { - if (arg1 != "error") - { - Vbacktrace_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "debug") - { - if (arg1 != "error") - { - Vdebug_on_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "verbose") - { - if (arg1 != "error") - { - Vverbose_warning = (arg1 == "on"); - done = true; - } - } - else if (arg2 == "quiet") - { - if (arg1 != "error") - { - Vquiet_warning = (arg1 == "on"); - done = true; - } - } - else - { - if (arg2 == "last") - arg2 = Vlast_warning_id; - - if (arg2 == "all") - initialize_warning_options (arg1); - else - { - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == arg2) - { - // FIXME -- if state for "all" is - // same as arg1, we can simply remove the - // item from the list. - - state(i) = arg1; - warning_options.assign ("state", state); - found = true; - break; - } - } - - if (! found) - { - // FIXME -- if state for "all" is - // same as arg1, we don't need to do anything. - - ident.resize (dim_vector (1, nel+1)); - state.resize (dim_vector (1, nel+1)); - - ident(nel) = arg2; - state(nel) = arg1; - - warning_options.clear (); - - warning_options.assign ("identifier", ident); - warning_options.assign ("state", state); - } - } - - done = true; - } - - if (done && nargout > 0) - retval = old_warning_options; - } - else if (arg1 == "query") - { - if (arg2 == "all") - retval = warning_options; - else if (arg2 == "backtrace" || arg2 == "debug" - || arg2 == "verbose" || arg2 == "quiet") - { - octave_scalar_map tmp; - tmp.assign ("identifier", arg2); - if (arg2 == "backtrace") - tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); - else if (arg2 == "debug") - tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); - else if (arg2 == "verbose") - tmp.assign ("state", Vverbose_warning ? "on" : "off"); - else - tmp.assign ("state", Vquiet_warning ? "on" : "off"); - - retval = tmp; - } - else - { - if (arg2 == "last") - arg2 = Vlast_warning_id; - - Cell ident = warning_options.contents ("identifier"); - Cell state = warning_options.contents ("state"); - - octave_idx_type nel = ident.numel (); - - bool found = false; - - std::string val; - - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == arg2) - { - val = state(i).string_value (); - found = true; - break; - } - } - - if (! found) - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (ident(i).string_value () == "all") - { - val = state(i).string_value (); - found = true; - break; - } - } - } - - if (found) - { - octave_scalar_map tmp; - - tmp.assign ("identifier", arg2); - tmp.assign ("state", val); - - retval = tmp; - } - else - error ("warning: unable to find default warning state!"); - } - - done = true; - } - } - } - else if (argc == 1) - { - retval = warning_options; - - done = true; - } - else if (argc == 2) - { - octave_value arg = args(0); - - octave_map old_warning_options = warning_options; - - if (arg.is_map ()) - { - octave_map m = arg.map_value (); - - if (m.contains ("identifier") && m.contains ("state")) - warning_options = m; - else - error ("warning: expecting structure with fields `identifier' and `state'"); - - done = true; - - if (nargout > 0) - retval = old_warning_options; - } - } - - if (! (error_state || done)) - { - octave_value_list nargs = args; - - std::string id; - - bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); - - if (error_state) - return retval; - - std::string prev_msg = Vlast_warning_message; - - std::string curr_msg = handle_message (warning_with_id, id.c_str (), - "unspecified warning", nargs, - have_fmt); - - if (nargout > 0) - retval = prev_msg; - } - - return retval; -} - -octave_value_list -set_warning_state (const std::string& id, const std::string& state) -{ - octave_value_list args; - - args(1) = id; - args(0) = state; - - return Fwarning (args, 1); -} - -octave_value_list -set_warning_state (const octave_value_list& args) -{ - return Fwarning (args, 1); -} - -void -disable_warning (const std::string& id) -{ - set_warning_state (id, "off"); -} - -void -initialize_default_warning_state (void) -{ - initialize_warning_options ("on"); - - // Most people will want to have the following disabled. - - disable_warning ("Octave:array-to-scalar"); - disable_warning ("Octave:array-to-vector"); - disable_warning ("Octave:imag-to-real"); - disable_warning ("Octave:matlab-incompatible"); - disable_warning ("Octave:missing-semicolon"); - disable_warning ("Octave:neg-dim-as-zero"); - disable_warning ("Octave:resize-on-range-error"); - disable_warning ("Octave:separator-insert"); - disable_warning ("Octave:single-quote-string"); - disable_warning ("Octave:str-to-num"); - disable_warning ("Octave:mixed-string-concat"); - disable_warning ("Octave:variable-switch-label"); - - // This should be an error unless we are in maximum braindamage mode. - // FIXME: Not quite right. This sets the error state even for braindamage - // mode. Also, this error is not triggered in normal mode because another - // error handler catches it first and gives: - // error: subscript indices must be either positive integers or logicals - set_warning_state ("Octave:noninteger-range-as-index", "error"); - -} - -DEFUN (lasterror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ -@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ -@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ -Query or set the last error message structure. When called without\n\ -arguments, return a structure containing the last error message and other\n\ -information related to this error. The elements of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'message'\n\ -The text of the last error message\n\ -\n\ -@item 'identifier'\n\ -The message identifier of this error message\n\ -\n\ -@item 'stack'\n\ -A structure containing information on where the message occurred. This may\n\ -be an empty structure if the information cannot\n\ -be obtained. The fields of the structure are:\n\ -\n\ -@table @asis\n\ -@item 'file'\n\ -The name of the file where the error occurred\n\ -\n\ -@item 'name'\n\ -The name of function in which the error occurred\n\ -\n\ -@item 'line'\n\ -The line number at which the error occurred\n\ -\n\ -@item 'column'\n\ -An optional field with the column number at which the error occurred\n\ -@end table\n\ -@end table\n\ -\n\ -The last error structure may be set by passing a scalar structure, @var{err},\n\ -as input. Any fields of @var{err} that match those above are set while any\n\ -unspecified fields are initialized with default values.\n\ -\n\ -If @code{lasterror} is called with the argument \"reset\", all fields are\n\ -set to their default values.\n\ -@seealso{lasterr}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - if (nargin < 2) - { - octave_scalar_map err; - - err.assign ("message", Vlast_error_message); - err.assign ("identifier", Vlast_error_id); - - err.assign ("stack", octave_value (Vlast_error_stack)); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - if (args(0).string_value () == "reset") - { - Vlast_error_message = std::string (); - Vlast_error_id = std::string (); - - Vlast_error_stack = initialize_last_error_stack (); - } - else - error ("lasterror: unrecognized string argument"); - } - else if (args(0).is_map ()) - { - octave_scalar_map new_err = args(0).scalar_map_value (); - std::string new_error_message; - std::string new_error_id; - std::string new_error_file; - std::string new_error_name; - int new_error_line = -1; - int new_error_column = -1; - - if (! error_state && new_err.contains ("message")) - { - const std::string tmp = - new_err.getfield ("message").string_value (); - new_error_message = tmp; - } - - if (! error_state && new_err.contains ("identifier")) - { - const std::string tmp = - new_err.getfield ("identifier").string_value (); - new_error_id = tmp; - } - - if (! error_state && new_err.contains ("stack")) - { - octave_scalar_map new_err_stack = - new_err.getfield ("stack").scalar_map_value (); - - if (! error_state && new_err_stack.contains ("file")) - { - const std::string tmp = - new_err_stack.getfield ("file").string_value (); - new_error_file = tmp; - } - - if (! error_state && new_err_stack.contains ("name")) - { - const std::string tmp = - new_err_stack.getfield ("name").string_value (); - new_error_name = tmp; - } - - if (! error_state && new_err_stack.contains ("line")) - { - const int tmp = - new_err_stack.getfield ("line").nint_value (); - new_error_line = tmp; - } - - if (! error_state && new_err_stack.contains ("column")) - { - const int tmp = - new_err_stack.getfield ("column").nint_value (); - new_error_column = tmp; - } - } - - if (! error_state) - { - Vlast_error_message = new_error_message; - Vlast_error_id = new_error_id; - - octave_idx_type curr_frame = -1; - - Vlast_error_stack - = octave_call_stack::backtrace (0, curr_frame); - } - } - else - error ("lasterror: argument must be a structure or a string"); - } - - if (! error_state) - retval = err; - } - else - print_usage (); - - return retval; -} - -DEFUN (lasterr, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ -@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ -Query or set the last error message. When called without input arguments,\n\ -return the last error message and message identifier. With one\n\ -argument, set the last error message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@seealso{lasterror}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - frame.protect_var (error_state); - error_state = 0; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lasterr"); - - if (! error_state) - { - std::string prev_error_id = Vlast_error_id; - std::string prev_error_message = Vlast_error_message; - - if (argc > 2) - Vlast_error_id = argv(2); - - if (argc > 1) - Vlast_error_message = argv(1); - - if (argc == 1 || nargout > 0) - { - retval(1) = prev_error_id; - retval(0) = prev_error_message; - } - } - else - error ("lasterr: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (lastwarn, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\ -Without any arguments, return the last warning message. With one\n\ -argument, set the last warning message to @var{msg}. With two arguments,\n\ -also set the last message identifier.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - if (argc < 4) - { - string_vector argv = args.make_argv ("lastwarn"); - - if (! error_state) - { - std::string prev_warning_id = Vlast_warning_id; - std::string prev_warning_message = Vlast_warning_message; - - if (argc > 2) - Vlast_warning_id = argv(2); - - if (argc > 1) - Vlast_warning_message = argv(1); - - if (argc == 1 || nargout > 0) - { - warning_state = 0; - retval(1) = prev_warning_id; - retval(0) = prev_warning_message; - } - } - else - error ("lastwarn: expecting arguments to be character strings"); - } - else - print_usage (); - - return retval; -} - -DEFUN (usage, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usage (@var{msg})\n\ -Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ -set Octave's internal error state such that control will return to the\n\ -top level without evaluating any more commands. This is useful for\n\ -aborting from functions.\n\ -\n\ -After @code{usage} is evaluated, Octave will print a traceback of all\n\ -the function calls leading to the usage message.\n\ -\n\ -You should use this function for reporting problems errors that result\n\ -from an improper call to a function, such as calling a function with an\n\ -incorrect number of arguments, or with arguments of the wrong type. For\n\ -example, most functions distributed with Octave begin with code like\n\ -this\n\ -\n\ -@example\n\ -@group\n\ -if (nargin != 2)\n\ - usage (\"foo (a, b)\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -to check for the proper number of arguments.\n\ -@end deftypefn") -{ - octave_value_list retval; - handle_message (usage_with_id, "", "unknown", args, true); - return retval; -} - -DEFUN (beep_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to ring the terminal bell before printing an error message.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (beep_on_error); -} - -DEFUN (debug_on_error, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when an error is encountered. This will also\n\ -inhibit printing of the normal traceback message (you will only see\n\ -the top-level error message).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_error); -} - -DEFUN (debug_on_warning, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter the debugger when a warning is encountered.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_warning); -} - -std::string -last_error_message (void) -{ - return Vlast_error_message; -} - -std::string -last_error_id (void) -{ - return Vlast_error_id; -} - -std::string -last_warning_message (void) -{ - return Vlast_warning_message; -} - -std::string -last_warning_id (void) -{ - return Vlast_warning_id; -} - -void -interpreter_try (unwind_protect& frame) -{ - frame.protect_var (error_state); - frame.protect_var (buffer_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - buffer_error_messages++; - Vdebug_on_error = false; - Vdebug_on_warning = false; -} - - diff -r 069c552587a0 -r 959953dba519 src/error.h --- a/src/error.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,142 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_error_h) -#define octave_error_h 1 - -#include -#include - -class octave_value_list; -class unwind_protect; - -#define panic_impossible() \ - panic ("impossible state reached in file `%s' at line %d", \ - __FILE__, __LINE__) - -extern OCTINTERP_API void reset_error_handler (void); - -extern OCTINTERP_API int warning_enabled (const std::string& id); - -extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); -extern OCTINTERP_API void message (const char *name, const char *fmt, ...); - -extern OCTINTERP_API void vusage (const char *fmt, va_list args); -extern OCTINTERP_API void usage (const char *fmt, ...); - -extern OCTINTERP_API void vwarning (const char *fmt, va_list args); -extern OCTINTERP_API void warning (const char *fmt, ...); - -extern OCTINTERP_API void verror (const char *fmt, va_list args); -extern OCTINTERP_API void error (const char *fmt, ...); - -extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); -extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); - -extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); -extern OCTINTERP_API void parse_error (const char *fmt, ...); - -extern OCTINTERP_API void -vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); - -extern OCTINTERP_API void -message_with_id (const char *id, const char *name, const char *fmt, ...); - -extern OCTINTERP_API void -vusage_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -usage_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vwarning_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -warning_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -verror_with_id_cfn (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -error_with_id_cfn (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void -vparse_error_with_id (const char *id, const char *fmt, va_list args); - -extern OCTINTERP_API void -parse_error_with_id (const char *id, const char *fmt, ...); - -extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; - -// Helper function for print_usage defined in defun.cc. -extern OCTINTERP_API void defun_usage_message (const std::string& msg); - -extern OCTINTERP_API octave_value_list -set_warning_state (const std::string& id, const std::string& state); - -extern OCTINTERP_API octave_value_list -set_warning_state (const octave_value_list& args); - -extern OCTINTERP_API void disable_warning (const std::string& id); -extern OCTINTERP_API void initialize_default_warning_state (void); - -// TRUE means that Octave will try to enter the debugger when an error -// is encountered. This will also inhibit printing of the normal -// traceback message (you will only see the top-level error message). -extern OCTINTERP_API bool Vdebug_on_error; - -// TRUE means that Octave will try to enter the debugger when a warning -// is encountered. -extern OCTINTERP_API bool Vdebug_on_warning; - -// Current error state. -extern OCTINTERP_API int error_state; - -// Current warning state. -extern OCTINTERP_API int warning_state; - -// Tell the error handler whether to print messages, or just store -// them for later. Used for handling errors in eval() and -// the `unwind_protect' statement. -extern OCTINTERP_API int buffer_error_messages; - -// TRUE means error messages are turned off. -extern OCTINTERP_API bool discard_error_messages; - -// TRUE means warning messages are turned off. -extern OCTINTERP_API bool discard_warning_messages; - -// Helper functions to pass last error and warning messages and ids -extern OCTINTERP_API std::string last_error_message (void); -extern OCTINTERP_API std::string last_error_id (void); -extern OCTINTERP_API std::string last_warning_message (void); -extern OCTINTERP_API std::string last_warning_id (void); - -extern OCTINTERP_API void interpreter_try (unwind_protect&); - -#endif diff -r 069c552587a0 -r 959953dba519 src/file-io.cc --- a/src/file-io.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2335 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -// Originally written by John C. Campbell -// -// Thomas Baier added the original versions of -// the following functions: -// -// popen -// pclose -// execute (now popen2.m) -// sync_system (now merged with system) -// async_system (now merged with system) - -// Extensively revised by John W. Eaton , -// April 1996. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include -#include -#include - -#ifdef HAVE_ZLIB_H -#include -#endif - -#include "error.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-ieee.h" -#include "oct-env.h" -#include "oct-locbuf.h" - -#include "defun.h" -#include "file-io.h" -#include "load-path.h" -#include "oct-fstrm.h" -#include "oct-iostrm.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-prcstrm.h" -#include "oct-stream.h" -#include "oct-strstrm.h" -#include "pager.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" - -static octave_value stdin_file; -static octave_value stdout_file; -static octave_value stderr_file; - -static octave_stream stdin_stream; -static octave_stream stdout_stream; -static octave_stream stderr_stream; - -void -initialize_file_io (void) -{ - stdin_stream = octave_istream::create (&std::cin, "stdin"); - - // This uses octave_stdout (see pager.h), not std::cout so that Octave's - // standard output stream will pass through the pager. - - stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); - - stderr_stream = octave_ostream::create (&std::cerr, "stderr"); - - stdin_file = octave_stream_list::insert (stdin_stream); - stdout_file = octave_stream_list::insert (stdout_stream); - stderr_file = octave_stream_list::insert (stderr_stream); -} - -void -close_files (void) -{ - octave_stream_list::clear (); -} - -// List of files to delete when we exit or crash. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack tmp_files; - -void -mark_for_deletion (const std::string& file) -{ - tmp_files.push (file); -} - -void -cleanup_tmp_files (void) -{ - while (! tmp_files.empty ()) - { - std::string filename = tmp_files.top (); - tmp_files.pop (); - gnulib::unlink (filename.c_str ()); - } -} - -static std::ios::openmode -fopen_mode_to_ios_mode (const std::string& mode_arg) -{ - std::ios::openmode retval = std::ios::in; - - if (! mode_arg.empty ()) - { - // Could probably be faster, but does it really matter? - - std::string mode = mode_arg; - - // 'W' and 'R' are accepted as 'w' and 'r', but we warn about - // them because Matlab says they perform "automatic flushing" - // but we don't know precisely what action that implies. - - size_t pos = mode.find ('W'); - - if (pos != std::string::npos) - { - warning ("fopen: treating mode \"W\" as equivalent to \"w\""); - mode[pos] = 'w'; - } - - pos = mode.find ('R'); - - if (pos != std::string::npos) - { - warning ("fopen: treating mode \"R\" as equivalent to \"r\""); - mode[pos] = 'r'; - } - - pos = mode.find ('z'); - - if (pos != std::string::npos) - { -#if defined (HAVE_ZLIB) - mode.erase (pos, 1); -#else - error ("this version of Octave does not support gzipped files"); -#endif - } - - if (! error_state) - { - if (mode == "rt") - retval = std::ios::in; - else if (mode == "wt") - retval = std::ios::out | std::ios::trunc; - else if (mode == "at") - retval = std::ios::out | std::ios::app; - else if (mode == "r+t" || mode == "rt+") - retval = std::ios::in | std::ios::out; - else if (mode == "w+t" || mode == "wt+") - retval = std::ios::in | std::ios::out | std::ios::trunc; - else if (mode == "a+t" || mode == "at+") - retval = std::ios::in | std::ios::out | std::ios::app; - else if (mode == "rb" || mode == "r") - retval = std::ios::in | std::ios::binary; - else if (mode == "wb" || mode == "w") - retval = std::ios::out | std::ios::trunc | std::ios::binary; - else if (mode == "ab" || mode == "a") - retval = std::ios::out | std::ios::app | std::ios::binary; - else if (mode == "r+b" || mode == "rb+" || mode == "r+") - retval = std::ios::in | std::ios::out | std::ios::binary; - else if (mode == "w+b" || mode == "wb+" || mode == "w+") - retval = (std::ios::in | std::ios::out | std::ios::trunc - | std::ios::binary); - else if (mode == "a+b" || mode == "ab+" || mode == "a+") - retval = (std::ios::in | std::ios::out | std::ios::app - | std::ios::binary); - else - ::error ("invalid mode specified"); - } - } - - return retval; -} - -DEFUN (fclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ -@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ -Close the specified file. If successful, @code{fclose} returns 0,\n\ -otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ -all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ -@seealso{fopen, freport}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "fclose"); - else - print_usage (); - - return retval; -} - -DEFUN (fclear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ -Clear the stream state for the specified file.\n\ -@seealso{fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fclear"); - - if (! error_state) - os.clearerr (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fflush, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ -Flush output to @var{fid}. This is useful for ensuring that all\n\ -pending output makes it to the screen before some other event occurs.\n\ -For example, it is always a good idea to flush the standard output\n\ -stream before calling @code{input}.\n\ -\n\ -@code{fflush} returns 0 on success and an OS dependent error value\n\ -(@minus{}1 on Unix) on error.\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - // FIXME -- any way to avoid special case for stdout? - - int fid = octave_stream_list::get_file_number (args (0)); - - if (fid == 1) - { - flush_octave_stdout (); - - retval = 0; - } - else - { - octave_stream os = octave_stream_list::lookup (fid, "fflush"); - - if (! error_state) - retval = os.flush (); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgetl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, excluding\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ -\n\ -To read a line and return the terminating newline see @code{fgets}.\n\ -@seealso{fgets, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgetl"; - - octave_value_list retval; - - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.getl (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fgets, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ -Read characters from a file, stopping after a newline, or EOF,\n\ -or @var{len} characters have been read. The characters read, including\n\ -the possible trailing newline, are returned as a string.\n\ -\n\ -If @var{len} is omitted, @code{fgets} reads until the next newline\n\ -character.\n\ -\n\ -If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ -\n\ -To read a line and discard the terminating newline see @code{fgetl}.\n\ -@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fgets"; - - octave_value_list retval; - - retval(1) = 0.0; - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - std::string tmp = os.gets (len_arg, err, who); - - if (! (error_state || err)) - { - retval(1) = tmp.length (); - retval(0) = tmp; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fskipl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ -@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ -Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ -@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ -@var{count}-times, or until the end-of-file marker is found.\n\ -\n\ -If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ -@code{Inf}, in which case lines are skipped until the end of the file.\n\ -This form is suitable for counting the number of lines in a file.\n\ -\n\ -Returns the number of lines skipped (end-of-line sequences encountered).\n\ -@seealso{fgetl, fgets, fscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fskipl"; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); - - bool err = false; - - long tmp = os.skipl (count_arg, err, who); - - if (! (error_state || err)) - retval = tmp; - } - } - else - print_usage (); - - return retval; -} - - -static octave_stream -do_stream_open (const std::string& name, const std::string& mode, - const std::string& arch, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::ios::openmode md = fopen_mode_to_ios_mode (mode); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt = - oct_mach_info::string_to_float_format (arch); - - if (! error_state) - { - std::string fname = file_ops::tilde_expand (name); - - file_stat fs (fname); - - if (! (md & std::ios::out - || octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - if (! fs.exists ()) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:fopen-file-in-path", - "fopen: file found in load path"); - fname = tmp; - } - } - } - - if (! fs.is_dir ()) - { - std::string tmode = mode; - - // Use binary mode if 't' is not specified, but don't add - // 'b' if it is already present. - - size_t bpos = tmode.find ('b'); - size_t tpos = tmode.find ('t'); - - if (bpos == std::string::npos && tpos == std::string::npos) - tmode += 'b'; - -#if defined (HAVE_ZLIB) - size_t pos = tmode.find ('z'); - - if (pos != std::string::npos) - { - tmode.erase (pos, 1); - - FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); - - int fd = fileno (fptr); - - gzFile gzf = ::gzdopen (fd, tmode.c_str ()); - - if (fptr) - retval = octave_zstdiostream::create (fname, gzf, fd, - md, flt_fmt); - else - retval.error (gnulib::strerror (errno)); - } - else -#endif - { - FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); - - retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); - - if (! fptr) - retval.error (gnulib::strerror (errno)); - } - - } - } - } - - return retval; -} - -static octave_stream -do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, - const octave_value& tc_arch, const char *fcn, int& fid) -{ - octave_stream retval; - - fid = -1; - - std::string name = tc_name.string_value (); - - if (! error_state) - { - std::string mode = tc_mode.string_value (); - - if (! error_state) - { - std::string arch = tc_arch.string_value (); - - if (! error_state) - retval = do_stream_open (name, mode, arch, fid); - else - ::error ("%s: architecture type must be a string", fcn); - } - else - ::error ("%s: file mode must be a string", fcn); - } - else - ::error ("%s: file name must be a string", fcn); - - return retval; -} - -DEFUN (fopen, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ -@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ -@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ -The first form of the @code{fopen} function opens the named file with\n\ -the specified mode (read-write, read-only, etc.) and architecture\n\ -interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ -an integer value that may be used to refer to the file later. If an\n\ -error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ -corresponding system error message. The @var{mode} is a one or two\n\ -character string that specifies whether the file is to be opened for\n\ -reading, writing, or both.\n\ -\n\ -The second form of the @code{fopen} function returns a vector of file ids\n\ -corresponding to all the currently open files, excluding the\n\ -@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ -\n\ -The third form of the @code{fopen} function returns information about the\n\ -open file given its file id.\n\ -\n\ -For example,\n\ -\n\ -@example\n\ -myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ -@end example\n\ -\n\ -@noindent\n\ -opens the file @file{splat.dat} for reading. If necessary, binary\n\ -numeric values will be read assuming they are stored in IEEE format with\n\ -the least significant bit first, and then converted to the native\n\ -representation.\n\ -\n\ -Opening a file that is already open simply opens it again and returns a\n\ -separate file id. It is not an error to open a file several times,\n\ -though writing to the same file through several different file ids may\n\ -produce unexpected results.\n\ -\n\ -The possible values @samp{mode} may have are\n\ -\n\ -@table @asis\n\ -@item @samp{r}\n\ -Open a file for reading.\n\ -\n\ -@item @samp{w}\n\ -Open a file for writing. The previous contents are discarded.\n\ -\n\ -@item @samp{a}\n\ -Open or create a file for writing at the end of the file.\n\ -\n\ -@item @samp{r+}\n\ -Open an existing file for reading and writing.\n\ -\n\ -@item @samp{w+}\n\ -Open a file for reading or writing. The previous contents are\n\ -discarded.\n\ -\n\ -@item @samp{a+}\n\ -Open or create a file for reading or writing at the end of the\n\ -file.\n\ -@end table\n\ -\n\ -Append a \"t\" to the mode string to open the file in text mode or a\n\ -\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ -mode reading and writing automatically converts linefeeds to the\n\ -appropriate line end character for the system (carriage-return linefeed\n\ -on Windows, carriage-return on Macintosh). The default if no mode is\n\ -specified is binary mode.\n\ -\n\ -Additionally, you may append a \"z\" to the mode string to open a\n\ -gzipped file for reading or writing. For this to be successful, you\n\ -must also open the file in binary mode.\n\ -\n\ -The parameter @var{arch} is a string specifying the default data format\n\ -for the file. Valid values for @var{arch} are:\n\ -\n\ -@table @asis\n\ -@samp{native}\n\ -The format of the current machine (this is the default).\n\ -\n\ -@samp{ieee-be}\n\ -IEEE big endian format.\n\ -\n\ -@samp{ieee-le}\n\ -IEEE little endian format.\n\ -\n\ -@samp{vaxd}\n\ -VAX D floating format.\n\ -\n\ -@samp{vaxg}\n\ -VAX G floating format.\n\ -\n\ -@samp{cray}\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -however, conversions are currently only supported for @samp{native}\n\ -@samp{ieee-be}, and @samp{ieee-le} formats.\n\ -@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(0) = -1.0; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - // If there is only one argument and it is a string but it - // is not the string "all", we assume it is a file to open - // with MODE = "r". To open a file called "all", you have - // to supply more than one argument. - - if (nargout < 2 && args(0).string_value () == "all") - return octave_stream_list::open_file_numbers (); - } - else - { - string_vector tmp = octave_stream_list::get_info (args(0)); - - if (! error_state) - { - retval(2) = tmp(2); - retval(1) = tmp(1); - retval(0) = tmp(0); - } - - return retval; - } - } - - if (nargin > 0 && nargin < 4) - { - octave_value mode = (nargin == 2 || nargin == 3) - ? args(1) : octave_value ("r"); - - octave_value arch = (nargin == 3) - ? args(2) : octave_value ("native"); - - int fid = -1; - - octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); - - if (os && ! error_state) - { - retval(1) = ""; - retval(0) = octave_stream_list::insert (os); - } - else - { - int error_number = 0; - - retval(1) = os.error (false, error_number); - retval(0) = -1.0; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (freport, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} freport ()\n\ -Print a list of which files have been opened, and whether they are open\n\ -for reading, writing, or both. For example:\n\ -\n\ -@example\n\ -@group\n\ -freport ()\n\ -\n\ - @print{} number mode name\n\ - @print{}\n\ - @print{} 0 r stdin\n\ - @print{} 1 w stdout\n\ - @print{} 2 w stderr\n\ - @print{} 3 r myfile\n\ -@end group\n\ -@end example\n\ -@seealso{fopen, fclose}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - warning ("freport: ignoring extra arguments"); - - octave_stdout << octave_stream_list::list_open_files (); - - return retval; -} - -DEFUN (frewind, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ -Move the file pointer to the beginning of the file @var{fid}, returning\n\ -0 for success, and -1 if an error was encountered. It is equivalent to\n\ -@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ -@seealso{fseek, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "frewind"); - - if (! error_state) - result = os.rewind (); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fseek, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ -@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ -@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ -Set the file pointer to any location within the file @var{fid}.\n\ -\n\ -The pointer is positioned @var{offset} characters from the @var{origin},\n\ -which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ -position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ -file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ -@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ -\n\ -Return 0 on success and -1 on error.\n\ -@seealso{fskipl, frewind, ftell, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), "fseek"); - - if (! error_state) - { - octave_value origin_arg = (nargin == 3) - ? args(2) : octave_value (-1.0); - - retval = os.seek (args(1), origin_arg); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (ftell, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ -Return the position of the file pointer as the number of characters\n\ -from the beginning of the file @var{fid}.\n\ -@seealso{fseek, feof, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "ftell"); - - if (! error_state) - retval = os.tell (); - } - else - print_usage (); - - return retval; -} - -DEFUN (fprintf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ -This function is just like @code{printf}, except that the output is\n\ -written to the stream @var{fid} instead of @code{stdout}.\n\ -If @var{fid} is omitted, the output is written to @code{stdout}.\n\ -@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fprintf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 1 || (nargin > 0 && args(0).is_string ())) - { - octave_stream os; - int fmt_n = 0; - - if (args(0).is_string ()) - { - os = octave_stream_list::lookup (1, who); - } - else - { - fmt_n = 1; - os = octave_stream_list::lookup (args(0), who); - } - - if (! error_state) - { - if (args(fmt_n).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1 + fmt_n) - { - tmp_args.resize (nargin-fmt_n-1, octave_value ()); - - for (int i = fmt_n + 1; i < nargin; i++) - tmp_args(i-fmt_n-1) = args(i); - } - - result = os.printf (args(fmt_n), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (printf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ -Print optional arguments under the control of the template string\n\ -@var{template} to the stream @code{stdout} and return the number of\n\ -characters printed.\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Output section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fprintf, sprintf, scanf}\n\ -@end deftypefn") -{ - static std::string who = "printf"; - - octave_value retval; - - int result = -1; - - int nargin = args.length (); - - if (nargin > 0) - { - if (args(0).is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - result = stdout_stream.printf (args(0), tmp_args, who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - print_usage (); - - if (nargout > 0) - retval = result; - - return retval; -} - -DEFUN (fputs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ -Write a string to a file with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fdisp, fprintf, fwrite, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fputs"; - - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - retval = os.puts (args(1), who); - } - else - print_usage (); - - return retval; -} - -DEFUN (puts, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} puts (@var{string})\n\ -Write a string to the standard output with no formatting.\n\ -\n\ -Return a non-negative number on success and EOF on error.\n\ -@seealso{fputs, disp}\n\ -@end deftypefn") -{ - static std::string who = "puts"; - - octave_value retval = -1; - - if (args.length () == 1) - retval = stdout_stream.puts (args(0), who); - else - print_usage (); - - return retval; -} - -DEFUN (sprintf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ -This is like @code{printf}, except that the output is returned as a\n\ -string. Unlike the C library function, which requires you to provide a\n\ -suitably sized string as an argument, Octave's @code{sprintf} function\n\ -returns the string, automatically sized to hold all of the items\n\ -converted.\n\ -@seealso{printf, fprintf, sscanf}\n\ -@end deftypefn") -{ - static std::string who = "sprintf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - retval(2) = -1.0; - retval(1) = "unknown error"; - retval(0) = ""; - - octave_ostrstream *ostr = new octave_ostrstream (); - - octave_stream os (ostr); - - if (os.is_valid ()) - { - octave_value fmt_arg = args(0); - - if (fmt_arg.is_string ()) - { - octave_value_list tmp_args; - - if (nargin > 1) - { - tmp_args.resize (nargin-1, octave_value ()); - - for (int i = 1; i < nargin; i++) - tmp_args(i-1) = args(i); - } - - retval(2) = os.printf (fmt_arg, tmp_args, who); - retval(1) = os.error (); - retval(0) = octave_value (ostr->str (), - fmt_arg.is_sq_string () ? '\'' : '"'); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create output buffer", who.c_str ()); - } - else - print_usage (); - - return retval; -} - -DEFUN (fscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{locale})\n\ -In the first form, read from @var{fid} according to @var{template},\n\ -returning the result in the matrix @var{val}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -A string is returned if @var{template} specifies only character\n\ -conversions.\n\ -\n\ -The number of items successfully read is returned in @var{count}.\n\ -\n\ -If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ -\n\ -In the second form, read from @var{fid} according to @var{template},\n\ -with each conversion specifier in @var{template} corresponding to a\n\ -single scalar return value. This form is more `C-like', and also\n\ -compatible with previous versions of Octave. The number of successful\n\ -conversions is returned in @var{count}. It permits to explicitly\n\ -specify a locale to take into account language specific features, \n\ -such as decimal separator. This operation restores the previous locales\n\ -setting at the end of the conversion.\n\ -@ifclear OCTAVE_MANUAL\n\ -\n\ -See the Formatted Input section of the GNU Octave manual for a\n\ -complete description of the syntax of the template string.\n\ -@end ifclear\n\ -@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ -@end deftypefn") -{ - static std::string who = "fscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - { - std::locale oldloc; - try - { - // Use args(2) val as the new locale setting. Keep - // old val for restoring afterwards. - oldloc = - os.imbue (std::locale (args(2).string_value ().c_str ())); - - } - catch (std::runtime_error) - { - // Display a warning if the specified locale is unknown - warning ("fscanf: invalid locale. Try `locale -a' for a list of supported values."); - oldloc = std::locale::classic (); - } - retval = os.oscanf (args(1), who); - os.imbue (oldloc); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - } - else - { - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - if (nargin == 2 || nargin == 3) - { - octave_stream os = octave_stream_list::lookup (args(0), who); - - if (! error_state) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), lo_ieee_inf_value ()); - - if (! error_state) - { - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - retval(2) = os.error (); - retval(1) = count; - retval(0) = tmp; - } - } - } - else - ::error ("%s: format must be a string", who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -static std::string -get_sscanf_data (const octave_value& val) -{ - std::string retval; - - if (val.is_string ()) - { - octave_value tmp = val.reshape (dim_vector (1, val.numel ())); - - retval = tmp.string_value (); - } - else - ::error ("sscanf: argument STRING must be a string"); - - return retval; -} - -DEFUN (sscanf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, @var{locale})\n\ -This is like @code{fscanf}, except that the characters are taken from the\n\ -string @var{string} instead of from a stream. Reaching the end of the\n\ -string is treated as an end-of-file condition. In addition to the values\n\ -returned by @code{fscanf}, the index of the next character to be read\n\ -is returned in @var{pos}.\n\ -@seealso{fscanf, scanf, sprintf}\n\ -@end deftypefn") -{ - static std::string who = "sscanf"; - - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3 && args(2).is_string ()) - { - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - { - // Use args(2) val as the new locale setting. As the os - // object is short lived, we don't need to restore - // locale afterwards. - try - { - os.imbue (std::locale (args(2).string_value ().c_str ())); - } - catch (std::runtime_error) - { - // Display a warning if the specified locale is unknown - warning ("sscanf: invalid locale. Try `locale -a' for a list of supported values."); - } - retval = os.oscanf (args(1), who); - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - else - ::error ("%s: argument STRING must be a string", who.c_str ()); - } - else - { - if (nargin == 2 || nargin == 3) - { - retval(3) = -1.0; - retval(2) = "unknown error"; - retval(1) = 0.0; - retval(0) = Matrix (); - - std::string data = get_sscanf_data (args(0)); - - if (! error_state) - { - octave_stream os = octave_istrstream::create (data); - - if (os.is_valid ()) - { - if (args(1).is_string ()) - { - octave_idx_type count = 0; - - Array size = (nargin == 3) - ? args(2).vector_value () - : Array (dim_vector (1, 1), - lo_ieee_inf_value ()); - - octave_value tmp = os.scanf (args(1), size, count, who); - - if (! error_state) - { - // FIXME -- is this the right thing to do? - // Extract error message first, because getting - // position will clear it. - std::string errmsg = os.error (); - - retval(3) - = (os.eof () ? data.length () : os.tell ()) + 1; - retval(2) = errmsg; - retval(1) = count; - retval(0) = tmp; - } - } - else - ::error ("%s: format TEMPLATE must be a string", who.c_str ()); - } - else - ::error ("%s: unable to create temporary input buffer", - who.c_str ()); - } - } - else - print_usage (); - } - - return retval; -} - -/* -%!test -%! assert (sscanf ("1,2", "%f", "C"), 1) -%! assert (sscanf ("1,2", "%f", "fr_FR"), 1.2) -*/ - -DEFUN (scanf, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} scanf (@var{template}, @var{locale})\n\ -This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ -\n\ -It is currently not useful to call @code{scanf} in interactive\n\ -programs.\n\ -@seealso{fscanf, sscanf, printf}\n\ -@end deftypefn") -{ - int nargin = args.length (); - - octave_value_list tmp_args (nargin+1, octave_value ()); - - tmp_args (0) = 0.0; - for (int i = 0; i < nargin; i++) - tmp_args (i+1) = args (i); - - return Ffscanf (tmp_args, nargout); -} - -static octave_value -do_fread (octave_stream& os, const octave_value& size_arg, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg, octave_idx_type& count) -{ - octave_value retval; - - count = -1; - - Array size = size_arg.vector_value (); - - if (! error_state) - { - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type input_type; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, - input_type, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.read (size, block_size, input_type, - output_type, skip, flt_fmt, count); - } - else - ::error ("fread: ARCH architecture type must be a string"); - } - else - ::error ("fread: SKIP must be an integer"); - } - else - ::error ("fread: invalid PRECISION specified"); - } - else - ::error ("fread: PRECISION must be a string"); - } - else - ::error ("fread: invalid SIZE specified"); - - return retval; -} - -DEFUN (fread, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ -Read binary data of type @var{precision} from the specified file ID\n\ -@var{fid}.\n\ -\n\ -The optional argument @var{size} specifies the amount of data to read\n\ -and may be one of\n\ -\n\ -@table @code\n\ -@item Inf\n\ -Read as much as possible, returning a column vector.\n\ -\n\ -@item @var{nr}\n\ -Read up to @var{nr} elements, returning a column vector.\n\ -\n\ -@item [@var{nr}, Inf]\n\ -Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ -number of elements read is not an exact multiple of @var{nr}, the last\n\ -column is padded with zeros.\n\ -\n\ -@item [@var{nr}, @var{nc}]\n\ -Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ -@var{nr} rows. If the number of elements read is not an exact multiple\n\ -of @var{nr}, the last column is padded with zeros.\n\ -@end table\n\ -\n\ -@noindent\n\ -If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ -\n\ -The optional argument @var{precision} is a string specifying the type of\n\ -data to read and may be one of\n\ -\n\ -@table @asis\n\ -@item \"schar\"\n\ -@itemx \"signed char\"\n\ -Signed character.\n\ -\n\ -@item \"uchar\"\n\ -@itemx \"unsigned char\"\n\ -Unsigned character.\n\ -\n\ -@item \"int8\"\n\ -@itemx \"integer*1\"\n\ -\n\ -8-bit signed integer.\n\ -\n\ -@item \"int16\"\n\ -@itemx \"integer*2\"\n\ -16-bit signed integer.\n\ -\n\ -@item \"int32\"\n\ -@itemx \"integer*4\"\n\ -32-bit signed integer.\n\ -\n\ -@item \"int64\"\n\ -@itemx \"integer*8\"\n\ -64-bit signed integer.\n\ -\n\ -@item \"uint8\"\n\ -8-bit unsigned integer.\n\ -\n\ -@item \"uint16\"\n\ -16-bit unsigned integer.\n\ -\n\ -@item \"uint32\"\n\ -32-bit unsigned integer.\n\ -\n\ -@item \"uint64\"\n\ -64-bit unsigned integer.\n\ -\n\ -@item \"single\"\n\ -@itemx \"float32\"\n\ -@itemx \"real*4\"\n\ -32-bit floating point number.\n\ -\n\ -@item \"double\"\n\ -@itemx \"float64\"\n\ -@itemx \"real*8\"\n\ -64-bit floating point number.\n\ -\n\ -@item \"char\"\n\ -@itemx \"char*1\"\n\ -Single character.\n\ -\n\ -@item \"short\"\n\ -Short integer (size is platform dependent).\n\ -\n\ -@item \"int\"\n\ -Integer (size is platform dependent).\n\ -\n\ -@item \"long\"\n\ -Long integer (size is platform dependent).\n\ -\n\ -@item \"ushort\"\n\ -@itemx \"unsigned short\"\n\ -Unsigned short integer (size is platform dependent).\n\ -\n\ -@item \"uint\"\n\ -@itemx \"unsigned int\"\n\ -Unsigned integer (size is platform dependent).\n\ -\n\ -@item \"ulong\"\n\ -@itemx \"unsigned long\"\n\ -Unsigned long integer (size is platform dependent).\n\ -\n\ -@item \"float\"\n\ -Single precision floating point number (size is platform dependent).\n\ -@end table\n\ -\n\ -@noindent\n\ -The default precision is @code{\"uchar\"}.\n\ -\n\ -The @var{precision} argument may also specify an optional repeat\n\ -count. For example, @samp{32*single} causes @code{fread} to read\n\ -a block of 32 single precision floating point numbers. Reading in\n\ -blocks is useful in combination with the @var{skip} argument.\n\ -\n\ -The @var{precision} argument may also specify a type conversion.\n\ -For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ -integer values and return an array of 32-bit integer values. By\n\ -default, @code{fread} returns a double precision array. The special\n\ -form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ -\n\ -The conversion and repeat counts may be combined. For example, the\n\ -specification @samp{32*single=>single} causes @code{fread} to read\n\ -blocks of single precision floating point values and return an array\n\ -of single precision values instead of the default array of double\n\ -precision values.\n\ -\n\ -The optional argument @var{skip} specifies the number of bytes to skip\n\ -after each element (or block of elements) is read. If it is not\n\ -specified, a value of 0 is assumed. If the final block read is not\n\ -complete, the final skip is omitted. For example,\n\ -\n\ -@example\n\ -fread (f, 10, \"3*single=>single\", 8)\n\ -@end example\n\ -\n\ -@noindent\n\ -will omit the final 8-byte skip because the last read will not be\n\ -a complete block of 3 values.\n\ -\n\ -The optional argument @var{arch} is a string specifying the data format\n\ -for the file. Valid values are\n\ -\n\ -@table @code\n\ -@item \"native\"\n\ -The format of the current machine.\n\ -\n\ -@item \"ieee-be\"\n\ -IEEE big endian.\n\ -\n\ -@item \"ieee-le\"\n\ -IEEE little endian.\n\ -\n\ -@item \"vaxd\"\n\ -VAX D floating format.\n\ -\n\ -@item \"vaxg\"\n\ -VAX G floating format.\n\ -\n\ -@item \"cray\"\n\ -Cray floating format.\n\ -@end table\n\ -\n\ -@noindent\n\ -Conversions are currently only supported for @code{\"ieee-be\"} and\n\ -@code{\"ieee-le\"} formats.\n\ -\n\ -The data read from the file is returned in @var{val}, and the number of\n\ -values read is returned in @code{count}\n\ -@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 6) - { - retval(1) = -1.0; - retval(0) = Matrix (); - - octave_stream os = octave_stream_list::lookup (args(0), "fread"); - - if (! error_state) - { - octave_value size = lo_ieee_inf_value (); - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - if (nargin > idx && ! args(idx).is_string ()) - size = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - octave_idx_type count = -1; - - octave_value tmp = do_fread (os, size, prec, skip, arch, count); - - retval(1) = count; - retval(0) = tmp; - } - } - else - print_usage (); - - return retval; -} - -static int -do_fwrite (octave_stream& os, const octave_value& data, - const octave_value& prec_arg, const octave_value& skip_arg, - const octave_value& arch_arg) -{ - int retval = -1; - - std::string prec = prec_arg.string_value (); - - if (! error_state) - { - int block_size = 1; - oct_data_conv::data_type output_type; - - oct_data_conv::string_to_data_type (prec, block_size, output_type); - - if (! error_state) - { - int skip = skip_arg.int_value (true); - - if (! error_state) - { - std::string arch = arch_arg.string_value (); - - if (! error_state) - { - oct_mach_info::float_format flt_fmt - = oct_mach_info::string_to_float_format (arch); - - if (! error_state) - retval = os.write (data, block_size, output_type, - skip, flt_fmt); - } - else - ::error ("fwrite: ARCH architecture type must be a string"); - } - else - ::error ("fwrite: SKIP must be an integer"); - } - else - ::error ("fwrite: invalid PRECISION specified"); - } - else - ::error ("fwrite: PRECISION must be a string"); - - return retval; -} - -DEFUN (fwrite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ -Write data in binary form of type @var{precision} to the specified file\n\ -ID @var{fid}, returning the number of values successfully written to the\n\ -file.\n\ -\n\ -The argument @var{data} is a matrix of values that are to be written to\n\ -the file. The values are extracted in column-major order.\n\ -\n\ -The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ -optional, and are interpreted as described for @code{fread}.\n\ -\n\ -The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ -are too large to fit in the specified precision.\n\ -@seealso{fread, fputs, fprintf, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin > 1 && nargin < 6) - { - octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); - - if (! error_state) - { - octave_value prec = "uchar"; - octave_value skip = 0; - octave_value arch = "unknown"; - - int idx = 1; - - octave_value data = args(idx++); - - if (nargin > idx) - prec = args(idx++); - - if (nargin > idx) - skip = args(idx++); - - if (nargin > idx) - arch = args(idx++); - else if (skip.is_string ()) - { - arch = skip; - skip = 0; - } - - double status = do_fwrite (os, data, prec, skip, arch); - - retval = status; - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("feof", Ffeof, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} feof (@var{fid})\n\ -Return 1 if an end-of-file condition has been encountered for a given\n\ -file and 0 otherwise. Note that it will only return 1 if the end of the\n\ -file has already been encountered, not if the next read operation will\n\ -result in an end-of-file condition.\n\ -@seealso{fread, fopen}\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_stream os = octave_stream_list::lookup (args(0), "feof"); - - if (! error_state) - retval = os.eof () ? 1.0 : 0.0; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("ferror", Fferror, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ -Return 1 if an error condition has been encountered for the file ID\n\ -@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ -has already been encountered, not if the next operation will result in\n\ -an error condition.\n\ -\n\ -The second argument is optional. If it is supplied, also clear the\n\ -error condition.\n\ -@seealso{fclear, fopen}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_stream os = octave_stream_list::lookup (args(0), "ferror"); - - if (! error_state) - { - bool clear = false; - - if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state) - clear = (opt == "clear"); - else - return retval; - } - - int error_number = 0; - - std::string error_message = os.error (clear, error_number); - - retval(1) = error_number; - retval(0) = error_message; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (popen, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ -Start a process and create a pipe. The name of the command to run is\n\ -given by @var{command}. The file identifier corresponding to the input\n\ -or output stream of the process is returned in @var{fid}. The argument\n\ -@var{mode} may be\n\ -\n\ -@table @code\n\ -@item \"r\"\n\ -The pipe will be connected to the standard output of the process, and\n\ -open for reading.\n\ -\n\ -@item \"w\"\n\ -The pipe will be connected to the standard input of the process, and\n\ -open for writing.\n\ -@end table\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ -while (ischar (s = fgets (fid)))\n\ - fputs (stdout, s);\n\ -endwhile\n\ -\n\ - @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ - @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ - @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string mode = args(1).string_value (); - - if (! error_state) - { - if (mode == "r") - { - octave_stream ips = octave_iprocstream::create (name); - - retval = octave_stream_list::insert (ips); - } - else if (mode == "w") - { - octave_stream ops = octave_oprocstream::create (name); - - retval = octave_stream_list::insert (ops); - } - else - ::error ("popen: invalid MODE specified"); - } - else - ::error ("popen: MODE must be a string"); - } - else - ::error ("popen: COMMAND must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (pclose, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ -Close a file identifier that was opened by @code{popen}. You may also\n\ -use @code{fclose} for the same purpose.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 1) - retval = octave_stream_list::remove (args(0), "pclose"); - else - print_usage (); - - return retval; -} - -DEFUNX ("tmpnam", Ftmpnam, args, , - "-*- texinfo -*-\n\ -@c List other forms of function in documentation index\n\ -@findex octave_tmp_file_name\n\ -\n\ -@deftypefn {Built-in Function} {} tmpnam ()\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ -@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ -Return a unique temporary file name as a string.\n\ -\n\ -If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ -If @var{dir} is also omitted, the default directory for temporary files\n\ -is used. If @var{dir} is provided, it must exist, otherwise the default\n\ -directory for temporary files is used. Since the named file is not\n\ -opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ -that it will not be available by the time your program attempts to open it.\n\ -@seealso{tmpfile, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value retval; - - int len = args.length (); - - if (len < 3) - { - std::string dir = len > 0 ? args(0).string_value () : std::string (); - - if (! error_state) - { - std::string pfx - = len > 1 ? args(1).string_value () : std::string ("oct-"); - - if (! error_state) - retval = octave_tempnam (dir, pfx); - else - ::error ("PREFIX must be a string"); - } - else - ::error ("DIR argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (octave_tmp_file_name, tmpnam); - -DEFUN (tmpfile, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ -The file will be deleted automatically when it is closed or when Octave\n\ -exits.\n\ -\n\ -If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ -string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ -system-dependent error message.\n\ -@seealso{tmpnam, mkstemp, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - FILE *fid = gnulib::tmpfile (); - - if (fid) - { - std::string nm; - - std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - retval(0) = octave_stream_list::insert (s); - else - error ("tmpfile: failed to create octave_stdiostream object"); - - } - else - { - retval(1) = gnulib::strerror (errno); - retval(0) = -1; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (mkstemp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ -Return the file ID corresponding to a new temporary file with a unique\n\ -name created from @var{template}. The last six characters of @var{template}\n\ -must be @code{XXXXXX} and these are replaced with a string that makes the\n\ -filename unique. The file is then created with mode read/write and\n\ -permissions that are system dependent (on GNU/Linux systems, the permissions\n\ -will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ -in binary mode and with the @w{@code{O_EXCL}} flag.\n\ -\n\ -If the optional argument @var{delete} is supplied and is true,\n\ -the file will be deleted automatically when Octave exits, or when\n\ -the function @code{purge_tmp_files} is called.\n\ -\n\ -If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ -the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ -is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ -error message.\n\ -@seealso{tmpfile, tmpnam, P_tmpdir}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string tmpl8 = args(0).string_value (); - - if (! error_state) - { - OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); - strcpy (tmp, tmpl8.c_str ()); - - int fd = gnulib::mkostemp (tmp, O_BINARY); - - if (fd < 0) - { - retval(2) = gnulib::strerror (errno); - retval(0) = fd; - } - else - { - const char *fopen_mode = "w+b"; - - FILE *fid = fdopen (fd, fopen_mode); - - if (fid) - { - std::string nm = tmp; - - std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); - - octave_stream s = octave_stdiostream::create (nm, fid, md); - - if (s) - { - retval(1) = nm; - retval(0) = octave_stream_list::insert (s); - - if (nargin == 2 && args(1).is_true ()) - mark_for_deletion (nm); - } - else - error ("mkstemp: failed to create octave_stdiostream object"); - } - else - { - retval(2) = gnulib::strerror (errno); - retval(0) = -1; - } - } - } - else - error ("mkstemp: TEMPLATE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -static int -convert (int x, int ibase, int obase) -{ - int retval = 0; - - int tmp = x % obase; - - if (tmp > ibase - 1) - ::error ("umask: invalid digit"); - else - { - retval = tmp; - int mult = ibase; - while ((x = (x - tmp) / obase)) - { - tmp = x % obase; - if (tmp > ibase - 1) - { - ::error ("umask: invalid digit"); - break; - } - retval += mult * tmp; - mult *= ibase; - } - } - - return retval; -} - -DEFUNX ("umask", Fumask, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} umask (@var{mask})\n\ -Set the permission mask for file creation. The parameter @var{mask}\n\ -is an integer, interpreted as an octal number. If successful,\n\ -returns the previous value of the mask (as an integer to be\n\ -interpreted as an octal number); otherwise an error message is printed.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int status = 0; - - if (args.length () == 1) - { - int mask = args(0).int_value (true); - - if (! error_state) - { - if (mask < 0) - { - status = -1; - ::error ("umask: MASK must be a positive integer value"); - } - else - { - int oct_mask = convert (mask, 8, 10); - - if (! error_state) - status = convert (octave_umask (oct_mask), 10, 8); - } - } - else - { - status = -1; - ::error ("umask: MASK must be an integer"); - } - } - else - print_usage (); - - if (status >= 0) - retval(0) = status; - - return retval; -} - -static octave_value -const_value (const char *, const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("P_tmpdir", FP_tmpdir, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} P_tmpdir ()\n\ -Return the default name of the directory for temporary files on\n\ -this system. The name of this directory is system dependent.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = get_P_tmpdir (); - else - print_usage (); - - return retval; -} - -// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be -// this way for Matlab compatibility. - -DEFUNX ("SEEK_SET", FSEEK_SET, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_SET ()\n\ -@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ -@deftypefnx {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to perform\n\ -one of the following actions:\n\ -\n\ -@table @code\n\ -@item SEEK_SET\n\ -Position file relative to the beginning.\n\ -\n\ -@item SEEK_CUR\n\ -Position file relative to the current position.\n\ -\n\ -@item SEEK_END\n\ -Position file relative to the end.\n\ -@end table\n\ -@seealso{fseek}\n\ -@end deftypefn") -{ - return const_value ("SEEK_SET", args, -1); -} - -DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the current position.\n\ -@seealso{SEEK_SET, SEEK_END}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_CUR", args, 0); -} - -DEFUNX ("SEEK_END", FSEEK_END, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SEEK_END ()\n\ -Return the numerical value to pass to @code{fseek} to\n\ -position the file pointer relative to the end of the file.\n\ -@seealso{SEEK_SET, SEEK_CUR}.\n\ -@end deftypefn") -{ - return const_value ("SEEK_END", args, 1); -} - -static octave_value -const_value (const char *, const octave_value_list& args, - const octave_value& val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -DEFUNX ("stdin", Fstdin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdin ()\n\ -Return the numeric value corresponding to the standard input stream.\n\ -When Octave is used interactively, this is filtered through the command\n\ -line editing functions.\n\ -@seealso{stdout, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdin", args, stdin_file); -} - -DEFUNX ("stdout", Fstdout, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stdout ()\n\ -Return the numeric value corresponding to the standard output stream.\n\ -Data written to the standard output is normally filtered through the pager.\n\ -@seealso{stdin, stderr}\n\ -@end deftypefn") -{ - return const_value ("stdout", args, stdout_file); -} - -DEFUNX ("stderr", Fstderr, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} stderr ()\n\ -Return the numeric value corresponding to the standard error stream.\n\ -Even if paging is turned on, the standard error is not sent to the\n\ -pager. It is useful for error messages and prompts.\n\ -@seealso{stdin, stdout}\n\ -@end deftypefn") -{ - return const_value ("stderr", args, stderr_file); -} diff -r 069c552587a0 -r 959953dba519 src/file-io.h --- a/src/file-io.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,36 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -// Written by John C. Campbell - -#if !defined (octave_file_io_h) -#define octave_file_io_h 1 - -extern OCTINTERP_API void initialize_file_io (void); - -extern OCTINTERP_API void close_files (void); - -extern OCTINTERP_API void mark_for_deletion (const std::string&); - -extern OCTINTERP_API void cleanup_tmp_files (void); - -#endif diff -r 069c552587a0 -r 959953dba519 src/gl-render.cc --- a/src/gl-render.cc Tue Jul 31 09:54:19 2012 -0400 +++ b/src/gl-render.cc Fri Aug 03 14:35:44 2012 -0400 @@ -2488,6 +2488,10 @@ Matrix x = props.get_xdata ().matrix_value (); Matrix y = props.get_ydata ().matrix_value (); + // Someone wants us to draw an empty image? No way. + if (x.is_empty () || y.is_empty ()) + return; + if (w > 1 && x(1) == x(0)) x(1) = x(1) + (w-1); diff -r 069c552587a0 -r 959953dba519 src/graphics.cc --- a/src/graphics.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10274 +0,0 @@ -/* - -Copyright (C) 2007-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-locbuf.h" -#include "singleton-cleanup.h" - -#include "cutils.h" -#include "defun.h" -#include "display.h" -#include "error.h" -#include "graphics.h" -#include "input.h" -#include "ov.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-fcn-handle.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "txt-eng-ft.h" -#include "unwind-prot.h" - -// forward declarations -static octave_value xget (const graphics_handle& h, const caseless_str& name); - -static void -gripe_set_invalid (const std::string& pname) -{ - error ("set: invalid value for %s property", pname.c_str ()); -} - -// Check to see that PNAME matches just one of PNAMES uniquely. -// Return the full name of the match, or an empty caseless_str object -// if there is no match, or the match is ambiguous. - -static caseless_str -validate_property_name (const std::string& who, const std::string& what, - const std::set& pnames, - const caseless_str& pname) -{ - size_t len = pname.length (); - std::set matches; - - for (std::set::const_iterator p = pnames.begin (); - p != pnames.end (); p++) - { - if (pname.compare (*p, len)) - { - if (len == p->length ()) - { - // Exact match. - return pname; - } - - matches.insert (*p); - } - } - - size_t num_matches = matches.size (); - - if (num_matches == 0) - { - error ("%s: unknown %s property %s", - who.c_str (), what.c_str (), pname.c_str ()); - } - else if (num_matches > 1) - { - string_vector sv (matches); - - std::ostringstream os; - - sv.list_in_columns (os); - - std::string match_list = os.str (); - - error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", - who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); - } - else if (num_matches == 1) - { - // Exact match was handled above. - - std::string possible_match = *(matches.begin ()); - - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s property %s", - who.c_str (), pname.c_str (), what.c_str (), - possible_match.c_str ()); - - return possible_match; - } - - return caseless_str (); -} - -static Matrix -jet_colormap (void) -{ - Matrix cmap (64, 3, 0.0); - - for (octave_idx_type i = 0; i < 64; i++) - { - // This is the jet colormap. It would be nice to be able - // to feval the jet function but since there is a static - // property object that includes a colormap_property - // object, we need to initialize this before main is even - // called, so calling an interpreted function is not - // possible. - - double x = i / 63.0; - - if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,0) = 4.0 * x - 3.0/2.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,0) = 1.0; - else if (x >= 7.0/8.0) - cmap(i,0) = -4.0 * x + 9.0/2.0; - - if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,1) = 4.0 * x - 1.0/2.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,1) = 1.0; - else if (x >= 5.0/8.0 && x < 7.0/8.0) - cmap(i,1) = -4.0 * x + 7.0/2.0; - - if (x < 1.0/8.0) - cmap(i,2) = 4.0 * x + 1.0/2.0; - else if (x >= 1.0/8.0 && x < 3.0/8.0) - cmap(i,2) = 1.0; - else if (x >= 3.0/8.0 && x < 5.0/8.0) - cmap(i,2) = -4.0 * x + 5.0/2.0; - } - - return cmap; -} - -static double -default_screendepth (void) -{ - return display_info::depth (); -} - -static Matrix -default_screensize (void) -{ - Matrix retval (1, 4, 1.0); - - retval(2) = display_info::width (); - retval(3) = display_info::height (); - - return retval; -} - -static double -default_screenpixelsperinch (void) -{ - return (display_info::x_dpi () + display_info::y_dpi ()) / 2; -} - -static Matrix -default_colororder (void) -{ - Matrix retval (7, 3, 0.0); - - retval(0,2) = 1.0; - - retval(1,1) = 0.5; - - retval(2,0) = 1.0; - - retval(3,1) = 0.75; - retval(3,2) = 0.75; - - retval(4,0) = 0.75; - retval(4,2) = 0.75; - - retval(5,0) = 0.75; - retval(5,1) = 0.75; - - retval(6,0) = 0.25; - retval(6,1) = 0.25; - retval(6,2) = 0.25; - - return retval; -} - -static Matrix -default_lim (bool logscale = false) -{ - Matrix m (1, 2, 0); - - if (logscale) - { - m(0) = 0.1; - m(1) = 1.0; - } - else - m(1) = 1; - - return m; -} - -static Matrix -default_data (void) -{ - Matrix retval (1, 2); - - retval(0) = 0; - retval(1) = 1; - - return retval; -} - -static Matrix -default_axes_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.13; - m(1) = 0.11; - m(2) = 0.775; - m(3) = 0.815; - return m; -} - -static Matrix -default_axes_outerposition (void) -{ - Matrix m (1, 4, 0.0); - m(2) = m(3) = 1.0; - return m; -} - -static Matrix -default_axes_tick (void) -{ - Matrix m (1, 6, 0.0); - m(0) = 0.0; - m(1) = 0.2; - m(2) = 0.4; - m(3) = 0.6; - m(4) = 0.8; - m(5) = 1.0; - return m; -} - -static Matrix -default_axes_ticklength (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 0.01; - m(1) = 0.025; - return m; -} - -static Matrix -default_figure_position (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 300; - m(1) = 200; - m(2) = 560; - m(3) = 420; - return m; -} - -static Matrix -default_figure_papersize (void) -{ - Matrix m (1, 2, 0.0); - m(0) = 8.5; - m(1) = 11.0; - return m; -} - -static Matrix -default_figure_paperposition (void) -{ - Matrix m (1, 4, 0.0); - m(0) = 0.25; - m(1) = 2.50; - m(2) = 8.00; - m(3) = 6.00; - return m; -} - -static Matrix -default_control_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 80; - retval(3) = 30; - - return retval; -} - -static Matrix -default_control_sliderstep (void) -{ - Matrix retval (1, 2, 0.0); - - retval(0) = 0.01; - retval(1) = 0.1; - - return retval; -} - -static Matrix -default_panel_position (void) -{ - Matrix retval (1, 4, 0.0); - - retval(0) = 0; - retval(1) = 0; - retval(2) = 0.5; - retval(3) = 0.5; - - return retval; -} - -static double -convert_font_size (double font_size, const caseless_str& from_units, - const caseless_str& to_units, double parent_height = 0) -{ - // Simple case where from_units == to_units - - if (from_units.compare (to_units)) - return font_size; - - // Converts the given fontsize using the following transformation: - // => points => - - double points_size = 0; - double res = 0; - - if (from_units.compare ("points")) - points_size = font_size; - else - { - res = xget (0, "screenpixelsperinch").double_value (); - - if (from_units.compare ("pixels")) - points_size = font_size * 72.0 / res; - else if (from_units.compare ("inches")) - points_size = font_size * 72.0; - else if (from_units.compare ("centimeters")) - points_size = font_size * 72.0 / 2.54; - else if (from_units.compare ("normalized")) - points_size = font_size * parent_height * 72.0 / res; - } - - double new_font_size = 0; - - if (to_units.compare ("points")) - new_font_size = points_size; - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - if (to_units.compare ("pixels")) - new_font_size = points_size * res / 72.0; - else if (to_units.compare ("inches")) - new_font_size = points_size / 72.0; - else if (to_units.compare ("centimeters")) - new_font_size = points_size * 2.54 / 72.0; - else if (to_units.compare ("normalized")) - { - // Avoid setting font size to (0/0) = NaN - - if (parent_height > 0) - new_font_size = points_size * res / (parent_height * 72.0); - } - } - - return new_font_size; -} - -static Matrix -convert_position (const Matrix& pos, const caseless_str& from_units, - const caseless_str& to_units, const Matrix& parent_dim) -{ - Matrix retval (1, pos.numel ()); - double res = 0; - bool is_rectangle = (pos.numel () == 4); - bool is_2d = (pos.numel () == 2); - - if (from_units.compare ("pixels")) - retval = pos; - else if (from_units.compare ("normalized")) - { - retval(0) = pos(0) * parent_dim(0) + 1; - retval(1) = pos(1) * parent_dim(1) + 1; - if (is_rectangle) - { - retval(2) = pos(2) * parent_dim(0); - retval(3) = pos(3) * parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (from_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - // FIXME -- this assumes the system font is Helvetica 10pt - // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 0.5 * pos(0) * f; - retval(1) = pos(1) * f; - if (is_rectangle) - { - retval(2) = 0.5 * pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (from_units.compare ("points")) - f = res / 72.0; - else if (from_units.compare ("inches")) - f = res; - else if (from_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = pos(0) * f + 1; - retval(1) = pos(1) * f + 1; - if (is_rectangle) - { - retval(2) = pos(2) * f; - retval(3) = pos(3) * f; - } - else if (! is_2d) - retval(2) = 0; - } - } - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("normalized")) - { - retval(0) = (retval(0) - 1) / parent_dim(0); - retval(1) = (retval(1) - 1) / parent_dim(1); - if (is_rectangle) - { - retval(2) /= parent_dim(0); - retval(3) /= parent_dim(1); - } - else if (! is_2d) - retval(2) = 0; - } - else if (to_units.compare ("characters")) - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - f = 12.0 * res / 74.951; - - if (f > 0) - { - retval(0) = 2 * retval(0) / f; - retval(1) = retval(1) / f; - if (is_rectangle) - { - retval(2) = 2 * retval(2) / f; - retval(3) = retval(3) / f; - } - else if (! is_2d) - retval(2) = 0; - } - } - else - { - if (res <= 0) - res = xget (0, "screenpixelsperinch").double_value (); - - double f = 0.0; - - if (to_units.compare ("points")) - f = res / 72.0; - else if (to_units.compare ("inches")) - f = res; - else if (to_units.compare ("centimeters")) - f = res / 2.54; - - if (f > 0) - { - retval(0) = (retval(0) - 1) / f; - retval(1) = (retval(1) - 1) / f; - if (is_rectangle) - { - retval(2) /= f; - retval(3) /= f; - } - else if (! is_2d) - retval(2) = 0; - } - } - } - else if (! is_rectangle && ! is_2d) - retval(2) = 0; - - return retval; -} - -static Matrix -convert_text_position (const Matrix& pos, const text::properties& props, - const caseless_str& from_units, - const caseless_str& to_units) -{ - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object ax = go.get_ancestor ("axes"); - - Matrix retval; - - if (ax.valid_object ()) - { - const axes::properties& ax_props = - dynamic_cast (ax.get_properties ()); - graphics_xform ax_xform = ax_props.get_transform (); - bool is_rectangle = (pos.numel () == 4); - Matrix ax_bbox = ax_props.get_boundingbox (true), - ax_size = ax_bbox.extract_n (0, 2, 1, 2); - - if (from_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), - v2 = ax_xform.transform (pos(0) + pos(2), - pos(1) + pos(3), 0); - - retval.resize (1, 4); - - retval(0) = v1(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; - retval(2) = v2(0) - v1(0); - retval(3) = v1(1) - v2(1); - } - else - { - ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); - - retval.resize (1, 3); - - retval(0) = v(0) - ax_bbox(0) + 1; - retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; - retval(2) = 0; - } - } - else - retval = convert_position (pos, from_units, "pixels", ax_size); - - if (! to_units.compare ("pixels")) - { - if (to_units.compare ("data")) - { - if (is_rectangle) - { - ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1), - v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); - - retval.resize (1, 4); - - retval(0) = v1(0); - retval(1) = v1(1); - retval(2) = v2(0) - v1(0); - retval(3) = v2(1) - v1(1); - } - else - { - ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, - ax_bbox(1) + ax_bbox(3) - retval(1) + 1); - - retval.resize (1, 3); - - retval(0) = v(0); - retval(1) = v(1); - retval(2) = v(2); - } - } - else - retval = convert_position (retval, "pixels", to_units, ax_size); - } - } - - return retval; -} - -// This function always returns the screensize in pixels -static Matrix -screen_size_pixels (void) -{ - graphics_object obj = gh_manager::get_object (0); - Matrix sz = obj.get ("screensize").matrix_value (); - return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); -} - -static void -convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, double x, octave_idx_type lda, - octave_idx_type nc, octave_idx_type i, double *av) -{ - if (is_scaled) - x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); - else - x = xround (x - 1); - - if (xisnan (x)) - { - av[i] = x; - av[i+lda] = x; - av[i+2*lda] = x; - } - else - { - if (x < 0) - x = 0; - else if (x >= nc) - x = (nc - 1); - - octave_idx_type idx = static_cast (x); - - av[i] = cmapv[idx]; - av[i+lda] = cmapv[idx+nc]; - av[i+2*lda] = cmapv[idx+2*nc]; - } -} - -template -void -convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, - const double *cmapv, const T *cv, octave_idx_type lda, - octave_idx_type nc, double *av) -{ - for (octave_idx_type i = 0; i < lda; i++) - convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); -} - -static octave_value -convert_cdata (const base_properties& props, const octave_value& cdata, - bool is_scaled, int cdim) -{ - dim_vector dv (cdata.dims ()); - - if (dv.length () == cdim && dv(cdim-1) == 3) - return cdata; - - Matrix cmap (1, 3, 0.0); - Matrix clim (1, 2, 0.0); - - graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); - graphics_object fig = go.get_ancestor ("figure"); - - if (fig.valid_object ()) - { - Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); - - if (! error_state) - cmap = _cmap; - } - - if (is_scaled) - { - graphics_object ax = go.get_ancestor ("axes"); - - if (ax.valid_object ()) - { - Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); - - if (! error_state) - clim = _clim; - } - } - - dv.resize (cdim); - dv(cdim-1) = 3; - - NDArray a (dv); - - octave_idx_type lda = a.numel () / static_cast (3); - octave_idx_type nc = cmap.rows (); - - double *av = a.fortran_vec (); - const double *cmapv = cmap.data (); - - double clim_0 = clim(0); - double clim_1 = clim(1); - -#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ - do \ - { \ - ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ - \ - convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ - tmp.data (), lda, nc, av); \ - } \ - while (0) - - if (cdata.is_uint8_type ()) - CONVERT_CDATA_1 (uint8NDArray, uint8_); - else if (cdata.is_single_type ()) - CONVERT_CDATA_1 (FloatNDArray, float_); - else if (cdata.is_double_type ()) - CONVERT_CDATA_1 (NDArray, ); - else - error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); - -#undef CONVERT_CDATA_1 - - return octave_value (a); -} - -template -static void -get_array_limits (const Array& m, double& emin, double& emax, - double& eminp, double& emaxp) -{ - const T *data = m.data (); - octave_idx_type n = m.numel (); - - for (octave_idx_type i = 0; i < n; i++) - { - double e = double (data[i]); - - // Don't need to test for NaN here as NaN>x and NaN emax) - emax = e; - - if (e > 0 && e < eminp) - eminp = e; - - if (e < 0 && e > emaxp) - emaxp = e; - } - } -} - -static bool -lookup_object_name (const caseless_str& name, caseless_str& go_name, - caseless_str& rest) -{ - int len = name.length (); - int offset = 0; - bool result = false; - - if (len >= 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len >= 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len >= 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len >= 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len >= 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len >= 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len >= 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len >= 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - go_name = pfx; - rest = name.substr (offset); - result = true; - } - } - - return result; -} - -static base_graphics_object* -make_graphics_object_from_type (const caseless_str& type, - const graphics_handle& h = graphics_handle (), - const graphics_handle& p = graphics_handle ()) -{ - base_graphics_object *go = 0; - - if (type.compare ("figure")) - go = new figure (h, p); - else if (type.compare ("axes")) - go = new axes (h, p); - else if (type.compare ("line")) - go = new line (h, p); - else if (type.compare ("text")) - go = new text (h, p); - else if (type.compare ("image")) - go = new image (h, p); - else if (type.compare ("patch")) - go = new patch (h, p); - else if (type.compare ("surface")) - go = new surface (h, p); - else if (type.compare ("hggroup")) - go = new hggroup (h, p); - else if (type.compare ("uimenu")) - go = new uimenu (h, p); - else if (type.compare ("uicontrol")) - go = new uicontrol (h, p); - else if (type.compare ("uipanel")) - go = new uipanel (h, p); - else if (type.compare ("uicontextmenu")) - go = new uicontextmenu (h, p); - else if (type.compare ("uitoolbar")) - go = new uitoolbar (h, p); - else if (type.compare ("uipushtool")) - go = new uipushtool (h, p); - else if (type.compare ("uitoggletool")) - go = new uitoggletool (h, p); - return go; -} - -// --------------------------------------------------------------------- - -bool -base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) -{ - if (do_set (v)) - { - - // Notify graphics toolkit. - if (id >= 0 && do_notify_toolkit) - { - graphics_object go = gh_manager::get_object (parent); - if (go) - go.update (id); - } - - // run listeners - if (do_run && ! error_state) - run_listeners (POSTSET); - - return true; - } - - return false; -} - - -void -base_property::run_listeners (listener_mode mode) -{ - const octave_value_list& l = listeners[mode]; - - for (int i = 0; i < l.length (); i++) - { - gh_manager::execute_listener (parent, l(i)); - - if (error_state) - break; - } -} - -radio_values::radio_values (const std::string& opt_string) - : default_val (), possible_vals () -{ - size_t beg = 0; - size_t len = opt_string.length (); - bool done = len == 0; - - while (! done) - { - size_t end = opt_string.find ('|', beg); - - if (end == std::string::npos) - { - end = len; - done = true; - } - - std::string t = opt_string.substr (beg, end-beg); - - // Might want more error checking here... - if (t[0] == '{') - { - t = t.substr (1, t.length () - 2); - default_val = t; - } - else if (beg == 0) // ensure default value - default_val = t; - - possible_vals.insert (t); - - beg = end + 1; - } -} - -std::string -radio_values::values_as_string (void) const -{ - std::string retval; - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - { - if (retval == "") - { - if (*it == default_value ()) - retval = "{" + *it + "}"; - else - retval = *it; - } - else - { - if (*it == default_value ()) - retval += " | {" + *it + "}"; - else - retval += " | " + *it; - } - } - if (retval != "") - retval = "[ " + retval + " ]"; - return retval; -} - -Cell -radio_values::values_as_cell (void) const -{ - octave_idx_type i = 0; - Cell retval (nelem (), 1); - for (std::set::const_iterator it = possible_vals.begin (); - it != possible_vals.end (); it++) - retval(i++) = std::string (*it); - return retval; -} - -bool -color_values::str2rgb (std::string str) -{ - double tmp_rgb[3] = {0, 0, 0}; - bool retval = true; - unsigned int len = str.length (); - - std::transform (str.begin (), str.end (), str.begin (), tolower); - - if (str.compare (0, len, "blue", 0, len) == 0) - tmp_rgb[2] = 1; - else if (str.compare (0, len, "black", 0, len) == 0 - || str.compare (0, len, "k", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; - else if (str.compare (0, len, "red", 0, len) == 0) - tmp_rgb[0] = 1; - else if (str.compare (0, len, "green", 0, len) == 0) - tmp_rgb[1] = 1; - else if (str.compare (0, len, "yellow", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = 1; - else if (str.compare (0, len, "magenta", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "cyan", 0, len) == 0) - tmp_rgb[1] = tmp_rgb[2] = 1; - else if (str.compare (0, len, "white", 0, len) == 0 - || str.compare (0, len, "w", 0, len) == 0) - tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; - else - retval = false; - - if (retval) - { - for (int i = 0; i < 3; i++) - xrgb(i) = tmp_rgb[i]; - } - - return retval; -} - -bool -color_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - - if (! s.empty ()) - { - std::string match; - - if (radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - { - color_values col (s); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - else - error ("invalid value for color property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_numeric_type ()) - { - Matrix m = val.matrix_value (); - - if (m.numel () == 3) - { - color_values col (m(0), m(1), m(2)); - if (! error_state) - { - if (current_type != color_t || col != color_val) - { - color_val = col; - current_type = color_t; - return true; - } - } - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - } - else - error ("invalid value for color property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -double_radio_property::do_set (const octave_value& val) -{ - if (val.is_string ()) - { - std::string s = val.string_value (); - std::string match; - - if (! s.empty () && radio_val.contains (s, match)) - { - if (current_type != radio_t || match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - current_type = radio_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - } - else if (val.is_scalar_type () && val.is_real_type ()) - { - double new_dval = val.double_value (); - - if (current_type != double_t || new_dval != dval) - { - dval = new_dval; - current_type = double_t; - return true; - } - } - else - error ("invalid value for double_radio property \"%s\"", - get_name ().c_str ()); - - return false; -} - -bool -array_property::validate (const octave_value& v) -{ - bool xok = false; - - // FIXME -- should we always support []? - if (v.is_empty () && v.is_numeric_type ()) - return true; - - // check value type - if (type_constraints.size () > 0) - { - for (std::list::const_iterator it = type_constraints.begin (); - ! xok && it != type_constraints.end (); ++it) - if ((*it) == v.class_name ()) - xok = true; - } - else - xok = v.is_numeric_type (); - - if (xok) - { - dim_vector vdims = v.dims (); - int vlen = vdims.length (); - - xok = false; - - // check value size - if (size_constraints.size () > 0) - for (std::list::const_iterator it = size_constraints.begin (); - ! xok && it != size_constraints.end (); ++it) - { - dim_vector itdims = (*it); - - if (itdims.length () == vlen) - { - xok = true; - - for (int i = 0; xok && i < vlen; i++) - if (itdims(i) >= 0 && itdims(i) != vdims(i)) - xok = false; - } - } - else - return true; - } - - return xok; -} - -bool -array_property::is_equal (const octave_value& v) const -{ - if (data.type_name () == v.type_name ()) - { - if (data.dims () == v.dims ()) - { - -#define CHECK_ARRAY_EQUAL(T,F,A) \ - { \ - if (data.numel () == 1) \ - return data.F ## scalar_value () == \ - v.F ## scalar_value (); \ - else \ - { \ - /* Keep copy of array_value to allow sparse/bool arrays */ \ - /* that are converted, to not be deallocated early */ \ - const A m1 = data.F ## array_value (); \ - const T* d1 = m1.data (); \ - const A m2 = v.F ## array_value (); \ - const T* d2 = m2.data ();\ - \ - bool flag = true; \ - \ - for (int i = 0; flag && i < data.numel (); i++) \ - if (d1[i] != d2[i]) \ - flag = false; \ - \ - return flag; \ - } \ - } - - if (data.is_double_type () || data.is_bool_type ()) - CHECK_ARRAY_EQUAL (double, , NDArray) - else if (data.is_single_type ()) - CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) - else if (data.is_int8_type ()) - CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) - else if (data.is_int16_type ()) - CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) - else if (data.is_int32_type ()) - CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) - else if (data.is_int64_type ()) - CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) - else if (data.is_uint8_type ()) - CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) - else if (data.is_uint16_type ()) - CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) - else if (data.is_uint32_type ()) - CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) - else if (data.is_uint64_type ()) - CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) - } - } - - return false; -} - -void -array_property::get_data_limits (void) -{ - xmin = xminp = octave_Inf; - xmax = xmaxp = -octave_Inf; - - if (! data.is_empty ()) - { - if (data.is_integer_type ()) - { - if (data.is_int8_type ()) - get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint8_type ()) - get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int16_type ()) - get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint16_type ()) - get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int32_type ()) - get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint32_type ()) - get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_int64_type ()) - get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); - else if (data.is_uint64_type ()) - get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); - } - else - get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); - } -} - -bool -handle_property::do_set (const octave_value& v) -{ - double dv = v.double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (dv); - - if (xisnan (gh.value ()) || gh.ok ()) - { - if (current_val != gh) - { - current_val = gh; - return true; - } - } - else - error ("set: invalid graphics handle (= %g) for property \"%s\"", - dv, get_name ().c_str ()); - } - else - error ("set: invalid graphics handle for property \"%s\"", - get_name ().c_str ()); - - return false; -} - -Matrix -children_property::do_get_children (bool return_hidden) const -{ - Matrix retval (children_list.size (), 1); - octave_idx_type k = 0; - - graphics_object go = gh_manager::get_object (0); - - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - if (! props.is_showhiddenhandles ()) - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_handle kid = *p; - - if (gh_manager::is_handle_visible (kid)) - { - if (! return_hidden) - retval(k++) = *p; - } - else if (return_hidden) - retval(k++) = *p; - } - - retval.resize (k, 1); - } - else - { - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(k++) = *p; - } - - return retval; -} - -void -children_property::do_delete_children (bool clear) -{ - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - graphics_object go = gh_manager::get_object (*p); - - if (go.valid_object ()) - gh_manager::free (*p); - - } - - if (clear) - children_list.clear (); -} - -bool -callback_property::validate (const octave_value& v) const -{ - // case 1: function handle - // case 2: cell array with first element being a function handle - // case 3: string corresponding to known function name - // case 4: evaluatable string - // case 5: empty matrix - - if (v.is_function_handle ()) - return true; - else if (v.is_string ()) - // complete validation will be done at execution-time - return true; - else if (v.is_cell () && v.length () > 0 - && (v.rows () == 1 || v.columns () == 1) - && v.cell_value ()(0).is_function_handle ()) - return true; - else if (v.is_empty ()) - return true; - - return false; -} - -// If TRUE, we are executing any callback function, or the functions it -// calls. Used to determine handle visibility inside callback -// functions. -static bool executing_callback = false; - -void -callback_property::execute (const octave_value& data) const -{ - unwind_protect frame; - - // We are executing the callback function associated with this - // callback property. When set to true, we avoid recursive calls to - // callback routines. - frame.protect_var (executing); - - // We are executing a callback function, so allow handles that have - // their handlevisibility property set to "callback" to be visible. - frame.protect_var (executing_callback); - - if (! executing) - { - executing = true; - executing_callback = true; - - if (callback.is_defined () && ! callback.is_empty ()) - gh_manager::execute_callback (get_parent (), callback, data); - } -} - -// Used to cache dummy graphics objects from which dynamic -// properties can be cloned. -static std::map dprop_obj_map; - -property -property::create (const std::string& name, const graphics_handle& h, - const caseless_str& type, const octave_value_list& args) -{ - property retval; - - if (type.compare ("string")) - { - std::string val = (args.length () > 0 ? args(0).string_value () : ""); - - if (! error_state) - retval = property (new string_property (name, h, val)); - } - else if (type.compare ("any")) - { - octave_value val = - (args.length () > 0 ? args(0) : octave_value (Matrix ())); - - retval = property (new any_property (name, h, val)); - } - else if (type.compare ("radio")) - { - if (args.length () > 0) - { - std::string vals = args(0).string_value (); - - if (! error_state) - { - retval = property (new radio_property (name, h, vals)); - - if (args.length () > 1) - retval.set (args(1)); - } - else - error ("addproperty: invalid argument for radio property, expected a string value"); - } - else - error ("addproperty: missing possible values for radio property"); - } - else if (type.compare ("double")) - { - double d = (args.length () > 0 ? args(0).double_value () : 0); - - if (! error_state) - retval = property (new double_property (name, h, d)); - } - else if (type.compare ("handle")) - { - double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); - - if (! error_state) - { - graphics_handle gh (hh); - - retval = property (new handle_property (name, h, gh)); - } - } - else if (type.compare ("boolean")) - { - retval = property (new bool_property (name, h, false)); - - if (args.length () > 0) - retval.set (args(0)); - } - else if (type.compare ("data")) - { - retval = property (new array_property (name, h, Matrix ())); - - if (args.length () > 0) - { - retval.set (args(0)); - - // FIXME -- additional argument could define constraints, - // but is this really useful? - } - } - else if (type.compare ("color")) - { - color_values cv (0, 0, 0); - radio_values rv; - - if (args.length () > 1) - rv = radio_values (args(1).string_value ()); - - if (! error_state) - { - retval = property (new color_property (name, h, cv, rv)); - - if (! error_state) - { - if (args.length () > 0 && ! args(0).is_empty ()) - retval.set (args(0)); - else - retval.set (rv.default_value ()); - } - } - } - else - { - caseless_str go_name, go_rest; - - if (lookup_object_name (type, go_name, go_rest)) - { - graphics_object go; - - std::map::const_iterator it = - dprop_obj_map.find (go_name); - - if (it == dprop_obj_map.end ()) - { - base_graphics_object *bgo = - make_graphics_object_from_type (go_name); - - if (bgo) - { - go = graphics_object (bgo); - - dprop_obj_map[go_name] = go; - } - } - else - go = it->second; - - if (go.valid_object ()) - { - property prop = go.get_properties ().get_property (go_rest); - - if (! error_state) - { - retval = prop.clone (); - - retval.set_parent (h); - retval.set_name (name); - - if (args.length () > 0) - retval.set (args(0)); - } - } - else - error ("addproperty: invalid object type (= %s)", - go_name.c_str ()); - } - else - error ("addproperty: unsupported type for dynamic property (= %s)", - type.c_str ()); - } - - return retval; -} - -static void -finalize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - for (int k = 0; k < children.numel (); k++) - finalize_r (children(k)); - - go.finalize (); - } -} - -static void -initialize_r (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - { - Matrix children = go.get_properties ().get_all_children (); - - go.initialize (); - - for (int k = 0; k < children.numel (); k++) - initialize_r (children(k)); - } -} - -void -figure::properties::set_toolkit (const graphics_toolkit& b) -{ - if (toolkit) - finalize_r (get___myhandle__ ()); - - toolkit = b; - __graphics_toolkit__ = b.get_name (); - __plot_stream__ = Matrix (); - - if (toolkit) - initialize_r (get___myhandle__ ()); - - mark_modified (); -} - -// --------------------------------------------------------------------- - -void -property_list::set (const caseless_str& name, const octave_value& val) -{ - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoogletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - // FIXME -- should we validate property names and values here? - - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - bool has_property = false; - if (pfx == "axes") - has_property = axes::properties::has_core_property (pname); - else if (pfx == "line") - has_property = line::properties::has_core_property (pname); - else if (pfx == "text") - has_property = text::properties::has_core_property (pname); - else if (pfx == "image") - has_property = image::properties::has_core_property (pname); - else if (pfx == "patch") - has_property = patch::properties::has_core_property (pname); - else if (pfx == "figure") - has_property = figure::properties::has_core_property (pname); - else if (pfx == "surface") - has_property = surface::properties::has_core_property (pname); - else if (pfx == "hggroup") - has_property = hggroup::properties::has_core_property (pname); - else if (pfx == "uimenu") - has_property = uimenu::properties::has_core_property (pname); - else if (pfx == "uicontrol") - has_property = uicontrol::properties::has_core_property (pname); - else if (pfx == "uipanel") - has_property = uipanel::properties::has_core_property (pname); - else if (pfx == "uicontextmenu") - has_property = uicontextmenu::properties::has_core_property (pname); - else if (pfx == "uitoolbar") - has_property = uitoolbar::properties::has_core_property (pname); - else if (pfx == "uipushtool") - has_property = uipushtool::properties::has_core_property (pname); - - if (has_property) - { - bool remove = false; - if (val.is_string ()) - { - caseless_str tval = val.string_value (); - - remove = tval.compare ("remove"); - } - - pval_map_type& pval_map = plist_map[pfx]; - - if (remove) - { - pval_map_iterator p = pval_map.find (pname); - - if (p != pval_map.end ()) - pval_map.erase (p); - } - else - pval_map[pname] = val; - } - else - error ("invalid %s property `%s'", pfx.c_str (), pname.c_str ()); - } - } - - if (! error_state && offset == 0) - error ("invalid default property specification"); -} - -octave_value -property_list::lookup (const caseless_str& name) const -{ - octave_value retval; - - size_t offset = 0; - - size_t len = name.length (); - - if (len > 4) - { - caseless_str pfx = name.substr (0, 4); - - if (pfx.compare ("axes") || pfx.compare ("line") - || pfx.compare ("text")) - offset = 4; - else if (len > 5) - { - pfx = name.substr (0, 5); - - if (pfx.compare ("image") || pfx.compare ("patch")) - offset = 5; - else if (len > 6) - { - pfx = name.substr (0, 6); - - if (pfx.compare ("figure") || pfx.compare ("uimenu")) - offset = 6; - else if (len > 7) - { - pfx = name.substr (0, 7); - - if (pfx.compare ("surface") || pfx.compare ("hggroup") - || pfx.compare ("uipanel")) - offset = 7; - else if (len > 9) - { - pfx = name.substr (0, 9); - - if (pfx.compare ("uicontrol") - || pfx.compare ("uitoolbar")) - offset = 9; - else if (len > 10) - { - pfx = name.substr (0, 10); - - if (pfx.compare ("uipushtool")) - offset = 10; - else if (len > 12) - { - pfx = name.substr (0, 12); - - if (pfx.compare ("uitoggletool")) - offset = 12; - else if (len > 13) - { - pfx = name.substr (0, 13); - - if (pfx.compare ("uicontextmenu")) - offset = 13; - } - } - } - } - } - } - } - - if (offset > 0) - { - std::string pname = name.substr (offset); - - std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); - std::transform (pname.begin (), pname.end (), pname.begin (), tolower); - - plist_map_const_iterator p = find (pfx); - - if (p != end ()) - { - const pval_map_type& pval_map = p->second; - - pval_map_const_iterator q = pval_map.find (pname); - - if (q != pval_map.end ()) - retval = q->second; - } - } - } - - return retval; -} - -octave_scalar_map -property_list::as_struct (const std::string& prefix_arg) const -{ - octave_scalar_map m; - - for (plist_map_const_iterator p = begin (); p != end (); p++) - { - std::string prefix = prefix_arg + p->first; - - const pval_map_type pval_map = p->second; - - for (pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - m.assign (prefix + q->first, q->second); - } - - return m; -} - -graphics_handle::graphics_handle (const octave_value& a) - : val (octave_NaN) -{ - if (a.is_empty ()) - /* do nothing */; - else - { - double tval = a.double_value (); - - if (! error_state) - val = tval; - else - error ("invalid graphics handle"); - } -} - -// Set properties given as a cs-list of name, value pairs. - -void -graphics_object::set (const octave_value_list& args) -{ - int nargin = args.length (); - - if (nargin == 0) - error ("graphics_object::set: Nothing to set"); - else if (nargin % 2 == 0) - { - for (int i = 0; i < nargin; i += 2) - { - caseless_str name = args(i).string_value (); - - if (! error_state) - { - octave_value val = args(i+1); - - set_value_or_default (name, val); - - if (error_state) - break; - } - else - error ("set: expecting argument %d to be a property name", i); - } - } - else - error ("set: invalid number of arguments"); -} - -/* -## test set with name, value pairs -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, "linewidth", 10, "marker", "x"); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -*/ - -// Set properties given in two cell arrays containing names and values. -void -graphics_object::set (const Array& names, - const Cell& values, octave_idx_type row) -{ - if (names.numel () != values.columns ()) - { - error ("set: number of names must match number of value columns (%d != %d)", - names.numel (), values.columns ()); - } - - octave_idx_type k = names.columns (); - - for (octave_idx_type column = 0; column < k; column++) - { - caseless_str name = names(column); - octave_value val = values(row, column); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set with cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); - -## test set with multiple handles and cell array arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); -%! assert (get (h, "linewidth"), {10; 5}); -%! assert (get (h, "marker"), {"x"; "o"}); -%! set (h, {"linewidth", "marker"}, {10, "x"}); -%! assert (get (h, "linewidth"), {10; 10}); -%! assert (get (h, "marker"), {"x"; "x"}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); - -%!error -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); -*/ - -// Set properties given in a struct array -void -graphics_object::set (const octave_map& m) -{ - for (octave_map::const_iterator p = m.begin (); - p != m.end (); p++) - { - caseless_str name = m.key (p); - - octave_value val = octave_value (m.contents (p).elem (m.numel () - 1)); - - set_value_or_default (name, val); - - if (error_state) - break; - } -} - -/* -## test set with struct arguments -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (h, struct ("linewidth", 10, "marker", "x")); -%! assert (get (h, "linewidth"), 10); -%! assert (get (h, "marker"), "x"); -%! h = plot (1:10, 10:-1:1, 1:10, 1:10); -%! set (h, struct ("linewidth", {5, 10})); -%! assert (get (h, "linewidth"), {10; 10}); -*/ - -// Set a property to a value or to its (factory) default value. - -void -graphics_object::set_value_or_default (const caseless_str& name, - const octave_value& val) -{ - if (val.is_string ()) - { - caseless_str tval = val.string_value (); - - octave_value default_val; - - if (tval.compare ("default")) - { - default_val = get_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else if (tval.compare ("factory")) - { - default_val = get_factory_default (name); - - if (error_state) - return; - - rep->set (name, default_val); - } - else - rep->set (name, val); - } - else - rep->set (name, val); -} - -/* -## test setting of default values -%!test -%! set (gcf, "visible", "off"); -%! h = plot (1:10, 10:-1:1); -%! set (0, "defaultlinelinewidth", 20); -%! set (h, "linewidth", "default"); -%! assert (get (h, "linewidth"), 20); -%! set (h, "linewidth", "factory"); -%! assert (get (h, "linewidth"), 0.5); -*/ - -static double -make_handle_fraction (void) -{ - static double maxrand = RAND_MAX + 2.0; - - return (rand () + 1.0) / maxrand; -} - -graphics_handle -gh_manager::do_get_handle (bool integer_figure_handle) -{ - graphics_handle retval; - - if (integer_figure_handle) - { - // Figure handles are positive integers corresponding to the - // figure number. - - // We always want the lowest unused figure number. - - retval = 1; - - while (handle_map.find (retval) != handle_map.end ()) - retval++; - } - else - { - // Other graphics handles are negative integers plus some random - // fractional part. To avoid running out of integers, we - // recycle the integer part but tack on a new random part each - // time. - - free_list_iterator p = handle_free_list.begin (); - - if (p != handle_free_list.end ()) - { - retval = *p; - handle_free_list.erase (p); - } - else - { - retval = graphics_handle (next_handle); - - next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); - } - } - - return retval; -} - -void -gh_manager::do_free (const graphics_handle& h) -{ - if (h.ok ()) - { - if (h.value () != 0) - { - iterator p = handle_map.find (h); - - if (p != handle_map.end ()) - { - base_properties& bp = p->second.get_properties (); - - bp.set_beingdeleted (true); - - bp.delete_children (); - - octave_value val = bp.get_deletefcn (); - - bp.execute_deletefcn (); - - // Notify graphics toolkit. - p->second.finalize (); - - // Note: this will be valid only for first explicitly - // deleted object. All its children will then have an - // unknown graphics toolkit. - - // Graphics handles for non-figure objects are negative - // integers plus some random fractional part. To avoid - // running out of integers, we recycle the integer part - // but tack on a new random part each time. - - handle_map.erase (p); - - if (h.value () < 0) - handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", h.value ()); - } - else - error ("graphics_handle::free: can't delete root figure"); - } -} - -void -gh_manager::do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) -{ - iterator p = handle_map.find (old_gh); - - if (p != handle_map.end ()) - { - graphics_object go = p->second; - - handle_map.erase (p); - - handle_map[new_gh] = go; - - if (old_gh.value () < 0) - handle_free_list.insert (std::ceil (old_gh.value ()) - - make_handle_fraction ()); - } - else - error ("graphics_handle::free: invalid object %g", old_gh.value ()); - - for (figure_list_iterator q = figure_list.begin (); - q != figure_list.end (); q++) - { - if (*q == old_gh) - { - *q = new_gh; - break; - } - } -} - -gh_manager *gh_manager::instance = 0; - -static void -xset (const graphics_handle& h, const caseless_str& name, - const octave_value& val) -{ - graphics_object obj = gh_manager::get_object (h); - obj.set (name, val); -} - -static void -xset (const graphics_handle& h, const octave_value_list& args) -{ - if (args.length () > 0) - { - graphics_object obj = gh_manager::get_object (h); - obj.set (args); - } -} - -static octave_value -xget (const graphics_handle& h, const caseless_str& name) -{ - graphics_object obj = gh_manager::get_object (h); - return obj.get (name); -} - -static graphics_handle -reparent (const octave_value& ov, const std::string& who, - const std::string& property, const graphics_handle& new_parent, - bool adopt = true) -{ - graphics_handle h = octave_NaN; - - double val = ov.double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = gh_manager::get_object (parent_h); - - parent_obj.remove_child (h); - - if (adopt) - obj.set ("parent", new_parent.value ()); - else - obj.reparent (new_parent); - } - else - error ("%s: invalid graphics handle (= %g) for %s", - who.c_str (), val, property.c_str ()); - } - else - error ("%s: expecting %s to be a graphics handle", - who.c_str (), property.c_str ()); - - return h; -} - -// This function is NOT equivalent to the scripting language function gcf. -graphics_handle -gcf (void) -{ - octave_value val = xget (0, "currentfigure"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -// This function is NOT equivalent to the scripting language function gca. -graphics_handle -gca (void) -{ - octave_value val = xget (gcf (), "currentaxes"); - - return val.is_empty () ? octave_NaN : val.double_value (); -} - -static void -delete_graphics_object (const graphics_handle& h) -{ - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - // Don't do recursive deleting, due to callbacks - if (! obj.get_properties ().is_beingdeleted ()) - { - graphics_handle parent_h = obj.get_parent (); - - graphics_object parent_obj = - gh_manager::get_object (parent_h); - - // NOTE: free the handle before removing it from its - // parent's children, such that the object's - // state is correct when the deletefcn callback - // is executed - - gh_manager::free (h); - - // A callback function might have already deleted - // the parent - if (parent_obj.valid_object ()) - parent_obj.remove_child (h); - - Vdrawnow_requested = true; - } - } -} - -static void -delete_graphics_object (double val) -{ - delete_graphics_object (gh_manager::lookup (val)); -} - -static void -delete_graphics_objects (const NDArray vals) -{ - for (octave_idx_type i = 0; i < vals.numel (); i++) - delete_graphics_object (vals.elem (i)); -} - -static void -close_figure (const graphics_handle& handle) -{ - octave_value closerequestfcn = xget (handle, "closerequestfcn"); - - OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); -} - -static void -force_close_figure (const graphics_handle& handle) -{ - // Remove the deletefcn and closerequestfcn callbacks and delete the - // object directly. - - xset (handle, "deletefcn", Matrix ()); - xset (handle, "closerequestfcn", Matrix ()); - - delete_graphics_object (handle); -} - -void -gh_manager::do_close_all_figures (void) -{ - // FIXME -- should we process or discard pending events? - - event_queue.clear (); - - // Don't use figure_list_iterator because we'll be removing elements - // from the list elsewhere. - - Matrix hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - close_figure (h); - } - - // They should all be closed now. If not, force them to close. - - hlist = do_figure_handle_list (true); - - for (octave_idx_type i = 0; i < hlist.numel (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok ()) - force_close_figure (h); - } - - // None left now, right? - - hlist = do_figure_handle_list (true); - - assert (hlist.numel () == 0); - - // Clear all callback objects from our list. - - callback_objects.clear (); -} - -static void -adopt (const graphics_handle& p, const graphics_handle& h) -{ - graphics_object parent_obj = gh_manager::get_object (p); - parent_obj.adopt (h); -} - -static bool -is_handle (const graphics_handle& h) -{ - return h.ok (); -} - -static bool -is_handle (double val) -{ - graphics_handle h = gh_manager::lookup (val); - - return h.ok (); -} - -static octave_value -is_handle (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle (handles (i)); - - retval = result; - } - } - - return retval; -} - -static bool -is_figure (double val) -{ - graphics_object obj = gh_manager::get_object (val); - - return obj && obj.isa ("figure"); -} - -static void -xcreatefcn (const graphics_handle& h) -{ - graphics_object obj = gh_manager::get_object (h); - obj.get_properties ().execute_createfcn (); -} - -static void -xinitialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - if (go) - go.initialize (); -} - -// --------------------------------------------------------------------- - -void -base_graphics_toolkit::update (const graphics_handle& h, int id) -{ - graphics_object go = gh_manager::get_object (h); - - update (go, id); -} - -bool -base_graphics_toolkit::initialize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - return initialize (go); -} - -void -base_graphics_toolkit::finalize (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (h); - - finalize (go); -} - -// --------------------------------------------------------------------- - -void -base_properties::set_from_list (base_graphics_object& obj, - property_list& defaults) -{ - std::string go_name = graphics_object_name (); - - property_list::plist_map_const_iterator p = defaults.find (go_name); - - if (p != defaults.end ()) - { - const property_list::pval_map_type pval_map = p->second; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string pname = q->first; - - obj.set (pname, q->second); - - if (error_state) - { - error ("error setting default property %s", pname.c_str ()); - break; - } - } - } -} - -octave_value -base_properties::get_dynamic (const caseless_str& name) const -{ - octave_value retval; - - std::map::const_iterator it = all_props.find (name); - - if (it != all_props.end ()) - retval = it->second.get (); - else - error ("get: unknown property \"%s\"", name.c_str ()); - - return retval; -} - -octave_value -base_properties::get_dynamic (bool all) const -{ - octave_scalar_map m; - - for (std::map::const_iterator it = all_props.begin (); - it != all_props.end (); ++it) - if (all || ! it->second.is_hidden ()) - m.assign (it->second.get_name (), it->second.get ()); - - return m; -} - -std::set -base_properties::dynamic_property_names (void) const -{ - return dynamic_properties; -} - -bool -base_properties::has_dynamic_property (const std::string& pname) -{ - const std::set& dynprops = dynamic_property_names (); - - if (dynprops.find (pname) != dynprops.end ()) - return true; - else - return all_props.find (pname) != all_props.end (); -} - -void -base_properties::set_dynamic (const caseless_str& pname, - const octave_value& val) -{ - std::map::iterator it = all_props.find (pname); - - if (it != all_props.end ()) - it->second.set (val); - else - error ("set: unknown property \"%s\"", pname.c_str ()); - - if (! error_state) - { - dynamic_properties.insert (pname); - - mark_modified (); - } -} - -property -base_properties::get_property_dynamic (const caseless_str& name) -{ - std::map::const_iterator it = all_props.find (name); - - if (it == all_props.end ()) - { - error ("get_property: unknown property \"%s\"", name.c_str ()); - return property (); - } - else - return it->second; -} - -void -base_properties::set_parent (const octave_value& val) -{ - double tmp = val.double_value (); - - graphics_handle new_parent = octave_NaN; - - if (! error_state) - { - new_parent = gh_manager::lookup (tmp); - - if (new_parent.ok ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - parent_obj.remove_child (__myhandle__); - - parent = new_parent.as_octave_value (); - - ::adopt (parent.handle_value (), __myhandle__); - } - else - error ("set: invalid graphics handle (= %g) for parent", tmp); - } - else - error ("set: expecting parent to be a graphics handle"); -} - -void -base_properties::mark_modified (void) -{ - __modified__ = "on"; - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj) - parent_obj.mark_modified (); -} - -void -base_properties::override_defaults (base_graphics_object& obj) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.override_defaults (obj); -} - -void -base_properties::update_axis_limits (const std::string& axis_type) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type); -} - -void -base_properties::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - obj.update_axis_limits (axis_type, h); -} - -bool -base_properties::is_handle_visible (void) const -{ - return (handlevisibility.is ("on") - || (executing_callback && ! handlevisibility.is ("off"))); -} - -graphics_toolkit -base_properties::get_toolkit (void) const -{ - graphics_object go = gh_manager::get_object (get_parent ()); - - if (go) - return go.get_toolkit (); - else - return graphics_toolkit (); -} - -void -base_properties::update_boundingbox (void) -{ - Matrix kids = get_children (); - - for (int i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - - if (go.valid_object ()) - go.get_properties ().update_boundingbox (); - } -} - -void -base_properties::update_autopos (const std::string& elem_type) -{ - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj.valid_object ()) - parent_obj.get_properties ().update_autopos (elem_type); -} - -void -base_properties::add_listener (const caseless_str& nm, const octave_value& v, - listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.add_listener (v, mode); -} - -void -base_properties::delete_listener (const caseless_str& nm, - const octave_value& v, listener_mode mode) -{ - property p = get_property (nm); - - if (! error_state && p.ok ()) - p.delete_listener (v, mode); -} - -// --------------------------------------------------------------------- - -void -base_graphics_object::update_axis_limits (const std::string& axis_type) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (valid_object ()) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - - if (parent_obj) - parent_obj.update_axis_limits (axis_type, h); - } - else - error ("base_graphics_object::update_axis_limits: invalid graphics object"); -} - -void -base_graphics_object::remove_all_listeners (void) -{ - octave_map m = get (true).map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - // FIXME -- there has to be a better way. I think we want to - // ask whether it is OK to delete the listener for the given - // property. How can we know in advance that it will be OK? - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (discard_error_messages); - frame.protect_var (Vdebug_on_error); - frame.protect_var (Vdebug_on_warning); - - discard_error_messages = true; - Vdebug_on_error = false; - Vdebug_on_warning = false; - - property p = get_properties ().get_property (pa->first); - - if (! error_state && p.ok ()) - p.delete_listener (); - } -} - -std::string -base_graphics_object::values_as_string (void) -{ - std::string retval; - - if (valid_object ()) - { - octave_map m = get ().map_value (); - - for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - retval += "\n\t" + std::string (pa->first) + ": "; - if (p.is_radio ()) - retval += p.values_as_string (); - } - } - } - if (retval != "") - retval += "\n"; - } - else - error ("base_graphics_object::values_as_string: invalid graphics object"); - - return retval; -} - -octave_scalar_map -base_graphics_object::values_as_struct (void) -{ - octave_scalar_map retval; - - if (valid_object ()) - { - octave_scalar_map m = get ().scalar_map_value (); - - for (octave_scalar_map::const_iterator pa = m.begin (); - pa != m.end (); pa++) - { - if (pa->first != "children") - { - property p = get_properties ().get_property (pa->first); - - if (p.ok () && ! p.is_hidden ()) - { - if (p.is_radio ()) - retval.assign (p.get_name (), p.values_as_cell ()); - else - retval.assign (p.get_name (), Cell ()); - } - } - } - } - else - error ("base_graphics_object::values_as_struct: invalid graphics object"); - - return retval; -} - -graphics_object -graphics_object::get_ancestor (const std::string& obj_type) const -{ - if (valid_object ()) - { - if (isa (obj_type)) - return *this; - else - return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); - } - else - return graphics_object (); -} - -// --------------------------------------------------------------------- - -#include "graphics-props.cc" - -// --------------------------------------------------------------------- - -void -root_figure::properties::set_currentfigure (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - { - currentfigure = val; - - if (val.ok ()) - gh_manager::push_figure (val); - } - else - gripe_set_invalid ("currentfigure"); -} - -void -root_figure::properties::set_callbackobject (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ())) - { - if (! cbo_stack.empty ()) - { - val = cbo_stack.front (); - - cbo_stack.pop_front (); - } - - callbackobject = val; - } - else if (is_handle (val)) - { - if (get_callbackobject ().ok ()) - cbo_stack.push_front (get_callbackobject ()); - - callbackobject = val; - } - else - gripe_set_invalid ("callbackobject"); -} - -void -figure::properties::set_integerhandle (const octave_value& val) -{ - if (! error_state) - { - if (integerhandle.set (val, true)) - { - bool int_fig_handle = integerhandle.is_on (); - - graphics_object this_go = gh_manager::get_object (__myhandle__); - - graphics_handle old_myhandle = __myhandle__; - - __myhandle__ = gh_manager::get_handle (int_fig_handle); - - gh_manager::renumber_figure (old_myhandle, __myhandle__); - - graphics_object parent_go = gh_manager::get_object (get_parent ()); - - base_properties& props = parent_go.get_properties (); - - props.renumber_child (old_myhandle, __myhandle__); - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object kid = gh_manager::get_object (kids(i)); - - kid.get_properties ().renumber_parent (__myhandle__); - } - - graphics_handle cf = gh_manager::current_figure (); - - if (__myhandle__ == cf) - xset (0, "currentfigure", __myhandle__.value ()); - - this_go.update (integerhandle.get_id ()); - - mark_modified (); - } - } -} - -// FIXME This should update monitorpositions and pointerlocation, but -// as these properties are yet used, and so it doesn't matter that they -// aren't set yet. -void -root_figure::properties::update_units (void) -{ - caseless_str xunits = get_units (); - - Matrix ss = default_screensize (); - - double dpi = get_screenpixelsperinch (); - - if (xunits.compare ("inches")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) /= dpi; - ss(3) /= dpi; - } - else if (xunits.compare ("centimeters")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 2.54 / dpi; - ss(3) *= 2.54 / dpi; - } - else if (xunits.compare ("normalized")) - { - ss = Matrix (1, 4, 1.0); - ss(0) = 0; - ss(1) = 0; - } - else if (xunits.compare ("points")) - { - ss(0) = 0; - ss(1) = 0; - ss(2) *= 72 / dpi; - ss(3) *= 72 / dpi; - } - - set_screensize (ss); -} - -Matrix -root_figure::properties::get_boundingbox (bool, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = Matrix (1, 4, 0); - pos(2) = screen_size(0); - pos(3) = screen_size(1); - return pos; -} - -/* -%!test -%! set (0, "units", "pixels"); -%! sz = get (0, "screensize") - [1, 1, 0, 0]; -%! dpi = get (0, "screenpixelsperinch"); -%! set (0, "units", "inches"); -%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); -%! set (0, "units", "centimeters"); -%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); -%! set (0, "units", "points"); -%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); -%! set (0, "units", "normalized"); -%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); -%! set (0, "units", "pixels"); -%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); -*/ - -void -root_figure::properties::remove_child (const graphics_handle& gh) -{ - gh_manager::pop_figure (gh); - - graphics_handle cf = gh_manager::current_figure (); - - xset (0, "currentfigure", cf.value ()); - - base_properties::remove_child (gh); -} - -property_list -root_figure::factory_properties = root_figure::init_factory_properties (); - -static void -reset_default_properties (property_list& default_properties) -{ - property_list new_defaults; - - for (property_list::plist_map_const_iterator p = default_properties.begin (); - p != default_properties.end (); p++) - { - const property_list::pval_map_type pval_map = p->second; - std::string prefix = p->first; - - for (property_list::pval_map_const_iterator q = pval_map.begin (); - q != pval_map.end (); - q++) - { - std::string s = q->first; - - if (prefix == "axes" && (s == "position" || s == "units")) - new_defaults.set (prefix + s, q->second); - else if (prefix == "figure" && (s == "position" || s == "units" - || s == "windowstyle" - || s == "paperunits")) - new_defaults.set (prefix + s, q->second); - } - } - - default_properties = new_defaults; -} - -void -root_figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -figure::properties::set_currentaxes (const octave_value& v) -{ - graphics_handle val (v); - - if (error_state) - return; - - if (xisnan (val.value ()) || is_handle (val)) - currentaxes = val; - else - gripe_set_invalid ("currentaxes"); -} - -void -figure::properties::remove_child (const graphics_handle& gh) -{ - base_properties::remove_child (gh); - - if (gh == currentaxes.handle_value ()) - { - graphics_handle new_currentaxes; - - Matrix kids = get_children (); - - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_handle kid = kids(i); - - graphics_object go = gh_manager::get_object (kid); - - if (go.isa ("axes")) - { - new_currentaxes = kid; - break; - } - } - - currentaxes = new_currentaxes; - } -} - -void -figure::properties::set_visible (const octave_value& val) -{ - std::string s = val.string_value (); - - if (! error_state) - { - if (s == "on") - xset (0, "currentfigure", __myhandle__.value ()); - - visible = val; - } -} - -Matrix -figure::properties::get_boundingbox (bool internal, const Matrix&) const -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = (internal ? - get_position ().matrix_value () : - get_outerposition ().matrix_value ()); - - pos = convert_position (pos, get_units (), "pixels", screen_size); - - pos(0)--; - pos(1)--; - pos(1) = screen_size(1) - pos(1) - pos(3); - - return pos; -} - -void -figure::properties::set_boundingbox (const Matrix& bb, bool internal, - bool do_notify_toolkit) -{ - Matrix screen_size = screen_size_pixels (); - Matrix pos = bb; - - pos(1) = screen_size(1) - pos(1) - pos(3); - pos(1)++; - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), screen_size); - - if (internal) - set_position (pos, do_notify_toolkit); - else - set_outerposition (pos, do_notify_toolkit); -} - -Matrix -figure::properties::map_from_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos(1) = bb(3) - pos(1); - pos(0)++; - pos = convert_position (pos, "pixels", get_units (), - bb.extract_n (0, 2, 1, 2)); - - return pos; -} - -Matrix -figure::properties::map_to_boundingbox (double x, double y) const -{ - Matrix bb = get_boundingbox (true); - Matrix pos (1, 2, 0); - - pos(0) = x; - pos(1) = y; - - pos = convert_position (pos, get_units (), "pixels", - bb.extract_n (0, 2, 1, 2)); - pos(0)--; - pos(1) = bb(3) - pos(1); - - return pos; -} - -void -figure::properties::set_position (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - Matrix old_bb, new_bb; - bool modified = false; - - old_bb = get_boundingbox (true); - modified = position.set (v, false, do_notify_toolkit); - new_bb = get_boundingbox (true); - - if (old_bb != new_bb) - { - if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) - { - execute_resizefcn (); - update_boundingbox (); - } - } - - if (modified) - { - position.run_listeners (POSTSET); - mark_modified (); - } - } -} - -void -figure::properties::set_outerposition (const octave_value& v, - bool do_notify_toolkit) -{ - if (! error_state) - { - if (outerposition.set (v, true, do_notify_toolkit)) - { - mark_modified (); - } - } -} - -void -figure::properties::set_paperunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = get_papertype (); - caseless_str punits = v.string_value (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - caseless_str old_paperunits = get_paperunits (); - if (paperunits.set (v, true)) - { - update_paperunits (old_paperunits); - mark_modified (); - } - } - } - } -} - -void -figure::properties::set_papertype (const octave_value& v) -{ - if (! error_state) - { - caseless_str typ = v.string_value (); - caseless_str punits = get_paperunits (); - if (! error_state) - { - if (punits.compare ("normalized") && typ.compare ("")) - error ("set: can't set the paperunits to normalized when the papertype is custom"); - else - { - if (papertype.set (v, true)) - { - update_papertype (); - mark_modified (); - } - } - } - } -} - -static Matrix -papersize_from_type (const caseless_str punits, const caseless_str typ) -{ - Matrix ret (1, 2, 1.0); - - if (! punits.compare ("normalized")) - { - double in2units; - double mm2units; - - if (punits.compare ("inches")) - { - in2units = 1.0; - mm2units = 1 / 25.4 ; - } - else if (punits.compare ("centimeters")) - { - in2units = 2.54; - mm2units = 1 / 10.0; - } - else // points - { - in2units = 72.0; - mm2units = 72.0 / 25.4; - } - - if (typ.compare ("usletter")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("uslegal")) - { - ret (0) = 8.5 * in2units; - ret (1) = 14.0 * in2units; - } - else if (typ.compare ("tabloid")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("a0")) - { - ret (0) = 841.0 * mm2units; - ret (1) = 1189.0 * mm2units; - } - else if (typ.compare ("a1")) - { - ret (0) = 594.0 * mm2units; - ret (1) = 841.0 * mm2units; - } - else if (typ.compare ("a2")) - { - ret (0) = 420.0 * mm2units; - ret (1) = 594.0 * mm2units; - } - else if (typ.compare ("a3")) - { - ret (0) = 297.0 * mm2units; - ret (1) = 420.0 * mm2units; - } - else if (typ.compare ("a4")) - { - ret (0) = 210.0 * mm2units; - ret (1) = 297.0 * mm2units; - } - else if (typ.compare ("a5")) - { - ret (0) = 148.0 * mm2units; - ret (1) = 210.0 * mm2units; - } - else if (typ.compare ("b0")) - { - ret (0) = 1029.0 * mm2units; - ret (1) = 1456.0 * mm2units; - } - else if (typ.compare ("b1")) - { - ret (0) = 728.0 * mm2units; - ret (1) = 1028.0 * mm2units; - } - else if (typ.compare ("b2")) - { - ret (0) = 514.0 * mm2units; - ret (1) = 728.0 * mm2units; - } - else if (typ.compare ("b3")) - { - ret (0) = 364.0 * mm2units; - ret (1) = 514.0 * mm2units; - } - else if (typ.compare ("b4")) - { - ret (0) = 257.0 * mm2units; - ret (1) = 364.0 * mm2units; - } - else if (typ.compare ("b5")) - { - ret (0) = 182.0 * mm2units; - ret (1) = 257.0 * mm2units; - } - else if (typ.compare ("arch-a")) - { - ret (0) = 9.0 * in2units; - ret (1) = 12.0 * in2units; - } - else if (typ.compare ("arch-b")) - { - ret (0) = 12.0 * in2units; - ret (1) = 18.0 * in2units; - } - else if (typ.compare ("arch-c")) - { - ret (0) = 18.0 * in2units; - ret (1) = 24.0 * in2units; - } - else if (typ.compare ("arch-d")) - { - ret (0) = 24.0 * in2units; - ret (1) = 36.0 * in2units; - } - else if (typ.compare ("arch-e")) - { - ret (0) = 36.0 * in2units; - ret (1) = 48.0 * in2units; - } - else if (typ.compare ("a")) - { - ret (0) = 8.5 * in2units; - ret (1) = 11.0 * in2units; - } - else if (typ.compare ("b")) - { - ret (0) = 11.0 * in2units; - ret (1) = 17.0 * in2units; - } - else if (typ.compare ("c")) - { - ret (0) = 17.0 * in2units; - ret (1) = 22.0 * in2units; - } - else if (typ.compare ("d")) - { - ret (0) = 22.0 * in2units; - ret (1) = 34.0 * in2units; - } - else if (typ.compare ("e")) - { - ret (0) = 34.0 * in2units; - ret (1) = 43.0 * in2units; - } - } - - return ret; -} - -void -figure::properties::update_paperunits (const caseless_str& old_paperunits) -{ - Matrix pos = get_paperposition ().matrix_value (); - Matrix sz = get_papersize ().matrix_value (); - - pos(0) /= sz(0); - pos(1) /= sz(1); - pos(2) /= sz(0); - pos(3) /= sz(1); - - std::string porient = get_paperorientation (); - caseless_str punits = get_paperunits (); - caseless_str typ = get_papertype (); - - if (typ.compare ("")) - { - if (old_paperunits.compare ("centimeters")) - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (old_paperunits.compare ("points")) - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - - if (punits.compare ("centimeters")) - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits.compare ("points")) - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - } - else - { - sz = papersize_from_type (punits, typ); - if (porient == "landscape") - std::swap (sz(0), sz(1)); - } - - pos(0) *= sz(0); - pos(1) *= sz(1); - pos(2) *= sz(0); - pos(3) *= sz(1); - - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); -} - -void -figure::properties::update_papertype (void) -{ - caseless_str typ = get_papertype (); - if (! typ.compare ("")) - { - Matrix sz = papersize_from_type (get_paperunits (), typ); - if (get_paperorientation () == "landscape") - std::swap (sz(0), sz(1)); - // Call papersize.set rather than set_papersize to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - } -} - -void -figure::properties::update_papersize (void) -{ - Matrix sz = get_papersize ().matrix_value (); - if (sz(0) > sz(1)) - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - paperorientation.set (octave_value ("landscape")); - } - else - { - paperorientation.set ("portrait"); - } - std::string punits = get_paperunits (); - if (punits == "centimeters") - { - sz(0) /= 2.54; - sz(1) /= 2.54; - } - else if (punits == "points") - { - sz(0) /= 72.0; - sz(1) /= 72.0; - } - if (punits == "normalized") - { - caseless_str typ = get_papertype (); - if (get_papertype () == "") - error ("set: can't set the papertype to when the paperunits is normalized"); - } - else - { - // TODO - the papersizes info is also in papersize_from_type(). - // Both should be rewritten to avoid the duplication. - std::string typ = ""; - const double mm2in = 1.0 / 25.4; - const double tol = 0.01; - - if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "usletter"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) - typ = "uslegal"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "tabloid"; - else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) - typ = "a0"; - else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) - typ = "a1"; - else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) - typ = "a2"; - else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) - typ = "a3"; - else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) - typ = "a4"; - else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) - typ = "a5"; - else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) - typ = "b0"; - else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) - typ = "b1"; - else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) - typ = "b2"; - else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) - typ = "b3"; - else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) - typ = "b4"; - else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) - typ = "b5"; - else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) - typ = "arch-a"; - else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) - typ = "arch-b"; - else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) - typ = "arch-c"; - else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) - typ = "arch-d"; - else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) - typ = "arch-e"; - else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) - typ = "a"; - else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) - typ = "b"; - else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) - typ = "c"; - else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) - typ = "d"; - else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) - typ = "e"; - // Call papertype.set rather than set_papertype to avoid loops between - // update_papersize and update_papertype - papertype.set (typ); - } - if (punits == "centimeters") - { - sz(0) *= 2.54; - sz(1) *= 2.54; - } - else if (punits == "points") - { - sz(0) *= 72.0; - sz(1) *= 72.0; - } - if (get_paperorientation () == "landscape") - { - std::swap (sz(0), sz(1)); - papersize.set (octave_value (sz)); - } -} - -/* -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]) -%! set (1, "paperunits", "points"); -%! assert (get (1, "papersize"), [5, 4] * 72, 1) -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize) -%! assert (get (1, "papersize"), [5, 4] * 72, 1) -%! close (1) -%!test -%! figure (1, "visible", "off"); -%! set (1, "paperunits", "inches"); -%! set (1, "papersize", [5, 4]) -%! set (1, "paperunits", "centimeters"); -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) -%! papersize = get (gcf, "papersize"); -%! set (1, "papersize", papersize + 1); -%! set (1, "papersize", papersize) -%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) -%! close (1) -*/ - -void -figure::properties::update_paperorientation (void) -{ - std::string porient = get_paperorientation (); - Matrix sz = get_papersize ().matrix_value (); - Matrix pos = get_paperposition ().matrix_value (); - if ((sz(0) > sz(1) && porient == "portrait") - || (sz(0) < sz(1) && porient == "landscape")) - { - std::swap (sz(0), sz(1)); - std::swap (pos(0), pos(1)); - std::swap (pos(2), pos(3)); - // Call papertype.set rather than set_papertype to avoid loops - // between update_papersize and update_papertype - papersize.set (octave_value (sz)); - paperposition.set (octave_value (pos)); - } -} - -/* -%!test -%! figure (1, "visible", false); -%! tol = 100 * eps (); -%! ## UPPER case and MiXed case is part of test and should not be changed. -%! set (gcf (), "paperorientation", "PORTRAIT"); -%! set (gcf (), "paperunits", "inches"); -%! set (gcf (), "papertype", "USletter"); -%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); -%! set (gcf (), "paperorientation", "Landscape"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); -%! set (gcf (), "paperunits", "centimeters"); -%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); -%! set (gcf (), "papertype", "a4"); -%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); -%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "portrait"); -%! set (gcf (), "papersize", [11.0, 8.5]); -%! assert (get (gcf (), "papertype"), "usletter"); -%! assert (get (gcf (), "paperorientation"), "landscape"); -*/ - -void -figure::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -figure::properties::update_units (const caseless_str& old_units) -{ - position.set (convert_position (get_position ().matrix_value (), old_units, - get_units (), screen_size_pixels ()), false); -} - -/* -%!test -%! figure (1, "visible", false); -%! set (0, "units", "pixels"); -%! rsz = get (0, "screensize"); -%! set (gcf (), "units", "pixels"); -%! fsz = get (gcf (), "position"); -%! set (gcf (), "units", "normalized"); -%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); -*/ - -std::string -figure::properties::get_title (void) const -{ - if (is_numbertitle ()) - { - std::ostringstream os; - std::string nm = get_name (); - - os << "Figure " << __myhandle__.value (); - if (! nm.empty ()) - os << ": " << get_name (); - - return os.str (); - } - else - return get_name (); -} - -octave_value -figure::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -figure::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -void -axes::properties::init (void) -{ - position.add_constraint (dim_vector (1, 4)); - position.add_constraint (dim_vector (0, 0)); - outerposition.add_constraint (dim_vector (1, 4)); - colororder.add_constraint (dim_vector (-1, 3)); - dataaspectratio.add_constraint (dim_vector (1, 3)); - plotboxaspectratio.add_constraint (dim_vector (1, 3)); - xlim.add_constraint (2); - ylim.add_constraint (2); - zlim.add_constraint (2); - clim.add_constraint (2); - alim.add_constraint (2); - xtick.add_constraint (dim_vector (1, -1)); - ytick.add_constraint (dim_vector (1, -1)); - ztick.add_constraint (dim_vector (1, -1)); - Matrix vw (1, 2, 0); - vw(1) = 90; - view = vw; - view.add_constraint (dim_vector (1, 2)); - cameraposition.add_constraint (dim_vector (1, 3)); - Matrix upv (1, 3, 0.0); - upv(2) = 1.0; - cameraupvector = upv; - cameraupvector.add_constraint (dim_vector (1, 3)); - currentpoint.add_constraint (dim_vector (2, 3)); - ticklength.add_constraint (dim_vector (1, 2)); - tightinset.add_constraint (dim_vector (1, 4)); - looseinset.add_constraint (dim_vector (1, 4)); - update_font (); - - x_zlim.resize (1, 2); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "cap"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - Matrix tlooseinset = default_axes_position (); - tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); - tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); - looseinset = tlooseinset; -} - -Matrix -axes::properties::calc_tightbox (const Matrix& init_pos) -{ - Matrix pos = init_pos; - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true); - Matrix ext = get_extent (true, true); - ext(1) = parent_bb(3) - ext(1) - ext(3); - ext(0)++; - ext(1)++; - ext = convert_position (ext, "pixels", get_units (), - parent_bb.extract_n (0, 2, 1, 2)); - if (ext(0) < pos(0)) - { - pos(2) += pos(0)-ext(0); - pos(0) = ext(0); - } - if (ext(0)+ext(2) > pos(0)+pos(2)) - pos(2) = ext(0)+ext(2)-pos(0); - - if (ext(1) < pos(1)) - { - pos(3) += pos(1)-ext(1); - pos(1) = ext(1); - } - if (ext(1)+ext(3) > pos(1)+pos(3)) - pos(3) = ext(1)+ext(3)-pos(1); - return pos; -} - -void -axes::properties::sync_positions (void) -{ - Matrix ref_linset = looseinset.get ().matrix_value (); - if (autopos_tag_is ("subplot")) - { - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - if (parent_obj.isa ("figure")) - { - // FIXME: temporarily changed units should be protected - // from interrupts - std::string fig_units = parent_obj.get ("units").string_value (); - parent_obj.set ("units", "pixels"); - - Matrix ref_outbox = outerposition.get ().matrix_value (); - ref_outbox(2) += ref_outbox(0); - ref_outbox(3) += ref_outbox(1); - - // Find those subplots that are left, right, bottom and top aligned - // with the current subplot - Matrix kids = parent_obj.get_properties ().get_children (); - std::vector aligned; - std::vector l_aligned, b_aligned, r_aligned, t_aligned; - for (octave_idx_type i = 0; i < kids.numel (); i++) - { - graphics_object go = gh_manager::get_object (kids(i)); - if (go.isa ("axes")) - { - axes::properties& props = - dynamic_cast (go.get_properties ()); - if (props.autopos_tag_is ("subplot")) - { - Matrix outpos = go.get ("outerposition").matrix_value (); - bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); - bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); - bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); - bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); - if (l_align || b_align || r_align || t_align) - { - aligned.push_back (kids(i)); - l_aligned.push_back (l_align); - b_aligned.push_back (b_align); - r_aligned.push_back (r_align); - t_aligned.push_back (t_align); - // FIXME: the temporarily deleted tags should be - // protected from interrupts - props.set_autopos_tag ("none"); - } - } - } - } - // Determine a minimum box which aligns the subplots - Matrix ref_box (1, 4, 0.); - ref_box(2) = 1.; - ref_box(3) = 1.; - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = std::min (0., linset(0)-0.01); - if (b_aligned[i]) - linset(1) = std::min (0., linset(1)-0.01); - if (r_aligned[i]) - linset(2) = std::min (0., linset(2)-0.01); - if (t_aligned[i]) - linset(3) = std::min (0., linset(3)-0.01); - props.set_looseinset (linset); - Matrix pos = props.get_position ().matrix_value (); - if (l_aligned[i]) - ref_box(0) = std::max (ref_box(0), pos(0)); - if (b_aligned[i]) - ref_box(1) = std::max (ref_box(1), pos(1)); - if (r_aligned[i]) - ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); - if (t_aligned[i]) - ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); - } - // Set common looseinset values for all aligned subplots and - // revert their tag values - for (size_t i = 0; i < aligned.size (); i++) - { - graphics_object go = gh_manager::get_object (aligned[i]); - axes::properties& props = - dynamic_cast (go.get_properties ()); - Matrix outpos = props.get_outerposition ().matrix_value (); - Matrix linset = props.get_looseinset ().matrix_value (); - if (l_aligned[i]) - linset(0) = (ref_box(0)-outpos(0))/outpos(2); - if (b_aligned[i]) - linset(1) = (ref_box(1)-outpos(1))/outpos(3); - if (r_aligned[i]) - linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); - if (t_aligned[i]) - linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); - props.set_looseinset (linset); - props.set_autopos_tag ("subplot"); - } - parent_obj.set ("units", fig_units); - } - } - else - sync_positions (ref_linset); -} - -void -axes::properties::sync_positions (const Matrix& linset) -{ - Matrix pos = position.get ().matrix_value (); - Matrix outpos = outerposition.get ().matrix_value (); - double lratio = linset(0); - double bratio = linset(1); - double wratio = 1-linset(0)-linset(2); - double hratio = 1-linset(1)-linset(3); - if (activepositionproperty.is ("outerposition")) - { - pos = outpos; - pos(0) = outpos(0)+lratio*outpos(2); - pos(1) = outpos(1)+bratio*outpos(3); - pos(2) = wratio*outpos(2); - pos(3) = hratio*outpos(3); - - position = pos; - update_transform (); - Matrix tightpos = calc_tightbox (pos); - - double thrshldx = 0.005*outpos(2); - double thrshldy = 0.005*outpos(3); - double minsizex = 0.2*outpos(2); - double minsizey = 0.2*outpos(3); - bool updatex = true, updatey = true; - for (int i = 0; i < 10; i++) - { - double dt; - bool modified = false; - dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); - if (dt < -thrshldx && updatex) - { - pos(2) += dt; - modified = true; - } - dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); - if (dt < -thrshldy && updatey) - { - pos(3) += dt; - modified = true; - } - dt = outpos(0)-tightpos(0); - if (dt > thrshldx && updatex) - { - pos(0) += dt; - pos(2) -= dt; - modified = true; - } - dt = outpos(1)-tightpos(1); - if (dt > thrshldy && updatey) - { - pos(1) += dt; - pos(3) -= dt; - modified = true; - } - - // Note: checking limit for minimum axes size - if (pos(2) < minsizex) - { - pos(0) -= 0.5*(minsizex-pos(2)); - pos(2) = minsizex; - updatex = false; - } - if (pos(3) < minsizey) - { - pos(1) -= 0.5*(minsizey-pos(3)); - pos(3) = minsizey; - updatey = false; - } - - if (modified) - { - position = pos; - update_transform (); - tightpos = calc_tightbox (pos); - } - else - break; - } - } - else - { - update_transform (); - - outpos(0) = pos(0)-pos(2)*lratio/wratio; - outpos(1) = pos(1)-pos(3)*bratio/hratio; - outpos(2) = pos(2)/wratio; - outpos(3) = pos(3)/hratio; - - outerposition = calc_tightbox (outpos); - } - - Matrix inset (1, 4, 1.0); - inset(0) = pos(0)-outpos(0); - inset(1) = pos(1)-outpos(1); - inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); - inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); - - tightinset = inset; -} - -void -axes::properties::set_text_child (handle_property& hp, - const std::string& who, - const octave_value& v) -{ - graphics_handle val; - - if (v.is_string ()) - { - val = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (val, "string", v); - } - else - { - graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); - - if (go.isa ("text")) - val = ::reparent (v, "set", who, __myhandle__, false); - else - { - std::string cname = v.class_name (); - - error ("set: expecting text graphics object or character string for %s property, found %s", - who.c_str (), cname.c_str ()); - } - } - - if (! error_state) - { - xset (val, "handlevisibility", "off"); - - gh_manager::free (hp.handle_value ()); - - base_properties::remove_child (hp.handle_value ()); - - hp = val; - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::set_xlabel (const octave_value& v) -{ - set_text_child (xlabel, "xlabel", v); - xset (xlabel.handle_value (), "positionmode", "auto"); - xset (xlabel.handle_value (), "rotationmode", "auto"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (xlabel.handle_value (), "clipping", "off"); - xset (xlabel.handle_value (), "color", get_xcolor ()); - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - update_xlabel_position (); -} - -void -axes::properties::set_ylabel (const octave_value& v) -{ - set_text_child (ylabel, "ylabel", v); - xset (ylabel.handle_value (), "positionmode", "auto"); - xset (ylabel.handle_value (), "rotationmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "color", get_ycolor ()); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - update_ylabel_position (); -} - -void -axes::properties::set_zlabel (const octave_value& v) -{ - set_text_child (zlabel, "zlabel", v); - xset (zlabel.handle_value (), "positionmode", "auto"); - xset (zlabel.handle_value (), "rotationmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "color", get_zcolor ()); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - update_zlabel_position (); -} - -void -axes::properties::set_title (const octave_value& v) -{ - set_text_child (title, "title", v); - xset (title.handle_value (), "positionmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "clipping", "off"); - xset (title.handle_value (), "autopos_tag", "title"); - update_title_position (); -} - -void -axes::properties::set_defaults (base_graphics_object& obj, - const std::string& mode) -{ - box = "on"; - colororder = default_colororder (); - dataaspectratio = Matrix (1, 3, 1.0); - dataaspectratiomode = "auto"; - layer = "bottom"; - - Matrix tlim (1, 2, 0.0); - tlim(1) = 1; - xlim = tlim; - ylim = tlim; - zlim = tlim; - - Matrix cl (1, 2, 0); - cl(1) = 1; - clim = cl; - - xlimmode = "auto"; - ylimmode = "auto"; - zlimmode = "auto"; - climmode = "auto"; - - xgrid = "off"; - ygrid = "off"; - zgrid = "off"; - xminorgrid = "off"; - yminorgrid = "off"; - zminorgrid = "off"; - xtick = Matrix (); - ytick = Matrix (); - ztick = Matrix (); - xtickmode = "auto"; - ytickmode = "auto"; - ztickmode = "auto"; - xticklabel = ""; - yticklabel = ""; - zticklabel = ""; - xticklabelmode = "auto"; - yticklabelmode = "auto"; - zticklabelmode = "auto"; - color = color_values ("white"); - xcolor = color_values ("black"); - ycolor = color_values ("black"); - zcolor = color_values ("black"); - xscale = "linear"; - yscale = "linear"; - zscale = "linear"; - xdir = "normal"; - ydir = "normal"; - zdir = "normal"; - yaxislocation = "left"; - xaxislocation = "bottom"; - - // Note: camera properties will be set through update_transform - camerapositionmode = "auto"; - cameratargetmode = "auto"; - cameraupvectormode = "auto"; - cameraviewanglemode = "auto"; - plotboxaspectratio = Matrix (1, 3, 1.0); - drawmode = "normal"; - gridlinestyle = ":"; - linestyleorder = "-"; - linewidth = 0.5; - minorgridlinestyle = ":"; - // Note: plotboxaspectratio will be set through update_aspectratiors - plotboxaspectratiomode = "auto"; - projection = "orthographic"; - tickdir = "in"; - tickdirmode = "auto"; - ticklength = default_axes_ticklength (); - tightinset = Matrix (1, 4, 0.0); - - sx = "linear"; - sy = "linear"; - sz = "linear"; - - Matrix tview (1, 2, 0.0); - tview(1) = 90; - view = tview; - - visible = "on"; - nextplot = "replace"; - - if (mode != "replace") - { - fontangle = "normal"; - fontname = OCTAVE_DEFAULT_FONTNAME; - fontsize = 10; - fontunits = "points"; - fontweight = "normal"; - - Matrix touterposition (1, 4, 0.0); - touterposition(2) = 1; - touterposition(3) = 1; - outerposition = touterposition; - - position = default_axes_position (); - - Matrix tlooseinset = default_axes_position (); - tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); - tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); - looseinset = tlooseinset; - - activepositionproperty = "outerposition"; - } - - delete_children (true); - - xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - title = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (xlabel.handle_value (), "handlevisibility", "off"); - xset (ylabel.handle_value (), "handlevisibility", "off"); - xset (zlabel.handle_value (), "handlevisibility", "off"); - xset (title.handle_value (), "handlevisibility", "off"); - - xset (xlabel.handle_value (), "horizontalalignment", "center"); - xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (ylabel.handle_value (), "horizontalalignment", "center"); - xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (zlabel.handle_value (), "horizontalalignment", "right"); - xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); - xset (title.handle_value (), "horizontalalignment", "center"); - xset (title.handle_value (), "horizontalalignmentmode", "auto"); - - xset (xlabel.handle_value (), "verticalalignment", "cap"); - xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); - xset (ylabel.handle_value (), "verticalalignment", "bottom"); - xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); - xset (title.handle_value (), "verticalalignment", "bottom"); - xset (title.handle_value (), "verticalalignmentmode", "auto"); - - xset (ylabel.handle_value (), "rotation", 90.0); - xset (ylabel.handle_value (), "rotationmode", "auto"); - - xset (zlabel.handle_value (), "visible", "off"); - - xset (xlabel.handle_value (), "clipping", "off"); - xset (ylabel.handle_value (), "clipping", "off"); - xset (zlabel.handle_value (), "clipping", "off"); - xset (title.handle_value (), "clipping", "off"); - - xset (xlabel.handle_value (), "autopos_tag", "xlabel"); - xset (ylabel.handle_value (), "autopos_tag", "ylabel"); - xset (zlabel.handle_value (), "autopos_tag", "zlabel"); - xset (title.handle_value (), "autopos_tag", "title"); - - adopt (xlabel.handle_value ()); - adopt (ylabel.handle_value ()); - adopt (zlabel.handle_value ()); - adopt (title.handle_value ()); - - update_transform (); - - override_defaults (obj); -} - -void -axes::properties::delete_text_child (handle_property& hp) -{ - graphics_handle h = hp.handle_value (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - if (go.valid_object ()) - gh_manager::free (h); - - base_properties::remove_child (h); - } - - // FIXME -- is it necessary to check whether the axes object is - // being deleted now? I think this function is only called when an - // individual child object is delete and not when the parent axes - // object is deleted. - - if (! is_beingdeleted ()) - { - hp = gh_manager::make_graphics_handle ("text", __myhandle__, - false, false); - - xset (hp.handle_value (), "handlevisibility", "off"); - - adopt (hp.handle_value ()); - } -} - -void -axes::properties::remove_child (const graphics_handle& h) -{ - if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) - delete_text_child (xlabel); - else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) - delete_text_child (ylabel); - else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) - delete_text_child (zlabel); - else if (title.handle_value ().ok () && h == title.handle_value ()) - delete_text_child (title); - else - base_properties::remove_child (h); -} - -inline Matrix -xform_matrix (void) -{ - Matrix m (4, 4, 0.0); - for (int i = 0; i < 4; i++) - m(i,i) = 1; - return m; -} - -inline ColumnVector -xform_vector (void) -{ - ColumnVector v (4, 0.0); - v(3) = 1; - return v; -} - -inline ColumnVector -xform_vector (double x, double y, double z) -{ - ColumnVector v (4, 1.0); - v(0) = x; v(1) = y; v(2) = z; - return v; -} - -inline ColumnVector -transform (const Matrix& m, double x, double y, double z) -{ - return (m * xform_vector (x, y, z)); -} - -inline Matrix -xform_scale (double x, double y, double z) -{ - Matrix m (4, 4, 0.0); - m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; - return m; -} - -inline Matrix -xform_translate (double x, double y, double z) -{ - Matrix m = xform_matrix (); - m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; - return m; -} - -inline void -scale (Matrix& m, double x, double y, double z) -{ - m = m * xform_scale (x, y, z); -} - -inline void -translate (Matrix& m, double x, double y, double z) -{ - m = m * xform_translate (x, y, z); -} - -inline void -xform (ColumnVector& v, const Matrix& m) -{ - v = m*v; -} - -inline void -scale (ColumnVector& v, double x, double y, double z) -{ - v(0) *= x; - v(1) *= y; - v(2) *= z; -} - -inline void -translate (ColumnVector& v, double x, double y, double z) -{ - v(0) += x; - v(1) += y; - v(2) += z; -} - -inline void -normalize (ColumnVector& v) -{ - double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); - scale (v, fact, fact, fact); -} - -inline double -dot (const ColumnVector& v1, const ColumnVector& v2) -{ - return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); -} - -inline double -norm (const ColumnVector& v) -{ - return sqrt (dot (v, v)); -} - -inline ColumnVector -cross (const ColumnVector& v1, const ColumnVector& v2) -{ - ColumnVector r = xform_vector (); - r(0) = v1(1)*v2(2)-v1(2)*v2(1); - r(1) = v1(2)*v2(0)-v1(0)*v2(2); - r(2) = v1(0)*v2(1)-v1(1)*v2(0); - return r; -} - -inline Matrix -unit_cube (void) -{ - static double data[32] = { - 0,0,0,1, - 1,0,0,1, - 0,1,0,1, - 0,0,1,1, - 1,1,0,1, - 1,0,1,1, - 0,1,1,1, - 1,1,1,1}; - Matrix m (4, 8); - memcpy (m.fortran_vec (), data, sizeof (double)*32); - return m; -} - -inline ColumnVector -cam2xform (const Array& m) -{ - ColumnVector retval (4, 1.0); - memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); - return retval; -} - -inline RowVector -xform2cam (const ColumnVector& v) -{ - return v.extract_n (0, 3).transpose (); -} - -void -axes::properties::update_camera (void) -{ - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); - Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); - Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); - - double xo = xlimits(xd > 0 ? 0 : 1); - double yo = ylimits(yd > 0 ? 0 : 1); - double zo = zlimits(zd > 0 ? 0 : 1); - - Matrix pb = get_plotboxaspectratio ().matrix_value (); - - bool autocam = (camerapositionmode_is ("auto") - && cameratargetmode_is ("auto") - && cameraupvectormode_is ("auto") - && cameraviewanglemode_is ("auto")); - bool dowarp = (autocam && dataaspectratiomode_is ("auto") - && plotboxaspectratiomode_is ("auto")); - - ColumnVector c_eye (xform_vector ()); - ColumnVector c_center (xform_vector ()); - ColumnVector c_upv (xform_vector ()); - - if (cameratargetmode_is ("auto")) - { - c_center(0) = (xlimits(0)+xlimits(1))/2; - c_center(1) = (ylimits(0)+ylimits(1))/2; - c_center(2) = (zlimits(0)+zlimits(1))/2; - - cameratarget = xform2cam (c_center); - } - else - c_center = cam2xform (get_cameratarget ().matrix_value ()); - - if (camerapositionmode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); - - if (el == 90 || el == -90) - c_eye(2) = d*signum (el); - else - { - az *= M_PI/180.0; - el *= M_PI/180.0; - c_eye(0) = d * cos (el) * sin (az); - c_eye(1) = -d* cos (el) * cos (az); - c_eye(2) = d * sin (el); - } - c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); - c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); - c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); - - cameraposition = xform2cam (c_eye); - } - else - c_eye = cam2xform (get_cameraposition ().matrix_value ()); - - if (cameraupvectormode_is ("auto")) - { - Matrix tview = get_view ().matrix_value (); - double az = tview(0), el = tview(1); - - if (el == 90 || el == -90) - { - c_upv(0) = - -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); - c_upv(1) = - signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); - } - else - c_upv(2) = 1; - - cameraupvector = xform2cam (c_upv); - } - else - c_upv = cam2xform (get_cameraupvector ().matrix_value ()); - - Matrix x_view = xform_matrix (); - Matrix x_projection = xform_matrix (); - Matrix x_viewport = xform_matrix (); - Matrix x_normrender = xform_matrix (); - Matrix x_pre = xform_matrix (); - - x_render = xform_matrix (); - x_render_inv = xform_matrix (); - - scale (x_pre, pb(0), pb(1), pb(2)); - translate (x_pre, -0.5, -0.5, -0.5); - scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_pre, -xo, -yo, -zo); - - xform (c_eye, x_pre); - xform (c_center, x_pre); - scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), - pb(2)/(zlimits(1)-zlimits(0))); - translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); - - ColumnVector F (c_center), f (F), UP (c_upv); - normalize (f); - normalize (UP); - - if (std::abs (dot (f, UP)) > 1e-15) - { - double fa = 1 / sqrt(1-f(2)*f(2)); - scale (UP, fa, fa, fa); - } - - ColumnVector s = cross (f, UP); - ColumnVector u = cross (s, f); - - scale (x_view, 1, 1, -1); - Matrix l = xform_matrix (); - l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); - l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); - l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); - x_view = x_view * l; - translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); - scale (x_view, pb(0), pb(1), pb(2)); - translate (x_view, -0.5, -0.5, -0.5); - - Matrix x_cube = x_view * unit_cube (); - ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); - double xM = cmax(0)-cmin(0); - double yM = cmax(1)-cmin(1); - - Matrix bb = get_boundingbox (true); - - double v_angle; - - if (cameraviewanglemode_is ("auto")) - { - double af; - - // FIXME -- was this really needed? When compared to Matlab, it - // does not seem to be required. Need investigation with concrete - // graphics toolkit to see results visually. - if (false && dowarp) - af = 1.0 / (xM > yM ? xM : yM); - else - { - if ((bb(2)/bb(3)) > (xM/yM)) - af = 1.0 / yM; - else - af = 1.0 / xM; - } - v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); - - cameraviewangle = v_angle; - } - else - v_angle = get_cameraviewangle (); - - double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); - scale (x_projection, pf, pf, 1); - - if (dowarp) - { - xM *= pf; - yM *= pf; - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); - } - else - { - double pix = 1; - if (autocam) - { - if ((bb(2)/bb(3)) > (xM/yM)) - pix = bb(3); - else - pix = bb(2); - } - else - pix = (bb(2) < bb(3) ? bb(2) : bb(3)); - translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); - scale (x_viewport, pix, -pix, 1); - } - - x_normrender = x_viewport * x_projection * x_view; - - x_cube = x_normrender * unit_cube (); - cmin = x_cube.row_min (); - cmax = x_cube.row_max (); - x_zlim.resize (1, 2); - x_zlim(0) = cmin(2); - x_zlim(1) = cmax(2); - - x_render = x_normrender; - scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_render, -xo, -yo, -zo); - - x_viewtransform = x_view; - x_projectiontransform = x_projection; - x_viewporttransform = x_viewport; - x_normrendertransform = x_normrender; - x_rendertransform = x_render; - - x_render_inv = x_render.inverse (); - - // Note: these matrices are a slight modified version of the regular - // matrices, more suited for OpenGL rendering (x_gl_mat1 => light - // => x_gl_mat2) - x_gl_mat1 = x_view; - scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), - zd/(zlimits(1)-zlimits(0))); - translate (x_gl_mat1, -xo, -yo, -zo); - x_gl_mat2 = x_viewport * x_projection; -} - -static bool updating_axes_layout = false; - -void -axes::properties::update_axes_layout (void) -{ - if (updating_axes_layout) - return; - - graphics_xform xform = get_transform (); - - double xd = (xdir_is ("normal") ? 1 : -1); - double yd = (ydir_is ("normal") ? 1 : -1); - double zd = (zdir_is ("normal") ? 1 : -1); - - const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); - const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); - const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); - double x_min = xlims(0), x_max = xlims(1); - double y_min = ylims(0), y_max = ylims(1); - double z_min = zlims(0), z_max = zlims(1); - - ColumnVector p1, p2, dir (3); - - xstate = ystate = zstate = AXE_ANY_DIR; - - p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); - p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - xstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - xstate = AXE_VERT_DIR; - else if (dir(1) == 0) - xstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - xPlane = (dir(0) > 0 ? x_max : x_min); - else - xPlane = (dir(1) < 0 ? x_max : x_min); - } - else - xPlane = (dir(2) < 0 ? x_min : x_max); - - xPlaneN = (xPlane == x_min ? x_max : x_min); - fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); - p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - ystate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - ystate = AXE_VERT_DIR; - else if (dir(1) == 0) - ystate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - yPlane = (dir(0) > 0 ? y_max : y_min); - else - yPlane = (dir(1) < 0 ? y_max : y_min); - } - else - yPlane = (dir(2) < 0 ? y_min : y_max); - - yPlaneN = (yPlane == y_min ? y_max : y_min); - fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); - p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); - dir(0) = xround (p2(0)-p1(0)); - dir(1) = xround (p2(1)-p1(1)); - dir(2) = (p2(2)-p1(2)); - if (dir(0) == 0 && dir(1) == 0) - zstate = AXE_DEPTH_DIR; - else if (dir(2) == 0) - { - if (dir(0) == 0) - zstate = AXE_VERT_DIR; - else if (dir(1) == 0) - zstate = AXE_HORZ_DIR; - } - - if (dir(2) == 0) - { - if (dir(1) == 0) - zPlane = (dir(0) > 0 ? z_min : z_max); - else - zPlane = (dir(1) < 0 ? z_min : z_max); - } - else - zPlane = (dir(2) < 0 ? z_min : z_max); - - zPlaneN = (zPlane == z_min ? z_max : z_min); - fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); - - unwind_protect frame; - frame.protect_var (updating_axes_layout); - updating_axes_layout = true; - - xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); - zSign = (zd*(zPlane-zPlaneN) <= 0); - xyzSym = zSign ? xySym : !xySym; - xpTick = (zSign ? xPlaneN : xPlane); - ypTick = (zSign ? yPlaneN : yPlane); - zpTick = (zSign ? zPlane : zPlaneN); - xpTickN = (zSign ? xPlane : xPlaneN); - ypTickN = (zSign ? yPlane : yPlaneN); - zpTickN = (zSign ? zPlaneN : zPlane); - - /* 2D mode */ - x2Dtop = false; - y2Dright = false; - layer2Dtop = false; - if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) - { - if (xaxislocation_is ("top")) - { - double tmp = yPlane; - yPlane = yPlaneN; - yPlaneN = tmp; - x2Dtop = true; - } - ypTick = yPlaneN; - ypTickN = yPlane; - if (yaxislocation_is ("right")) - { - double tmp = xPlane; - xPlane = xPlaneN; - xPlaneN = tmp; - y2Dright = true; - } - xpTick = xPlaneN; - xpTickN = xPlane; - if (layer_is ("top")) - { - zpTick = zPlaneN; - layer2Dtop = true; - } - else - zpTick = zPlane; - } - - Matrix viewmat = get_view ().matrix_value (); - nearhoriz = std::abs (viewmat(1)) <= 5; - - update_ticklength (); -} - -void -axes::properties::update_ticklength (void) -{ - bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + - (ystate > AXE_DEPTH_DIR ? 1 : 0) + - (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); - - if (tickdirmode_is ("auto")) - tickdir.set (mode2d ? "in" : "out", true); - - double ticksign = (tickdir_is ("in") ? -1 : 1); - - Matrix bbox = get_boundingbox (true); - Matrix ticklen = get_ticklength ().matrix_value (); - ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); - ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); - - xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); - - xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; - ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; - ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; - - update_xlabel_position (); - update_ylabel_position (); - update_zlabel_position (); - update_title_position (); -} - -/* -## FIXME: A demo can't be called in a C++ file. This should be made a test -## or moved to a .m file where it can be called. -%!demo -%! clf; -%! subplot (2,1,1); -%! plot (rand (3)); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -%! subplot (2,1,2); -%! plot (rand (3)); -%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); -%! xlabel xlabel; -%! ylabel ylabel; -%! title title; -*/ - -static bool updating_xlabel_position = false; - -void -axes::properties::update_xlabel_position (void) -{ - if (updating_xlabel_position) - return; - - text::properties& xlabel_props = reinterpret_cast - (gh_manager::get_object (get_xlabel ()).get_properties ()); - - bool is_empty = xlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_xlabel_position); - updating_xlabel_position = true; - - if (! is_empty) - { - if (xlabel_props.horizontalalignmentmode_is ("auto")) - { - xlabel_props.set_horizontalalignment - (xstate > AXE_DEPTH_DIR - ? "center" : (xyzSym ? "left" : "right")); - - xlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (xlabel_props.verticalalignmentmode_is ("auto")) - { - xlabel_props.set_verticalalignment - (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); - - xlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (xlabel_props.positionmode_is ("auto") - || xlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fy); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); - else - p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (xstate) - { - case AXE_ANY_DIR: - p(0) += (xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += (x2Dtop ? -hmax : hmax); - break; - } - - if (xlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - xlabel_props.set_position (p.extract_n (0, 3).transpose ()); - xlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && xlabel_props.rotationmode_is ("auto")) - { - xlabel_props.set_rotation (angle); - xlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_ylabel_position = false; - -void -axes::properties::update_ylabel_position (void) -{ - if (updating_ylabel_position) - return; - - text::properties& ylabel_props = reinterpret_cast - (gh_manager::get_object (get_ylabel ()).get_properties ()); - - bool is_empty = ylabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_ylabel_position); - updating_ylabel_position = true; - - if (! is_empty) - { - if (ylabel_props.horizontalalignmentmode_is ("auto")) - { - ylabel_props.set_horizontalalignment - (ystate > AXE_DEPTH_DIR - ? "center" : (!xyzSym ? "left" : "right")); - - ylabel_props.set_horizontalalignmentmode ("auto"); - } - - if (ylabel_props.verticalalignmentmode_is ("auto")) - { - ylabel_props.set_verticalalignment - (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); - - ylabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (ylabel_props.positionmode_is ("auto") - || ylabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_ytick ().matrix_value (), - get_yticklabel ().all_strings (), - get_ylim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p = - graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); - - bool tick_along_z = nearhoriz || xisinf (fx); - if (tick_along_z) - p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); - else - p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); - - p = xform.transform (p(0), p(1), p(2), false); - - switch (ystate) - { - case AXE_ANY_DIR: - p(0) += (!xyzSym ? wmax : -wmax); - p(1) += hmax; - break; - - case AXE_VERT_DIR: - p(0) += (y2Dright ? wmax : -wmax); - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (ylabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - ylabel_props.set_position (p.extract_n (0, 3).transpose ()); - ylabel_props.set_positionmode ("auto"); - } - - if (! is_empty && ylabel_props.rotationmode_is ("auto")) - { - ylabel_props.set_rotation (angle); - ylabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_zlabel_position = false; - -void -axes::properties::update_zlabel_position (void) -{ - if (updating_zlabel_position) - return; - - text::properties& zlabel_props = reinterpret_cast - (gh_manager::get_object (get_zlabel ()).get_properties ()); - - bool camAuto = cameraupvectormode_is ("auto"); - bool is_empty = zlabel_props.get_string ().is_empty (); - - unwind_protect frame; - frame.protect_var (updating_zlabel_position); - updating_zlabel_position = true; - - if (! is_empty) - { - if (zlabel_props.horizontalalignmentmode_is ("auto")) - { - zlabel_props.set_horizontalalignment - ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); - - zlabel_props.set_horizontalalignmentmode ("auto"); - } - - if (zlabel_props.verticalalignmentmode_is ("auto")) - { - zlabel_props.set_verticalalignment - (zstate == AXE_VERT_DIR - ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); - - zlabel_props.set_verticalalignmentmode ("auto"); - } - } - - if (zlabel_props.positionmode_is ("auto") - || zlabel_props.rotationmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_ztick ().matrix_value (), - get_zticklabel ().all_strings (), - get_zlim ().matrix_value ()); - - double wmax = ext(0), hmax = ext(1), angle = 0; - ColumnVector p; - - if (xySym) - { - p = graphics_xform::xform_vector (xPlaneN, yPlane, - (zpTickN+zpTick)/2); - if (xisinf (fy)) - p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); - else - p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); - } - else - { - p = graphics_xform::xform_vector (xPlane, yPlaneN, - (zpTickN+zpTick)/2); - if (xisinf (fx)) - p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); - else - p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); - } - - p = xform.transform (p(0), p(1), p(2), false); - - switch (zstate) - { - case AXE_ANY_DIR: - if (camAuto) - { - p(0) -= wmax; - angle = 90; - } - - // FIXME -- what's the correct offset? - // - // p[0] += (!xySym ? wmax : -wmax); - // p[1] += (zSign ? hmax : -hmax); - - break; - - case AXE_VERT_DIR: - p(0) -= wmax; - angle = 90; - break; - - case AXE_HORZ_DIR: - p(1) += hmax; - break; - } - - if (zlabel_props.positionmode_is ("auto")) - { - p = xform.untransform (p(0), p(1), p(2), true); - zlabel_props.set_position (p.extract_n (0, 3).transpose ()); - zlabel_props.set_positionmode ("auto"); - } - - if (! is_empty && zlabel_props.rotationmode_is ("auto")) - { - zlabel_props.set_rotation (angle); - zlabel_props.set_rotationmode ("auto"); - } - } -} - -static bool updating_title_position = false; - -void -axes::properties::update_title_position (void) -{ - if (updating_title_position) - return; - - text::properties& title_props = reinterpret_cast - (gh_manager::get_object (get_title ()).get_properties ()); - - unwind_protect frame; - frame.protect_var (updating_title_position); - updating_title_position = true; - - if (title_props.positionmode_is ("auto")) - { - graphics_xform xform = get_transform (); - - // FIXME: bbox should be stored in axes::properties - Matrix bbox = get_extent (false); - - ColumnVector p = - graphics_xform::xform_vector (bbox(0)+bbox(2)/2, - bbox(1)-10, - (x_zlim(0)+x_zlim(1))/2); - - if (x2Dtop) - { - Matrix ext (1, 2, 0.0); - ext = get_ticklabel_extents (get_xtick ().matrix_value (), - get_xticklabel ().all_strings (), - get_xlim ().matrix_value ()); - p(1) -= ext(1); - } - - p = xform.untransform (p(0), p(1), p(2), true); - - title_props.set_position (p.extract_n (0, 3).transpose ()); - title_props.set_positionmode ("auto"); - } -} - -void -axes::properties::update_autopos (const std::string& elem_type) -{ - if (elem_type == "xlabel") - update_xlabel_position (); - else if (elem_type == "ylabel") - update_ylabel_position (); - else if (elem_type == "zlabel") - update_zlabel_position (); - else if (elem_type == "title") - update_title_position (); - else if (elem_type == "sync") - sync_positions (); -} - -static void -normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, - double xlength, double ylength, double zlength) -{ - double xval = xlength/scalefactors(0); - double yval = ylength/scalefactors(1); - double zval = zlength/scalefactors(2); - - double minval = xmin (xmin (xval, yval), zval); - - aspectratios(0) = xval/minval; - aspectratios(1) = yval/minval; - aspectratios(2) = zval/minval; -} - -static void -max_axes_scale (double& s, Matrix& limits, const Matrix& kids, - double pbfactor, double dafactor, char limit_type, bool tight) -{ - if (tight) - { - double minval = octave_Inf; - double maxval = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); - if (!xisinf (minval) && !xisnan (minval) - && !xisinf (maxval) && !xisnan (maxval)) - { - limits(0) = minval; - limits(1) = maxval; - s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); - } - } - else - s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); -} - -static bool updating_aspectratios = false; - -void -axes::properties::update_aspectratios (void) -{ - if (updating_aspectratios) - return; - - Matrix xlimits = get_xlim ().matrix_value (); - Matrix ylimits = get_ylim ().matrix_value (); - Matrix zlimits = get_zlim ().matrix_value (); - - double dx = (xlimits(1)-xlimits(0)); - double dy = (ylimits(1)-ylimits(0)); - double dz = (zlimits(1)-zlimits(0)); - - Matrix da = get_dataaspectratio ().matrix_value (); - Matrix pba = get_plotboxaspectratio ().matrix_value (); - - if (dataaspectratiomode_is ("auto")) - { - if (plotboxaspectratiomode_is ("auto")) - { - pba = Matrix (1, 3, 1.0); - plotboxaspectratio.set (pba, false); - } - - normalized_aspectratios (da, pba, dx, dy, dz); - dataaspectratio.set (da, false); - } - else if (plotboxaspectratiomode_is ("auto")) - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - else - { - double s = -octave_Inf; - bool modified_limits = false; - Matrix kids; - - if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - kids = get_children (); - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); - } - else if (xlimmode_is ("auto") && ylimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); - } - else if (ylimmode_is ("auto") && zlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); - } - else if (zlimmode_is ("auto") && xlimmode_is ("auto")) - { - modified_limits = true; - max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); - } - - if (modified_limits) - { - - unwind_protect frame; - frame.protect_var (updating_aspectratios); - - updating_aspectratios = true; - - dx = pba(0) *da(0); - dy = pba(1) *da(1); - dz = pba(2) *da(2); - if (xisinf (s)) - s = 1 / xmin (xmin (dx, dy), dz); - - if (xlimmode_is ("auto")) - { - dx = s * dx; - xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); - xlimits(1) = xlimits(0) + dx; - set_xlim (xlimits); - set_xlimmode ("auto"); - } - - if (ylimmode_is ("auto")) - { - dy = s * dy; - ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); - ylimits(1) = ylimits(0) + dy; - set_ylim (ylimits); - set_ylimmode ("auto"); - } - - if (zlimmode_is ("auto")) - { - dz = s * dz; - zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); - zlimits(1) = zlimits(0) + dz; - set_zlim (zlimits); - set_zlimmode ("auto"); - } - } - else - { - normalized_aspectratios (pba, da, dx, dy, dz); - plotboxaspectratio.set (pba, false); - } - } -} - -void -axes::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif -#endif -} - -// The INTERNAL flag defines whether position or outerposition is used. - -Matrix -axes::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = (internal ? - get_position ().matrix_value () - : get_outerposition ().matrix_value ()); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -Matrix -axes::properties::get_extent (bool with_text, bool only_text_height) const -{ - graphics_xform xform = get_transform (); - - Matrix ext (1, 4, 0.0); - ext(0) = octave_Inf; - ext(1) = octave_Inf; - ext(2) = -octave_Inf; - ext(3) = -octave_Inf; - for (int i = 0; i <= 1; i++) - for (int j = 0; j <= 1; j++) - for (int k = 0; k <= 1; k++) - { - ColumnVector p = xform.transform (i ? xPlaneN : xPlane, - j ? yPlaneN : yPlane, - k ? zPlaneN : zPlane, false); - ext(0) = std::min (ext(0), p(0)); - ext(1) = std::min (ext(1), p(1)); - ext(2) = std::max (ext(2), p(0)); - ext(3) = std::max (ext(3), p(1)); - } - - if (with_text) - { - for (int i = 0; i < 4; i++) - { - graphics_handle text_handle; - if (i == 0) - text_handle = get_title (); - else if (i == 1) - text_handle = get_xlabel (); - else if (i == 2) - text_handle = get_ylabel (); - else if (i == 3) - text_handle = get_zlabel (); - - text::properties& text_props = reinterpret_cast - (gh_manager::get_object (text_handle).get_properties ()); - - Matrix text_pos = text_props.get_data_position (); - text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); - if (text_props.get_string ().is_empty ()) - { - ext(0) = std::min (ext(0), text_pos(0)); - ext(1) = std::min (ext(1), text_pos(1)); - ext(2) = std::max (ext(2), text_pos(0)); - ext(3) = std::max (ext(3), text_pos(1)); - } - else - { - Matrix text_ext = text_props.get_extent_matrix (); - - bool ignore_horizontal = false; - bool ignore_vertical = false; - if (only_text_height) - { - double text_rotation = text_props.get_rotation (); - if (text_rotation == 0. || text_rotation == 180.) - ignore_horizontal = true; - else if (text_rotation == 90. || text_rotation == 270.) - ignore_vertical = true; - } - - if (! ignore_horizontal) - { - ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); - ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); - } - - if (! ignore_vertical) - { - ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); - ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); - } - } - } - } - - ext(2) = ext(2)-ext(0); - ext(3) = ext(3)-ext(1); - - return ext; -} - -void -axes::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -axes::properties::update_units (const caseless_str& old_units) -{ - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - caseless_str new_units = get_units (); - position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); - outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); - tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); -} - -void -axes::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -axes::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (true).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -axes::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (true).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -ColumnVector -graphics_xform::xform_vector (double x, double y, double z) -{ - return ::xform_vector (x, y, z); -} - -Matrix -graphics_xform::xform_eye (void) -{ - return ::xform_matrix (); -} - -ColumnVector -graphics_xform::transform (double x, double y, double z, - bool use_scale) const -{ - if (use_scale) - { - x = sx.scale (x); - y = sy.scale (y); - z = sz.scale (z); - } - - return ::transform (xform, x, y, z); -} - -ColumnVector -graphics_xform::untransform (double x, double y, double z, - bool use_scale) const -{ - ColumnVector v = ::transform (xform_inv, x, y, z); - - if (use_scale) - { - v(0) = sx.unscale (v(0)); - v(1) = sy.unscale (v(1)); - v(2) = sz.unscale (v(2)); - } - - return v; -} - -octave_value -axes::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -// FIXME -- remove. -// FIXME -- maybe this should go into array_property class? -/* -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const array_property& data) -{ - double val = data.min_val (); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - val = data.max_val (); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - val = data.min_pos (); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - val = data.max_neg (); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; -} -*/ - -static void -check_limit_vals (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const octave_value& data) -{ - if (data.is_matrix_type ()) - { - Matrix m = data.matrix_value (); - - if (! error_state && m.numel () == 4) - { - double val; - - val = m(0); - if (! (xisinf (val) || xisnan (val)) && val < min_val) - min_val = val; - - val = m(1); - if (! (xisinf (val) || xisnan (val)) && val > max_val) - max_val = val; - - val = m(2); - if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) - min_pos = val; - - val = m(3); - if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) - max_neg = val; - } - } -} - -// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is -// integer. - -static void -magform (double x, double& a, int& b) -{ - if (x == 0) - { - a = 0; - b = 0; - } - else - { - b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); - a = x / std::pow (10.0, b); - } -} - -// A translation from Tom Holoryd's python code at -// http://kurage.nimh.nih.gov/tomh/tics.py -// FIXME -- add log ticks - -double -axes::properties::calc_tick_sep (double lo, double hi) -{ - int ticint = 5; - - // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and - // SCALE3 for Determination of Scales on Computer Generated - // Plots", Communications of the ACM, 10 (1973), 639-640. - // Also cited as ACM Algorithm 463. - - double a; - int b, x; - - magform ((hi-lo)/ticint, a, b); - - static const double sqrt_2 = sqrt (2.0); - static const double sqrt_10 = sqrt (10.0); - static const double sqrt_50 = sqrt (50.0); - - if (a < sqrt_2) - x = 1; - else if (a < sqrt_10) - x = 2; - else if (a < sqrt_50) - x = 5; - else - x = 10; - - return x * std::pow (10., b); - -} - -// Attempt to make "nice" limits from the actual max and min of the -// data. For log plots, we will also use the smallest strictly positive -// value. - -Matrix -axes::properties::get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale) -{ - Matrix retval; - - double min_val = xmin; - double max_val = xmax; - - if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) - { - retval = default_lim (logscale); - return retval; - } - else if (! (xisinf (min_val) || xisinf (max_val))) - { - if (logscale) - { - if (xisinf (min_pos) && xisinf (max_neg)) - { - // TODO -- max_neg is needed for "loglog ([0 -Inf])" - // This is the only place where max_neg is needed. - // Is there another way? - retval = default_lim (); - retval(0) = pow (10., retval(0)); - retval(1) = pow (10., retval(1)); - return retval; - } - if ((min_val <= 0 && max_val > 0)) - { - warning ("axis: omitting non-positive data in log plot"); - min_val = min_pos; - } - // FIXME -- maybe this test should also be relative? - if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) - { - // Widen range when too small - if (min_val >= 0) - { - min_val *= 0.9; - max_val *= 1.1; - } - else - { - min_val *= 1.1; - max_val *= 0.9; - } - } - if (min_val > 0) - { - // Log plots with all positive data - min_val = pow (10, gnulib::floor (log10 (min_val))); - max_val = pow (10, std::ceil (log10 (max_val))); - } - else - { - // Log plots with all negative data - min_val = -pow (10, std::ceil (log10 (-min_val))); - max_val = -pow (10, gnulib::floor (log10 (-max_val))); - } - } - else - { - if (min_val == 0 && max_val == 0) - { - min_val = -1; - max_val = 1; - } - // FIXME -- maybe this test should also be relative? - else if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) - { - min_val -= 0.1 * std::abs (min_val); - max_val += 0.1 * std::abs (max_val); - } - - double tick_sep = calc_tick_sep (min_val , max_val); - double min_tick = gnulib::floor (min_val / tick_sep); - double max_tick = std::ceil (max_val / tick_sep); - // Prevent round-off from cropping ticks - min_val = std::min (min_val, tick_sep * min_tick); - max_val = std::max (max_val, tick_sep * max_tick); - } - } - - retval.resize (1, 2); - - retval(1) = max_val; - retval(0) = min_val; - - return retval; -} - -void -axes::properties::calc_ticks_and_lims (array_property& lims, - array_property& ticks, - array_property& mticks, - bool limmode_is_auto, bool is_logscale) -{ - // FIXME -- add log ticks and lims - - if (lims.get ().is_empty ()) - return; - - double lo = (lims.get ().matrix_value ()) (0); - double hi = (lims.get ().matrix_value ()) (1); - bool is_negative = lo < 0 && hi < 0; - double tmp; - // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) - if (hi < lo) - { - tmp = hi; - hi = lo; - lo = tmp; - } - - if (is_logscale) - { - if (is_negative) - { - tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - } - - double tick_sep = calc_tick_sep (lo , hi); - - if (is_logscale && ! (xisinf (hi) || xisinf (lo))) - { - // FIXME - what if (hi-lo) < tick_sep? - // ex: loglog ([1 1.1]) - tick_sep = std::max (tick_sep, 1.); - tick_sep = std::ceil (tick_sep); - } - - int i1 = static_cast (gnulib::floor (lo / tick_sep)); - int i2 = static_cast (std::ceil (hi / tick_sep)); - - if (limmode_is_auto) - { - // adjust limits to include min and max tics - Matrix tmp_lims (1,2); - tmp_lims(0) = std::min (tick_sep * i1, lo); - tmp_lims(1) = std::max (tick_sep * i2, hi); - - if (is_logscale) - { - tmp_lims(0) = std::pow (10.,tmp_lims(0)); - tmp_lims(1) = std::pow (10.,tmp_lims(1)); - if (tmp_lims(0) <= 0) - tmp_lims(0) = std::pow (10., lo); - if (is_negative) - { - tmp = tmp_lims(0); - tmp_lims(0) = -tmp_lims(1); - tmp_lims(1) = -tmp; - } - } - lims = tmp_lims; - } - - Matrix tmp_ticks (1, i2-i1+1); - for (int i = 0; i <= i2-i1; i++) - { - tmp_ticks (i) = tick_sep * (i+i1); - if (is_logscale) - tmp_ticks (i) = std::pow (10., tmp_ticks (i)); - } - if (is_logscale && is_negative) - { - Matrix rev_ticks (1, i2-i1+1); - rev_ticks = -tmp_ticks; - for (int i = 0; i <= i2-i1; i++) - tmp_ticks (i) = rev_ticks (i2-i1-i); - } - - ticks = tmp_ticks; - - int n = is_logscale ? 8 : 4; - Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); - - for (int i = 0; i < tmp_ticks.numel ()-1; i++) - { - double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); - for (int j = 0; j < n; j++) - { - tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); - } - } - mticks = tmp_mticks; -} - -void -axes::properties::calc_ticklabels (const array_property& ticks, - any_property& labels, bool logscale) -{ - Matrix values = ticks.get ().matrix_value (); - Cell c (values.dims ()); - std::ostringstream os; - - if (logscale) - { - double significand; - double exponent; - double exp_max = 0.; - double exp_min = 0.; - - for (int i = 0; i < values.numel (); i++) - { - exp_max = std::max (exp_max, std::log10 (values(i))); - exp_min = std::max (exp_min, std::log10 (values(i))); - } - - for (int i = 0; i < values.numel (); i++) - { - if (values(i) < 0.) - exponent = gnulib::floor (std::log10 (-values(i))); - else - exponent = gnulib::floor (std::log10 (values(i))); - significand = values(i) * std::pow (10., -exponent); - os.str (std::string ()); - os << significand; - if (exponent < 0.) - { - os << "e-"; - exponent = -exponent; - } - else - os << "e+"; - if (exponent < 10. && (exp_max > 9 || exp_min < -9)) - os << "0"; - os << exponent; - c(i) = os.str (); - } - } - else - { - for (int i = 0; i < values.numel (); i++) - { - os.str (std::string ()); - os << values(i); - c(i) = os.str (); - } - } - - labels = c; -} - -Matrix -axes::properties::get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits) -{ -#ifndef HAVE_FREETYPE - double fontsize = get ("fontsize").double_value (); -#endif - - Matrix ext (1, 2, 0.0); - double wmax = 0., hmax = 0.; - int n = std::min (ticklabels.numel (), ticks.numel ()); - for (int i = 0; i < n; i++) - { - double val = ticks(i); - if (limits(0) <= val && val <= limits(1)) - { -#ifdef HAVE_FREETYPE - ext = text_renderer.get_extent (ticklabels(i)); - wmax = std::max (wmax, ext(0)); - hmax = std::max (hmax, ext(1)); -#else - //FIXME: find a better approximation - int len = ticklabels(i).length (); - wmax = std::max (wmax, 0.5*fontsize*len); - hmax = fontsize; -#endif - } - } - - ext(0) = wmax; - ext(1) = hmax; - return ext; -} - -void -get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type) -{ - octave_idx_type n = kids.numel (); - - switch (limit_type) - { - case 'x': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_xliminclude ()) - { - octave_value lim = obj.get_xlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'y': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_yliminclude ()) - { - octave_value lim = obj.get_ylim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'z': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_zliminclude ()) - { - octave_value lim = obj.get_zlim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'c': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_climinclude ()) - { - octave_value lim = obj.get_clim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - case 'a': - for (octave_idx_type i = 0; i < n; i++) - { - graphics_object obj = gh_manager::get_object (kids(i)); - - if (obj.is_aliminclude ()) - { - octave_value lim = obj.get_alim (); - - check_limit_vals (min_val, max_val, min_pos, max_neg, lim); - } - } - break; - - default: - break; - } -} - -static bool updating_axis_limits = false; - -void -axes::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_axis_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - double val; - -#define FIX_LIMITS \ - if (limits.numel () == 4) \ - { \ - val = limits(0); \ - if (! (xisinf (val) || xisnan (val))) \ - min_val = val; \ - val = limits(1); \ - if (! (xisinf (val) || xisnan (val))) \ - max_val = val; \ - val = limits(2); \ - if (! (xisinf (val) || xisnan (val))) \ - min_pos = val; \ - val = limits(3); \ - if (! (xisinf (val) || xisnan (val))) \ - max_neg = val; \ - } \ - else \ - { \ - limits.resize (4, 1); \ - limits(0) = min_val; \ - limits(1) = max_val; \ - limits(2) = min_pos; \ - limits(3) = max_neg; \ - } - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - limits = xproperties.get_xlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - limits = xproperties.get_ylim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - limits = xproperties.get_zlim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - limits = xproperties.get_clim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - limits = xproperties.get_alim ().matrix_value (); - FIX_LIMITS ; - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - -#undef FIX_LIMITS - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); - -} - -void -axes::update_axis_limits (const std::string& axis_type) -{ - if (updating_axis_limits || updating_aspectratios) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - Matrix limits; - - if (axis_type == "xdata" || axis_type == "xscale" - || axis_type == "xlimmode" || axis_type == "xliminclude" - || axis_type == "xlim") - { - if (xproperties.xlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.xscale_is ("log")); - - update_type = 'x'; - } - } - else if (axis_type == "ydata" || axis_type == "yscale" - || axis_type == "ylimmode" || axis_type == "yliminclude" - || axis_type == "ylim") - { - if (xproperties.ylimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.yscale_is ("log")); - - update_type = 'y'; - } - } - else if (axis_type == "zdata" || axis_type == "zscale" - || axis_type == "zlimmode" || axis_type == "zliminclude" - || axis_type == "zlim") - { - if (xproperties.zlimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, - min_pos, max_neg, - xproperties.zscale_is ("log")); - - update_type = 'z'; - } - } - else if (axis_type == "cdata" || axis_type == "climmode" - || axis_type == "cdatamapping" || axis_type == "climinclude" - || axis_type == "clim") - { - if (xproperties.climmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - { - max_val = min_val + 1; - min_val -= 1; - } - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'c'; - } - - } - else if (axis_type == "alphadata" || axis_type == "alimmode" - || axis_type == "alphadatamapping" || axis_type == "aliminclude" - || axis_type == "alim") - { - if (xproperties.alimmode_is ("auto")) - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - if (min_val > max_val) - { - min_val = min_pos = 0; - max_val = 1; - } - else if (min_val == max_val) - max_val = min_val + 1; - - limits.resize (1, 2); - - limits(0) = min_val; - limits(1) = max_val; - - update_type = 'a'; - } - - } - - unwind_protect frame; - frame.protect_var (updating_axis_limits); - - updating_axis_limits = true; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - xproperties.set_xlimmode ("auto"); - xproperties.update_xlim (); - break; - - case 'y': - xproperties.set_ylim (limits); - xproperties.set_ylimmode ("auto"); - xproperties.update_ylim (); - break; - - case 'z': - xproperties.set_zlim (limits); - xproperties.set_zlimmode ("auto"); - xproperties.update_zlim (); - break; - - case 'c': - xproperties.set_clim (limits); - xproperties.set_climmode ("auto"); - break; - - case 'a': - xproperties.set_alim (limits); - xproperties.set_alimmode ("auto"); - break; - - default: - break; - } - - xproperties.update_transform (); -} - -inline -double force_in_range (const double x, const double lower, const double upper) -{ - if (x < lower) - { return lower; } - else if (x > upper) - { return upper; } - else - { return x; } -} - -static Matrix -do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - val = std::log10 (-val); - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - val = std::log10 (val); - } - } - - // Perform the zooming - lo = val + factor * (lo - val); - hi = val + factor * (hi - val); - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_zoom (x, factor, xlims, xscale_is ("log")); - ylims = do_zoom (y, factor, ylims, yscale_is ("log")); - - zoom (xlims, ylims, push_to_zoom_stack); -} - -void -axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) -{ - if (push_to_zoom_stack) - { - zoom_stack.push_front (xlimmode.get ()); - zoom_stack.push_front (xlim.get ()); - zoom_stack.push_front (ylimmode.get ()); - zoom_stack.push_front (ylim.get ()); - } - - xlim = xl; - xlimmode = "manual"; - ylim = yl; - ylimmode = "manual"; - - update_transform (); - update_xlim (false); - update_ylim (false); -} - -static Matrix -do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) -{ - Matrix new_lims = lims; - - double lo = lims(0); - double hi = lims(1); - - bool is_negative = lo < 0 && hi < 0; - - double delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = hi; - hi = std::log10 (-lo); - lo = std::log10 (-tmp); - x0 = -x0; - x1 = -x1; - } - else - { - hi = std::log10 (hi); - lo = std::log10 (lo); - } - - delta = std::log10 (x0) - std::log10 (x1); - } - else - { - delta = x0 - x1; - } - - // Perform the translation - lo += delta; - hi += delta; - - if (is_logscale) - { - if (is_negative) - { - double tmp = -std::pow (10.0, hi); - hi = -std::pow (10.0, lo); - lo = tmp; - } - else - { - lo = std::pow (10.0, lo); - hi = std::pow (10.0, hi); - } - } - - new_lims(0) = lo; - new_lims(1) = hi; - - return new_lims; -} - -void -axes::properties::translate_view (double x0, double x1, double y0, double y1) -{ - // FIXME: Do we need error checking here? - Matrix xlims = get_xlim ().matrix_value (); - Matrix ylims = get_ylim ().matrix_value (); - - // Get children axes limits - Matrix kids = get_children (); - double minx = octave_Inf; - double maxx = -octave_Inf; - double min_pos_x = octave_Inf; - double max_neg_x = -octave_Inf; - get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); - - double miny = octave_Inf; - double maxy = -octave_Inf; - double min_pos_y = octave_Inf; - double max_neg_y = -octave_Inf; - get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); - - xlims = do_translate (x0, x1, xlims, xscale_is ("log")); - ylims = do_translate (y0, y1, ylims, yscale_is ("log")); - - zoom (xlims, ylims, false); -} - -void -axes::properties::rotate_view (double delta_el, double delta_az) -{ - Matrix v = get_view ().matrix_value (); - - v(1) += delta_el; - - if (v(1) > 90) - v(1) = 90; - if (v(1) < -90) - v(1) = -90; - - v(0) = fmod (v(0) - delta_az + 720,360); - - set_view (v); - update_transform (); -} - -void -axes::properties::unzoom (void) -{ - if (zoom_stack.size () >= 4) - { - ylim = zoom_stack.front (); - zoom_stack.pop_front (); - ylimmode = zoom_stack.front (); - zoom_stack.pop_front (); - xlim = zoom_stack.front (); - zoom_stack.pop_front (); - xlimmode = zoom_stack.front (); - zoom_stack.pop_front (); - - update_transform (); - update_xlim (false); - update_ylim (false); - } -} - -void -axes::properties::clear_zoom_stack (void) -{ - while (zoom_stack.size () > 4) - zoom_stack.pop_front (); - - unzoom (); -} - -void -axes::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -void -axes::initialize (const graphics_object& go) -{ - base_graphics_object::initialize (go); - - xinitialize (xproperties.get_title ()); - xinitialize (xproperties.get_xlabel ()); - xinitialize (xproperties.get_ylabel ()); - xinitialize (xproperties.get_zlabel ()); -} - -// --------------------------------------------------------------------- - -Matrix -line::properties::compute_xlim (void) const -{ - Matrix m (1, 4); - - m(0) = xdata.min_val (); - m(1) = xdata.max_val (); - m(2) = xdata.min_pos (); - m(3) = xdata.max_neg (); - - return m; -} - -Matrix -line::properties::compute_ylim (void) const -{ - Matrix m (1, 4); - - m(0) = ydata.min_val (); - m(1) = ydata.max_val (); - m(2) = ydata.min_pos (); - m(3) = ydata.max_neg (); - - return m; -} - -// --------------------------------------------------------------------- - -Matrix -text::properties::get_data_position (void) const -{ - Matrix pos = get_position ().matrix_value (); - - if (! units_is ("data")) - pos = convert_text_position (pos, *this, get_units (), "data"); - - return pos; -} - -Matrix -text::properties::get_extent_matrix (void) const -{ - // FIXME: Should this function also add the (x,y) base position? - return extent.get ().matrix_value (); -} - -octave_value -text::properties::get_extent (void) const -{ - // FIXME: This doesn't work right for 3D plots. - // (It doesn't in Matlab either, at least not in version 6.5.) - Matrix m = extent.get ().matrix_value (); - Matrix pos = get_position ().matrix_value (); - Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); - - m(0) += p(0); - m(1) += p(1); - - return convert_text_position (m, *this, "pixels", get_units ()); -} - -void -text::properties::update_font (void) -{ -#ifdef HAVE_FREETYPE -#ifdef HAVE_FONTCONFIG - renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#endif - renderer.set_color (get_color_rgb ()); -#endif -} - -void -text::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - int halign = 0, valign = 0; - - if (horizontalalignment_is ("center")) - halign = 1; - else if (horizontalalignment_is ("right")) - halign = 2; - - if (verticalalignment_is ("top")) - valign = 2; - else if (verticalalignment_is ("baseline")) - valign = 3; - else if (verticalalignment_is ("middle")) - valign = 1; - - Matrix bbox; - - // FIXME: string should be parsed only when modified, for efficiency - - octave_value string_prop = get_string (); - - string_vector sv = string_prop.all_strings (); - - renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, - halign, valign, get_rotation ()); - /* The bbox is relative to the text's position. - We'll leave it that way, because get_position () does not return - valid results when the text is first constructed. - Conversion to proper coordinates is performed in get_extent. */ - set_extent (bbox); - -#endif - - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos ("sync"); -} - -void -text::properties::request_autopos (void) -{ - if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || - autopos_tag_is ("zlabel") || autopos_tag_is ("title")) - update_autopos (get_autopos_tag ()); -} - -void -text::properties::update_units (void) -{ - if (! units_is ("data")) - { - set_xliminclude ("off"); - set_yliminclude ("off"); - set_zliminclude ("off"); - } - - Matrix pos = get_position ().matrix_value (); - - pos = convert_text_position (pos, *this, cached_units, get_units ()); - // FIXME: if the current axes view is 2D, then one should - // probably drop the z-component of "pos" and leave "zliminclude" - // to "off". - set_position (pos); - - if (units_is ("data")) - { - set_xliminclude ("on"); - set_yliminclude ("on"); - // FIXME: see above - set_zliminclude ("off"); - } - - cached_units = get_units (); -} - -double -text::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - { - graphics_object go (gh_manager::get_object (get___myhandle__ ())); - graphics_object ax (go.get_ancestor ("axes")); - - parent_height = ax.get_properties ().get_boundingbox (true).elem (3); - } - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -image::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), - cdatamapping_is ("scaled"), 3); -} - -// --------------------------------------------------------------------- - -octave_value -patch::properties::get_color_data (void) const -{ - octave_value fvc = get_facevertexcdata (); - if (fvc.is_undefined () || fvc.is_empty ()) - return Matrix (); - else - return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); -} - -// --------------------------------------------------------------------- - -octave_value -surface::properties::get_color_data (void) const -{ - return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); -} - -inline void -cross_product (double x1, double y1, double z1, - double x2, double y2, double z2, - double& x, double& y, double& z) -{ - x += (y1 * z2 - z1 * y2); - y += (z1 * x2 - x1 * z2); - z += (x1 * y2 - y1 * x2); -} - -void -surface::properties::update_normals (void) -{ - if (normalmode_is ("auto")) - { - Matrix x = get_xdata ().matrix_value (); - Matrix y = get_ydata ().matrix_value (); - Matrix z = get_zdata ().matrix_value (); - - - int p = z.columns (), q = z.rows (); - int i1 = 0, i2 = 0, i3 = 0; - int j1 = 0, j2 = 0, j3 = 0; - - bool x_mat = (x.rows () == q); - bool y_mat = (y.columns () == p); - - NDArray n (dim_vector (q, p, 3), 0.0); - - for (int i = 0; i < p; i++) - { - if (y_mat) - { - i1 = i - 1; - i2 = i; - i3 = i + 1; - } - - for (int j = 0; j < q; j++) - { - if (x_mat) - { - j1 = j - 1; - j2 = j; - j3 = j + 1; - } - - double& nx = n(j, i, 0); - double& ny = n(j, i, 1); - double& nz = n(j, i, 2); - - if ((j > 0) && (i > 0)) - // upper left quadrangle - cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), - x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), - nx, ny, nz); - - if ((j > 0) && (i < (p -1))) - // upper right quadrangle - cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), - x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), - nx, ny, nz); - - if ((j < (q - 1)) && (i > 0)) - // lower left quadrangle - cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), - x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), - nx, ny, nz); - - if ((j < (q - 1)) && (i < (p -1))) - // lower right quadrangle - cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), - x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), - nx, ny, nz); - - double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); - - nx /= d; - ny /= d; - nz /= d; - } - } - vertexnormals = n; - } -} - -// --------------------------------------------------------------------- - -void -hggroup::properties::update_limits (void) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim"); - obj.update_axis_limits ("ylim"); - obj.update_axis_limits ("zlim"); - obj.update_axis_limits ("clim"); - obj.update_axis_limits ("alim"); - } -} - -void -hggroup::properties::update_limits (const graphics_handle& h) const -{ - graphics_object obj = gh_manager::get_object (__myhandle__); - - if (obj) - { - obj.update_axis_limits ("xlim", h); - obj.update_axis_limits ("ylim", h); - obj.update_axis_limits ("zlim", h); - obj.update_axis_limits ("clim", h); - obj.update_axis_limits ("alim", h); - } -} - -static bool updating_hggroup_limits = false; - -void -hggroup::update_axis_limits (const std::string& axis_type, - const graphics_handle& h) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = Matrix (1, 1, h.value ()); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - Matrix limits; - double val; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - limits = xproperties.get_xlim ().matrix_value (); - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - limits = xproperties.get_ylim ().matrix_value (); - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - limits = xproperties.get_zlim ().matrix_value (); - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - limits = xproperties.get_clim ().matrix_value (); - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - limits = xproperties.get_alim ().matrix_value (); - update_type = 'a'; - } - - if (limits.numel () == 4) - { - val = limits(0); - if (! (xisinf (val) || xisnan (val))) - min_val = val; - val = limits(1); - if (! (xisinf (val) || xisnan (val))) - max_val = val; - val = limits(2); - if (! (xisinf (val) || xisnan (val))) - min_pos = val; - val = limits(3); - if (! (xisinf (val) || xisnan (val))) - max_neg = val; - } - else - { - limits.resize (4,1); - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - } - - get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - if (limits(0) != min_val || limits(1) != max_val - || limits(2) != min_pos || limits(3) != max_neg) - { - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type, h); - } -} - -void -hggroup::update_axis_limits (const std::string& axis_type) -{ - if (updating_hggroup_limits) - return; - - Matrix kids = xproperties.get_children (); - - double min_val = octave_Inf; - double max_val = -octave_Inf; - double min_pos = octave_Inf; - double max_neg = -octave_Inf; - - char update_type = 0; - - if (axis_type == "xlim" || axis_type == "xliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); - - update_type = 'x'; - } - else if (axis_type == "ylim" || axis_type == "yliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); - - update_type = 'y'; - } - else if (axis_type == "zlim" || axis_type == "zliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); - - update_type = 'z'; - } - else if (axis_type == "clim" || axis_type == "climinclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); - - update_type = 'c'; - } - else if (axis_type == "alim" || axis_type == "aliminclude") - { - get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); - - update_type = 'a'; - } - - unwind_protect frame; - frame.protect_var (updating_hggroup_limits); - - updating_hggroup_limits = true; - - Matrix limits (1, 4, 0.0); - - limits(0) = min_val; - limits(1) = max_val; - limits(2) = min_pos; - limits(3) = max_neg; - - switch (update_type) - { - case 'x': - xproperties.set_xlim (limits); - break; - - case 'y': - xproperties.set_ylim (limits); - break; - - case 'z': - xproperties.set_zlim (limits); - break; - - case 'c': - xproperties.set_clim (limits); - break; - - case 'a': - xproperties.set_alim (limits); - break; - - default: - break; - } - - base_graphics_object::update_axis_limits (axis_type); -} - -// --------------------------------------------------------------------- - -octave_value -uicontrol::properties::get_extent (void) const -{ - Matrix m = extent.get ().matrix_value (); - - graphics_object parent_obj = - gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - return convert_position (m, "pixels", get_units (), parent_size); -} - -void -uicontrol::properties::update_text_extent (void) -{ -#ifdef HAVE_FREETYPE - - text_element *elt; - ft_render text_renderer; - Matrix box; - - // FIXME: parsed content should be cached for efficiency - // FIXME: support multiline text - - elt = text_parser_none ().parse (get_string_string ()); -#ifdef HAVE_FONTCONFIG - text_renderer.set_font (get_fontname (), - get_fontweight (), - get_fontangle (), - get_fontsize ()); -#endif - box = text_renderer.get_extent (elt, 0); - - Matrix ext (1, 4, 0.0); - - // FIXME: also handle left and bottom components - - ext(0) = ext(1) = 1; - ext(2) = box(0); - ext(3) = box(1); - - set_extent (ext); - -#endif -} - -void -uicontrol::properties::update_units (void) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, cached_units, get_units (), parent_size); - set_position (pos); - - cached_units = get_units (); -} - -void -uicontrol::properties::set_style (const octave_value& st) -{ - if (get___object__ ().is_empty ()) - style = st; - else - error ("set: cannot change the style of a uicontrol object after creation."); -} - -Matrix -uicontrol::properties::get_boundingbox (bool, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - return pos; -} - -void -uicontrol::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uicontrol::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - fontsize.set (octave_value (fsz), true); -} - -double -uicontrol::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -Matrix -uipanel::properties::get_boundingbox (bool internal, - const Matrix& parent_pix_size) const -{ - Matrix pos = get_position ().matrix_value (); - Matrix parent_size (parent_pix_size); - - if (parent_size.numel () == 0) - { - graphics_object obj = gh_manager::get_object (get_parent ()); - - parent_size = - obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); - } - - pos = convert_position (pos, get_units (), "pixels", parent_size); - - pos(0)--; - pos(1)--; - pos(1) = parent_size(1) - pos(1) - pos(3); - - if (internal) - { - double outer_height = pos(3); - - pos(0) = pos(1) = 0; - - if (! bordertype_is ("none")) - { - double bw = get_borderwidth (); - double mul = 1.0; - - if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) - mul = 2.0; - - pos(0) += mul * bw; - pos(1) += mul * bw; - pos(2) -= 2 * mul * bw; - pos(3) -= 2 * mul * bw; - } - - if (! get_title ().empty ()) - { - double fs = get_fontsize (); - - if (! fontunits_is ("pixels")) - { - double res = xget (0, "screenpixelsperinch").double_value (); - - if (fontunits_is ("points")) - fs *= (res / 72.0); - else if (fontunits_is ("inches")) - fs *= res; - else if (fontunits_is ("centimeters")) - fs *= (res / 2.54); - else if (fontunits_is ("normalized")) - fs *= outer_height; - } - - if (titleposition_is ("lefttop") || titleposition_is ("centertop") - || titleposition_is ("righttop")) - pos(1) += (fs / 2); - pos(3) -= (fs / 2); - } - } - - return pos; -} - -void -uipanel::properties::set_units (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_units = get_units (); - if (units.set (v, true)) - { - update_units (old_units); - mark_modified (); - } - } -} - -void -uipanel::properties::update_units (const caseless_str& old_units) -{ - Matrix pos = get_position ().matrix_value (); - - graphics_object parent_obj = gh_manager::get_object (get_parent ()); - Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), - parent_size = parent_bbox.extract_n (0, 2, 1, 2); - - pos = convert_position (pos, old_units, get_units (), parent_size); - set_position (pos); -} - -void -uipanel::properties::set_fontunits (const octave_value& v) -{ - if (! error_state) - { - caseless_str old_fontunits = get_fontunits (); - if (fontunits.set (v, true)) - { - update_fontunits (old_fontunits); - mark_modified (); - } - } -} - -void -uipanel::properties::update_fontunits (const caseless_str& old_units) -{ - caseless_str new_units = get_fontunits (); - double parent_height = get_boundingbox (false).elem (3); - double fsz = get_fontsize (); - - fsz = convert_font_size (fsz, old_units, new_units, parent_height); - - set_fontsize (octave_value (fsz)); -} - -double -uipanel::properties::get_fontsize_points (double box_pix_height) const -{ - double fs = get_fontsize (); - double parent_height = box_pix_height; - - if (fontunits_is ("normalized") && parent_height <= 0) - parent_height = get_boundingbox (false).elem (3); - - return convert_font_size (fs, get_fontunits (), "points", parent_height); -} - -// --------------------------------------------------------------------- - -octave_value -uitoolbar::get_default (const caseless_str& name) const -{ - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - retval = parent_obj.get_default (name); - } - - return retval; -} - -void -uitoolbar::reset_default_properties (void) -{ - ::reset_default_properties (default_properties); -} - -// --------------------------------------------------------------------- - -octave_value -base_graphics_object::get_default (const caseless_str& name) const -{ - graphics_handle parent = get_parent (); - graphics_object parent_obj = gh_manager::get_object (parent); - - return parent_obj.get_default (type () + name); -} - -octave_value -base_graphics_object::get_factory_default (const caseless_str& name) const -{ - graphics_object parent_obj = gh_manager::get_object (0); - - return parent_obj.get_factory_default (type () + name); -} - -// We use a random value for the handle to avoid issues with plots and -// scalar values for the first argument. -gh_manager::gh_manager (void) - : handle_map (), handle_free_list (), - next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), - figure_list (), graphics_lock (), event_queue (), - callback_objects (), event_processing (0) -{ - handle_map[0] = graphics_object (new root_figure ()); - - // Make sure the default graphics toolkit is registered. - gtk_manager::default_toolkit (); -} - -void -gh_manager::create_instance (void) -{ - instance = new gh_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_handle -gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit) -{ - graphics_handle h = get_handle (integer_figure_handle); - - base_graphics_object *go = 0; - - go = make_graphics_object_from_type (go_name, h, p); - - if (go) - { - graphics_object obj (go); - - handle_map[h] = obj; - if (do_createfcn) - go->get_properties ().execute_createfcn (); - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - } - else - error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", - go_name.c_str ()); - - return h; -} - -graphics_handle -gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) -{ - graphics_handle h = val; - - base_graphics_object* go = new figure (h, 0); - graphics_object obj (go); - - handle_map[h] = obj; - - // Notify graphics toolkit. - if (do_notify_toolkit) - obj.initialize (); - - return h; -} - -void -gh_manager::do_push_figure (const graphics_handle& h) -{ - do_pop_figure (h); - - figure_list.push_front (h); -} - -void -gh_manager::do_pop_figure (const graphics_handle& h) -{ - for (figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - if (*p == h) - { - figure_list.erase (p); - break; - } - } -} - -class -callback_event : public base_graphics_event -{ -public: - callback_event (const graphics_handle& h, const std::string& name, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (name), - callback (), callback_data (data) { } - - callback_event (const graphics_handle& h, const octave_value& cb, - const octave_value& data = Matrix ()) - : base_graphics_event (), handle (h), callback_name (), - callback (cb), callback_data (data) { } - - void execute (void) - { - if (callback.is_defined ()) - gh_manager::execute_callback (handle, callback, callback_data); - else - gh_manager::execute_callback (handle, callback_name, callback_data); - } - -private: - callback_event (void) - : base_graphics_event (), handle (), - callback_name (), callback_data () - { } - -private: - graphics_handle handle; - std::string callback_name; - octave_value callback; - octave_value callback_data; -}; - -class -function_event : public base_graphics_event -{ -public: - function_event (graphics_event::event_fcn fcn, void* data = 0) - : base_graphics_event (), function (fcn), - function_data (data) { } - - void execute (void) - { - function (function_data); - } - -private: - - graphics_event::event_fcn function; - - void* function_data; - - // function_event objects must be created with at least a function. - function_event (void); - - // No copying! - - function_event (const function_event &); - - function_event & operator = (const function_event &); -}; - -class -set_event : public base_graphics_event -{ -public: - set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, bool do_notify_toolkit = true) - : base_graphics_event (), handle (h), property_name (name), - property_value (value), notify_toolkit (do_notify_toolkit) { } - - void execute (void) - { - gh_manager::auto_lock guard; - - graphics_object go = gh_manager::get_object (handle); - - if (go) - { - property p = go.get_properties ().get_property (property_name); - - if (p.ok ()) - p.set (property_value, true, notify_toolkit); - } - } - -private: - set_event (void) - : base_graphics_event (), handle (), property_name (), property_value () - { } - -private: - graphics_handle handle; - std::string property_name; - octave_value property_value; - bool notify_toolkit; -}; - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, name, data); - - return e; -} - -graphics_event -graphics_event::create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data) -{ - graphics_event e; - - e.rep = new callback_event (h, cb, data); - - return e; -} - -graphics_event -graphics_event::create_function_event (graphics_event::event_fcn fcn, - void *data) -{ - graphics_event e; - - e.rep = new function_event (fcn, data); - - return e; -} - -graphics_event -graphics_event::create_set_event (const graphics_handle& h, - const std::string& name, - const octave_value& data, - bool notify_toolkit) -{ - graphics_event e; - - e.rep = new set_event (h, name, data, notify_toolkit); - - return e; -} - -static void -xset_gcbo (const graphics_handle& h) -{ - graphics_object go = gh_manager::get_object (0); - root_figure::properties& props = - dynamic_cast (go.get_properties ()); - - props.set_callbackobject (h.as_octave_value ()); -} - -void -gh_manager::do_restore_gcbo (void) -{ - gh_manager::auto_lock guard; - - callback_objects.pop_front (); - - xset_gcbo (callback_objects.empty () - ? graphics_handle () - : callback_objects.front ().get_handle ()); -} - -void -gh_manager::do_execute_listener (const graphics_handle& h, - const octave_value& l) -{ - if (octave_thread::is_octave_thread ()) - gh_manager::execute_callback (h, l, octave_value ()); - else - { - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_callback_event (h, l)); - } -} - -void -gh_manager::do_execute_callback (const graphics_handle& h, - const octave_value& cb_arg, - const octave_value& data) -{ - if (cb_arg.is_defined () && ! cb_arg.is_empty ()) - { - octave_value_list args; - octave_function *fcn = 0; - - args(0) = h.as_octave_value (); - if (data.is_defined ()) - args(1) = data; - else - args(1) = Matrix (); - - unwind_protect_safe frame; - frame.add_fcn (gh_manager::restore_gcbo); - - if (true) - { - gh_manager::auto_lock guard; - - callback_objects.push_front (get_object (h)); - xset_gcbo (h); - } - - BEGIN_INTERRUPT_WITH_EXCEPTIONS; - - // Copy CB because "function_value" method is non-const. - - octave_value cb = cb_arg; - - if (cb.is_function () || cb.is_function_handle ()) - fcn = cb.function_value (); - else if (cb.is_string ()) - { - int status; - std::string s = cb.string_value (); - - eval_string (s, false, status, 0); - } - else if (cb.is_cell () && cb.length () > 0 - && (cb.rows () == 1 || cb.columns () == 1) - && (cb.cell_value ()(0).is_function () - || cb.cell_value ()(0).is_function_handle ())) - { - Cell c = cb.cell_value (); - - fcn = c(0).function_value (); - if (! error_state) - { - for (int i = 1; i < c.length () ; i++) - args(1+i) = c(i); - } - } - else - { - std::string nm = cb.class_name (); - error ("trying to execute non-executable object (class = %s)", - nm.c_str ()); - } - - if (fcn && ! error_state) - feval (fcn, args); - - END_INTERRUPT_WITH_EXCEPTIONS; - } -} - -void -gh_manager::do_post_event (const graphics_event& e) -{ - event_queue.push_back (e); - - command_editor::add_event_hook (gh_manager::process_events); -} - -void -gh_manager::do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data) -{ - gh_manager::auto_lock guard; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - { - if (callback_objects.empty ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - const graphics_object& current = callback_objects.front (); - - if (current.get_properties ().is_interruptible ()) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str busy_action (go.get_properties ().get_busyaction ()); - - if (busy_action.compare ("queue")) - do_post_event (graphics_event::create_callback_event (h, name, data)); - else - { - caseless_str cname (name); - - if (cname.compare ("deletefcn") - || cname.compare ("createfcn") - || (go.isa ("figure") - && (cname.compare ("closerequestfcn") - || cname.compare ("resizefcn")))) - do_post_event (graphics_event::create_callback_event (h, name, data)); - } - } - } - } -} - -void -gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_function_event (fcn, fcn_data)); -} - -void -gh_manager::do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit) -{ - gh_manager::auto_lock guard; - - do_post_event (graphics_event::create_set_event (h, name, value, - notify_toolkit)); -} - -int -gh_manager::do_process_events (bool force) -{ - graphics_event e; - bool old_Vdrawnow_requested = Vdrawnow_requested; - bool events_executed = false; - - do - { - e = graphics_event (); - - gh_manager::lock (); - - if (! event_queue.empty ()) - { - if (callback_objects.empty () || force) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - else - { - const graphics_object& go = callback_objects.front (); - - if (go.get_properties ().is_interruptible ()) - { - e = event_queue.front (); - - event_queue.pop_front (); - } - } - } - - gh_manager::unlock (); - - if (e.ok ()) - { - e.execute (); - events_executed = true; - } - } - while (e.ok ()); - - gh_manager::lock (); - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - - gh_manager::unlock (); - - if (events_executed) - flush_octave_stdout (); - - if (Vdrawnow_requested && ! old_Vdrawnow_requested) - { - feval ("drawnow"); - - Vdrawnow_requested = false; - } - - return 0; -} - -void -gh_manager::do_enable_event_processing (bool enable) -{ - gh_manager::auto_lock guard; - - if (enable) - { - event_processing++; - - command_editor::add_event_hook (gh_manager::process_events); - } - else - { - event_processing--; - - if (event_queue.empty () && event_processing == 0) - command_editor::remove_event_hook (gh_manager::process_events); - } -} - -property_list::plist_map_type -root_figure::init_factory_properties (void) -{ - property_list::plist_map_type plist_map; - - plist_map["figure"] = figure::properties::factory_defaults (); - plist_map["axes"] = axes::properties::factory_defaults (); - plist_map["line"] = line::properties::factory_defaults (); - plist_map["text"] = text::properties::factory_defaults (); - plist_map["image"] = image::properties::factory_defaults (); - plist_map["patch"] = patch::properties::factory_defaults (); - plist_map["surface"] = surface::properties::factory_defaults (); - plist_map["hggroup"] = hggroup::properties::factory_defaults (); - plist_map["uimenu"] = uimenu::properties::factory_defaults (); - plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); - plist_map["uipanel"] = uipanel::properties::factory_defaults (); - plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); - plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); - plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); - plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); - - return plist_map; -} - -// --------------------------------------------------------------------- - -DEFUN (ishandle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ -Return true if @var{h} is a graphics handle and false otherwise.\n\ -@var{h} may also be a matrix of handles in which case a logical\n\ -array is returned that is true where the elements of @var{h} are\n\ -graphics handles and false where they are not.\n\ -@seealso{isfigure}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 1) - retval = is_handle (args(0)); - else - print_usage (); - - return retval; -} - -static bool -is_handle_visible (const graphics_handle& h) -{ - return h.ok () && gh_manager::is_handle_visible (h); -} - -static bool -is_handle_visible (double val) -{ - return is_handle_visible (gh_manager::lookup (val)); -} - -static octave_value -is_handle_visible (const octave_value& val) -{ - octave_value retval = false; - - if (val.is_real_scalar () && is_handle_visible (val.double_value ())) - retval = true; - else if (val.is_numeric_type () && val.is_real_type ()) - { - const NDArray handles = val.array_value (); - - if (! error_state) - { - boolNDArray result (handles.dims ()); - - for (octave_idx_type i = 0; i < handles.numel (); i++) - result.xelem (i) = is_handle_visible (handles (i)); - - retval = result; - } - } - - return retval; -} - -DEFUN (__is_handle_visible__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - retval = is_handle_visible (args(0)); - else - print_usage (); - - return retval; -} - -DEFUN (reset, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ -Remove any defaults set for the handle @var{h}. The default figure\n\ -properties of \"position\", \"units\", \"windowstyle\" and\n\ -\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ -are not reset.\n\ -@end deftypefn") -{ - int nargin = args.length (); - - if (nargin != 1) - print_usage (); - else - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - gh_manager::get_object (hcv(n)).reset_default_properties (); - } - } - - return octave_value (); -} - -DEFUN (set, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ -@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ -Set named property values for the graphics handle (or vector of graphics\n\ -handles) @var{h}.\n\ -There are three ways how to give the property names and values:\n\ -\n\ -@itemize\n\ -@item as a comma separated list of @var{property}, @var{value} pairs\n\ -\n\ -Here, each @var{property} is a string containing the property name, each\n\ -@var{value} is a value of the appropriate type for the property.\n\ -\n\ -@item as a cell array of strings @var{properties} containing property names\n\ -and a cell array @var{values} containing property values.\n\ -\n\ -In this case, the number of columns of @var{values} must match the number of\n\ -elements in @var{properties}. The first column of @var{values} contains\n\ -values for the first entry in @var{properties}, etc. The number of rows of\n\ -@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ -first case, each handle in @var{h} will be assigned the same values. In the\n\ -latter case, the first handle in @var{h} will be assigned the values from\n\ -the first row of @var{values} and so on.\n\ -\n\ -@item as a structure array @var{pv}\n\ -\n\ -Here, the field names of @var{pv} represent the property names, and the field\n\ -values give the property values. In contrast to the previous case, all\n\ -elements of @var{pv} will be set in all handles in @var{h} independent of\n\ -the dimensions of @var{pv}.\n\ -@end itemize\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - // get vector of graphics handles - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - bool request_drawnow = false; - - // loop over graphics objects - for (octave_idx_type n = 0; n < hcv.length (); n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 3 && args(1).is_cellstr () - && args(2).is_cell ()) - { - if (args(2).cell_value ().rows () == 1) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), 0); - } - else if (hcv.length () == args(2).cell_value ().rows ()) - { - obj.set (args(1).cellstr_value (), - args(2).cell_value (), n); - } - else - { - error ("set: number of graphics handles must match number of value rows (%d != %d)", - hcv.length (), args(2).cell_value ().rows ()); - break; - - } - } - else if (nargin == 2 && args(1).is_map ()) - { - obj.set (args(1).map_value ()); - } - else if (nargin == 1) - { - if (nargout != 0) - retval = obj.values_as_struct (); - else - { - std::string s = obj.values_as_string (); - if (! error_state) - octave_stdout << s; - } - } - else - { - obj.set (args.splice (0, 1)); - request_drawnow = true; - } - } - else - { - error ("set: invalid handle (= %g)", hcv(n)); - break; - } - - if (error_state) - break; - - request_drawnow = true; - } - - if (! error_state && request_drawnow) - Vdrawnow_requested = true; - } - else - error ("set: expecting graphics handle as first argument"); - } - else - print_usage (); - - return retval; -} - -static std::string -get_graphics_object_type (const double val) -{ - std::string retval; - - graphics_object obj = gh_manager::get_object (val); - - if (obj) - retval = obj.type (); - else - error ("get: invalid handle (= %g)", val); - - return retval; -} - -DEFUN (get, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ -Return the named property @var{p} from the graphics handle @var{h}.\n\ -If @var{p} is omitted, return the complete property list for @var{h}.\n\ -If @var{h} is a vector, return a cell array including the property\n\ -values or lists respectively.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - bool use_cell_format = false; - - if (nargin == 1 || nargin == 2) - { - if (args(0).is_empty ()) - { - retval = Matrix (); - return retval; - } - - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - if (nargin == 1 && len > 1) - { - std::string t0 = get_graphics_object_type (hcv(0)); - - if (! error_state) - { - for (octave_idx_type n = 1; n < len; n++) - { - std::string t = get_graphics_object_type (hcv(n)); - - if (error_state) - break; - - if (t != t0) - { - error ("get: vector of handles must all have same type"); - break; - } - } - - } - } - - if (! error_state) - { - if (nargin > 1 && args(1).is_cellstr ()) - { - Array plist = args(1).cellstr_value (); - - if (! error_state) - { - octave_idx_type plen = plist.numel (); - - use_cell_format = true; - - vals.resize (dim_vector (len, plen)); - - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - for (octave_idx_type m = 0; ! error_state && m < plen; m++) - { - caseless_str property = plist(m); - - vals(n, m) = obj.get (property); - } - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting property name or cell array of property names as second argument"); - } - else - { - caseless_str property; - - if (nargin > 1) - { - property = args(1).string_value (); - - if (error_state) - error ("get: expecting property name or cell array of property names as second argument"); - } - - vals.resize (dim_vector (len, 1)); - - if (! error_state) - { - for (octave_idx_type n = 0; ! error_state && n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - { - if (nargin == 1) - vals(n) = obj.get (); - else - vals(n) = obj.get (property); - } - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - if (use_cell_format) - retval = vals; - else - { - octave_idx_type len = vals.numel (); - - if (len == 0) - retval = Matrix (); - else if (len == 1) - retval = vals(0); - else if (len > 1 && nargin == 1) - { - OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); - - for (octave_idx_type n = 0; n < len; n++) - tmp[n] = vals(n).scalar_map_value (); - - retval = octave_map::cat (0, len, tmp); - } - else - retval = vals; - } - } - - return retval; -} - -/* -%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) -*/ - -// Return all properties from the graphics handle @var{h}. -// If @var{h} is a vector, return a cell array including the -// property values or lists respectively. - -DEFUN (__get__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - Cell vals; - - int nargin = args.length (); - - if (nargin == 1) - { - ColumnVector hcv (args(0).vector_value ()); - - if (! error_state) - { - octave_idx_type len = hcv.length (); - - vals.resize (dim_vector (len, 1)); - - for (octave_idx_type n = 0; n < len; n++) - { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) - vals(n) = obj.get (true); - else - { - error ("get: invalid handle (= %g)", hcv(n)); - break; - } - } - } - else - error ("get: expecting graphics handle as first argument"); - } - else - print_usage (); - - if (! error_state) - { - octave_idx_type len = vals.numel (); - - if (len > 1) - retval = vals; - else if (len == 1) - retval = vals(0); - } - - return retval; -} - -static octave_value -make_graphics_object (const std::string& go_name, - bool integer_figure_handle, - const octave_value_list& args) -{ - octave_value retval; - - double val = octave_NaN; - - octave_value_list xargs = args.splice (0, 1); - - caseless_str p ("parent"); - - for (int i = 0; i < xargs.length (); i++) - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - val = xargs(i+1).double_value (); - - if (! error_state) - { - xargs = xargs.splice (i, 2); - break; - } - } - else - error ("__go_%s__: missing value for parent property", - go_name.c_str ()); - } - - if (! error_state && xisnan (val)) - val = args(0).double_value (); - - if (! error_state) - { - graphics_handle parent = gh_manager::lookup (val); - - if (parent.ok ()) - { - graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, - integer_figure_handle, - false, false); - - if (! error_state) - { - adopt (parent, h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - - if (! error_state) - Vdrawnow_requested = true; - } - else - error ("__go%s__: unable to create graphics handle", - go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - } - else - error ("__go_%s__: invalid parent", go_name.c_str ()); - - return retval; -} - -DEFUN (__go_figure__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () > 0) - { - double val = args(0).double_value (); - - if (! error_state) - { - if (is_figure (val)) - { - graphics_handle h = gh_manager::lookup (val); - - xset (h, args.splice (0, 1)); - - retval = h.value (); - } - else - { - bool int_fig_handle = true; - - octave_value_list xargs = args.splice (0, 1); - - graphics_handle h = octave_NaN; - - if (xisnan (val)) - { - caseless_str p ("integerhandle"); - - for (int i = 0; i < xargs.length (); i++) - { - if (xargs(i).is_string () - && p.compare (xargs(i).string_value ())) - { - if (i < (xargs.length () - 1)) - { - std::string pval = xargs(i+1).string_value (); - - if (! error_state) - { - caseless_str on ("on"); - int_fig_handle = on.compare (pval); - xargs = xargs.splice (i, 2); - break; - } - } - } - } - - h = gh_manager::make_graphics_handle ("figure", 0, - int_fig_handle, - false, false); - - if (! int_fig_handle) - { - // We need to intiailize the integerhandle - // property without calling the set_integerhandle - // method, because doing that will generate a new - // handle value... - - graphics_object go = gh_manager::get_object (h); - go.get_properties ().init_integerhandle ("off"); - } - } - else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val, false); - - if (! error_state && h.ok ()) - { - adopt (0, h); - - gh_manager::push_figure (h); - - xset (h, xargs); - xcreatefcn (h); - xinitialize (h); - - retval = h.value (); - } - else - error ("__go_figure__: failed to create figure handle"); - } - } - else - error ("__go_figure__: expecting figure number to be double value"); - } - else - print_usage (); - - return retval; -} - -#define GO_BODY(TYPE) \ - gh_manager::auto_lock guard; \ - \ - octave_value retval; \ - \ - if (args.length () > 0) \ - retval = make_graphics_object (#TYPE, false, args); \ - else \ - print_usage (); \ - \ - return retval - -int -calc_dimensions (const graphics_object& go) -{ - - int nd = 2; - - if (go.isa ("surface")) - nd = 3; - - if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) - nd = 3; - - Matrix kids = go.get_properties ().get_children (); - - for (octave_idx_type i = 0; i < kids.length (); i++) - { - graphics_handle hnd = gh_manager::lookup (kids(i)); - - if (hnd.ok ()) - { - const graphics_object& kid = gh_manager::get_object (hnd); - - if (kid.valid_object ()) - nd = calc_dimensions (kid); - - if (nd == 3) - break; - } - } - - return nd; -} - -DEFUN (__calc_dimensions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ -Internal function. Determine the number of dimensions in a graphics\n\ -object, whether 2 or 3.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - retval = calc_dimensions (gh_manager::get_object (h)); - else - error ("__calc_dimensions__: expecting graphics handle as only argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (axes); -} - -DEFUN (__go_line__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (line); -} - -DEFUN (__go_text__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (text); -} - -DEFUN (__go_image__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (image); -} - -DEFUN (__go_surface__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (surface); -} - -DEFUN (__go_patch__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (patch); -} - -DEFUN (__go_hggroup__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (hggroup); -} - -DEFUN (__go_uimenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uimenu); -} - -DEFUN (__go_uicontrol__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontrol); -} - -DEFUN (__go_uipanel__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipanel); -} - -DEFUN (__go_uicontextmenu__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uicontextmenu); -} - -DEFUN (__go_uitoolbar__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoolbar); -} - -DEFUN (__go_uipushtool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uipushtool); -} - -DEFUN (__go_uitoggletool__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - GO_BODY (uitoggletool); -} - -DEFUN (__go_delete__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value_list retval; - - if (args.length () == 1) - { - graphics_handle h = octave_NaN; - - const NDArray vals = args (0).array_value (); - - if (! error_state) - { - // Check is all the handles to delete are valid first - // as callbacks might delete one of the handles we - // later want to delete - for (octave_idx_type i = 0; i < vals.numel (); i++) - { - h = gh_manager::lookup (vals.elem (i)); - - if (! h.ok ()) - { - error ("delete: invalid graphics object (= %g)", - vals.elem (i)); - break; - } - } - - if (! error_state) - delete_graphics_objects (vals); - } - else - error ("delete: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_axes_init__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - int nargin = args.length (); - - std::string mode = ""; - - if (nargin == 2) - { - mode = args(1).string_value (); - - if (error_state) - return retval; - } - - if (nargin == 1 || nargin == 2) - { - graphics_handle h = octave_NaN; - - double val = args(0).double_value (); - - if (! error_state) - { - h = gh_manager::lookup (val); - - if (h.ok ()) - { - graphics_object obj = gh_manager::get_object (h); - - obj.set_defaults (mode); - - h = gh_manager::lookup (val); - if (! h.ok ()) - error ("__go_axes_init__: axis deleted during initialization (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object (= %g)", val); - } - else - error ("__go_axes_init__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__go_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::handle_list (show_hidden)); -} - -DEFUN (__go_figure_handles__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - bool show_hidden = false; - - if (args.length () > 0) - show_hidden = args(0).bool_value (); - - return octave_value (gh_manager::figure_handle_list (show_hidden)); -} - -DEFUN (__go_execute_callback__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ -@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - double val = args(0).double_value (); - - if (! error_state) - { - graphics_handle h = gh_manager::lookup (val); - - if (h.ok ()) - { - std::string name = args(1).string_value (); - - if (! error_state) - { - if (nargin == 2) - gh_manager::execute_callback (h, name); - else - gh_manager::execute_callback (h, name, args(2)); - } - else - error ("__go_execute_callback__: invalid callback name"); - } - else - error ("__go_execute_callback__: invalid graphics object (= %g)", - val); - } - else - error ("__go_execute_callback__: invalid graphics object"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__image_pixel_size__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ -Internal function: returns the pixel size of the image in normalized units.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - double h = args(0).double_value (); - - if (! error_state) - { - graphics_object fobj = gh_manager::get_object (h); - if (fobj && fobj.isa ("image")) - { - image::properties& ip = - dynamic_cast (fobj.get_properties ()); - - Matrix dp = Matrix (1, 2, 0); - dp(0, 0) = ip.pixel_xsize (); - dp(0, 1) = ip.pixel_ysize (); - retval = dp; - } - else - error ("__image_pixel_size__: object is not an image"); - } - else - error ("__image_pixel_size__: argument is not a handle"); - } - else - print_usage (); - - return retval; -} - -gtk_manager *gtk_manager::instance = 0; - -void -gtk_manager::create_instance (void) -{ - instance = new gtk_manager (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); -} - -graphics_toolkit -gtk_manager::do_get_toolkit (void) const -{ - graphics_toolkit retval; - - const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); - - if (pl == loaded_toolkits.end ()) - { - const_available_toolkits_iterator pa = available_toolkits.find (dtk); - - if (pa != available_toolkits.end ()) - { - octave_value_list args; - args(0) = dtk; - feval ("graphics_toolkit", args); - - if (! error_state) - pl = loaded_toolkits.find (dtk); - - if (error_state || pl == loaded_toolkits.end ()) - error ("failed to load %s graphics toolkit", dtk.c_str ()); - else - retval = pl->second; - } - else - error ("default graphics toolkit `%s' is not available!", - dtk.c_str ()); - } - else - retval = pl->second; - - return retval; -} - -DEFUN (available_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ -Return a cell array of registered graphics toolkits.\n\ -@seealso{graphics_toolkit, register_graphics_toolkit}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::available_toolkits_list ()); -} - -DEFUN (register_graphics_toolkit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ -List @var{toolkit} as an available graphics toolkit.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - octave_value retval; - - gh_manager::auto_lock guard; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - gtk_manager::register_toolkit (name); - else - error ("register_graphics_toolkit: expecting character string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (loaded_graphics_toolkits, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ -Return a cell array of the currently loaded graphics toolkits.\n\ -@seealso{available_graphics_toolkits}\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - return octave_value (gtk_manager::loaded_toolkits_list ()); -} - -DEFUN (drawnow, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} drawnow ()\n\ -@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ -@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ -Update figure windows and their children. The event queue is flushed and\n\ -any callbacks generated are executed. With the optional argument\n\ -@code{\"expose\"}, only graphic objects are updated and no other events or\n\ -callbacks are processed.\n\ -The third calling form of @code{drawnow} is for debugging and is\n\ -undocumented.\n\ -@end deftypefn") -{ - static int drawnow_executing = 0; - - octave_value retval; - - gh_manager::lock (); - - unwind_protect frame; - frame.protect_var (Vdrawnow_requested, false); - - frame.protect_var (drawnow_executing); - - if (++drawnow_executing <= 1) - { - if (args.length () == 0 || args.length () == 1) - { - Matrix hlist = gh_manager::figure_handle_list (true); - - for (int i = 0; ! error_state && i < hlist.length (); i++) - { - graphics_handle h = gh_manager::lookup (hlist(i)); - - if (h.ok () && h != 0) - { - graphics_object go = gh_manager::get_object (h); - figure::properties& fprops = dynamic_cast (go.get_properties ()); - - if (fprops.is_modified ()) - { - if (fprops.is_visible ()) - { - gh_manager::unlock (); - - fprops.get_toolkit ().redraw_figure (go); - - gh_manager::lock (); - } - - fprops.set_modified (false); - } - } - } - - bool do_events = true; - - if (args.length () == 1) - { - caseless_str val (args(0).string_value ()); - - if (! error_state && val.compare ("expose")) - do_events = false; - else - { - error ("drawnow: invalid argument, expected `expose' as argument"); - return retval; - } - } - - if (do_events) - { - gh_manager::unlock (); - - gh_manager::process_events (); - - gh_manager::lock (); - } - } - else if (args.length () >= 2 && args.length () <= 4) - { - std::string term, file, debug_file; - bool mono; - - term = args(0).string_value (); - - if (! error_state) - { - file = args(1).string_value (); - - if (! error_state) - { - size_t pos = file.find_first_not_of ("|"); - if (pos > 0) - file = file.substr (pos); - else - { - pos = file.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string dirname = file.substr (0, pos+1); - - file_stat fs (dirname); - - if (! (fs && fs.is_dir ())) - { - error ("drawnow: nonexistent directory `%s'", - dirname.c_str ()); - - return retval; - } - } - } - - mono = (args.length () >= 3 ? args(2).bool_value () : false); - - if (! error_state) - { - debug_file = (args.length () > 3 ? args(3).string_value () - : ""); - - if (! error_state) - { - graphics_handle h = gcf (); - - if (h.ok ()) - { - graphics_object go = gh_manager::get_object (h); - - gh_manager::unlock (); - - go.get_toolkit () - .print_figure (go, term, file, mono, debug_file); - - gh_manager::lock (); - } - else - error ("drawnow: nothing to draw"); - } - else - error ("drawnow: invalid DEBUG_FILE, expected a string value"); - } - else - error ("drawnow: invalid colormode MONO, expected a boolean value"); - } - else - error ("drawnow: invalid FILE, expected a string value"); - } - else - error ("drawnow: invalid terminal TERM, expected a string value"); - } - else - print_usage (); - } - - gh_manager::unlock (); - - return retval; -} - -DEFUN (addlistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ -Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ -object @var{h}. Property listeners are executed (in order of registration)\n\ -when the property is set. The new value is already available when the\n\ -listeners are executed.\n\ -\n\ -@var{prop} must be a string naming a valid property in @var{h}.\n\ -\n\ -@var{fcn} can be a function handle, a string or a cell array whose first\n\ -element is a function handle. If @var{fcn} is a function handle, the\n\ -corresponding function should accept at least 2 arguments, that will be\n\ -set to the object handle and the empty matrix respectively. If @var{fcn}\n\ -is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ -array, the first element must be a function handle with the same signature\n\ -as described above. The next elements of the cell array are passed\n\ -as additional arguments to the function.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3 && args.length () <= 4) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - go.add_property_listener (pname, args(2), POSTSET); - - if (args.length () == 4) - { - caseless_str persistent = args(3).string_value (); - if (persistent.compare ("persistent")) - go.add_property_listener (pname, args(2), PERSISTENT); - } - } - else - error ("addlistener: invalid graphics object (= %g)", - h); - } - else - error ("addlistener: invalid property name, expected a string value"); - } - else - error ("addlistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (dellistener, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ -Remove the registration of @var{fcn} as a listener for the property\n\ -@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ -be the same variable (not just the same value), as was passed to the\n\ -original call to @code{addlistener}.\n\ -\n\ -If @var{fcn} is not defined then all listener functions of @var{prop}\n\ -are removed.\n\ -\n\ -Example:\n\ -\n\ -@example\n\ -@group\n\ -function my_listener (h, dummy, p1)\n\ - fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ -endfunction\n\ -\n\ -c = @{@@my_listener, \"my string\"@};\n\ -addlistener (gcf, \"position\", c);\n\ -dellistener (gcf, \"position\", c);\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () == 3 || args.length () == 2) - { - double h = args(0).double_value (); - - if (! error_state) - { - std::string pname = args(1).string_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - if (args.length () == 2) - go.delete_property_listener (pname, octave_value (), POSTSET); - else - { - caseless_str persistent = args(2).string_value (); - if (persistent.compare ("persistent")) - { - go.delete_property_listener (pname, octave_value (), PERSISTENT); - go.delete_property_listener (pname, octave_value (), POSTSET); - } - else - go.delete_property_listener (pname, args(2), POSTSET); - } - } - else - error ("dellistener: invalid graphics object (= %g)", - h); - } - else - error ("dellistener: invalid property name, expected a string value"); - } - else - error ("dellistener: invalid handle"); - } - else - print_usage (); - - return retval; -} - -DEFUN (addproperty, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ -@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ -Create a new property named @var{name} in graphics object @var{h}.\n\ -@var{type} determines the type of the property to create. @var{args}\n\ -usually contains the default value of the property, but additional\n\ -arguments might be given, depending on the type of the property.\n\ -\n\ -The supported property types are:\n\ -\n\ -@table @code\n\ -@item string\n\ -A string property. @var{arg} contains the default string value.\n\ -\n\ -@item any\n\ -An un-typed property. This kind of property can hold any octave\n\ -value. @var{args} contains the default value.\n\ -\n\ -@item radio\n\ -A string property with a limited set of accepted values. The first\n\ -argument must be a string with all accepted values separated by\n\ -a vertical bar ('|'). The default value can be marked by enclosing\n\ -it with a '@{' '@}' pair. The default value may also be given as\n\ -an optional second string argument.\n\ -\n\ -@item boolean\n\ -A boolean property. This property type is equivalent to a radio\n\ -property with \"on|off\" as accepted values. @var{arg} contains\n\ -the default property value.\n\ -\n\ -@item double\n\ -A scalar double property. @var{arg} contains the default value.\n\ -\n\ -@item handle\n\ -A handle property. This kind of property holds the handle of a\n\ -graphics object. @var{arg} contains the default handle value.\n\ -When no default value is given, the property is initialized to\n\ -the empty matrix.\n\ -\n\ -@item data\n\ -A data (matrix) property. @var{arg} contains the default data\n\ -value. When no default value is given, the data is initialized to\n\ -the empty matrix.\n\ -\n\ -@item color\n\ -A color property. @var{arg} contains the default color value.\n\ -When no default color is given, the property is set to black.\n\ -An optional second string argument may be given to specify an\n\ -additional set of accepted string values (like a radio property).\n\ -@end table\n\ -\n\ -@var{type} may also be the concatenation of a core object type and\n\ -a valid property name for that object type. The property created\n\ -then has the same characteristics as the referenced property (type,\n\ -possible values, hidden state@dots{}). This allows to clone an existing\n\ -property into the graphics object @var{h}.\n\ -\n\ -Examples:\n\ -\n\ -@example\n\ -@group\n\ -addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ -addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ -addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ -@end group\n\ -@end example\n\ -\n\ -@end deftypefn") -{ - gh_manager::auto_lock guard; - - octave_value retval; - - if (args.length () >= 3) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - double h = args(1).double_value (); - - if (! error_state) - { - graphics_handle gh = gh_manager::lookup (h); - - if (gh.ok ()) - { - graphics_object go = gh_manager::get_object (gh); - - std::string type = args(2).string_value (); - - if (! error_state) - { - if (! go.get_properties ().has_property (name)) - { - property p = property::create (name, gh, type, - args.splice (0, 3)); - - if (! error_state) - go.get_properties ().insert_property (name, p); - } - else - error ("addproperty: a `%s' property already exists in the graphics object", - name.c_str ()); - } - else - error ("addproperty: invalid property TYPE, expected a string value"); - } - else - error ("addproperty: invalid graphics object (= %g)", h); - } - else - error ("addproperty: invalid handle value"); - } - else - error ("addproperty: invalid property NAME, expected a string value"); - } - else - print_usage (); - - return retval; -} - -octave_value -get_property_from_handle (double handle, const std::string& property, - const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - octave_value retval; - - if (obj) - retval = obj.get (caseless_str (property)); - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return retval; -} - -bool -set_property_in_handle (double handle, const std::string& property, - const octave_value& arg, const std::string& func) -{ - gh_manager::auto_lock guard; - - graphics_object obj = gh_manager::get_object (handle); - int ret = false; - - if (obj) - { - obj.set (caseless_str (property), arg); - - if (! error_state) - ret = true; - } - else - error ("%s: invalid handle (= %g)", func.c_str (), handle); - - return ret; -} - -static bool -compare_property_values (const octave_value& o1, const octave_value& o2) -{ - octave_value_list args (2); - - args(0) = o1; - args(1) = o2; - - octave_value_list result = feval ("isequal", args, 1); - - if (! error_state && result.length () > 0) - return result(0).bool_value (); - - return false; -} - -static std::map waitfor_results; - -static void -cleanup_waitfor_id (uint32_t id) -{ - waitfor_results.erase (id); -} - -static void -do_cleanup_waitfor_listener (const octave_value& listener, - listener_mode mode = POSTSET) -{ - Cell c = listener.cell_value (); - - if (c.numel () >= 4) - { - double h = c(2).double_value (); - - if (! error_state) - { - caseless_str pname = c(3).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (go.get_properties ().has_property (pname)) - { - go.get_properties () - .delete_listener (pname, listener, mode); - if (mode == POSTSET) - go.get_properties () - .delete_listener (pname, listener, PERSISTENT); - } - } - } - } - } -} - -static void -cleanup_waitfor_postset_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, POSTSET); } - -static void -cleanup_waitfor_predelete_listener (const octave_value& listener) -{ do_cleanup_waitfor_listener (listener, PREDELETE); } - -static octave_value_list -waitfor_listener (const octave_value_list& args, int) -{ - if (args.length () > 3) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - { - if (args.length () > 5) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname = args(4).string_value (); - - if (! error_state) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - octave_value pvalue = go.get (pname); - - if (compare_property_values (pvalue, args(5))) - waitfor_results[id] = true; - } - } - } - } - else - waitfor_results[id] = true; - } - } - - return octave_value_list (); -} - -static octave_value_list -waitfor_del_listener (const octave_value_list& args, int) -{ - if (args.length () > 2) - { - uint32_t id = args(2).uint32_scalar_value ().value (); - - if (! error_state) - waitfor_results[id] = true; - } - - return octave_value_list (); -} - -DEFUN (waitfor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ -@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ -@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ -Suspend the execution of the current program until a condition is\n\ -satisfied on the graphics handle @var{h}. While the program is suspended\n\ -graphics events are still being processed normally, allowing callbacks to\n\ -modify the state of graphics objects. This function is reentrant and can be\n\ -called from a callback, while another @code{waitfor} call is pending at\n\ -top-level.\n\ -\n\ -In the first form, program execution is suspended until the graphics object\n\ -@var{h} is destroyed. If the graphics handle is invalid, the function\n\ -returns immediately.\n\ -\n\ -In the second form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is modified. If the graphics\n\ -handle is invalid or the property does not exist, the function returns\n\ -immediately.\n\ -\n\ -In the third form, execution is suspended until the graphics object is\n\ -destroyed or the property named @var{prop} is set to @var{value}. The\n\ -function @code{isequal} is used to compare property values. If the graphics\n\ -handle is invalid, the property does not exist or the property is already\n\ -set to @var{value}, the function returns immediately.\n\ -\n\ -An optional timeout can be specified using the property @code{timeout}.\n\ -This timeout value is the number of seconds to wait for the condition to be\n\ -true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ -warning is issued and a value of 1 is used instead. If the timeout value is\n\ -not an integer, it is truncated towards 0.\n\ -\n\ -To define a condition on a property named @code{timeout}, use the string\n\ -@code{\\timeout} instead.\n\ -\n\ -In all cases, typing CTRL-C stops program execution immediately.\n\ -@seealso{isequal}\n\ -@end deftypefn") -{ - if (args.length () > 0) - { - double h = args(0).double_value (); - - if (! error_state) - { - caseless_str pname; - - unwind_protect frame; - - static uint32_t id_counter = 0; - uint32_t id = 0; - - int max_arg_index = 0; - int timeout_index = -1; - - int timeout = 0; - - if (args.length () > 1) - { - pname = args(1).string_value (); - if (! error_state - && ! pname.empty () - && ! pname.compare ("timeout")) - { - if (pname.compare ("\\timeout")) - pname = "timeout"; - - static octave_value wf_listener; - - if (! wf_listener.is_defined ()) - wf_listener = - octave_value (new octave_builtin (waitfor_listener, - "waitfor_listener")); - - max_arg_index++; - if (args.length () > 2) - { - if (args(2).is_string ()) - { - caseless_str s = args(2).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = 2; - else - max_arg_index++; - } - } - else - max_arg_index++; - } - - Cell listener (1, max_arg_index >= 2 ? 5 : 4); - - id = id_counter++; - frame.add_fcn (cleanup_waitfor_id, id); - waitfor_results[id] = false; - - listener(0) = wf_listener; - listener(1) = octave_uint32 (id); - listener(2) = h; - listener(3) = pname; - - if (max_arg_index >= 2) - listener(4) = args(2); - - octave_value ov_listener (listener); - - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - graphics_object go = gh_manager::get_object (handle); - - if (max_arg_index >= 2 - && compare_property_values (go.get (pname), - args(2))) - waitfor_results[id] = true; - else - { - - frame.add_fcn (cleanup_waitfor_postset_listener, - ov_listener); - go.add_property_listener (pname, ov_listener, - POSTSET); - go.add_property_listener (pname, ov_listener, - PERSISTENT); - - if (go.get_properties () - .has_dynamic_property (pname)) - { - static octave_value wf_del_listener; - - if (! wf_del_listener.is_defined ()) - wf_del_listener = - octave_value (new octave_builtin - (waitfor_del_listener, - "waitfor_del_listener")); - - Cell del_listener (1, 4); - - del_listener(0) = wf_del_listener; - del_listener(1) = octave_uint32 (id); - del_listener(2) = h; - del_listener(3) = pname; - - octave_value ov_del_listener (del_listener); - - frame.add_fcn (cleanup_waitfor_predelete_listener, - ov_del_listener); - go.add_property_listener (pname, ov_del_listener, - PREDELETE); - } - } - } - } - else if (error_state || pname.empty ()) - error ("waitfor: invalid property name, expected a non-empty string value"); - } - - if (! error_state - && timeout_index < 0 - && args.length () > (max_arg_index + 1)) - { - caseless_str s = args(max_arg_index + 1).string_value (); - - if (! error_state) - { - if (s.compare ("timeout")) - timeout_index = max_arg_index + 1; - else - error ("waitfor: invalid parameter `%s'", s.c_str ()); - } - else - error ("waitfor: invalid parameter, expected `timeout'"); - } - - if (! error_state && timeout_index >= 0) - { - if (args.length () > (timeout_index + 1)) - { - timeout = static_cast - (args(timeout_index + 1).scalar_value ()); - - if (! error_state) - { - if (timeout < 1) - { - warning ("waitfor: the timeout value must be >= 1, using 1 instead"); - timeout = 1; - } - } - else - error ("waitfor: invalid timeout value, expected a value >= 1"); - } - else - error ("waitfor: missing timeout value"); - } - - // FIXME: There is still a "hole" in the following loop. The code - // assumes that an object handle is unique, which is a fair - // assumptions, except for figures. If a figure is destroyed - // then recreated with the same figure ID, within the same - // run of event hooks, then the figure destruction won't be - // caught and the loop will not stop. This is an unlikely - // possibility in practice, though. - // - // Using deletefcn callback is also unreliable as it could be - // modified during a callback execution and the waitfor loop - // would not stop. - // - // The only "good" implementation would require object - // listeners, similar to property listeners. - - time_t start = 0; - - if (timeout > 0) - start = time (0); - - while (! error_state) - { - if (true) - { - gh_manager::auto_lock guard; - - graphics_handle handle = gh_manager::lookup (h); - - if (handle.ok ()) - { - if (! pname.empty () && waitfor_results[id]) - break; - } - else - break; - } - - octave_usleep (100000); - - OCTAVE_QUIT; - - command_editor::run_event_hooks (); - - if (timeout > 0) - { - if (start + timeout < time (0)) - break; - } - } - } - else - error ("waitfor: invalid handle value."); - } - else - print_usage (); - - return octave_value (); -} diff -r 069c552587a0 -r 959953dba519 src/graphics.in.h --- a/src/graphics.in.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5830 +0,0 @@ -/* - -Copyright (C) 2007-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (graphics_h) -#define graphics_h 1 - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include -#include -#include -#include -#include - -#include "caseless-str.h" -#include "lo-ieee.h" - -#include "gripes.h" -#include "oct-map.h" -#include "oct-mutex.h" -#include "oct-refcount.h" -#include "ov.h" -#include "txt-eng-ft.h" - -// FIXME -- maybe this should be a configure option? -// Matlab defaults to "Helvetica", but that causes problems for many -// gnuplot users. -#if !defined (OCTAVE_DEFAULT_FONTNAME) -#define OCTAVE_DEFAULT_FONTNAME "*" -#endif - -// --------------------------------------------------------------------- - -class graphics_handle -{ -public: - graphics_handle (void) : val (octave_NaN) { } - - graphics_handle (const octave_value& a); - - graphics_handle (int a) : val (a) { } - - graphics_handle (double a) : val (a) { } - - graphics_handle (const graphics_handle& a) : val (a.val) { } - - graphics_handle& operator = (const graphics_handle& a) - { - if (&a != this) - val = a.val; - - return *this; - } - - ~graphics_handle (void) { } - - double value (void) const { return val; } - - octave_value as_octave_value (void) const - { - return ok () ? octave_value (val) : octave_value (Matrix ()); - } - - // Prefix increment/decrement operators. - graphics_handle& operator ++ (void) - { - ++val; - return *this; - } - - graphics_handle& operator -- (void) - { - --val; - return *this; - } - - // Postfix increment/decrement operators. - const graphics_handle operator ++ (int) - { - graphics_handle old_value = *this; - ++(*this); - return old_value; - } - - const graphics_handle operator -- (int) - { - graphics_handle old_value = *this; - --(*this); - return old_value; - } - - bool ok (void) const { return ! xisnan (val); } - -private: - double val; -}; - -inline bool -operator == (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () == b.value (); -} - -inline bool -operator != (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () != b.value (); -} - -inline bool -operator < (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () < b.value (); -} - -inline bool -operator <= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () <= b.value (); -} - -inline bool -operator >= (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () >= b.value (); -} - -inline bool -operator > (const graphics_handle& a, const graphics_handle& b) -{ - return a.value () > b.value (); -} - -// --------------------------------------------------------------------- - -class base_scaler -{ -public: - base_scaler (void) { } - - virtual ~base_scaler (void) { } - - virtual Matrix scale (const Matrix& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual NDArray scale (const NDArray& m) const - { - error ("invalid axis scale"); - return m; - } - - virtual double scale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual double unscale (double d) const - { - error ("invalid axis scale"); - return d; - } - - virtual base_scaler* clone () const - { return new base_scaler (); } - - virtual bool is_linear (void) const - { return false; } -}; - -class lin_scaler : public base_scaler -{ -public: - lin_scaler (void) { } - - Matrix scale (const Matrix& m) const { return m; } - - NDArray scale (const NDArray& m) const { return m; } - - double scale (double d) const { return d; } - - double unscale (double d) const { return d; } - - base_scaler* clone (void) const { return new lin_scaler (); } - - bool is_linear (void) const { return true; } -}; - -class log_scaler : public base_scaler -{ -public: - log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return log10 (d); } - - double unscale (double d) const - { return pow (10.0, d); } - - base_scaler* clone (void) const - { return new log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = log10 (src[i]); - } -}; - -class neg_log_scaler : public base_scaler -{ -public: - neg_log_scaler (void) { } - - Matrix scale (const Matrix& m) const - { - Matrix retval (m.rows (), m.cols ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - NDArray scale (const NDArray& m) const - { - NDArray retval (m.dims ()); - - do_scale (m.data (), retval.fortran_vec (), m.numel ()); - - return retval; - } - - double scale (double d) const - { return -log10 (-d); } - - double unscale (double d) const - { return -pow (10.0, -d); } - - base_scaler* clone (void) const - { return new neg_log_scaler (); } - -private: - void do_scale (const double *src, double *dest, int n) const - { - for (int i = 0; i < n; i++) - dest[i] = -log10 (-src[i]); - } -}; - -class scaler -{ -public: - scaler (void) : rep (new base_scaler ()) { } - - scaler (const scaler& s) : rep (s.rep->clone ()) { } - - scaler (const std::string& s) - : rep (s == "log" - ? new log_scaler () - : (s == "neglog" ? new neg_log_scaler () - : (s == "linear" ? new lin_scaler () : new base_scaler ()))) - { } - - ~scaler (void) { delete rep; } - - Matrix scale (const Matrix& m) const - { return rep->scale (m); } - - NDArray scale (const NDArray& m) const - { return rep->scale (m); } - - double scale (double d) const - { return rep->scale (d); } - - double unscale (double d) const - { return rep->unscale (d); } - - bool is_linear (void) const - { return rep->is_linear (); } - - scaler& operator = (const scaler& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - rep = s.rep->clone (); - - return *this; - } - - scaler& operator = (const std::string& s) - { - if (rep) - { - delete rep; - rep = 0; - } - - if (s == "log") - rep = new log_scaler (); - else if (s == "neglog") - rep = new neg_log_scaler (); - else if (s == "linear") - rep = new lin_scaler (); - else - rep = new base_scaler (); - - return *this; - } - -private: - base_scaler *rep; -}; - -// --------------------------------------------------------------------- - -class property; - -enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; - -class base_property -{ -public: - friend class property; - -public: - base_property (void) - : id (-1), count (1), name (), parent (), hidden (), listeners () - { } - - base_property (const std::string& s, const graphics_handle& h) - : id (-1), count (1), name (s), parent (h), hidden (false), listeners () - { } - - base_property (const base_property& p) - : id (-1), count (1), name (p.name), parent (p.parent), - hidden (p.hidden), listeners () - { } - - virtual ~base_property (void) { } - - bool ok (void) const { return parent.ok (); } - - std::string get_name (void) const { return name; } - - void set_name (const std::string& s) { name = s; } - - graphics_handle get_parent (void) const { return parent; } - - void set_parent (const graphics_handle &h) { parent = h; } - - bool is_hidden (void) const { return hidden; } - - void set_hidden (bool flag) { hidden = flag; } - - virtual bool is_radio (void) const { return false; } - - int get_id (void) const { return id; } - - void set_id (int d) { id = d; } - - // Sets property value, notifies graphics toolkit. - // If do_run is true, runs associated listeners. - OCTINTERP_API bool set (const octave_value& v, bool do_run = true, - bool do_notify_toolkit = true); - - virtual octave_value get (void) const - { - error ("get: invalid property \"%s\"", name.c_str ()); - return octave_value (); - } - - - virtual std::string values_as_string (void) const - { - error ("values_as_string: invalid property \"%s\"", name.c_str ()); - return std::string (); - } - - virtual Cell values_as_cell (void) const - { - error ("values_as_cell: invalid property \"%s\"", name.c_str ()); - return Cell (); - } - - base_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - l.resize (l.length () + 1, v); - } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { - octave_value_list& l = listeners[mode]; - - if (v.is_defined ()) - { - bool found = false; - int i; - - for (i = 0; i < l.length (); i++) - { - if (v.internal_rep () == l(i).internal_rep ()) - { - found = true; - break; - } - } - if (found) - { - for (int j = i; j < l.length () - 1; j++) - l(j) = l(j + 1); - - l.resize (l.length () - 1); - } - } - else - { - if (mode == PERSISTENT) - l.resize (0); - else - { - octave_value_list lnew (0); - octave_value_list& lp = listeners[PERSISTENT]; - for (int i = l.length () - 1; i >= 0 ; i--) - { - for (int j = 0; j < lp.length (); j++) - { - if (l(i).internal_rep () == lp(j).internal_rep ()) - { - lnew.resize (lnew.length () + 1, l(i)); - break; - } - } - } - l = lnew; - } - } - - } - - OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); - - virtual base_property* clone (void) const - { return new base_property (*this); } - -protected: - virtual bool do_set (const octave_value&) - { - error ("set: invalid property \"%s\"", name.c_str ()); - return false; - } - -private: - typedef std::map listener_map; - typedef std::map::iterator listener_map_iterator; - typedef std::map::const_iterator listener_map_const_iterator; - -private: - int id; - octave_refcount count; - std::string name; - graphics_handle parent; - bool hidden; - listener_map listeners; -}; - -// --------------------------------------------------------------------- - -class string_property : public base_property -{ -public: - string_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), str (val) { } - - string_property (const string_property& p) - : base_property (p), str (p.str) { } - - octave_value get (void) const - { return octave_value (str); } - - std::string string_value (void) const { return str; } - - string_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - std::string new_str = val.string_value (); - - if (new_str != str) - { - str = new_str; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - std::string str; -}; - -// --------------------------------------------------------------------- - -class string_array_property : public base_property -{ -public: - enum desired_enum { string_t, cell_t }; - - string_array_property (const std::string& s, const graphics_handle& h, - const std::string& val = "", const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - size_t pos = 0; - - while (true) - { - size_t new_pos = val.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - str.append (val.substr (pos)); - break; - } - else - str.append (val.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - } - - string_array_property (const std::string& s, const graphics_handle& h, - const Cell& c, const char& sep = '|', - const desired_enum& typ = string_t) - : base_property (s, h), desired_type (typ), separator (sep), str () - { - if (c.is_cellstr ()) - { - string_vector strings (c.numel ()); - - for (octave_idx_type i = 0; i < c.numel (); i++) - strings[i] = c(i).string_value (); - - str = strings; - } - else - error ("set: invalid order property value for \"%s\"", - get_name ().c_str ()); - } - - string_array_property (const string_array_property& p) - : base_property (p), desired_type (p.desired_type), - separator (p.separator), str (p.str) { } - - octave_value get (void) const - { - if (desired_type == string_t) - return octave_value (string_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - std::string s; - - for (octave_idx_type i = 0; i < str.length (); i++) - { - s += str[i]; - if (i != str.length () - 1) - s += separator; - } - - return s; - } - - Cell cell_value (void) const {return Cell (str);} - - string_vector string_vector_value (void) const { return str; } - - string_array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new string_array_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - bool replace = false; - std::string new_str = val.string_value (); - string_vector strings; - size_t pos = 0; - - while (pos != std::string::npos) - { - size_t new_pos = new_str.find_first_of (separator, pos); - - if (new_pos == std::string::npos) - { - strings.append (new_str.substr (pos)); - break; - } - else - strings.append (new_str.substr (pos, new_pos - pos)); - - pos = new_pos + 1; - } - - if (str.numel () == strings.numel ()) - { - for (octave_idx_type i = 0; i < str.numel (); i++) - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - else - replace = true; - - desired_type = string_t; - - if (replace) - { - str = strings; - return true; - } - } - else if (val.is_cellstr ()) - { - bool replace = false; - Cell new_cell = val.cell_value (); - - string_vector strings = new_cell.cellstr_value (); - - octave_idx_type nel = strings.length (); - - if (nel != str.length ()) - replace = true; - else - { - for (octave_idx_type i = 0; i < nel; i++) - { - if (strings[i] != str[i]) - { - replace = true; - break; - } - } - } - - desired_type = cell_t; - - if (replace) - { - str = strings; - return true; - } - } - else - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - desired_enum desired_type; - char separator; - string_vector str; -}; - -// --------------------------------------------------------------------- - -class text_label_property : public base_property -{ -public: - enum type { char_t, cellstr_t }; - - text_label_property (const std::string& s, const graphics_handle& h, - const std::string& val = "") - : base_property (s, h), value (val), stored_type (char_t) - { } - - text_label_property (const std::string& s, const graphics_handle& h, - const NDArray& nda) - : base_property (s, h), stored_type (char_t) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - } - - text_label_property (const std::string& s, const graphics_handle& h, - const Cell& c) - : base_property (s, h), stored_type (cellstr_t) - { - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - break; - } - } - } - - text_label_property (const text_label_property& p) - : base_property (p), value (p.value), stored_type (p.stored_type) - { } - - bool empty (void) const - { - octave_value tmp = get (); - return tmp.is_empty (); - } - - octave_value get (void) const - { - if (stored_type == char_t) - return octave_value (char_value ()); - else - return octave_value (cell_value ()); - } - - std::string string_value (void) const - { - return value.empty () ? std::string () : value[0]; - } - - string_vector string_vector_value (void) const { return value; } - - charMatrix char_value (void) const { return charMatrix (value, ' '); } - - Cell cell_value (void) const {return Cell (value); } - - text_label_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new text_label_property (*this); } - -protected: - - bool do_set (const octave_value& val) - { - if (val.is_string ()) - { - value = val.all_strings (); - - stored_type = char_t; - } - else if (val.is_cell ()) - { - Cell c = val.cell_value (); - - octave_idx_type nel = c.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - octave_value tmp = c(i); - - if (tmp.is_string ()) - value[i] = c(i).string_value (); - else - { - double d = c(i).double_value (); - - if (! error_state) - { - std::ostringstream buf; - buf << d; - value[i] = buf.str (); - } - else - return false; - } - } - - stored_type = cellstr_t; - } - else - { - NDArray nda = val.array_value (); - - if (! error_state) - { - octave_idx_type nel = nda.numel (); - - value.resize (nel); - - for (octave_idx_type i = 0; i < nel; i++) - { - std::ostringstream buf; - buf << nda(i); - value[i] = buf.str (); - } - - stored_type = char_t; - } - else - { - error ("set: invalid string property value for \"%s\"", - get_name ().c_str ()); - - return false; - } - } - - return true; - } - -private: - string_vector value; - type stored_type; -}; - -// --------------------------------------------------------------------- - -class radio_values -{ -public: - OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); - - radio_values (const radio_values& a) - : default_val (a.default_val), possible_vals (a.possible_vals) { } - - radio_values& operator = (const radio_values& a) - { - if (&a != this) - { - default_val = a.default_val; - possible_vals = a.possible_vals; - } - - return *this; - } - - std::string default_value (void) const { return default_val; } - - bool validate (const std::string& val, std::string& match) - { - bool retval = true; - - if (! contains (val, match)) - { - error ("invalid value = %s", val.c_str ()); - retval = false; - } - - return retval; - } - - bool contains (const std::string& val, std::string& match) - { - size_t k = 0; - - size_t len = val.length (); - - std::string first_match; - - for (std::set::const_iterator p = possible_vals.begin (); - p != possible_vals.end (); p++) - { - if (p->compare (val, len)) - { - if (len == p->length ()) - { - // We found a full match (consider the case of val == - // "replace" with possible values "replace" and - // "replacechildren"). Any other matches are - // irrelevant, so set match and return now. - - match = *p; - return true; - } - else - { - if (k == 0) - first_match = *p; - - k++; - } - } - } - - if (k == 1) - { - match = first_match; - return true; - } - else - return false; - } - - std::string values_as_string (void) const; - - Cell values_as_cell (void) const; - - octave_idx_type nelem (void) const { return possible_vals.size (); } - -private: - // Might also want to cache - std::string default_val; - std::set possible_vals; -}; - -class radio_property : public base_property -{ -public: - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v = radio_values ()) - : base_property (nm, h), - vals (v), current_val (v.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - vals (v), current_val (vals.default_value ()) { } - - radio_property (const std::string& nm, const graphics_handle& h, - const radio_values& v, const std::string& def) - : base_property (nm, h), - vals (v), current_val (def) { } - - radio_property (const radio_property& p) - : base_property (p), vals (p.vals), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - const std::string& current_value (void) const { return current_val; } - - std::string values_as_string (void) const { return vals.values_as_string (); } - - Cell values_as_cell (void) const { return vals.values_as_cell (); } - - bool is (const caseless_str& v) const - { return v.compare (current_val); } - - bool is_radio (void) const { return true; } - - radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new radio_property (*this); } - -protected: - bool do_set (const octave_value& newval) - { - if (newval.is_string ()) - { - std::string s = newval.string_value (); - - std::string match; - - if (vals.validate (s, match)) - { - if (match != current_val) - { - if (s.length () != match.length ()) - warning_with_id ("Octave:abbreviated-property-match", - "%s: allowing %s to match %s value %s", - "set", s.c_str (), get_name ().c_str (), - match.c_str ()); - current_val = match; - return true; - } - } - else - error ("set: invalid value for radio property \"%s\" (value = %s)", - get_name ().c_str (), s.c_str ()); - } - else - error ("set: invalid value for radio property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - radio_values vals; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class color_values -{ -public: - color_values (double r = 0, double g = 0, double b = 1) - : xrgb (1, 3) - { - xrgb(0) = r; - xrgb(1) = g; - xrgb(2) = b; - - validate (); - } - - color_values (std::string str) - : xrgb (1, 3) - { - if (! str2rgb (str)) - error ("invalid color specification: %s", str.c_str ()); - } - - color_values (const color_values& c) - : xrgb (c.xrgb) - { } - - color_values& operator = (const color_values& c) - { - if (&c != this) - xrgb = c.xrgb; - - return *this; - } - - bool operator == (const color_values& c) const - { - return (xrgb(0) == c.xrgb(0) - && xrgb(1) == c.xrgb(1) - && xrgb(2) == c.xrgb(2)); - } - - bool operator != (const color_values& c) const - { return ! (*this == c); } - - Matrix rgb (void) const { return xrgb; } - - operator octave_value (void) const { return xrgb; } - - void validate (void) const - { - for (int i = 0; i < 3; i++) - { - if (xrgb(i) < 0 || xrgb(i) > 1) - { - error ("invalid RGB color specification"); - break; - } - } - } - -private: - Matrix xrgb; - - OCTINTERP_API bool str2rgb (std::string str); -}; - -class color_property : public base_property -{ -public: - color_property (const color_values& c, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_values& c = color_values (), - const radio_values& v = radio_values ()) - : base_property (nm, h), - current_type (color_t), color_val (c), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const radio_values& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (v.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), color_val (color_values ()), radio_val (v), - current_val (radio_val.default_value ()) - { } - - color_property (const std::string& nm, const graphics_handle& h, - const color_property& v) - : base_property (nm, h), - current_type (v.current_type), color_val (v.color_val), - radio_val (v.radio_val), current_val (v.current_val) - { } - - color_property (const color_property& p) - : base_property (p), current_type (p.current_type), - color_val (p.color_val), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == color_t) - return color_val.rgb (); - - return current_val; - } - - bool is_rgb (void) const { return (current_type == color_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - Matrix rgb (void) const - { - if (current_type != color_t) - error ("color has no rgb value"); - - return color_val.rgb (); - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("color has no radio value"); - - return current_val; - } - - color_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const { return new color_property (*this); } - - std::string values_as_string (void) const { return radio_val.values_as_string (); } - - Cell values_as_cell (void) const { return radio_val.values_as_cell (); } - -protected: - OCTINTERP_API bool do_set (const octave_value& newval); - -private: - enum current_enum { color_t, radio_t } current_type; - color_values color_val; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class double_property : public base_property -{ -public: - double_property (const std::string& nm, const graphics_handle& h, - double d = 0) - : base_property (nm, h), - current_val (d) { } - - double_property (const double_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return octave_value (current_val); } - - double double_value (void) const { return current_val; } - - double_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new double_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (v.is_scalar_type () && v.is_real_type ()) - { - double new_val = v.double_value (); - - if (new_val != current_val) - { - current_val = new_val; - return true; - } - } - else - error ("set: invalid value for double property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - double current_val; -}; - -// --------------------------------------------------------------------- - -class double_radio_property : public base_property -{ -public: - double_radio_property (double d, const radio_values& v) - : base_property ("", graphics_handle ()), - current_type (double_t), dval (d), radio_val (v), - current_val (v.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const std::string& v) - : base_property (nm, h), - current_type (radio_t), dval (0), radio_val (v), - current_val (radio_val.default_value ()) - { } - - double_radio_property (const std::string& nm, const graphics_handle& h, - const double_radio_property& v) - : base_property (nm, h), - current_type (v.current_type), dval (v.dval), - radio_val (v.radio_val), current_val (v.current_val) - { } - - double_radio_property (const double_radio_property& p) - : base_property (p), current_type (p.current_type), - dval (p.dval), radio_val (p.radio_val), - current_val (p.current_val) { } - - octave_value get (void) const - { - if (current_type == double_t) - return dval; - - return current_val; - } - - bool is_double (void) const { return (current_type == double_t); } - - bool is_radio (void) const { return (current_type == radio_t); } - - bool is (const std::string& v) const - { return (is_radio () && current_val == v); } - - double double_value (void) const - { - if (current_type != double_t) - error ("%s: property has no double", get_name ().c_str ()); - - return dval; - } - - const std::string& current_value (void) const - { - if (current_type != radio_t) - error ("%s: property has no radio value"); - - return current_val; - } - - double_radio_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - operator octave_value (void) const { return get (); } - - base_property* clone (void) const - { return new double_radio_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - enum current_enum { double_t, radio_t } current_type; - double dval; - radio_values radio_val; - std::string current_val; -}; - -// --------------------------------------------------------------------- - -class array_property : public base_property -{ -public: - array_property (void) - : base_property ("", graphics_handle ()), data (Matrix ()), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - array_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), data (m), - xmin (), xmax (), xminp (), xmaxp (), - type_constraints (), size_constraints () - { - get_data_limits (); - } - - // This copy constructor is only intended to be used - // internally to access min/max values; no need to - // copy constraints. - array_property (const array_property& p) - : base_property (p), data (p.data), - xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), - type_constraints (), size_constraints () - { } - - octave_value get (void) const { return data; } - - void add_constraint (const std::string& type) - { type_constraints.push_back (type); } - - void add_constraint (const dim_vector& dims) - { size_constraints.push_back (dims); } - - double min_val (void) const { return xmin; } - double max_val (void) const { return xmax; } - double min_pos (void) const { return xminp; } - double max_neg (void) const { return xmaxp; } - - Matrix get_limits (void) const - { - Matrix m (1, 4); - - m(0) = min_val (); - m(1) = max_val (); - m(2) = min_pos (); - m(3) = max_neg (); - - return m; - } - - array_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - array_property *p = new array_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - if (validate (v)) - { - // FIXME -- should we check for actual data change? - if (! is_equal (v)) - { - data = v; - - get_data_limits (); - - return true; - } - } - else - error ("invalid value for array property \"%s\"", - get_name ().c_str ()); - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); - - OCTINTERP_API bool is_equal (const octave_value& v) const; - - OCTINTERP_API void get_data_limits (void); - -protected: - octave_value data; - double xmin; - double xmax; - double xminp; - double xmaxp; - std::list type_constraints; - std::list size_constraints; -}; - -class row_vector_property : public array_property -{ -public: - row_vector_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : array_property (nm, h, m) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - row_vector_property (const row_vector_property& p) - : array_property (p) - { - add_constraint (dim_vector (-1, 1)); - add_constraint (dim_vector (1, -1)); - } - - void add_constraint (const std::string& type) - { - array_property::add_constraint (type); - } - - void add_constraint (const dim_vector& dims) - { - array_property::add_constraint (dims); - } - - void add_constraint (octave_idx_type len) - { - size_constraints.remove (dim_vector (1, -1)); - size_constraints.remove (dim_vector (-1, 1)); - - add_constraint (dim_vector (1, len)); - add_constraint (dim_vector (len, 1)); - } - - row_vector_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const - { - row_vector_property *p = new row_vector_property (*this); - - p->type_constraints = type_constraints; - p->size_constraints = size_constraints; - - return p; - } - -protected: - bool do_set (const octave_value& v) - { - bool retval = array_property::do_set (v); - - if (! error_state) - { - dim_vector dv = data.dims (); - - if (dv(0) > 1 && dv(1) == 1) - { - int tmp = dv(0); - dv(0) = dv(1); - dv(1) = tmp; - - data = data.reshape (dv); - } - - return retval; - } - - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v); -}; - -// --------------------------------------------------------------------- - -class bool_property : public radio_property -{ -public: - bool_property (const std::string& nm, const graphics_handle& h, - bool val) - : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) - { } - - bool_property (const std::string& nm, const graphics_handle& h, - const char* val) - : radio_property (nm, h, radio_values ("on|off"), val) - { } - - bool_property (const bool_property& p) - : radio_property (p) { } - - bool is_on (void) const { return is ("on"); } - - bool_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new bool_property (*this); } - -protected: - bool do_set (const octave_value& val) - { - if (val.is_bool_scalar ()) - return radio_property::do_set (val.bool_value () ? "on" : "off"); - else - return radio_property::do_set (val); - } -}; - -// --------------------------------------------------------------------- - -class handle_property : public base_property -{ -public: - handle_property (const std::string& nm, const graphics_handle& h, - const graphics_handle& val = graphics_handle ()) - : base_property (nm, h), - current_val (val) { } - - handle_property (const handle_property& p) - : base_property (p), current_val (p.current_val) { } - - octave_value get (void) const { return current_val.as_octave_value (); } - - graphics_handle handle_value (void) const { return current_val; } - - handle_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - handle_property& operator = (const graphics_handle& h) - { - set (octave_value (h.value ())); - return *this; - } - - base_property* clone (void) const { return new handle_property (*this); } - -protected: - OCTINTERP_API bool do_set (const octave_value& v); - -private: - graphics_handle current_val; -}; - -// --------------------------------------------------------------------- - -class any_property : public base_property -{ -public: - any_property (const std::string& nm, const graphics_handle& h, - const octave_value& m = Matrix ()) - : base_property (nm, h), data (m) { } - - any_property (const any_property& p) - : base_property (p), data (p.data) { } - - octave_value get (void) const { return data; } - - any_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new any_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - data = v; - return true; - } - -private: - octave_value data; -}; - -// --------------------------------------------------------------------- - -class children_property : public base_property -{ -public: - children_property (void) - : base_property ("", graphics_handle ()), children_list () - { - do_init_children (Matrix ()); - } - - children_property (const std::string& nm, const graphics_handle& h, - const Matrix &val) - : base_property (nm, h), children_list () - { - do_init_children (val); - } - - children_property (const children_property& p) - : base_property (p), children_list () - { - do_init_children (p.children_list); - } - - children_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new children_property (*this); } - - bool remove_child (const double &val) - { - return do_remove_child (val); - } - - void adopt (const double &val) - { - do_adopt_child (val); - } - - Matrix get_children (void) const - { - return do_get_children (false); - } - - Matrix get_hidden (void) const - { - return do_get_children (true); - } - - Matrix get_all (void) const - { - return do_get_all_children (); - } - - octave_value get (void) const - { - return octave_value (get_children ()); - } - - void delete_children (bool clear = false) - { - do_delete_children (clear); - } - - void renumber (graphics_handle old_gh, graphics_handle new_gh) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == old_gh) - { - *p = new_gh.value (); - return; - } - } - - error ("children_list::renumber: child not found!"); - } - -private: - typedef std::list::iterator children_list_iterator; - typedef std::list::const_iterator const_children_list_iterator; - std::list children_list; - -protected: - bool do_set (const octave_value& val) - { - const Matrix new_kids = val.matrix_value (); - - octave_idx_type nel = new_kids.numel (); - - const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); - - bool is_ok = true; - - if (! error_state) - { - const Matrix visible_kids = do_get_children (false); - - if (visible_kids.numel () == new_kids.numel ()) - { - Matrix t1 = visible_kids.sort (); - Matrix t2 = new_kids_column.sort (); - - if (t1 != t2) - is_ok = false; - } - else - is_ok = false; - - if (! is_ok) - error ("set: new children must be a permutation of existing children"); - } - else - { - is_ok = false; - error ("set: expecting children to be array of graphics handles"); - } - - if (is_ok) - { - Matrix tmp = new_kids_column.stack (get_hidden ()); - - children_list.clear (); - - // Don't use do_init_children here, as that reverses the - // order of the list, and we don't want to do that if setting - // the child list directly. - - for (octave_idx_type i = 0; i < tmp.numel (); i++) - children_list.push_back (tmp.xelem (i)); - } - - return is_ok; - } - -private: - void do_init_children (const Matrix &val) - { - children_list.clear (); - for (octave_idx_type i = 0; i < val.numel (); i++) - children_list.push_front (val.xelem (i)); - } - - void do_init_children (const std::list &val) - { - children_list.clear (); - for (const_children_list_iterator p = val.begin (); p != val.end (); p++) - children_list.push_front (*p); - } - - Matrix do_get_children (bool return_hidden) const; - - Matrix do_get_all_children (void) const - { - Matrix retval (children_list.size (), 1); - octave_idx_type i = 0; - - for (const_children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - retval(i++) = *p; - return retval; - } - - bool do_remove_child (double child) - { - for (children_list_iterator p = children_list.begin (); - p != children_list.end (); p++) - { - if (*p == child) - { - children_list.erase (p); - return true; - } - } - return false; - } - - void do_adopt_child (const double &val) - { - children_list.push_front (val); - } - - void do_delete_children (bool clear); -}; - - - -// --------------------------------------------------------------------- - -class callback_property : public base_property -{ -public: - callback_property (const std::string& nm, const graphics_handle& h, - const octave_value& m) - : base_property (nm, h), callback (m), executing (false) { } - - callback_property (const callback_property& p) - : base_property (p), callback (p.callback), executing (false) { } - - octave_value get (void) const { return callback; } - - OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; - - bool is_defined (void) const - { - return (callback.is_defined () && ! callback.is_empty ()); - } - - callback_property& operator = (const octave_value& val) - { - set (val); - return *this; - } - - base_property* clone (void) const { return new callback_property (*this); } - -protected: - bool do_set (const octave_value& v) - { - if (validate (v)) - { - callback = v; - return true; - } - else - error ("invalid value for callback property \"%s\"", - get_name ().c_str ()); - return false; - } - -private: - OCTINTERP_API bool validate (const octave_value& v) const; - -private: - octave_value callback; - - // If TRUE, we are executing this callback. - mutable bool executing; -}; - -// --------------------------------------------------------------------- - -class property -{ -public: - property (void) : rep (new base_property ("", graphics_handle ())) - { } - - property (base_property *bp, bool persist = false) : rep (bp) - { if (persist) rep->count++; } - - property (const property& p) : rep (p.rep) - { - rep->count++; - } - - ~property (void) - { - if (--rep->count == 0) - delete rep; - } - - bool ok (void) const - { return rep->ok (); } - - std::string get_name (void) const - { return rep->get_name (); } - - void set_name (const std::string& name) - { rep->set_name (name); } - - graphics_handle get_parent (void) const - { return rep->get_parent (); } - - void set_parent (const graphics_handle& h) - { rep->set_parent (h); } - - bool is_hidden (void) const - { return rep->is_hidden (); } - - void set_hidden (bool flag) - { rep->set_hidden (flag); } - - bool is_radio (void) const - { return rep->is_radio (); } - - int get_id (void) const - { return rep->get_id (); } - - void set_id (int d) - { rep->set_id (d); } - - octave_value get (void) const - { return rep->get (); } - - bool set (const octave_value& val, bool do_run = true, - bool do_notify_toolkit = true) - { return rep->set (val, do_run, do_notify_toolkit); } - - std::string values_as_string (void) const - { return rep->values_as_string (); } - - Cell values_as_cell (void) const - { return rep->values_as_cell (); } - - property& operator = (const octave_value& val) - { - *rep = val; - return *this; - } - - property& operator = (const property& p) - { - if (rep && --rep->count == 0) - delete rep; - - rep = p.rep; - rep->count++; - - return *this; - } - - void add_listener (const octave_value& v, listener_mode mode = POSTSET) - { rep->add_listener (v, mode); } - - void delete_listener (const octave_value& v = octave_value (), - listener_mode mode = POSTSET) - { rep->delete_listener (v, mode); } - - void run_listeners (listener_mode mode = POSTSET) - { rep->run_listeners (mode); } - - OCTINTERP_API static - property create (const std::string& name, const graphics_handle& parent, - const caseless_str& type, - const octave_value_list& args); - - property clone (void) const - { return property (rep->clone ()); } - - /* - const string_property& as_string_property (void) const - { return *(dynamic_cast (rep)); } - - const radio_property& as_radio_property (void) const - { return *(dynamic_cast (rep)); } - - const color_property& as_color_property (void) const - { return *(dynamic_cast (rep)); } - - const double_property& as_double_property (void) const - { return *(dynamic_cast (rep)); } - - const bool_property& as_bool_property (void) const - { return *(dynamic_cast (rep)); } - - const handle_property& as_handle_property (void) const - { return *(dynamic_cast (rep)); } - */ - -private: - base_property *rep; -}; - -// --------------------------------------------------------------------- - -class property_list -{ -public: - typedef std::map pval_map_type; - typedef std::map plist_map_type; - - typedef pval_map_type::iterator pval_map_iterator; - typedef pval_map_type::const_iterator pval_map_const_iterator; - - typedef plist_map_type::iterator plist_map_iterator; - typedef plist_map_type::const_iterator plist_map_const_iterator; - - property_list (const plist_map_type& m = plist_map_type ()) - : plist_map (m) { } - - ~property_list (void) { } - - void set (const caseless_str& name, const octave_value& val); - - octave_value lookup (const caseless_str& name) const; - - plist_map_iterator begin (void) { return plist_map.begin (); } - plist_map_const_iterator begin (void) const { return plist_map.begin (); } - - plist_map_iterator end (void) { return plist_map.end (); } - plist_map_const_iterator end (void) const { return plist_map.end (); } - - plist_map_iterator find (const std::string& go_name) - { - return plist_map.find (go_name); - } - - plist_map_const_iterator find (const std::string& go_name) const - { - return plist_map.find (go_name); - } - - octave_scalar_map as_struct (const std::string& prefix_arg) const; - -private: - plist_map_type plist_map; -}; - -// --------------------------------------------------------------------- - -class graphics_toolkit; -class graphics_object; - -class base_graphics_toolkit -{ -public: - friend class graphics_toolkit; - -public: - base_graphics_toolkit (const std::string& nm) - : name (nm), count (0) { } - - virtual ~base_graphics_toolkit (void) { } - - std::string get_name (void) const { return name; } - - virtual bool is_valid (void) const { return false; } - - virtual void redraw_figure (const graphics_object&) const - { gripe_invalid ("redraw_figure"); } - - virtual void print_figure (const graphics_object&, const std::string&, - const std::string&, bool, - const std::string& = "") const - { gripe_invalid ("print_figure"); } - - virtual Matrix get_canvas_size (const graphics_handle&) const - { - gripe_invalid ("get_canvas_size"); - return Matrix (1, 2, 0.0); - } - - virtual double get_screen_resolution (void) const - { - gripe_invalid ("get_screen_resolution"); - return 72.0; - } - - virtual Matrix get_screen_size (void) const - { - gripe_invalid ("get_screen_size"); - return Matrix (1, 2, 0.0); - } - - // Callback function executed when the given graphics object - // changes. This allows the graphics toolkit to act on property - // changes if needed. - virtual void update (const graphics_object&, int) - { gripe_invalid ("base_graphics_toolkit::update"); } - - void update (const graphics_handle&, int); - - // Callback function executed when the given graphics object is - // created. This allows the graphics toolkit to do toolkit-specific - // initializations for a newly created object. - virtual bool initialize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } - - bool initialize (const graphics_handle&); - - // Callback function executed just prior to deleting the given - // graphics object. This allows the graphics toolkit to perform - // toolkit-specific cleanup operations before an object is deleted. - virtual void finalize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::finalize"); } - - void finalize (const graphics_handle&); - - // Close the graphics toolkit. - virtual void close (void) - { gripe_invalid ("base_graphics_toolkit::close"); } - -private: - std::string name; - octave_refcount count; - -private: - void gripe_invalid (const std::string& fname) const - { - if (! is_valid ()) - error ("%s: invalid graphics toolkit", fname.c_str ()); - } -}; - -class graphics_toolkit -{ -public: - graphics_toolkit (void) - : rep (new base_graphics_toolkit ("unknown")) - { - rep->count++; - } - - graphics_toolkit (base_graphics_toolkit* b) - : rep (b) - { - rep->count++; - } - - graphics_toolkit (const graphics_toolkit& b) - : rep (b.rep) - { - rep->count++; - } - - ~graphics_toolkit (void) - { - if (--rep->count == 0) - delete rep; - } - - graphics_toolkit& operator = (const graphics_toolkit& b) - { - if (rep != b.rep) - { - if (--rep->count == 0) - delete rep; - - rep = b.rep; - rep->count++; - } - - return *this; - } - - operator bool (void) const { return rep->is_valid (); } - - std::string get_name (void) const { return rep->get_name (); } - - void redraw_figure (const graphics_object& go) const - { rep->redraw_figure (go); } - - void print_figure (const graphics_object& go, const std::string& term, - const std::string& file, bool mono, - const std::string& debug_file = "") const - { rep->print_figure (go, term, file, mono, debug_file); } - - Matrix get_canvas_size (const graphics_handle& fh) const - { return rep->get_canvas_size (fh); } - - double get_screen_resolution (void) const - { return rep->get_screen_resolution (); } - - Matrix get_screen_size (void) const - { return rep->get_screen_size (); } - - // Notifies graphics toolkit that object't property has changed. - void update (const graphics_object& go, int id) - { rep->update (go, id); } - - void update (const graphics_handle& h, int id) - { rep->update (h, id); } - - // Notifies graphics toolkit that new object was created. - bool initialize (const graphics_object& go) - { return rep->initialize (go); } - - bool initialize (const graphics_handle& h) - { return rep->initialize (h); } - - // Notifies graphics toolkit that object was destroyed. - // This is called only for explicitly deleted object. Children are - // deleted implicitly and graphics toolkit isn't notified. - void finalize (const graphics_object& go) - { rep->finalize (go); } - - void finalize (const graphics_handle& h) - { rep->finalize (h); } - - // Close the graphics toolkit. - void close (void) { rep->close (); } - -private: - - base_graphics_toolkit *rep; -}; - -class gtk_manager -{ -public: - - static graphics_toolkit get_toolkit (void) - { - return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); - } - - static void register_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_register_toolkit (name); - } - - static void unregister_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unregister_toolkit (name); - } - - static void load_toolkit (const graphics_toolkit& tk) - { - if (instance_ok ()) - instance->do_load_toolkit (tk); - } - - static void unload_toolkit (const std::string& name) - { - if (instance_ok ()) - instance->do_unload_toolkit (name); - } - - static graphics_toolkit find_toolkit (const std::string& name) - { - return instance_ok () - ? instance->do_find_toolkit (name) : graphics_toolkit (); - } - - static Cell available_toolkits_list (void) - { - return instance_ok () ? instance->do_available_toolkits_list () : Cell (); - } - - static Cell loaded_toolkits_list (void) - { - return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); - } - - static void unload_all_toolkits (void) - { - if (instance_ok ()) - instance->do_unload_all_toolkits (); - } - - static std::string default_toolkit (void) - { - return instance_ok () ? instance->do_default_toolkit () : std::string (); - } - -private: - - // FIXME -- default toolkit should be configurable. - - gtk_manager (void) - : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } - - ~gtk_manager (void) { } - - OCTINTERP_API static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - OCTINTERP_API static gtk_manager *instance; - - // The name of the default toolkit. - std::string dtk; - - // The list of toolkits that we know about. - std::set available_toolkits; - - // The list of toolkits we have actually loaded. - std::map loaded_toolkits; - - typedef std::set::iterator available_toolkits_iterator; - - typedef std::set::const_iterator - const_available_toolkits_iterator; - - typedef std::map::iterator - loaded_toolkits_iterator; - - typedef std::map::const_iterator - const_loaded_toolkits_iterator; - - graphics_toolkit do_get_toolkit (void) const; - - void do_register_toolkit (const std::string& name) - { - available_toolkits.insert (name); - } - - void do_unregister_toolkit (const std::string& name) - { - available_toolkits.erase (name); - } - - void do_load_toolkit (const graphics_toolkit& tk) - { - loaded_toolkits[tk.get_name ()] = tk; - } - - void do_unload_toolkit (const std::string& name) - { - loaded_toolkits.erase (name); - } - - graphics_toolkit do_find_toolkit (const std::string& name) const - { - const_loaded_toolkits_iterator p = loaded_toolkits.find (name); - - if (p != loaded_toolkits.end ()) - return p->second; - else - return graphics_toolkit (); - } - - Cell do_available_toolkits_list (void) const - { - Cell m (1 , available_toolkits.size ()); - - octave_idx_type i = 0; - for (const_available_toolkits_iterator p = available_toolkits.begin (); - p != available_toolkits.end (); p++) - m(i++) = *p; - - return m; - } - - Cell do_loaded_toolkits_list (void) const - { - Cell m (1 , loaded_toolkits.size ()); - - octave_idx_type i = 0; - for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); - p != loaded_toolkits.end (); p++) - m(i++) = p->first; - - return m; - } - - void do_unload_all_toolkits (void) - { - while (! loaded_toolkits.empty ()) - { - loaded_toolkits_iterator p = loaded_toolkits.begin (); - - std::string name = p->first; - - p->second.close (); - - // The toolkit may have unloaded itself. If not, we'll do - // it here. - if (loaded_toolkits.find (name) != loaded_toolkits.end ()) - unload_toolkit (name); - } - } - - std::string do_default_toolkit (void) { return dtk; } -}; - -// --------------------------------------------------------------------- - -class base_graphics_object; -class graphics_object; - -class OCTINTERP_API base_properties -{ -public: - base_properties (const std::string& ty = "unknown", - const graphics_handle& mh = graphics_handle (), - const graphics_handle& p = graphics_handle ()); - - virtual ~base_properties (void) { } - - virtual std::string graphics_object_name (void) const { return "unknonwn"; } - - void mark_modified (void); - - void override_defaults (base_graphics_object& obj); - - virtual void init_integerhandle (const octave_value&) - { - panic_impossible (); - } - - // Look through DEFAULTS for properties with given CLASS_NAME, and - // apply them to the current object with set (virtual method). - - void set_from_list (base_graphics_object& obj, property_list& defaults); - - void insert_property (const std::string& name, property p) - { - p.set_name (name); - p.set_parent (__myhandle__); - all_props[name] = p; - } - - virtual void set (const caseless_str&, const octave_value&); - - virtual octave_value get (const caseless_str& pname) const; - - virtual octave_value get (const std::string& pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (const char *pname) const - { - return get (caseless_str (pname)); - } - - virtual octave_value get (bool all = false) const; - - virtual property get_property (const caseless_str& pname); - - virtual bool has_property (const caseless_str&) const - { - panic_impossible (); - return false; - } - - bool is_modified (void) const { return is___modified__ (); } - - virtual void remove_child (const graphics_handle& h) - { - if (children.remove_child (h.value ())) - mark_modified (); - } - - virtual void adopt (const graphics_handle& h) - { - children.adopt (h.value ()); - mark_modified (); - } - - virtual graphics_toolkit get_toolkit (void) const; - - virtual Matrix get_boundingbox (bool /*internal*/ = false, - const Matrix& /*parent_pix_size*/ = Matrix ()) const - { return Matrix (1, 4, 0.0); } - - virtual void update_boundingbox (void); - - virtual void update_autopos (const std::string& elem_type); - - virtual void add_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - virtual void delete_listener (const caseless_str&, const octave_value&, - listener_mode = POSTSET); - - void set_tag (const octave_value& val) { tag = val; } - - void set_parent (const octave_value& val); - - Matrix get_children (void) const - { - return children.get_children (); - } - - Matrix get_all_children (void) const - { - return children.get_all (); - } - - Matrix get_hidden_children (void) const - { - return children.get_hidden (); - } - - void set_modified (const octave_value& val) { set___modified__ (val); } - - void set___modified__ (const octave_value& val) { __modified__ = val; } - - void reparent (const graphics_handle& new_parent) { parent = new_parent; } - - // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent - // axes object. - - virtual void update_axis_limits (const std::string& axis_type) const; - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) const; - - virtual void delete_children (bool clear = false) - { - children.delete_children (clear); - } - - void renumber_child (graphics_handle old_gh, graphics_handle new_gh) - { - children.renumber (old_gh, new_gh); - } - - void renumber_parent (graphics_handle new_gh) - { - parent = new_gh; - } - - static property_list::pval_map_type factory_defaults (void); - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_BASE_PROPERTIES_GET_FUNCTIONS - - virtual octave_value get_xlim (void) const { return octave_value (); } - virtual octave_value get_ylim (void) const { return octave_value (); } - virtual octave_value get_zlim (void) const { return octave_value (); } - virtual octave_value get_clim (void) const { return octave_value (); } - virtual octave_value get_alim (void) const { return octave_value (); } - - virtual bool is_xliminclude (void) const { return false; } - virtual bool is_yliminclude (void) const { return false; } - virtual bool is_zliminclude (void) const { return false; } - virtual bool is_climinclude (void) const { return false; } - virtual bool is_aliminclude (void) const { return false; } - - bool is_handle_visible (void) const; - - std::set dynamic_property_names (void) const; - - bool has_dynamic_property (const std::string& pname); - -protected: - std::set dynamic_properties; - - void set_dynamic (const caseless_str& pname, const octave_value& val); - - octave_value get_dynamic (const caseless_str& pname) const; - - octave_value get_dynamic (bool all = false) const; - - property get_property_dynamic (const caseless_str& pname); - - BEGIN_BASE_PROPERTIES - // properties common to all objects - bool_property beingdeleted , "off" - radio_property busyaction , "{queue}|cancel" - callback_property buttondownfcn , Matrix () - children_property children gf , Matrix () - bool_property clipping , "on" - callback_property createfcn , Matrix () - callback_property deletefcn , Matrix () - radio_property handlevisibility , "{on}|callback|off" - bool_property hittest , "on" - bool_property interruptible , "on" - handle_property parent fs , p - bool_property selected , "off" - bool_property selectionhighlight , "on" - string_property tag s , "" - string_property type frs , ty - any_property userdata , Matrix () - bool_property visible , "on" - // additional (octave-specific) properties - bool_property __modified__ s , "on" - graphics_handle __myhandle__ fhrs , mh - // FIXME -- should this really be here? - handle_property uicontextmenu , graphics_handle () - END_PROPERTIES - -protected: - struct cmp_caseless_str - { - bool operator () (const caseless_str &a, const caseless_str &b) const - { - std::string a1 = a; - std::transform (a1.begin (), a1.end (), a1.begin (), tolower); - std::string b1 = b; - std::transform (b1.begin (), b1.end (), b1.begin (), tolower); - - return a1 < b1; - } - }; - - std::map all_props; - -protected: - void insert_static_property (const std::string& name, base_property& p) - { insert_property (name, property (&p, true)); } - - virtual void init (void) { } -}; - -class OCTINTERP_API base_graphics_object -{ -public: - friend class graphics_object; - - base_graphics_object (void) : count (1), toolkit_flag (false) { } - - virtual ~base_graphics_object (void) { } - - virtual void mark_modified (void) - { - if (valid_object ()) - get_properties ().mark_modified (); - else - error ("base_graphics_object::mark_modified: invalid graphics object"); - } - - virtual void override_defaults (base_graphics_object& obj) - { - if (valid_object ()) - get_properties ().override_defaults (obj); - else - error ("base_graphics_object::override_defaults: invalid graphics object"); - } - - virtual void set_from_list (property_list& plist) - { - if (valid_object ()) - get_properties ().set_from_list (*this, plist); - else - error ("base_graphics_object::set_from_list: invalid graphics object"); - } - - virtual void set (const caseless_str& pname, const octave_value& pval) - { - if (valid_object ()) - get_properties ().set (pname, pval); - else - error ("base_graphics_object::set: invalid graphics object"); - } - - virtual void set_defaults (const std::string&) - { - error ("base_graphics_object::set_defaults: invalid graphics object"); - } - - virtual octave_value get (bool all = false) const - { - if (valid_object ()) - return get_properties ().get (all); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get (const caseless_str& pname) const - { - if (valid_object ()) - return get_properties ().get (pname); - else - { - error ("base_graphics_object::get: invalid graphics object"); - return octave_value (); - } - } - - virtual octave_value get_default (const caseless_str&) const; - - virtual octave_value get_factory_default (const caseless_str&) const; - - virtual octave_value get_defaults (void) const - { - error ("base_graphics_object::get_defaults: invalid graphics object"); - return octave_value (); - } - - virtual octave_value get_factory_defaults (void) const - { - error ("base_graphics_object::get_factory_defaults: invalid graphics object"); - return octave_value (); - } - - virtual std::string values_as_string (void); - - virtual octave_scalar_map values_as_struct (void); - - virtual graphics_handle get_parent (void) const - { - if (valid_object ()) - return get_properties ().get_parent (); - else - { - error ("base_graphics_object::get_parent: invalid graphics object"); - return graphics_handle (); - } - } - - graphics_handle get_handle (void) const - { - if (valid_object ()) - return get_properties ().get___myhandle__ (); - else - { - error ("base_graphics_object::get_handle: invalid graphics object"); - return graphics_handle (); - } - } - - virtual void remove_child (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().remove_child (h); - else - error ("base_graphics_object::remove_child: invalid graphics object"); - } - - virtual void adopt (const graphics_handle& h) - { - if (valid_object ()) - get_properties ().adopt (h); - else - error ("base_graphics_object::adopt: invalid graphics object"); - } - - virtual void reparent (const graphics_handle& np) - { - if (valid_object ()) - get_properties ().reparent (np); - else - error ("base_graphics_object::reparent: invalid graphics object"); - } - - virtual void defaults (void) const - { - if (valid_object ()) - { - std::string msg = (type () + "::defaults"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - - virtual base_properties& get_properties (void) - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual const base_properties& get_properties (void) const - { - static base_properties properties; - error ("base_graphics_object::get_properties: invalid graphics object"); - return properties; - } - - virtual void update_axis_limits (const std::string& axis_type); - - virtual void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - virtual bool valid_object (void) const { return false; } - - bool valid_toolkit_object (void) const { return toolkit_flag; } - - virtual std::string type (void) const - { - return (valid_object () ? get_properties ().graphics_object_name () - : "unknown"); - } - - bool isa (const std::string& go_name) const - { - return type () == go_name; - } - - virtual graphics_toolkit get_toolkit (void) const - { - if (valid_object ()) - return get_properties ().get_toolkit (); - else - { - error ("base_graphics_object::get_toolkit: invalid graphics object"); - return graphics_toolkit (); - } - } - - virtual void add_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().add_listener (nm, v, mode); - } - - virtual void delete_property_listener (const std::string& nm, - const octave_value& v, - listener_mode mode = POSTSET) - { - if (valid_object ()) - get_properties ().delete_listener (nm, v, mode); - } - - virtual void remove_all_listeners (void); - - virtual void reset_default_properties (void) - { - if (valid_object ()) - { - std::string msg = (type () + "::reset_default_properties"); - gripe_not_implemented (msg.c_str ()); - } - else - error ("base_graphics_object::default: invalid graphics object"); - } - -protected: - virtual void initialize (const graphics_object& go) - { - if (! toolkit_flag) - toolkit_flag = get_toolkit ().initialize (go); - } - - virtual void finalize (const graphics_object& go) - { - if (toolkit_flag) - { - get_toolkit ().finalize (go); - toolkit_flag = false; - } - } - - virtual void update (const graphics_object& go, int id) - { - if (toolkit_flag) - get_toolkit ().update (go, id); - } - -protected: - // A reference count. - octave_refcount count; - - // A flag telling whether this object is a valid object - // in the backend context. - bool toolkit_flag; - - // No copying! - - base_graphics_object (const base_graphics_object&) : count (0) { } - - base_graphics_object& operator = (const base_graphics_object&) - { - return *this; - } -}; - -class OCTINTERP_API graphics_object -{ -public: - graphics_object (void) : rep (new base_graphics_object ()) { } - - graphics_object (base_graphics_object *new_rep) - : rep (new_rep) { } - - graphics_object (const graphics_object& obj) : rep (obj.rep) - { - rep->count++; - } - - graphics_object& operator = (const graphics_object& obj) - { - if (rep != obj.rep) - { - if (--rep->count == 0) - delete rep; - - rep = obj.rep; - rep->count++; - } - - return *this; - } - - ~graphics_object (void) - { - if (--rep->count == 0) - delete rep; - } - - void mark_modified (void) { rep->mark_modified (); } - - void override_defaults (base_graphics_object& obj) - { - rep->override_defaults (obj); - } - - void set_from_list (property_list& plist) { rep->set_from_list (plist); } - - void set (const caseless_str& name, const octave_value& val) - { - rep->set (name, val); - } - - void set (const octave_value_list& args); - - void set (const Array& names, const Cell& values, - octave_idx_type row); - - void set (const octave_map& m); - - void set_value_or_default (const caseless_str& name, - const octave_value& val); - - void set_defaults (const std::string& mode) { rep->set_defaults (mode); } - - octave_value get (bool all = false) const { return rep->get (all); } - - octave_value get (const caseless_str& name) const - { - return name.compare ("default") - ? get_defaults () - : (name.compare ("factory") - ? get_factory_defaults () : rep->get (name)); - } - - octave_value get (const std::string& name) const - { - return get (caseless_str (name)); - } - - octave_value get (const char *name) const - { - return get (caseless_str (name)); - } - - octave_value get_default (const caseless_str& name) const - { - return rep->get_default (name); - } - - octave_value get_factory_default (const caseless_str& name) const - { - return rep->get_factory_default (name); - } - - octave_value get_defaults (void) const { return rep->get_defaults (); } - - octave_value get_factory_defaults (void) const - { - return rep->get_factory_defaults (); - } - - std::string values_as_string (void) { return rep->values_as_string (); } - - octave_map values_as_struct (void) { return rep->values_as_struct (); } - - graphics_handle get_parent (void) const { return rep->get_parent (); } - - graphics_handle get_handle (void) const { return rep->get_handle (); } - - graphics_object get_ancestor (const std::string& type) const; - - void remove_child (const graphics_handle& h) { rep->remove_child (h); } - - void adopt (const graphics_handle& h) { rep->adopt (h); } - - void reparent (const graphics_handle& h) { rep->reparent (h); } - - void defaults (void) const { rep->defaults (); } - - bool isa (const std::string& go_name) const { return rep->isa (go_name); } - - base_properties& get_properties (void) { return rep->get_properties (); } - - const base_properties& get_properties (void) const - { - return rep->get_properties (); - } - - void update_axis_limits (const std::string& axis_type) - { - rep->update_axis_limits (axis_type); - } - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h) - { - rep->update_axis_limits (axis_type, h); - } - - bool valid_object (void) const { return rep->valid_object (); } - - std::string type (void) const { return rep->type (); } - - operator bool (void) const { return rep->valid_object (); } - - // FIXME -- these functions should be generated automatically by the - // genprops.awk script. - // - // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS - - octave_value get_xlim (void) const - { return get_properties ().get_xlim (); } - - octave_value get_ylim (void) const - { return get_properties ().get_ylim (); } - - octave_value get_zlim (void) const - { return get_properties ().get_zlim (); } - - octave_value get_clim (void) const - { return get_properties ().get_clim (); } - - octave_value get_alim (void) const - { return get_properties ().get_alim (); } - - bool is_xliminclude (void) const - { return get_properties ().is_xliminclude (); } - - bool is_yliminclude (void) const - { return get_properties ().is_yliminclude (); } - - bool is_zliminclude (void) const - { return get_properties ().is_zliminclude (); } - - bool is_climinclude (void) const - { return get_properties ().is_climinclude (); } - - bool is_aliminclude (void) const - { return get_properties ().is_aliminclude (); } - - bool is_handle_visible (void) const - { return get_properties ().is_handle_visible (); } - - graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } - - void add_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->add_property_listener (nm, v, mode); } - - void delete_property_listener (const std::string& nm, const octave_value& v, - listener_mode mode = POSTSET) - { rep->delete_property_listener (nm, v, mode); } - - void initialize (void) { rep->initialize (*this); } - - void finalize (void) { rep->finalize (*this); } - - void update (int id) { rep->update (*this, id); } - - void reset_default_properties (void) - { rep->reset_default_properties (); } - -private: - base_graphics_object *rep; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API root_figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // FIXME -- it seems strange to me that the diary, diaryfile, - // echo, format, formatspacing, language, and recursionlimit - // properties are here. WTF do they have to do with graphics? - // Also note that these properties (and the monitorpositions, - // pointerlocation, and pointerwindow properties) are not yet used - // by Octave, so setting them will have no effect, and changes - // made elswhere (say, the diary or format functions) will not - // cause these properties to be updated. - - BEGIN_PROPERTIES (root_figure, root) - handle_property callbackobject Sr , graphics_handle () - array_property commandwindowsize r , Matrix (1, 2, 0) - handle_property currentfigure S , graphics_handle () - bool_property diary , "off" - string_property diaryfile , "diary" - bool_property echo , "off" - radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" - radio_property formatspacing , "{loose}|compact" - string_property language , "ascii" - array_property monitorpositions , Matrix (1, 4, 0) - array_property pointerlocation , Matrix (1, 2, 0) - double_property pointerwindow , 0.0 - double_property recursionlimit , 256.0 - double_property screendepth r , default_screendepth () - double_property screenpixelsperinch r , default_screenpixelsperinch () - array_property screensize r , default_screensize () - bool_property showhiddenhandles , "off" - radio_property units U , "inches|centimeters|normalized|points|{pixels}" - END_PROPERTIES - - private: - std::list cbo_stack; - }; - -private: - properties xproperties; - -public: - - root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } - - ~root_figure (void) { } - - void mark_modified (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - return get_default (name.substr (7)); - else if (name.compare ("factory", 7)) - return get_factory_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const - { - octave_value retval = default_properties.lookup (name); - - if (retval.is_undefined ()) - { - // no default property found, use factory default - retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid default property `%s'", name.c_str ()); - } - - return retval; - } - - octave_value get_factory_default (const caseless_str& name) const - { - octave_value retval = factory_properties.lookup (name); - - if (retval.is_undefined ()) - error ("get: invalid factory default property `%s'", name.c_str ()); - - return retval; - } - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - octave_value get_factory_defaults (void) const - { - return factory_properties.as_struct ("factory"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; - - static property_list factory_properties; - - static property_list::plist_map_type init_factory_properties (void); -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API figure : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void init_integerhandle (const octave_value& val) - { - integerhandle = val; - } - - void remove_child (const graphics_handle& h); - - void set_visible (const octave_value& val); - - graphics_toolkit get_toolkit (void) const - { - if (! toolkit) - toolkit = gtk_manager::get_toolkit (); - - return toolkit; - } - - void set_toolkit (const graphics_toolkit& b); - - void set___graphics_toolkit__ (const octave_value& val) - { - if (! error_state) - { - if (val.is_string ()) - { - std::string nm = val.string_value (); - graphics_toolkit b = gtk_manager::find_toolkit (nm); - if (b.get_name () != nm) - { - error ("set___graphics_toolkit__: invalid graphics toolkit"); - } - else - { - set_toolkit (b); - mark_modified (); - } - } - else - error ("set___graphics_toolkit__ must be a string"); - } - } - - void set_position (const octave_value& val, - bool do_notify_toolkit = true); - - void set_outerposition (const octave_value& val, - bool do_notify_toolkit = true); - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - void set_boundingbox (const Matrix& bb, bool internal = false, - bool do_notify_toolkit = true); - - Matrix map_from_boundingbox (double x, double y) const; - - Matrix map_to_boundingbox (double x, double y) const; - - void update_units (const caseless_str& old_units); - - void update_paperunits (const caseless_str& old_paperunits); - - std::string get_title (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (figure) - any_property __plot_stream__ h , Matrix () - bool_property __enhanced__ h , "on" - radio_property nextplot , "new|{add}|replacechildren|replace" - callback_property closerequestfcn , "closereq" - handle_property currentaxes S , graphics_handle () - array_property colormap , jet_colormap () - radio_property paperorientation U , "{portrait}|landscape|rotated" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - array_property alphamap , Matrix (64, 1, 1) - string_property currentcharacter r , "" - handle_property currentobject r , graphics_handle () - array_property currentpoint r , Matrix (2, 1, 0) - bool_property dockcontrols , "off" - bool_property doublebuffer , "on" - string_property filename , "" - bool_property integerhandle S , "on" - bool_property inverthardcopy , "off" - callback_property keypressfcn , Matrix () - callback_property keyreleasefcn , Matrix () - radio_property menubar , "none|{figure}" - double_property mincolormap , 64 - string_property name , "" - bool_property numbertitle , "on" - array_property outerposition s , Matrix (1, 4, -1.0) - radio_property paperunits Su , "{inches}|centimeters|normalized|points" - array_property paperposition , default_figure_paperposition () - radio_property paperpositionmode , "auto|{manual}" - array_property papersize U , default_figure_papersize () - radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" - radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" - array_property pointershapecdata , Matrix (16, 16, 0) - array_property pointershapehotspot , Matrix (1, 2, 0) - array_property position s , default_figure_position () - radio_property renderer , "{painters}|zbuffer|opengl|none" - radio_property renderermode , "{auto}|manual" - bool_property resize , "on" - callback_property resizefcn , Matrix () - radio_property selectiontype , "{normal}|open|alt|extend" - radio_property toolbar , "none|{auto}|figure" - radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" - callback_property windowbuttondownfcn , Matrix () - callback_property windowbuttonmotionfcn , Matrix () - callback_property windowbuttonupfcn , Matrix () - callback_property windowbuttonwheelfcn , Matrix () - radio_property windowstyle , "{normal}|modal|docked" - string_property wvisual , "" - radio_property wvisualmode , "{auto}|manual" - string_property xdisplay , "" - string_property xvisual , "" - radio_property xvisualmode , "{auto}|manual" - callback_property buttondownfcn , Matrix () - string_property __graphics_toolkit__ s , "gnuplot" - any_property __guidata__ h , Matrix () - END_PROPERTIES - - protected: - void init (void) - { - colormap.add_constraint (dim_vector (-1, 3)); - alphamap.add_constraint (dim_vector (-1, 1)); - paperposition.add_constraint (dim_vector (1, 4)); - pointershapecdata.add_constraint (dim_vector (16, 16)); - pointershapehotspot.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (1, 4)); - outerposition.add_constraint (dim_vector (1, 4)); - } - - private: - mutable graphics_toolkit toolkit; - }; - -private: - properties xproperties; - -public: - figure (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~figure (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (root figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API graphics_xform -{ -public: - graphics_xform (void) - : xform (xform_eye ()), xform_inv (xform_eye ()), - sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) - { - zlim(1) = 1.0; - } - - graphics_xform (const Matrix& xm, const Matrix& xim, - const scaler& x, const scaler& y, const scaler& z, - const Matrix& zl) - : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } - - graphics_xform (const graphics_xform& g) - : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), - sy (g.sy), sz (g.sz), zlim (g.zlim) { } - - ~graphics_xform (void) { } - - graphics_xform& operator = (const graphics_xform& g) - { - xform = g.xform; - xform_inv = g.xform_inv; - sx = g.sx; - sy = g.sy; - sz = g.sz; - zlim = g.zlim; - - return *this; - } - - static ColumnVector xform_vector (double x, double y, double z); - - static Matrix xform_eye (void); - - ColumnVector transform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, double z, - bool use_scale = true) const; - - ColumnVector untransform (double x, double y, bool use_scale = true) const - { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } - - Matrix xscale (const Matrix& m) const { return sx.scale (m); } - Matrix yscale (const Matrix& m) const { return sy.scale (m); } - Matrix zscale (const Matrix& m) const { return sz.scale (m); } - - Matrix scale (const Matrix& m) const - { - bool has_z = (m.columns () > 2); - - if (sx.is_linear () && sy.is_linear () - && (! has_z || sz.is_linear ())) - return m; - - Matrix retval (m.dims ()); - - int r = m.rows (); - - for (int i = 0; i < r; i++) - { - retval(i,0) = sx.scale (m(i,0)); - retval(i,1) = sy.scale (m(i,1)); - if (has_z) - retval(i,2) = sz.scale (m(i,2)); - } - - return retval; - } - -private: - Matrix xform; - Matrix xform_inv; - scaler sx, sy, sz; - Matrix zlim; -}; - -enum { - AXE_ANY_DIR = 0, - AXE_DEPTH_DIR = 1, - AXE_HORZ_DIR = 2, - AXE_VERT_DIR = 3 -}; - -class OCTINTERP_API axes : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void set_defaults (base_graphics_object& obj, const std::string& mode); - - void remove_child (const graphics_handle& h); - - const scaler& get_x_scaler (void) const { return sx; } - const scaler& get_y_scaler (void) const { return sy; } - const scaler& get_z_scaler (void) const { return sz; } - - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - Matrix get_extent (bool with_text = false, bool only_text_height=false) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - void update_boundingbox (void) - { - if (units_is ("normalized")) - { - sync_positions (); - base_properties::update_boundingbox (); - } - } - - void update_camera (void); - void update_axes_layout (void); - void update_aspectratios (void); - void update_transform (void) - { - update_aspectratios (); - update_camera (); - update_axes_layout (); - } - - void update_autopos (const std::string& elem_type); - void update_xlabel_position (void); - void update_ylabel_position (void); - void update_zlabel_position (void); - void update_title_position (void); - - graphics_xform get_transform (void) const - { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } - - Matrix get_transform_matrix (void) const { return x_render; } - Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } - Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } - Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } - Matrix get_transform_zlim (void) const { return x_zlim; } - - int get_xstate (void) const { return xstate; } - int get_ystate (void) const { return ystate; } - int get_zstate (void) const { return zstate; } - double get_xPlane (void) const { return xPlane; } - double get_xPlaneN (void) const { return xPlaneN; } - double get_yPlane (void) const { return yPlane; } - double get_yPlaneN (void) const { return yPlaneN; } - double get_zPlane (void) const { return zPlane; } - double get_zPlaneN (void) const { return zPlaneN; } - double get_xpTick (void) const { return xpTick; } - double get_xpTickN (void) const { return xpTickN; } - double get_ypTick (void) const { return ypTick; } - double get_ypTickN (void) const { return ypTickN; } - double get_zpTick (void) const { return zpTick; } - double get_zpTickN (void) const { return zpTickN; } - double get_x_min (void) const { return std::min (xPlane, xPlaneN); } - double get_x_max (void) const { return std::max (xPlane, xPlaneN); } - double get_y_min (void) const { return std::min (yPlane, yPlaneN); } - double get_y_max (void) const { return std::max (yPlane, yPlaneN); } - double get_z_min (void) const { return std::min (zPlane, zPlaneN); } - double get_z_max (void) const { return std::max (zPlane, zPlaneN); } - double get_fx (void) const { return fx; } - double get_fy (void) const { return fy; } - double get_fz (void) const { return fz; } - double get_xticklen (void) const { return xticklen; } - double get_yticklen (void) const { return yticklen; } - double get_zticklen (void) const { return zticklen; } - double get_xtickoffset (void) const { return xtickoffset; } - double get_ytickoffset (void) const { return ytickoffset; } - double get_ztickoffset (void) const { return ztickoffset; } - bool get_x2Dtop (void) const { return x2Dtop; } - bool get_y2Dright (void) const { return y2Dright; } - bool get_layer2Dtop (void) const { return layer2Dtop; } - bool get_xySym (void) const { return xySym; } - bool get_xyzSym (void) const { return xyzSym; } - bool get_zSign (void) const { return zSign; } - bool get_nearhoriz (void) const { return nearhoriz; } - - ColumnVector pixel2coord (double px, double py) const - { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } - - ColumnVector coord2pixel (double x, double y, double z) const - { return get_transform ().transform (x, y, z); } - - void zoom_about_point (double x, double y, double factor, - bool push_to_zoom_stack = true); - void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); - void translate_view (double x0, double x1, double y0, double y1); - void rotate_view (double delta_az, double delta_el); - void unzoom (void); - void clear_zoom_stack (void); - - void update_units (const caseless_str& old_units); - - void update_fontunits (const caseless_str& old_fontunits); - - private: - scaler sx, sy, sz; - Matrix x_render, x_render_inv; - Matrix x_gl_mat1, x_gl_mat2; - Matrix x_zlim; - std::list zoom_stack; - - // Axes layout data - int xstate, ystate, zstate; - double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; - double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; - double fx, fy, fz; - double xticklen, yticklen, zticklen; - double xtickoffset, ytickoffset, ztickoffset; - bool x2Dtop, y2Dright, layer2Dtop; - bool xySym, xyzSym, zSign, nearhoriz; - -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text (tick labels) size - ft_render text_renderer; -#endif - - void set_text_child (handle_property& h, const std::string& who, - const octave_value& v); - - void delete_text_child (handle_property& h); - - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (axes) - array_property position u , default_axes_position () - bool_property box , "on" - array_property colororder , default_colororder () - array_property dataaspectratio mu , Matrix (1, 3, 1.0) - radio_property dataaspectratiomode u , "{auto}|manual" - radio_property layer u , "{bottom}|top" - row_vector_property xlim mu , default_lim () - row_vector_property ylim mu , default_lim () - row_vector_property zlim mu , default_lim () - row_vector_property clim m , default_lim () - row_vector_property alim m , default_lim () - radio_property xlimmode al , "{auto}|manual" - radio_property ylimmode al , "{auto}|manual" - radio_property zlimmode al , "{auto}|manual" - radio_property climmode al , "{auto}|manual" - radio_property alimmode , "{auto}|manual" - handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) - bool_property xgrid , "off" - bool_property ygrid , "off" - bool_property zgrid , "off" - bool_property xminorgrid , "off" - bool_property yminorgrid , "off" - bool_property zminorgrid , "off" - row_vector_property xtick mu , default_axes_tick () - row_vector_property ytick mu , default_axes_tick () - row_vector_property ztick mu , default_axes_tick () - radio_property xtickmode u , "{auto}|manual" - radio_property ytickmode u , "{auto}|manual" - radio_property ztickmode u , "{auto}|manual" - bool_property xminortick , "off" - bool_property yminortick , "off" - bool_property zminortick , "off" - // FIXME -- should be kind of string array. - any_property xticklabel m , "" - any_property yticklabel m , "" - any_property zticklabel m , "" - radio_property xticklabelmode u , "{auto}|manual" - radio_property yticklabelmode u , "{auto}|manual" - radio_property zticklabelmode u , "{auto}|manual" - radio_property interpreter , "tex|{none}|latex" - color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) - color_property xcolor , color_values (0, 0, 0) - color_property ycolor , color_values (0, 0, 0) - color_property zcolor , color_values (0, 0, 0) - radio_property xscale alu , "{linear}|log" - radio_property yscale alu , "{linear}|log" - radio_property zscale alu , "{linear}|log" - radio_property xdir u , "{normal}|reverse" - radio_property ydir u , "{normal}|reverse" - radio_property zdir u , "{normal}|reverse" - radio_property yaxislocation u , "{left}|right|zero" - radio_property xaxislocation u , "{bottom}|top|zero" - array_property view u , Matrix () - bool_property __hold_all__ h , "off" - radio_property nextplot , "new|add|replacechildren|{replace}" - array_property outerposition u , default_axes_outerposition () - radio_property activepositionproperty , "{outerposition}|position" - color_property ambientlightcolor , color_values (1, 1, 1) - array_property cameraposition m , Matrix (1, 3, 0.0) - array_property cameratarget m , Matrix (1, 3, 0.0) - array_property cameraupvector m , Matrix () - double_property cameraviewangle m , 10.0 - radio_property camerapositionmode , "{auto}|manual" - radio_property cameratargetmode , "{auto}|manual" - radio_property cameraupvectormode , "{auto}|manual" - radio_property cameraviewanglemode , "{auto}|manual" - array_property currentpoint , Matrix (2, 3, 0.0) - radio_property drawmode , "{normal}|fast" - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" - radio_property fontweight u , "{normal}|light|demi|bold" - radio_property gridlinestyle , "-|--|{:}|-.|none" - string_array_property linestyleorder , "-" - double_property linewidth , 0.5 - radio_property minorgridlinestyle , "-|--|{:}|-.|none" - array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) - radio_property plotboxaspectratiomode u , "{auto}|manual" - radio_property projection , "{orthographic}|perpective" - radio_property tickdir mu , "{in}|out" - radio_property tickdirmode u , "{auto}|manual" - array_property ticklength u , default_axes_ticklength () - array_property tightinset r , Matrix (1, 4, 0.0) - // FIXME -- uicontextmenu should be moved here. - radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" - // hidden properties for transformation computation - array_property x_viewtransform h , Matrix (4, 4, 0.0) - array_property x_projectiontransform h , Matrix (4, 4, 0.0) - array_property x_viewporttransform h , Matrix (4, 4, 0.0) - array_property x_normrendertransform h , Matrix (4, 4, 0.0) - array_property x_rendertransform h , Matrix (4, 4, 0.0) - // hidden properties for minor ticks - row_vector_property xmtick h , Matrix () - row_vector_property ymtick h , Matrix () - row_vector_property zmtick h , Matrix () - // hidden properties for inset - array_property looseinset hu , Matrix (1, 4, 0.0) - // hidden properties for alignment of subplots - radio_property autopos_tag h , "{none}|subplot" - END_PROPERTIES - - protected: - void init (void); - - private: - - std::string - get_scale (const std::string& scale, const Matrix& lims) - { - std::string retval = scale; - - if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) - retval = "neglog"; - - return retval; - } - - void update_xscale (void) - { - sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); - } - - void update_yscale (void) - { - sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); - } - - void update_zscale (void) - { - sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); - } - - void update_view (void) { sync_positions (); } - void update_dataaspectratio (void) { sync_positions (); } - void update_dataaspectratiomode (void) { sync_positions (); } - void update_plotboxaspectratio (void) { sync_positions (); } - void update_plotboxaspectratiomode (void) { sync_positions (); } - - void update_layer (void) { update_axes_layout (); } - void update_yaxislocation (void) - { - update_axes_layout (); - update_ylabel_position (); - } - void update_xaxislocation (void) - { - update_axes_layout (); - update_xlabel_position (); - } - - void update_xdir (void) { update_camera (); update_axes_layout (); } - void update_ydir (void) { update_camera (); update_axes_layout (); } - void update_zdir (void) { update_camera (); update_axes_layout (); } - - void update_ticklength (void); - void update_tickdir (void) { update_ticklength (); } - void update_tickdirmode (void) { update_ticklength (); } - - void update_xtick (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_ytick (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_ztick (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_xtickmode (void) - { - if (xtickmode.is ("auto")) - { - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - update_xtick (); - } - } - void update_ytickmode (void) - { - if (ytickmode.is ("auto")) - { - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - update_ytick (); - } - } - void update_ztickmode (void) - { - if (ztickmode.is ("auto")) - { - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - update_ztick (); - } - } - - void update_xticklabelmode (void) - { - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - } - void update_yticklabelmode (void) - { - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - } - void update_zticklabelmode (void) - { - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - } - - void update_font (void); - void update_fontname (void) { update_font (); } - void update_fontsize (void) { update_font (); } - void update_fontangle (void) { update_font (); } - void update_fontweight (void) { update_font (); } - - void sync_positions (const Matrix& linset); - void sync_positions (void); - - void update_outerposition (void) - { - set_activepositionproperty ("outerposition"); - sync_positions (); - } - - void update_position (void) - { - set_activepositionproperty ("position"); - sync_positions (); - } - - void update_looseinset (void) { sync_positions (); } - - double calc_tick_sep (double minval, double maxval); - void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, - bool limmode_is_auto, bool is_logscale); - void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); - Matrix get_ticklabel_extents (const Matrix& ticks, - const string_vector& ticklabels, - const Matrix& limits); - - void fix_limits (array_property& lims) - { - if (lims.get ().is_empty ()) - return; - - Matrix l = lims.get ().matrix_value (); - if (l(0) > l(1)) - { - l(0) = 0; - l(1) = 1; - lims = l; - } - else if (l(0) == l(1)) - { - l(0) -= 0.5; - l(1) += 0.5; - lims = l; - } - } - - Matrix calc_tightbox (const Matrix& init_pos); - - public: - Matrix get_axis_limits (double xmin, double xmax, - double min_pos, double max_neg, - bool logscale); - - void update_xlim (bool do_clr_zoom = true) - { - if (xtickmode.is ("auto")) - calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); - if (xticklabelmode.is ("auto")) - calc_ticklabels (xtick, xticklabel, xscale.is ("log")); - - fix_limits (xlim); - - update_xscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_ylim (bool do_clr_zoom = true) - { - if (ytickmode.is ("auto")) - calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); - if (yticklabelmode.is ("auto")) - calc_ticklabels (ytick, yticklabel, yscale.is ("log")); - - fix_limits (ylim); - - update_yscale (); - - if (do_clr_zoom) - zoom_stack.clear (); - - update_axes_layout (); - } - - void update_zlim (void) - { - if (ztickmode.is ("auto")) - calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); - if (zticklabelmode.is ("auto")) - calc_ticklabels (ztick, zticklabel, zscale.is ("log")); - - fix_limits (zlim); - - update_zscale (); - - zoom_stack.clear (); - - update_axes_layout (); - } - - }; - -private: - properties xproperties; - -public: - axes (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - xproperties.update_transform (); - } - - ~axes (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - void set_defaults (const std::string& mode) - { - remove_all_listeners (); - xproperties.set_defaults (*this, mode); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - // FIXME -- finish this. - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -protected: - void initialize (const graphics_object& go); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API line : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - // properties which are not in matlab: interpreter - - BEGIN_PROPERTIES (line) - row_vector_property xdata u , default_data () - row_vector_property ydata u , default_data () - row_vector_property zdata u , Matrix () - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - color_property color , color_values (0, 0, 0) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property erasemode , "{normal}|none|xor|background" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "off" - END_PROPERTIES - - private: - Matrix compute_xlim (void) const; - Matrix compute_ylim (void) const; - - void update_xdata (void) { set_xlim (compute_xlim ()); } - - void update_ydata (void) { set_ylim (compute_ylim ()); } - - void update_zdata (void) - { - set_zlim (zdata.get_limits ()); - set_zliminclude (get_zdata ().numel () > 0); - } - }; - -private: - properties xproperties; - -public: - line (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~line (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API text : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - double get_fontsize_points (double box_pix_height = 0) const; - - void set_position (const octave_value& val) - { - if (! error_state) - { - octave_value new_val (val); - - if (new_val.numel () == 2) - { - dim_vector dv (1, 3); - - new_val = new_val.resize (dv, true); - } - - if (position.set (new_val, false)) - { - set_positionmode ("manual"); - update_position (); - position.run_listeners (POSTSET); - mark_modified (); - } - else - set_positionmode ("manual"); - } - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (text) - text_label_property string u , "" - radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" - array_property position smu , Matrix (1, 3, 0.0) - double_property rotation mu , 0 - radio_property horizontalalignment mu , "{left}|center|right" - color_property color u , color_values (0, 0, 0) - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontangle u , "{normal}|italic|oblique" - radio_property fontweight u , "light|{normal}|demi|bold" - radio_property interpreter u , "{tex}|none|latex" - color_property backgroundcolor , "{none}" - string_property displayname , "" - color_property edgecolor , "{none}" - radio_property erasemode , "{normal}|none|xor|background" - bool_property editing , "off" - radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - double_property margin , 1 - radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" - array_property extent rG , Matrix (1, 4, 0.0) - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - bool_property xliminclude hl , "off" - bool_property yliminclude hl , "off" - bool_property zliminclude hl , "off" - // hidden properties for auto-positioning - radio_property positionmode hu , "{auto}|manual" - radio_property rotationmode hu , "{auto}|manual" - radio_property horizontalalignmentmode hu , "{auto}|manual" - radio_property verticalalignmentmode hu , "{auto}|manual" - radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" - END_PROPERTIES - - Matrix get_data_position (void) const; - Matrix get_extent_matrix (void) const; - const uint8NDArray& get_pixels (void) const { return pixels; } -#if HAVE_FREETYPE - // freetype renderer, used for calculation of text size - ft_render renderer; -#endif - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 3)); - cached_units = get_units (); - update_font (); - } - - private: - void update_position (void) - { - Matrix pos = get_data_position (); - Matrix lim; - - lim = Matrix (1, 3, pos(0)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_xlim (lim); - - lim = Matrix (1, 3, pos(1)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_ylim (lim); - - if (pos.numel () == 3) - { - lim = Matrix (1, 3, pos(2)); - lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); - set_zliminclude ("on"); - set_zlim (lim); - } - else - set_zliminclude ("off"); - } - - void update_text_extent (void); - - void request_autopos (void); - void update_positionmode (void) { request_autopos (); } - void update_rotationmode (void) { request_autopos (); } - void update_horizontalalignmentmode (void) { request_autopos (); } - void update_verticalalignmentmode (void) { request_autopos (); } - - void update_font (void); - void update_string (void) { request_autopos (); update_text_extent (); } - void update_rotation (void) { update_text_extent (); } - void update_color (void) { update_font (); } - void update_fontname (void) { update_font (); update_text_extent (); } - void update_fontsize (void) { update_font (); update_text_extent (); } - void update_fontangle (void) { update_font (); update_text_extent (); } - void update_fontweight (void) { update_font (); update_text_extent (); } - void update_interpreter (void) { update_text_extent (); } - void update_horizontalalignment (void) { update_text_extent (); } - void update_verticalalignment (void) { update_text_extent (); } - - void update_units (void); - - private: - std::string cached_units; - uint8NDArray pixels; - }; - -private: - properties xproperties; - -public: - text (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.set_clipping ("off"); - xproperties.override_defaults (*this); - } - - ~text (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API image : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - octave_value get_color_data (void) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (image) - row_vector_property xdata u , Matrix () - row_vector_property ydata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property clim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property climinclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (2); - ydata.add_constraint (2); - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("logical"); - cdata.add_constraint ("uint8"); - cdata.add_constraint ("uint16"); - cdata.add_constraint ("int16"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_xdata (void) - { - Matrix limits = xdata.get_limits (); - float dp = pixel_xsize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_xlim (limits); - } - - void update_ydata (void) - { - Matrix limits = ydata.get_limits (); - float dp = pixel_ysize (); - - limits(0) = limits(0) - dp; - limits(1) = limits(1) + dp; - set_ylim (limits); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - float pixel_size (octave_idx_type dim, const Matrix limits) - { - octave_idx_type l = dim - 1; - float dp; - - if (l > 0 && limits(0) != limits(1)) - dp = (limits(1) - limits(0))/(2*l); - else - { - if (limits(1) == limits(2)) - dp = 0.5; - else - dp = (limits(1) - limits(0))/2; - } - return dp; - } - - public: - float pixel_xsize (void) - { - return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); - } - - float pixel_ysize (void) - { - return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); - } - }; - -private: - properties xproperties; - -public: - image (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~image (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API patch : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (patch) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping l , "{scaled}|direct" - array_property faces , Matrix () - array_property facevertexalphadata , Matrix () - array_property facevertexcdata , Matrix () - array_property vertices , Matrix () - array_property vertexnormals , Matrix () - radio_property normalmode , "{auto}|manual" - color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property facelighting , "flat|{none}|gouraud|phong" - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property backfacelighting , "{reverselit}|unlit|lit" - double_property ambientstrength , 0.3 - double_property diffusestrength , 0.6 - double_property specularstrength , 0.6 - double_property specularexponent , 10.0 - double_property specularcolorreflectance , 1.0 - radio_property erasemode , "{normal}|background|xor|none" - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none|flat" - color_property markerfacecolor , "auto|{none}|flat" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - radio_property alphadatamapping l , "none|{scaled}|direct" - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - vertices.add_constraint (dim_vector (-1, 2)); - vertices.add_constraint (dim_vector (-1, 3)); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - facevertexcdata.add_constraint (dim_vector (-1, 1)); - facevertexcdata.add_constraint (dim_vector (-1, 3)); - facevertexalphadata.add_constraint (dim_vector (-1, 1)); - } - - private: - void update_xdata (void) { set_xlim (xdata.get_limits ()); } - void update_ydata (void) { set_ylim (ydata.get_limits ()); } - void update_zdata (void) { set_zlim (zdata.get_limits ()); } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - }; - -private: - properties xproperties; - -public: - patch (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~patch (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API surface : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - octave_value get_color_data (void) const; - - bool is_climinclude (void) const - { return (climinclude.is_on () && cdatamapping.is ("scaled")); } - std::string get_climinclude (void) const - { return climinclude.current_value (); } - - bool is_aliminclude (void) const - { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } - std::string get_aliminclude (void) const - { return aliminclude.current_value (); } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (surface) - array_property xdata u , Matrix () - array_property ydata u , Matrix () - array_property zdata u , Matrix () - array_property cdata u , Matrix () - radio_property cdatamapping al , "{scaled}|direct" - string_property xdatasource , "" - string_property ydatasource , "" - string_property zdatasource , "" - string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp|texturemap" - double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) - color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) - radio_property linestyle , "{-}|--|:|-.|none" - double_property linewidth , 0.5 - radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" - color_property markeredgecolor , "{auto}|none" - color_property markerfacecolor , "auto|{none}" - double_property markersize , 6 - radio_property interpreter , "{tex}|none|latex" - string_property displayname , "" - array_property alphadata u , Matrix () - radio_property alphadatamapping l , "none|direct|{scaled}" - double_property ambientstrength , 0.3 - radio_property backfacelighting , "unlit|lit|{reverselit}" - double_property diffusestrength , 0.6 - double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) - radio_property edgelighting , "{none}|flat|gouraud|phong" - radio_property erasemode , "{normal}|none|xor|background" - radio_property facelighting , "{none}|flat|gouraud|phong" - radio_property meshstyle , "{both}|row|column" - radio_property normalmode u , "{auto}|manual" - double_property specularcolorreflectance , 1 - double_property specularexponent , 10 - double_property specularstrength , 0.9 - array_property vertexnormals u , Matrix () - // hidden properties for limit computation - row_vector_property xlim hlr , Matrix () - row_vector_property ylim hlr , Matrix () - row_vector_property zlim hlr , Matrix () - row_vector_property clim hlr , Matrix () - row_vector_property alim hlr , Matrix () - bool_property xliminclude hl , "on" - bool_property yliminclude hl , "on" - bool_property zliminclude hl , "on" - bool_property climinclude hlg , "on" - bool_property aliminclude hlg , "on" - END_PROPERTIES - - protected: - void init (void) - { - xdata.add_constraint (dim_vector (-1, -1)); - ydata.add_constraint (dim_vector (-1, -1)); - zdata.add_constraint (dim_vector (-1, -1)); - alphadata.add_constraint ("single"); - alphadata.add_constraint ("double"); - alphadata.add_constraint ("uint8"); - alphadata.add_constraint (dim_vector (-1, -1)); - vertexnormals.add_constraint (dim_vector (-1, -1, 3)); - cdata.add_constraint ("single"); - cdata.add_constraint ("double"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1)); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - - private: - void update_normals (void); - - void update_xdata (void) - { - update_normals (); - set_xlim (xdata.get_limits ()); - } - - void update_ydata (void) - { - update_normals (); - set_ylim (ydata.get_limits ()); - } - - void update_zdata (void) - { - update_normals (); - set_zlim (zdata.get_limits ()); - } - - void update_cdata (void) - { - if (cdatamapping_is ("scaled")) - set_clim (cdata.get_limits ()); - else - clim = cdata.get_limits (); - } - - void update_alphadata (void) - { - if (alphadatamapping_is ("scaled")) - set_alim (alphadata.get_limits ()); - else - alim = alphadata.get_limits (); - } - - void update_normalmode (void) - { update_normals (); } - - void update_vertexnormals (void) - { set_normalmode ("manual"); } - }; - -private: - properties xproperties; - -public: - surface (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~surface (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API hggroup : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - update_limits (); - } - - void adopt (const graphics_handle& h) - { - - base_properties::adopt (h); - update_limits (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (hggroup) - // hidden properties for limit computation - row_vector_property xlim hr , Matrix () - row_vector_property ylim hr , Matrix () - row_vector_property zlim hr , Matrix () - row_vector_property clim hr , Matrix () - row_vector_property alim hr , Matrix () - bool_property xliminclude h , "on" - bool_property yliminclude h , "on" - bool_property zliminclude h , "on" - bool_property climinclude h , "on" - bool_property aliminclude h , "on" - END_PROPERTIES - - private: - void update_limits (void) const; - - void update_limits (const graphics_handle& h) const; - - protected: - void init (void) - { } - - }; - -private: - properties xproperties; - -public: - hggroup (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~hggroup (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void update_axis_limits (const std::string& axis_type); - - void update_axis_limits (const std::string& axis_type, - const graphics_handle& h); - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uimenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - void remove_child (const graphics_handle& h) - { - base_properties::remove_child (h); - } - - void adopt (const graphics_handle& h) - { - base_properties::adopt (h); - } - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uimenu) - any_property __object__ , Matrix () - string_property accelerator , "" - callback_property callback , Matrix () - bool_property checked , "off" - bool_property enable , "on" - color_property foregroundcolor , color_values (0, 0, 0) - string_property label , "" - double_property position , 9 - bool_property separator , "off" - string_property fltk_label h , "" - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uimenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uimenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontextmenu : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontextmenu) - any_property __object__ , Matrix () - callback_property callback , Matrix () - array_property position , Matrix (1, 2, 0.0) - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 2)); - position.add_constraint (dim_vector (2, 1)); - visible.set (octave_value (true)); - } - }; - -private: - properties xproperties; - -public: - uicontextmenu (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontextmenu (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uicontrol : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uicontrol) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - callback_property callback , Matrix () - array_property cdata , Matrix () - bool_property clipping , "on" - radio_property enable , "{on}|inactive|off" - array_property extent rG , Matrix (1, 4, 0.0) - radio_property fontangle u , "{normal}|italic|oblique" - string_property fontname u , OCTAVE_DEFAULT_FONTNAME - double_property fontsize u , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight u , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - radio_property horizontalalignment , "{left}|center|right" - callback_property keypressfcn , Matrix () - double_property listboxtop , 1 - double_property max , 1 - double_property min , 0 - array_property position , default_control_position () - array_property sliderstep , default_control_sliderstep () - string_array_property string u , "" - radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" - string_property tooltipstring , "" - radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" - row_vector_property value , Matrix (1, 1, 1.0) - radio_property verticalalignment , "top|{middle}|bottom" - END_PROPERTIES - - private: - std::string cached_units; - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - position.add_constraint (dim_vector (1, 4)); - sliderstep.add_constraint (dim_vector (1, 2)); - cached_units = get_units (); - } - - void update_text_extent (void); - - void update_string (void) { update_text_extent (); } - void update_fontname (void) { update_text_extent (); } - void update_fontsize (void) { update_text_extent (); } - void update_fontangle (void) { update_text_extent (); } - void update_fontweight (void) { update_text_extent (); } - void update_fontunits (const caseless_str& old_units); - - void update_units (void); - - }; - -private: - properties xproperties; - -public: - uicontrol (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uicontrol (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipanel : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - Matrix get_boundingbox (bool internal = false, - const Matrix& parent_pix_size = Matrix ()) const; - - double get_fontsize_points (double box_pix_height = 0) const; - - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipanel) - any_property __object__ , Matrix () - color_property backgroundcolor , color_values (1, 1, 1) - radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" - double_property borderwidth , 1 - radio_property fontangle , "{normal}|italic|oblique" - string_property fontname , OCTAVE_DEFAULT_FONTNAME - double_property fontsize , 10 - radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" - radio_property fontweight , "light|{normal}|demi|bold" - color_property foregroundcolor , color_values (0, 0, 0) - color_property highlightcolor , color_values (1, 1, 1) - array_property position , default_panel_position () - callback_property resizefcn , Matrix () - color_property shadowcolor , color_values (0, 0, 0) - string_property title , "" - radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" - radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" - END_PROPERTIES - - protected: - void init (void) - { - position.add_constraint (dim_vector (1, 4)); - } - - void update_units (const caseless_str& old_units); - void update_fontunits (const caseless_str& old_units); - - }; - -private: - properties xproperties; - -public: - uipanel (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipanel (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoolbar : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoolbar) - any_property __object__ , Matrix () - END_PROPERTIES - - protected: - void init (void) - { } - }; - -private: - properties xproperties; - -public: - uitoolbar (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p), default_properties () - { - xproperties.override_defaults (*this); - } - - ~uitoolbar (void) { } - - void override_defaults (base_graphics_object& obj) - { - // Allow parent (figure) to override first (properties knows how - // to find the parent object). - xproperties.override_defaults (obj); - - // Now override with our defaults. If the default_properties - // list includes the properties for all defaults (line, - // surface, etc.) then we don't have to know the type of OBJ - // here, we just call its set function and let it decide which - // properties from the list to use. - obj.set_from_list (default_properties); - } - - void set (const caseless_str& name, const octave_value& value) - { - if (name.compare ("default", 7)) - // strip "default", pass rest to function that will - // parse the remainder and add the element to the - // default_properties map. - default_properties.set (name.substr (7), value); - else - xproperties.set (name, value); - } - - octave_value get (const caseless_str& name) const - { - octave_value retval; - - if (name.compare ("default", 7)) - retval = get_default (name.substr (7)); - else - retval = xproperties.get (name); - - return retval; - } - - octave_value get_default (const caseless_str& name) const; - - octave_value get_defaults (void) const - { - return default_properties.as_struct ("default"); - } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - - void reset_default_properties (void); - -private: - property_list default_properties; -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uipushtool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uipushtool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - bool_property separator , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uipushtool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uipushtool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -class OCTINTERP_API uitoggletool : public base_graphics_object -{ -public: - class OCTINTERP_API properties : public base_properties - { - public: - // See the genprops.awk script for an explanation of the - // properties declarations. - - BEGIN_PROPERTIES (uitoggletool) - any_property __object__ , Matrix () - array_property cdata , Matrix () - callback_property clickedcallback , Matrix () - bool_property enable , "on" - callback_property offcallback , Matrix () - callback_property oncallback , Matrix () - bool_property separator , "off" - bool_property state , "off" - string_property tooltipstring , "" - END_PROPERTIES - - protected: - void init (void) - { - cdata.add_constraint ("double"); - cdata.add_constraint ("single"); - cdata.add_constraint ("uint8"); - cdata.add_constraint (dim_vector (-1, -1, 3)); - } - }; - -private: - properties xproperties; - -public: - uitoggletool (const graphics_handle& mh, const graphics_handle& p) - : base_graphics_object (), xproperties (mh, p) - { - xproperties.override_defaults (*this); - } - - ~uitoggletool (void) { } - - base_properties& get_properties (void) { return xproperties; } - - const base_properties& get_properties (void) const { return xproperties; } - - bool valid_object (void) const { return true; } - -}; - -// --------------------------------------------------------------------- - -octave_value -get_property_from_handle (double handle, const std::string &property, - const std::string &func); -bool -set_property_in_handle (double handle, const std::string &property, - const octave_value &arg, const std::string &func); - -// --------------------------------------------------------------------- - -class graphics_event; - -class -base_graphics_event -{ -public: - friend class graphics_event; - - base_graphics_event (void) : count (1) { } - - virtual ~base_graphics_event (void) { } - - virtual void execute (void) = 0; - -private: - octave_refcount count; -}; - -class -graphics_event -{ -public: - typedef void (*event_fcn) (void*); - - graphics_event (void) : rep (0) { } - - graphics_event (const graphics_event& e) : rep (e.rep) - { - rep->count++; - } - - ~graphics_event (void) - { - if (rep && --rep->count == 0) - delete rep; - } - - graphics_event& operator = (const graphics_event& e) - { - if (rep != e.rep) - { - if (rep && --rep->count == 0) - delete rep; - - rep = e.rep; - if (rep) - rep->count++; - } - - return *this; - } - - void execute (void) - { if (rep) rep->execute (); } - - bool ok (void) const - { return (rep != 0); } - - static graphics_event - create_callback_event (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()); - - static graphics_event - create_callback_event (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()); - - static graphics_event - create_function_event (event_fcn fcn, void *data = 0); - - static graphics_event - create_set_event (const graphics_handle& h, const std::string& name, - const octave_value& value, - bool notify_toolkit = true); -private: - base_graphics_event *rep; -}; - -class OCTINTERP_API gh_manager -{ -protected: - - gh_manager (void); - -public: - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create gh_manager!"); - - retval = false; - } - - return retval; - } - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static graphics_handle get_handle (bool integer_figure_handle) - { - return instance_ok () - ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); - } - - static void free (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_free (h); - } - - static void renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh) - { - if (instance_ok ()) - instance->do_renumber_figure (old_gh, new_gh); - } - - static graphics_handle lookup (double val) - { - return instance_ok () ? instance->do_lookup (val) : graphics_handle (); - } - - static graphics_handle lookup (const octave_value& val) - { - return val.is_real_scalar () - ? lookup (val.double_value ()) : graphics_handle (); - } - - static graphics_object get_object (double val) - { - return get_object (lookup (val)); - } - - static graphics_object get_object (const graphics_handle& h) - { - return instance_ok () ? instance->do_get_object (h) : graphics_object (); - } - - static graphics_handle - make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, - bool integer_figure_handle = false, - bool do_createfcn = true, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_graphics_handle (go_name, parent, - integer_figure_handle, - do_createfcn, do_notify_toolkit) - : graphics_handle (); - } - - static graphics_handle make_figure_handle (double val, - bool do_notify_toolkit = true) - { - return instance_ok () - ? instance->do_make_figure_handle (val, do_notify_toolkit) - : graphics_handle (); - } - - static void push_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_push_figure (h); - } - - static void pop_figure (const graphics_handle& h) - { - if (instance_ok ()) - instance->do_pop_figure (h); - } - - static graphics_handle current_figure (void) - { - return instance_ok () - ? instance->do_current_figure () : graphics_handle (); - } - - static Matrix handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_handle_list (show_hidden) : Matrix (); - } - - static void lock (void) - { - if (instance_ok ()) - instance->do_lock (); - } - - static bool try_lock (void) - { - if (instance_ok ()) - return instance->do_try_lock (); - else - return false; - } - - static void unlock (void) - { - if (instance_ok ()) - instance->do_unlock (); - } - - static Matrix figure_handle_list (bool show_hidden = false) - { - return instance_ok () - ? instance->do_figure_handle_list (show_hidden) : Matrix (); - } - - static void execute_listener (const graphics_handle& h, - const octave_value& l) - { - if (instance_ok ()) - instance->do_execute_listener (h, l); - } - - static void execute_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - octave_value cb; - - if (true) - { - gh_manager::auto_lock lock; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - cb = go.get (name); - } - - if (! error_state) - execute_callback (h, cb, data); - } - - static void execute_callback (const graphics_handle& h, - const octave_value& cb, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_execute_callback (h, cb, data); - } - - static void post_callback (const graphics_handle& h, - const std::string& name, - const octave_value& data = Matrix ()) - { - if (instance_ok ()) - instance->do_post_callback (h, name, data); - } - - static void post_function (graphics_event::event_fcn fcn, void* data = 0) - { - if (instance_ok ()) - instance->do_post_function (fcn, data); - } - - static void post_set (const graphics_handle& h, const std::string& name, - const octave_value& value, bool notify_toolkit = true) - { - if (instance_ok ()) - instance->do_post_set (h, name, value, notify_toolkit); - } - - static int process_events (void) - { - return (instance_ok () ? instance->do_process_events () : 0); - } - - static int flush_events (void) - { - return (instance_ok () ? instance->do_process_events (true) : 0); - } - - static void enable_event_processing (bool enable = true) - { - if (instance_ok ()) - instance->do_enable_event_processing (enable); - } - - static bool is_handle_visible (const graphics_handle& h) - { - bool retval = false; - - graphics_object go = get_object (h); - - if (go.valid_object ()) - retval = go.is_handle_visible (); - - return retval; - } - - static void close_all_figures (void) - { - if (instance_ok ()) - instance->do_close_all_figures (); - } - -public: - class auto_lock : public octave_autolock - { - public: - auto_lock (bool wait = true) - : octave_autolock (instance_ok () - ? instance->graphics_lock - : octave_mutex (), - wait) - { } - - private: - - // No copying! - auto_lock (const auto_lock&); - auto_lock& operator = (const auto_lock&); - }; - -private: - - static gh_manager *instance; - - typedef std::map::iterator iterator; - typedef std::map::const_iterator const_iterator; - - typedef std::set::iterator free_list_iterator; - typedef std::set::const_iterator const_free_list_iterator; - - typedef std::list::iterator figure_list_iterator; - typedef std::list::const_iterator const_figure_list_iterator; - - // A map of handles to graphics objects. - std::map handle_map; - - // The available graphics handles. - std::set handle_free_list; - - // The next handle available if handle_free_list is empty. - double next_handle; - - // The allocated figure handles. Top of the stack is most recently - // created. - std::list figure_list; - - // The lock for accessing the graphics sytsem. - octave_mutex graphics_lock; - - // The list of events queued by graphics toolkits. - std::list event_queue; - - // The stack of callback objects. - std::list callback_objects; - - // A flag telling whether event processing must be constantly on. - int event_processing; - - graphics_handle do_get_handle (bool integer_figure_handle); - - void do_free (const graphics_handle& h); - - void do_renumber_figure (const graphics_handle& old_gh, - const graphics_handle& new_gh); - - graphics_handle do_lookup (double val) - { - iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); - - return (p != handle_map.end ()) ? p->first : graphics_handle (); - } - - graphics_object do_get_object (const graphics_handle& h) - { - iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); - - return (p != handle_map.end ()) ? p->second : graphics_object (); - } - - graphics_handle do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, - bool integer_figure_handle, - bool do_createfcn, - bool do_notify_toolkit); - - graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); - - Matrix do_handle_list (bool show_hidden) - { - Matrix retval (1, handle_map.size ()); - - octave_idx_type i = 0; - for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) - { - graphics_handle h = p->first; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - Matrix do_figure_handle_list (bool show_hidden) - { - Matrix retval (1, figure_list.size ()); - - octave_idx_type i = 0; - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (show_hidden || is_handle_visible (h)) - retval(i++) = h.value (); - } - - retval.resize (1, i); - - return retval; - } - - void do_push_figure (const graphics_handle& h); - - void do_pop_figure (const graphics_handle& h); - - graphics_handle do_current_figure (void) const - { - graphics_handle retval; - - for (const_figure_list_iterator p = figure_list.begin (); - p != figure_list.end (); - p++) - { - graphics_handle h = *p; - - if (is_handle_visible (h)) - retval = h; - } - - return retval; - } - - void do_lock (void) { graphics_lock.lock (); } - - bool do_try_lock (void) { return graphics_lock.try_lock (); } - - void do_unlock (void) { graphics_lock.unlock (); } - - void do_execute_listener (const graphics_handle& h, const octave_value& l); - - void do_execute_callback (const graphics_handle& h, const octave_value& cb, - const octave_value& data); - - void do_post_callback (const graphics_handle& h, const std::string name, - const octave_value& data); - - void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); - - void do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value, bool notify_toolkit = true); - - int do_process_events (bool force = false); - - void do_close_all_figures (void); - - static void restore_gcbo (void) - { - if (instance_ok ()) - instance->do_restore_gcbo (); - } - - void do_restore_gcbo (void); - - void do_post_event (const graphics_event& e); - - void do_enable_event_processing (bool enable = true); -}; - -void get_children_limits (double& min_val, double& max_val, - double& min_pos, double& max_neg, - const Matrix& kids, char limit_type); - -OCTINTERP_API int calc_dimensions (const graphics_object& gh); - -// This function is NOT equivalent to the scripting language function gcf. -OCTINTERP_API graphics_handle gcf (void); - -// This function is NOT equivalent to the scripting language function gca. -OCTINTERP_API graphics_handle gca (void); - -OCTINTERP_API void close_all_figures (void); - -#endif diff -r 069c552587a0 -r 959953dba519 src/help.cc --- a/src/help.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1405 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "load-path.h" -#include "oct-obj.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-pr-code.h" -#include "sighandlers.h" -#include "symtab.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "quit.h" - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -std::string Vinfo_program; - -// Name of the makeinfo program to run. -static std::string Vmakeinfo_program = "makeinfo"; - -// If TRUE, don't print additional help message in help and usage -// functions. -static bool Vsuppress_verbose_help_message = false; - -#include - -typedef std::map map_type; -typedef map_type::value_type pair_type; -typedef map_type::const_iterator map_iter; - -template -std::size_t -size (T const (&)[z]) -{ - return z; -} - -const static pair_type operators[] = -{ - pair_type ("!", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !\n\ -Logical 'not' operator.\n\ -@seealso{~, not}\n\ -@end deftypefn"), - - pair_type ("~", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~\n\ -Logical 'not' operator.\n\ -@seealso{!, not}\n\ -@end deftypefn"), - - pair_type ("!=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} !=\n\ -Logical 'not equals' operator.\n\ -@seealso{~=, ne}\n\ -@end deftypefn"), - - pair_type ("~=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ~=\n\ -Logical 'not equals' operator.\n\ -@seealso{!=, ne}\n\ -@end deftypefn"), - - pair_type ("\"", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \"\n\ -String delimiter.\n\ -@end deftypefn"), - - pair_type ("#", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #\n\ -Begin comment character.\n\ -@seealso{%, #@\\{}\n\ -@end deftypefn"), - - pair_type ("%", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %\n\ -Begin comment character.\n\ -@seealso{#, %@\\{}\n\ -@end deftypefn"), - - pair_type ("#{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\{, #@\\}, #}\n\ -@end deftypefn"), - - pair_type ("%{", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@{\n\ -Begin block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@{}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\{, %@\\}, %}\n\ -@end deftypefn"), - - pair_type ("#}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} #@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{#@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{%@\\}, #@\\{, #}\n\ -@end deftypefn"), - - pair_type ("%}", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} %@}\n\ -Close block comment. There must be nothing else, other than\n\ -whitespace, in the line both before and after @code{%@}}.\n\ -It is possible to nest block comments.\n\ -@seealso{#@\\}, %@\\{, %}\n\ -@end deftypefn"), - - pair_type ("...", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ...\n\ -Continuation marker. Joins current line with following line.\n\ -@end deftypefn"), - - pair_type ("&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &\n\ -Element by element logical 'and' operator.\n\ -@seealso{&&, and}\n\ -@end deftypefn"), - - pair_type ("&&", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} &&\n\ -Logical 'and' operator (with short-circuit evaluation).\n\ -@seealso{&, and}\n\ -@end deftypefn"), - - pair_type ("'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} '\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -complex conjugate (Hermitian) transpose.\n\ -\n\ -The single quote character may also be used to delimit strings, but\n\ -it is better to use the double quote character, since that is never\n\ -ambiguous.\n\ -@seealso{.', transpose}\n\ -@end deftypefn"), - - pair_type ("(", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} (\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type (")", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} )\n\ -Array index or function argument delimiter.\n\ -@end deftypefn"), - - pair_type ("*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} *\n\ -Multiplication operator.\n\ -@seealso{.*, times}\n\ -@end deftypefn"), - - pair_type ("**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} **\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ^\n\ -Power operator. This may return complex results for real inputs. Use\n\ -@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ -real results when possible.\n\ -@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("+", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} +\n\ -Addition operator.\n\ -@seealso{plus}\n\ -@end deftypefn"), - - pair_type ("++", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ++\n\ -Increment operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{--}\n\ -@end deftypefn"), - - pair_type (",", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ,\n\ -Array index, function argument, or command separator.\n\ -@end deftypefn"), - - pair_type ("-", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} -\n\ -Subtraction or unary negation operator.\n\ -@seealso{minus}\n\ -@end deftypefn"), - - pair_type ("--", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} --\n\ -Decrement operator. As in C, may be applied as a prefix or postfix\n\ -operator.\n\ -@seealso{++}\n\ -@end deftypefn"), - - pair_type (".'", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .'\n\ -Matrix transpose operator. For complex matrices, computes the\n\ -transpose, @emph{not} the complex conjugate transpose.\n\ -@seealso{', transpose}\n\ -@end deftypefn"), - - pair_type (".*", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element multiplication operator.\n\ -@seealso{*, times}\n\ -@end deftypefn"), - - pair_type (".**", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .*\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type (".^", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .^\n\ -Element by element power operator. If several complex results are possible,\n\ -returns the one with smallest non-negative argument (angle). Use\n\ -@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ -real result is preferred.\n\ -@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ -@end deftypefn"), - - pair_type ("./", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ./\n\ -Element by element right division operator.\n\ -@seealso{/, .\\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("/", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} /\n\ -Right division operator.\n\ -@seealso{./, \\, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type (".\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} .\\\n\ -Element by element left division operator.\n\ -@seealso{\\, ./, rdivide, mrdivide}\n\ -@end deftypefn"), - - pair_type ("\\", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} \\\n\ -Left division operator.\n\ -@seealso{.\\, /, ldivide, mldivide}\n\ -@end deftypefn"), - - pair_type (":", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} :\n\ -Select entire rows or columns of matrices.\n\ -@end deftypefn"), - - pair_type (";", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ;\n\ -Array row or command separator.\n\ -@seealso{,}\n\ -@end deftypefn"), - - pair_type ("<", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <\n\ -'Less than' operator.\n\ -@seealso{lt}\n\ -@end deftypefn"), - - pair_type ("<=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} <=\n\ -'Less than' or 'equals' operator.\n\ -@seealso{le}\n\ -@end deftypefn"), - - pair_type ("=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} =\n\ -Assignment operator.\n\ -@end deftypefn"), - - pair_type ("==", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ==\n\ -Equality test operator.\n\ -@seealso{eq}\n\ -@end deftypefn"), - - pair_type (">", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >\n\ -'Greater than' operator.\n\ -@seealso{gt}\n\ -@end deftypefn"), - - pair_type (">=", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} >=\n\ -'Greater than' or 'equals' operator.\n\ -@seealso{ge}\n\ -@end deftypefn"), - - pair_type ("[", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} [\n\ -Return list delimiter.\n\ -@seealso{]}\n\ -@end deftypefn"), - - pair_type ("]", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ]\n\ -Return list delimiter.\n\ -@seealso{[}\n\ -@end deftypefn"), - - pair_type ("|", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} |\n\ -Element by element logical 'or' operator.\n\ -@seealso{||, or}\n\ -@end deftypefn"), - - pair_type ("||", - "-*- texinfo -*-\n\ -@deftypefn {Operator} {} ||\n\ -Logical 'or' (with short-circuit evaluation) operator.\n\ -@seealso{|, or}\n\ -@end deftypefn"), -}; - -const static pair_type keywords[] = -{ - pair_type ("break", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} break\n\ -Exit the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, continue}\n\ -@end deftypefn"), - - pair_type ("case", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} case @{@var{value}@}\n\ -A case statement in an switch. Octave cases are exclusive and do not\n\ -fall-through as do C-language cases. A switch statement must have at least\n\ -one case. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} catch\n\ -Begin the cleanup part of a try-catch block.\n\ -@seealso{try}\n\ -@end deftypefn"), - - pair_type ("continue", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} continue\n\ -Jump to the end of the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, parfor, break}\n\ -@end deftypefn"), - - pair_type ("do", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} do\n\ -Begin a do-until loop. This differs from a do-while loop in that the\n\ -body of the loop is executed at least once.\n\ -@seealso{while}\n\ -@end deftypefn"), - - pair_type ("else", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} else\n\ -Alternate action for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("elseif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} elseif (@var{condition})\n\ -Alternate conditional test for an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("end", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end\n\ -Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ -@code{function} block.\n\ -@seealso{for, parfor, if, do, while, function}\n\ -@end deftypefn"), - - pair_type ("end_try_catch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_try_catch\n\ -Mark the end of an @code{try-catch} block.\n\ -@seealso{try, catch}\n\ -@end deftypefn"), - - pair_type ("end_unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} end_unwind_protect\n\ -Mark the end of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("endfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfor\n\ -Mark the end of a for loop. See @code{for} for an example.\n\ -@seealso{for}\n\ -@end deftypefn"), - - pair_type ("endfunction", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endfunction\n\ -Mark the end of a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("endif", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endif\n\ -Mark the end of an if block. See @code{if} for an example.\n\ -@seealso{if}\n\ -@end deftypefn"), - - pair_type ("endparfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endparfor\n\ -Mark the end of a parfor loop. See @code{parfor} for an example.\n\ -@seealso{parfor}\n\ -@end deftypefn"), - - pair_type ("endswitch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endswitch\n\ -Mark the end of a switch block. See @code{switch} for an example.\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("endwhile", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} endwhile\n\ -Mark the end of a while loop. See @code{while} for an example.\n\ -@seealso{do, while}\n\ -@end deftypefn"), - - pair_type ("for", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -Begin a for loop.\n\ -\n\ -@example\n\ -@group\n\ -for i = 1:10\n\ - i\n\ -endfor\n\ -@end group\n\ -@end example\n\ -@seealso{do, parfor, while}\n\ -@end deftypefn"), - - pair_type ("function", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ -@deftypefnx {Keyword} {} function @var{outputs} = function\n\ -Begin a function body with @var{outputs} as results and @var{inputs} as\n\ -parameters.\n\ -@seealso{return}\n\ -@end deftypefn"), - - pair_type ("global", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} global\n\ -Declare variables to have global scope.\n\ -\n\ -@example\n\ -@group\n\ -global @var{x};\n\ -if (isempty (@var{x}))\n\ - x = 1;\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("if", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ -@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ -Begin an if block.\n\ -\n\ -@example\n\ -@group\n\ -x = 1;\n\ -if (x == 1)\n\ - disp (\"one\");\n\ -elseif (x == 2)\n\ - disp (\"two\");\n\ -else\n\ - disp (\"not one or two\");\n\ -endif\n\ -@end group\n\ -@end example\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("otherwise", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} otherwise\n\ -The default statement in a switch block (similar to else in an if block).\n\ -@seealso{switch}\n\ -@end deftypefn"), - - pair_type ("parfor", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ -@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ -Begin a for loop that may execute in parallel.\n\ -\n\ -@example\n\ -@group\n\ -parfor i = 1:10\n\ - i\n\ -endparfor\n\ -@end group\n\ -@end example\n\ -@seealso{for, do, while}\n\ -@end deftypefn"), - - pair_type ("persistent", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} persistent @var{var}\n\ -Declare variables as persistent. A variable that has been declared\n\ -persistent within a function will retain its contents in memory between\n\ -subsequent calls to the same function. The difference between persistent\n\ -variables and global variables is that persistent variables are local in \n\ -scope to a particular function and are not visible elsewhere.\n\ -@seealso{global}\n\ -@end deftypefn"), - - pair_type ("return", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} return\n\ -Return from a function.\n\ -@seealso{function}\n\ -@end deftypefn"), - - pair_type ("static", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} static\n\ -This function has been deprecated in favor of persistent.\n\ -@seealso{persistent}\n\ -@end deftypefn"), - - pair_type ("switch", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} switch @var{statement}\n\ -Begin a switch block.\n\ -\n\ -@example\n\ -@group\n\ -yesno = \"yes\"\n\ -\n\ -switch yesno\n\ - case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ - value = 1;\n\ - case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ - value = 0;\n\ - otherwise\n\ - error (\"invalid value\");\n\ -endswitch\n\ -@end group\n\ -@end example\n\ -@seealso{if, case, otherwise}\n\ -@end deftypefn"), - - pair_type ("try", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} try\n\ -Begin a try-catch block.\n\ -\n\ -If an error occurs within a try block, then the catch code will be run and\n\ -execution will proceed after the catch block (though it is often\n\ -recommended to use the lasterr function to re-throw the error after cleanup\n\ -is completed).\n\ -@seealso{catch, unwind_protect}\n\ -@end deftypefn"), - - pair_type ("until", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} until\n\ -End a do-until loop.\n\ -@seealso{do}\n\ -@end deftypefn"), - - pair_type ("unwind_protect", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect\n\ -Begin an unwind_protect block.\n\ -\n\ -If an error occurs within the first part of an unwind_protect block\n\ -the commands within the unwind_protect_cleanup block are executed before\n\ -the error is thrown. If an error is not thrown, then the\n\ -unwind_protect_cleanup block is still executed (in other words, the\n\ -unwind_protect_cleanup will be run with or without an error in the\n\ -unwind_protect block).\n\ -@seealso{unwind_protect_cleanup, try}\n\ -@end deftypefn"), - - pair_type ("unwind_protect_cleanup", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} unwind_protect_cleanup\n\ -Begin the cleanup section of an unwind_protect block.\n\ -@seealso{unwind_protect}\n\ -@end deftypefn"), - - pair_type ("varargin", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargin\n\ -Pass an arbitrary number of arguments into a function.\n\ -@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("varargout", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} varargout\n\ -Pass an arbitrary number of arguments out of a function.\n\ -@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ -@end deftypefn"), - - pair_type ("while", - "-*- texinfo -*-\n\ -@deftypefn {Keyword} {} while\n\ -Begin a while loop.\n\ -@seealso{do}\n\ -@end deftypefn"), -}; - -// Return a copy of the operator or keyword names. -static string_vector -names (const map_type& lst) -{ - string_vector retval (lst.size ()); - int j = 0; - for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) - retval[j++] = iter->first; - return retval; -} - -const static map_type operators_map (operators, operators + size (operators)); -const static map_type keywords_map (keywords, keywords + size (keywords)); -const static string_vector keyword_names = names (keywords_map); - -// FIXME -- It's not likely that this does the right thing now. - -string_vector -make_name_list (void) -{ - const int key_len = keyword_names.length (); - - const string_vector bif = symbol_table::built_in_function_names (); - const int bif_len = bif.length (); - - const string_vector cfl = symbol_table::cmdline_function_names (); - const int cfl_len = cfl.length (); - - const string_vector lcl = symbol_table::variable_names (); - const int lcl_len = lcl.length (); - - const string_vector ffl = load_path::fcn_names (); - const int ffl_len = ffl.length (); - - const string_vector afl = autoloaded_functions (); - const int afl_len = afl.length (); - - const int total_len - = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; - - string_vector list (total_len); - - // Put all the symbols in one big list. - - int j = 0; - int i = 0; - for (i = 0; i < key_len; i++) - list[j++] = keyword_names[i]; - - for (i = 0; i < bif_len; i++) - list[j++] = bif[i]; - - for (i = 0; i < cfl_len; i++) - list[j++] = cfl[i]; - - for (i = 0; i < lcl_len; i++) - list[j++] = lcl[i]; - - for (i = 0; i < ffl_len; i++) - list[j++] = ffl[i]; - - for (i = 0; i < afl_len; i++) - list[j++] = afl[i]; - - return list; -} - -static bool -looks_like_html (const std::string& msg) -{ - const size_t p1 = msg.find ('\n'); - std::string t = msg.substr (0, p1); - const size_t p2 = t.find ("doc_string (); - - retval = true; - - w = fcn->fcn_file_name (); - - if (w.empty ()) - w = fcn->is_user_function () - ? "command-line function" : "built-in function"; - } - } - - return retval; -} - -static bool -raw_help_from_file (const std::string& nm, std::string& h, - std::string& file, bool& symbol_found) -{ - bool retval = false; - - // FIXME -- this is a bit of a kluge... - unwind_protect frame; - frame.protect_var (reading_script_file); - reading_script_file = true; - - h = get_help_from_file (nm, symbol_found, file); - - if (h.length () > 0) - retval = true; - - return retval; -} - -static bool -raw_help_from_map (const std::string& nm, std::string& h, - const map_type& map, bool& symbol_found) -{ - map_iter idx = map.find (nm); - symbol_found = (idx != map.end ()); - h = (symbol_found) ? idx->second : ""; - return symbol_found; -} - -std::string -raw_help (const std::string& nm, bool& symbol_found) -{ - std::string h; - std::string w; - std::string f; - - (raw_help_from_symbol_table (nm, h, w, symbol_found) - || raw_help_from_file (nm, h, f, symbol_found) - || raw_help_from_map (nm, h, operators_map, symbol_found) - || raw_help_from_map (nm, h, keywords_map, symbol_found)); - - return h; -} - -static void -do_get_help_text (const std::string& name, std::string& text, - std::string& format) -{ - bool symbol_found = false; - text = raw_help (name, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ -Return the raw help text of function @var{name}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string name = args (0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text (name, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text: invalid input"); - } - else - print_usage (); - - return retval; -} - -static void -do_get_help_text_from_file (const std::string& fname, std::string& text, - std::string& format) -{ - bool symbol_found = false; - - std::string f; - - raw_help_from_file (fname, text, f, symbol_found); - - format = "Not found"; - if (symbol_found) - { - size_t idx = -1; - if (text.empty ()) - { - format = "Not documented"; - } - else if (looks_like_texinfo (text, idx)) - { - format = "texinfo"; - text.erase (0, idx); - } - else if (looks_like_html (text)) - { - format = "html"; - } - else - { - format = "plain text"; - } - } -} - -DEFUN (get_help_text_from_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ -Return the raw help text from the file @var{fname}.\n\ -\n\ -The raw help text is returned in @var{text} and the format in @var{format}\n\ -The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ -@t{\"plain text\"}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - const std::string fname = args(0).string_value (); - - if (! error_state) - { - std::string text; - std::string format; - - do_get_help_text_from_file (fname, text, format); - - retval(1) = format; - retval(0) = text; - } - else - error ("get_help_text_from_file: invalid input"); - } - else - print_usage (); - - return retval; -} - -// Return a cell array of strings containing the names of all -// operators. - -DEFUN (__operators__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __operators__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (operators_map))); -} - -// Return a cell array of strings containing the names of all -// keywords. - -DEFUN (__keywords__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __keywords__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (Cell (names (keywords_map))); -} - -// Return a cell array of strings containing the names of all builtin -// functions. - -DEFUN (__builtins__, , , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __builtins__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - const string_vector bif = symbol_table::built_in_function_names (); - - return octave_value (Cell (bif)); -} - -static std::string -do_which (const std::string& name, std::string& type) -{ - std::string file; - - type = std::string (); - - octave_value val = symbol_table::find_function (name); - - if (name.find_first_of ('.') == std::string::npos) - { - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - { - file = fcn->fcn_file_name (); - - if (file.empty ()) - { - if (fcn->is_user_function ()) - type = "command-line function"; - else - { - file = fcn->src_file_name (); - type = "built-in function"; - } - } - else - type = val.is_user_script () - ? std::string ("script") : std::string ("function"); - } - } - else - { - // We might find a file that contains only a doc string. - - file = load_path::find_fcn_file (name); - } - } - else - { - // File query. - - // For compatibility: "file." queries "file". - if (name.size () > 1 && name[name.size () - 1] == '.') - file = load_path::find_file (name.substr (0, name.size () - 1)); - else - file = load_path::find_file (name); - } - - - return file; -} - -std::string -do_which (const std::string& name) -{ - std::string retval; - - std::string type; - - retval = do_which (name, type); - - return retval; -} - -DEFUN (__which__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - string_vector argv = args.make_argv ("which"); - - if (! error_state) - { - int argc = argv.length (); - - if (argc > 1) - { - octave_map m (dim_vector (1, argc-1)); - - Cell names (1, argc-1); - Cell files (1, argc-1); - Cell types (1, argc-1); - - for (int i = 1; i < argc; i++) - { - std::string name = argv[i]; - - std::string type; - - std::string file = do_which (name, type); - - names(i-1) = name; - files(i-1) = file; - types(i-1) = type; - } - - m.assign ("name", names); - m.assign ("file", files); - m.assign ("type", types); - - retval = m; - } - else - print_usage (); - } - - return retval; -} - -// FIXME -- Are we sure this function always does the right thing? -inline bool -file_is_in_dir (const std::string filename, const std::string dir) -{ - if (filename.find (dir) == 0) - { - const int dir_len = dir.size (); - const int filename_len = filename.size (); - const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; - - int num_seps = 0; - for (int i = dir_len; i < filename_len; i++) - if (file_ops::is_dir_sep (filename[i])) - num_seps ++; - - return (num_seps <= max_allowed_seps); - } - else - return false; -} - -// Return a cell array of strings containing the names of all -// functions available in DIRECTORY. If no directory is given, search -// the current path. - -DEFUN (__list_functions__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ -@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - // Get list of functions - string_vector ffl = load_path::fcn_names (); - string_vector afl = autoloaded_functions (); - - if (args.length () == 0) - retval = Cell (ffl.append (afl)); - else - { - std::string dir = args (0).string_value (); - - if (! error_state) - { - string_vector fl = load_path::files (dir, true); - - if (! error_state) - { - // Return a sorted list with unique entries (in case of - // .m and .oct versions of the same function in a given - // directory, for example). - fl.sort (true); - - retval = Cell (fl); - } - } - else - error ("__list_functions__: DIRECTORY argument must be a string"); - } - - return retval; -} - -DEFUN (doc_cache_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave documentation cache file. A cache file significantly improves\n\ -the performance of the @code{lookfor} command. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ -@samp{--doc-cache-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{lookfor, info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); -} - -DEFUN (texi_macros_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -file containing Texinfo macros that are prepended to documentation strings\n\ -before they are passed to makeinfo. The default value is \n\ -@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -and @var{version} is the Octave version number.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ -@samp{--texi-macros-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); -} - -DEFUN (info_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -Octave info file. The default value is\n\ -@file{@var{octave-home}/info/octave.info}, in\n\ -which @var{octave-home} is the root directory of the Octave installation.\n\ -The default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ -@samp{--info-file NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_program, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); -} - -DEFUN (info_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -info program to run. The default value is\n\ -@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ -in which @var{octave-home} is the root directory of the Octave installation,\n\ -@var{version} is the Octave version number, and @var{arch}\n\ -is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ -default value may be overridden by the environment variable\n\ -@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ -@samp{--info-program NAME}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{info_file, doc, help, makeinfo_program}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); -} - -DEFUN (makeinfo_program, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the\n\ -program that Octave runs to format help text containing\n\ -Texinfo markup commands. The default value is @code{makeinfo}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); -} - -DEFUN (suppress_verbose_help_message, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave\n\ -will add additional help information to the end of the output from\n\ -the @code{help} command and usage messages for built-in commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); -} diff -r 069c552587a0 -r 959953dba519 src/help.h --- a/src/help.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_help_h) -#define octave_help_h 1 - -#include -#include - -class string_vector; - -extern string_vector make_name_list (void); - -extern OCTINTERP_API std::string raw_help (const std::string&, bool&); - -// Name of the doc cache file specified on the command line. -// (--doc-cache-file file) -extern std::string Vdoc_cache_file; - -// Name of the file containing local Texinfo macros that are prepended -// to doc strings before processing. -// (--texi-macros-file) -extern std::string Vtexi_macros_file; - -// Name of the info file specified on command line. -// (--info-file file) -extern std::string Vinfo_file; - -// Name of the info reader we'd like to use. -// (--info-program program) -extern std::string Vinfo_program; - -extern std::string do_which (const std::string& name); - -#endif diff -r 069c552587a0 -r 959953dba519 src/input.cc --- a/src/input.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1570 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -// Get command input interactively or from files. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "file-ops.h" -#include "quit.h" -#include "str-vec.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-map.h" -#include "oct-hist.h" -#include "toplev.h" -#include "oct-obj.h" -#include "pager.h" -#include "parse.h" -#include "pathlen.h" -#include "pt.h" -#include "pt-const.h" -#include "pt-eval.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Primary prompt string. -static std::string VPS1 = "\\s:\\#> "; - -// Secondary prompt string. -static std::string VPS2 = "> "; - -// String printed before echoed input (enabled by --echo-input). -std::string VPS4 = "+ "; - -// Echo commands as they are executed? -// -// 1 ==> echo commands read from script files -// 2 ==> echo commands from functions -// 4 ==> echo commands read from command line -// -// more than one state can be active at once. -int Vecho_executing_commands = ECHO_OFF; - -// The time we last printed a prompt. -octave_time Vlast_prompt_time = 0.0; - -// Character to append after successful command-line completion attempts. -static char Vcompletion_append_char = ' '; - -// Global pointer for eval(). -std::string current_eval_string; - -// TRUE means get input from current_eval_string. -bool get_input_from_eval_string = false; - -// TRUE means we haven't been asked for the input from -// current_eval_string yet. -bool input_from_eval_string_pending = false; - -// TRUE means that input is coming from a file that was named on -// the command line. -bool input_from_command_line_file = false; - -// TRUE means that stdin is a terminal, not a pipe or redirected file. -bool stdin_is_tty = false; - -// TRUE means we're parsing a function file. -bool reading_fcn_file = false; - -// TRUE means we're parsing a classdef file. -bool reading_classdef_file = false; - -// Simple name of function file we are reading. -std::string curr_fcn_file_name; - -// Full name of file we are reading. -std::string curr_fcn_file_full_name; - -// TRUE means we're parsing a script file. -bool reading_script_file = false; - -// If we are reading from an M-file, this is it. -FILE *ff_instream = 0; - -// TRUE means this is an interactive shell. -bool interactive = false; - -// TRUE means the user forced this shell to be interactive (-i). -bool forced_interactive = false; - -// Should we issue a prompt? -int promptflag = 1; - -// The current line of input, from wherever. -std::string current_input_line; - -// TRUE after a call to completion_matches. -bool octave_completion_matches_called = false; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -bool Vdrawnow_requested = false; - -// TRUE if we are in debugging mode. -bool Vdebugging = false; - -// If we are in debugging mode, this is the last command entered, so -// that we can repeat the previous command if the user just types RET. -static std::string last_debugging_command; - -// TRUE if we are running in the Emacs GUD mode. -static bool Vgud_mode = false; - -// The filemarker used to separate filenames from subfunction names -char Vfilemarker = '>'; - -static void -do_input_echo (const std::string& input_string) -{ - int do_echo = reading_script_file ? - (Vecho_executing_commands & ECHO_SCRIPTS) - : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; - - if (do_echo) - { - if (forced_interactive) - { - if (promptflag > 0) - octave_stdout << command_editor::decode_prompt_string (VPS1); - else - octave_stdout << command_editor::decode_prompt_string (VPS2); - } - else - octave_stdout << command_editor::decode_prompt_string (VPS4); - - if (! input_string.empty ()) - { - octave_stdout << input_string; - - if (input_string[input_string.length () - 1] != '\n') - octave_stdout << "\n"; - } - } -} - -std::string -gnu_readline (const std::string& s, bool force_readline) -{ - octave_quit (); - - std::string retval; - - if (line_editing || force_readline) - { - bool eof; - - retval = command_editor::readline (s, eof); - - if (! eof && retval.empty ()) - retval = "\n"; - } - else - { - if (! s.empty () && (interactive || forced_interactive)) - { - FILE *stream = command_editor::get_output_stream (); - - gnulib::fputs (s.c_str (), stream); - gnulib::fflush (stream); - } - - FILE *curr_stream = command_editor::get_input_stream (); - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - curr_stream = ff_instream; - - retval = octave_fgets (curr_stream); - } - - return retval; -} - -static inline std::string -interactive_input (const std::string& s, bool force_readline = false) -{ - Vlast_prompt_time.stamp (); - - if (Vdrawnow_requested && (interactive || forced_interactive)) - { - feval ("drawnow"); - - flush_octave_stdout (); - - // We set Vdrawnow_requested to false even if there is an error - // in drawnow so that the error doesn't reappear at every prompt. - - Vdrawnow_requested = false; - - if (error_state) - return "\n"; - } - - return gnu_readline (s, force_readline); -} - -static std::string -octave_gets (void) -{ - octave_quit (); - - std::string retval; - - bool history_skip_auto_repeated_debugging_command = false; - - if ((interactive || forced_interactive) - && (! (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file))) - { - std::string ps = (promptflag > 0) ? VPS1 : VPS2; - - std::string prompt = command_editor::decode_prompt_string (ps); - - pipe_handler_error_count = 0; - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - retval = interactive_input (prompt); - - // There is no need to update the load_path cache if there is no - // user input. - if (! retval.empty () - && retval.find_first_not_of (" \t\n\r") != std::string::npos) - { - load_path::update (); - - if (Vdebugging) - last_debugging_command = retval; - else - last_debugging_command = std::string (); - } - else if (Vdebugging) - { - retval = last_debugging_command; - history_skip_auto_repeated_debugging_command = true; - } - } - else - retval = gnu_readline (""); - - current_input_line = retval; - - if (! current_input_line.empty ()) - { - if (! (input_from_startup_file || input_from_command_line_file - || history_skip_auto_repeated_debugging_command)) - command_history::add (current_input_line); - - if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) - { - octave_diary << current_input_line; - - if (current_input_line[current_input_line.length () - 1] != '\n') - octave_diary << "\n"; - } - - do_input_echo (current_input_line); - } - else if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) - octave_diary << "\n"; - - return retval; -} - -// Read a line from the input stream. - -static std::string -get_user_input (void) -{ - octave_quit (); - - std::string retval; - - if (get_input_from_eval_string) - { - if (input_from_eval_string_pending) - { - input_from_eval_string_pending = false; - - retval = current_eval_string; - - size_t len = retval.length (); - - if (len > 0 && retval[len-1] != '\n') - retval.append ("\n"); - } - } - else - retval = octave_gets (); - - current_input_line = retval; - - return retval; -} - -int -octave_read (char *buf, unsigned max_size) -{ - // FIXME -- is this a safe way to buffer the input? - - static const char * const eol = "\n"; - static std::string input_buf; - static const char *pos = 0; - static size_t chars_left = 0; - - int status = 0; - if (chars_left == 0) - { - pos = 0; - - input_buf = get_user_input (); - - chars_left = input_buf.length (); - - pos = input_buf.c_str (); - } - - if (chars_left > 0) - { - size_t len = max_size > chars_left ? chars_left : max_size; - assert (len > 0); - - memcpy (buf, pos, len); - - chars_left -= len; - pos += len; - - // Make sure input ends with a new line character. - if (chars_left == 0 && buf[len-1] != '\n') - { - if (len < max_size) - { - // There is enough room to plug the newline character in - // the buffer. - buf[len++] = '\n'; - } - else - { - // There isn't enough room to plug the newline character - // in the buffer so make sure it is returned on the next - // octave_read call. - pos = eol; - chars_left = 1; - } - } - - status = len; - - } - else if (chars_left == 0) - { - status = 0; - } - else - status = -1; - - return status; -} - -// Fix things up so that input can come from file `name', printing a -// warning if the file doesn't exist. - -FILE * -get_input_from_file (const std::string& name, int warn) -{ - FILE *instream = 0; - - if (name.length () > 0) - instream = gnulib::fopen (name.c_str (), "rb"); - - if (! instream && warn) - warning ("%s: no such file or directory", name.c_str ()); - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - ff_instream = instream; - else - command_editor::set_input_stream (instream); - - return instream; -} - -// Fix things up so that input can come from the standard input. This -// may need to become much more complicated, which is why it's in a -// separate function. - -FILE * -get_input_from_stdin (void) -{ - command_editor::set_input_stream (stdin); - return command_editor::get_input_stream (); -} - -// FIXME -- make this generate file names when appropriate. - -static string_vector -generate_possible_completions (const std::string& text, std::string& prefix, - std::string& hint) -{ - string_vector names; - - prefix = ""; - - if (looks_like_struct (text)) - names = generate_struct_completions (text, prefix, hint); - else - names = make_name_list (); - - // Sort and remove duplicates. - - names.sort (true); - - return names; -} - -static bool -is_completing_dirfns (void) -{ - static std::string dirfns_commands[] = {"cd", "ls"}; - static const size_t dirfns_commands_length = 2; - - bool retval = false; - - std::string line = command_editor::get_line_buffer (); - - for (size_t i = 0; i < dirfns_commands_length; i++) - { - int index = line.find (dirfns_commands[i] + " "); - - if (index == 0) - { - retval = true; - break; - } - } - - return retval; -} - -static std::string -generate_completion (const std::string& text, int state) -{ - std::string retval; - - static std::string prefix; - static std::string hint; - - static size_t hint_len = 0; - - static int list_index = 0; - static int name_list_len = 0; - static int name_list_total_len = 0; - static string_vector name_list; - static string_vector file_name_list; - - static int matches = 0; - - if (state == 0) - { - list_index = 0; - - prefix = ""; - - hint = text; - - // No reason to display symbols while completing a - // file/directory operation. - - if (is_completing_dirfns ()) - name_list = string_vector (); - else - name_list = generate_possible_completions (text, prefix, hint); - - name_list_len = name_list.length (); - - file_name_list = command_editor::generate_filename_completions (text); - - name_list.append (file_name_list); - - name_list_total_len = name_list.length (); - - hint_len = hint.length (); - - matches = 0; - - for (int i = 0; i < name_list_len; i++) - if (hint == name_list[i].substr (0, hint_len)) - matches++; - } - - if (name_list_total_len > 0 && matches > 0) - { - while (list_index < name_list_total_len) - { - std::string name = name_list[list_index]; - - list_index++; - - if (hint == name.substr (0, hint_len)) - { - if (list_index <= name_list_len && ! prefix.empty ()) - retval = prefix + "." + name; - else - retval = name; - - // FIXME -- looks_like_struct is broken for now, - // so it always returns false. - - if (matches == 1 && looks_like_struct (retval)) - { - // Don't append anything, since we don't know - // whether it should be '(' or '.'. - - command_editor::set_completion_append_character ('\0'); - } - else - command_editor::set_completion_append_character - (Vcompletion_append_char); - - break; - } - } - } - - return retval; -} - -static std::string -quoting_filename (const std::string &text, int, char quote) -{ - if (quote) - return text; - else - return (std::string ("'") + text); -} - -void -initialize_command_input (void) -{ - // If we are using readline, this allows conditional parsing of the - // .inputrc file. - - command_editor::set_name ("Octave"); - - // FIXME -- this needs to include a comma too, but that - // causes trouble for the new struct element completion code. - - static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; - - command_editor::set_basic_word_break_characters (s); - - command_editor::set_completer_word_break_characters (s); - - command_editor::set_basic_quote_characters ("\""); - - command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); - command_editor::set_completer_quote_characters ("'\""); - - command_editor::set_completion_function (generate_completion); - - command_editor::set_quoting_function (quoting_filename); -} - -static void -get_debug_input (const std::string& prompt) -{ - octave_user_code *caller = octave_call_stack::caller_user_code (); - std::string nm; - - int curr_debug_line = octave_call_stack::current_line (); - - bool have_file = false; - - if (caller) - { - nm = caller->fcn_file_name (); - - if (nm.empty ()) - nm = caller->name (); - else - have_file = true; - } - else - curr_debug_line = -1; - - std::ostringstream buf; - - if (! nm.empty ()) - { - if (Vgud_mode) - { - static char ctrl_z = 'Z' & 0x1f; - - buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; - } - else - { - // FIXME -- we should come up with a clean way to detect - // that we are stopped on the no-op command that marks the - // end of a function or script. - - buf << "stopped in " << nm; - - if (curr_debug_line > 0) - buf << " at line " << curr_debug_line; - - if (have_file) - { - std::string line_buf - = get_file_line (nm, curr_debug_line); - - if (! line_buf.empty ()) - buf << "\n" << curr_debug_line << ": " << line_buf; - } - } - } - - std::string msg = buf.str (); - - if (! msg.empty ()) - std::cerr << msg << std::endl; - - unwind_protect frame; - - frame.protect_var (VPS1); - VPS1 = prompt; - - if (! (interactive || forced_interactive) - || (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file)) - { - frame.protect_var (forced_interactive); - forced_interactive = true; - - frame.protect_var (reading_fcn_file); - reading_fcn_file = false; - - frame.protect_var (reading_classdef_file); - reading_classdef_file = false; - - frame.protect_var (reading_script_file); - reading_script_file = false; - - frame.protect_var (input_from_startup_file); - input_from_startup_file = false; - - frame.protect_var (input_from_command_line_file); - input_from_command_line_file = false; - - frame.protect_var (get_input_from_eval_string); - get_input_from_eval_string = false; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); - - // FIXME: are these safe? - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - } - - while (Vdebugging) - { - reset_error_handler (); - - reset_parser (); - - // Save current value of global_command. - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - // This is the same as yyparse in parse.y. - int retval = octave_parse (); - - if (retval == 0 && global_command) - { - unwind_protect inner_frame; - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - inner_frame.add_fcn (cleanup_statement_list, &global_command); - - global_command->accept (*current_evaluator); - - if (octave_completion_matches_called) - octave_completion_matches_called = false; - } - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - octave_quit (); - } -} - -// If the user simply hits return, this will produce an empty matrix. - -static octave_value_list -get_user_input (const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - int nargin = args.length (); - - int read_as_string = 0; - - if (nargin == 2) - read_as_string++; - - std::string prompt = args(0).string_value (); - - if (error_state) - { - error ("input: unrecognized argument"); - return retval; - } - - flush_octave_stdout (); - - octave_pager_stream::reset (); - octave_diary_stream::reset (); - - octave_diary << prompt; - - std::string input_buf = interactive_input (prompt.c_str (), true); - - if (! (error_state || input_buf.empty ())) - { - if (! input_from_startup_file) - command_history::add (input_buf); - - size_t len = input_buf.length (); - - octave_diary << input_buf; - - if (input_buf[len - 1] != '\n') - octave_diary << "\n"; - - if (len < 1) - return read_as_string ? octave_value ("") : octave_value (Matrix ()); - - if (read_as_string) - { - // FIXME -- fix gnu_readline and octave_gets instead! - if (input_buf.length () == 1 && input_buf[0] == '\n') - retval(0) = ""; - else - retval(0) = input_buf; - } - else - { - int parse_status = 0; - - retval = eval_string (input_buf, true, parse_status, nargout); - - if (! Vdebugging && retval.length () == 0) - retval(0) = Matrix (); - } - } - else - error ("input: reading user-input failed!"); - - return retval; -} - -DEFUN (input, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} input (@var{prompt})\n\ -@deftypefnx {Built-in Function} {} input (@var{prompt}, \"s\")\n\ -Print a prompt and wait for user input. For example,\n\ -\n\ -@example\n\ -input (\"Pick a number, any number! \")\n\ -@end example\n\ -\n\ -@noindent\n\ -prints the prompt\n\ -\n\ -@example\n\ -Pick a number, any number!\n\ -@end example\n\ -\n\ -@noindent\n\ -and waits for the user to enter a value. The string entered by the user\n\ -is evaluated as an expression, so it may be a literal constant, a\n\ -variable name, or any other valid expression.\n\ -\n\ -Currently, @code{input} only returns one value, regardless of the number\n\ -of values produced by the evaluation of the expression.\n\ -\n\ -If you are only interested in getting a literal string value, you can\n\ -call @code{input} with the character string @code{\"s\"} as the second\n\ -argument. This tells Octave to return the string entered by the user\n\ -directly, without evaluating it first.\n\ -\n\ -Because there may be output waiting to be displayed by the pager, it is\n\ -a good idea to always call @code{fflush (stdout)} before calling\n\ -@code{input}. This will ensure that all pending output is written to\n\ -the screen before your prompt. @xref{Input and Output}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - retval = get_user_input (args, nargout); - else - print_usage (); - - return retval; -} - -bool -octave_yes_or_no (const std::string& prompt) -{ - std::string prompt_string = prompt + "(yes or no) "; - - while (1) - { - std::string input_buf = interactive_input (prompt_string, true); - - if (input_buf == "yes") - return true; - else if (input_buf == "no") - return false; - else - message (0, "Please answer yes or no."); - } -} - -DEFUN (yes_or_no, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} yes_or_no (@var{prompt})\n\ -Ask the user a yes-or-no question. Return 1 if the answer is yes.\n\ -Takes one argument, which is the string to display to ask the\n\ -question. It should end in a space; @samp{yes-or-no-p} adds\n\ -@samp{(yes or no) } to it. The user must confirm the answer with\n\ -RET and can edit it until it has been confirmed.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - std::string prompt; - - if (nargin == 1) - { - prompt = args(0).string_value (); - - if (error_state) - { - error ("yes_or_no: PROMPT must be a character string"); - return retval; - } - } - - retval = octave_yes_or_no (prompt); - } - else - print_usage (); - - return retval; -} - -octave_value -do_keyboard (const octave_value_list& args) -{ - octave_value retval; - - int nargin = args.length (); - - assert (nargin == 0 || nargin == 1); - - unwind_protect frame; - - frame.add_fcn (command_history::ignore_entries, - command_history::ignoring_entries ()); - - command_history::ignore_entries (false); - - frame.protect_var (Vdebugging); - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // FIXME -- probably we just want to print one line, not the - // entire statement, which might span many lines... - // - // tree_print_code tpc (octave_stdout); - // stmt.accept (tpc); - - Vdebugging = true; - - std::string prompt = "debug> "; - if (nargin > 0) - prompt = args(0).string_value (); - - if (! error_state) - get_debug_input (prompt); - - return retval; -} - -DEFUN (keyboard, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} keyboard ()\n\ -@deftypefnx {Built-in Function} {} keyboard (@var{prompt})\n\ -This function is normally used for simple debugging. When the\n\ -@code{keyboard} function is executed, Octave prints a prompt and waits\n\ -for user input. The input strings are then evaluated and the results\n\ -are printed. This makes it possible to examine the values of variables\n\ -within a function, and to assign new values if necessary. To leave the\n\ -prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ -The @code{keyboard} function does not return an exit status.\n\ -\n\ -If @code{keyboard} is invoked without arguments, a default prompt of\n\ -@samp{debug> } is used.\n\ -@seealso{dbcont, dbquit}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0 || nargin == 1) - { - unwind_protect frame; - - frame.add_fcn (octave_call_stack::restore_frame, - octave_call_stack::current_frame ()); - - // Skip the frame assigned to the keyboard function. - octave_call_stack::goto_frame_relative (0); - - tree_evaluator::debug_mode = true; - - tree_evaluator::current_frame = octave_call_stack::current_frame (); - - do_keyboard (args); - } - else - print_usage (); - - return retval; -} - -DEFUN (echo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} echo options\n\ -Control whether commands are displayed as they are executed. Valid\n\ -options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Enable echoing of commands as they are executed in script files.\n\ -\n\ -@item off\n\ -Disable echoing of commands as they are executed in script files.\n\ -\n\ -@item on all\n\ -Enable echoing of commands as they are executed in script files and\n\ -functions.\n\ -\n\ -@item off all\n\ -Disable echoing of commands as they are executed in script files and\n\ -functions.\n\ -@end table\n\ -\n\ -@noindent\n\ -With no arguments, @code{echo} toggles the current echo state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("echo"); - - if (error_state) - return retval; - - switch (argc) - { - case 1: - { - if ((Vecho_executing_commands & ECHO_SCRIPTS) - || (Vecho_executing_commands & ECHO_FUNCTIONS)) - Vecho_executing_commands = ECHO_OFF; - else - Vecho_executing_commands = ECHO_SCRIPTS; - } - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - Vecho_executing_commands = ECHO_SCRIPTS; - else if (arg == "off") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - case 3: - { - std::string arg = argv[1]; - - if (arg == "on" && argv[2] == "all") - { - int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); - Vecho_executing_commands = tmp; - } - else if (arg == "off" && argv[2] == "all") - Vecho_executing_commands = ECHO_OFF; - else - print_usage (); - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (completion_matches, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ -Generate possible completions given @var{hint}.\n\ -\n\ -This function is provided for the benefit of programs like Emacs which\n\ -might be controlling Octave and handling user input. The current\n\ -command number is not incremented when this function is called. This is\n\ -a feature, not a bug.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string hint = args(0).string_value (); - - if (! error_state) - { - int n = 32; - - string_vector list (n); - - int k = 0; - - for (;;) - { - std::string cmd = generate_completion (hint, k); - - if (! cmd.empty ()) - { - if (k == n) - { - n *= 2; - list.resize (n); - } - - list[k++] = cmd; - } - else - { - list.resize (k); - break; - } - } - - if (nargout > 0) - { - if (! list.empty ()) - retval = list; - else - retval = ""; - } - else - { - // We don't use string_vector::list_in_columns here - // because it will be easier for Emacs if the names - // appear in a single column. - - int len = list.length (); - - for (int i = 0; i < len; i++) - octave_stdout << list[i] << "\n"; - } - - octave_completion_matches_called = true; - } - } - else - print_usage (); - - return retval; -} - -DEFUN (read_readline_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} read_readline_init_file (@var{file})\n\ -Read the readline library initialization file @var{file}. If\n\ -@var{file} is omitted, read the default initialization file (normally\n\ -@file{~/.inputrc}).\n\ -\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 0) - command_editor::read_init_file (); - else if (nargin == 1) - { - std::string file = args(0).string_value (); - - if (! error_state) - command_editor::read_init_file (file); - } - else - print_usage (); - - return retval; -} - -DEFUN (re_read_readline_init_file, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} re_read_readline_init_file ()\n\ -Re-read the last readline library initialization file that was read.\n\ -@xref{Readline Init File, , , readline, GNU Readline Library},\n\ -for details.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - command_editor::re_read_init_file (); - else - print_usage (); - - return retval; -} - -typedef std::map hook_fcn_map_type; - -static hook_fcn_map_type hook_fcn_map; - -static int -input_event_hook (void) -{ - if (! lexer_flags.defining_func) - { - hook_fcn_map_type::iterator p = hook_fcn_map.begin (); - - while (p != hook_fcn_map.end ()) - { - std::string hook_fcn = p->first; - octave_value user_data = p->second; - - hook_fcn_map_type::iterator q = p++; - - if (is_valid_function (hook_fcn)) - { - if (user_data.is_defined ()) - feval (hook_fcn, user_data, 0); - else - feval (hook_fcn, octave_value_list (), 0); - } - else - hook_fcn_map.erase (q); - } - - if (hook_fcn_map.empty ()) - command_editor::remove_event_hook (input_event_hook); - } - - return 0; -} - -DEFUN (add_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn})\n\ -@deftypefnx {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ -Add the named function @var{fcn} to the list of functions to call\n\ -periodically when Octave is waiting for input. The function should\n\ -have the form\n\ -\n\ -@example\n\ -@var{fcn} (@var{data})\n\ -@end example\n\ -\n\ -If @var{data} is omitted, Octave calls the function without any\n\ -arguments.\n\ -@seealso{remove_input_event_hook}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - octave_value user_data; - - if (nargin == 2) - user_data = args(1); - - std::string hook_fcn = args(0).string_value (); - - if (! error_state) - { - if (hook_fcn_map.empty ()) - command_editor::add_event_hook (input_event_hook); - - hook_fcn_map[hook_fcn] = user_data; - } - else - error ("add_input_event_hook: expecting string as first arg"); - } - else - print_usage (); - - return retval; -} - -DEFUN (remove_input_event_hook, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} remove_input_event_hook (@var{fcn})\n\ -Remove the named function @var{fcn} from the list of functions to call\n\ -periodically when Octave is waiting for input.\n\ -@seealso{add_input_event_hook}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string hook_fcn = args(0).string_value (); - - if (! error_state) - { - hook_fcn_map_type::iterator p = hook_fcn_map.find (hook_fcn); - - if (p != hook_fcn_map.end ()) - hook_fcn_map.erase (p); - else - error ("remove_input_event_hook: %s not found in list", - hook_fcn.c_str ()); - - if (hook_fcn_map.empty ()) - command_editor::remove_event_hook (input_event_hook); - } - else - error ("remove_input_event_hook: expecting string as first arg"); - } - else - print_usage (); - - return retval; -} - -DEFUN (PS1, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ -Query or set the primary prompt string. When executing interactively,\n\ -Octave displays the primary prompt when it is ready to read a command.\n\ -\n\ -The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ -To change it, use a command like\n\ -\n\ -@example\n\ -PS1 (\"\\\\u@@\\\\H> \")\n\ -@end example\n\ -\n\ -@noindent\n\ -which will result in the prompt @samp{boris@@kremvax> } for the user\n\ -@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ -backslashes are required to enter a backslash into a double-quoted\n\ -character string. @xref{Strings}.\n\ -\n\ -You can also use ANSI escape sequences if your terminal supports them.\n\ -This can be useful for coloring the prompt. For example,\n\ -\n\ -@example\n\ -PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will give the default Octave prompt a red coloring.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS2, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS1); -} - -DEFUN (PS2, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ -Query or set the secondary prompt string. The secondary prompt is\n\ -printed when Octave is expecting additional input to complete a\n\ -command. For example, if you are typing a @code{for} loop that spans several\n\ -lines, Octave will print the secondary prompt at the beginning of\n\ -each line after the first. The default value of the secondary prompt\n\ -string is @code{\"> \"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PS1, PS4}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS2); -} - -DEFUN (PS4, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ -Query or set the character string used to prefix output produced\n\ -when echoing commands is enabled.\n\ -The default value is @code{\"+ \"}.\n\ -@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{echo, echo_executing_commands, PS1, PS2}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (PS4); -} - -DEFUN (completion_append_char, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ -Query or set the internal character variable that is appended to\n\ -successful command-line completion attempts. The default\n\ -value is @code{\" \"} (a single space).\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (completion_append_char); -} - -DEFUN (echo_executing_commands, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls the echo state.\n\ -It may be the sum of the following values:\n\ -\n\ -@table @asis\n\ -@item 1\n\ -Echo commands read from script files.\n\ -\n\ -@item 2\n\ -Echo commands from functions.\n\ -\n\ -@item 4\n\ -Echo commands read from command line.\n\ -@end table\n\ -\n\ -More than one state can be active at once. For example, a value of 3 is\n\ -equivalent to the command @kbd{echo on all}.\n\ -\n\ -The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ -command or the command line option @option{--echo-commands}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (echo_executing_commands); -} - -DEFUN (__request_drawnow__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ -@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - Vdrawnow_requested = true; - else if (nargin == 1) - Vdrawnow_requested = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (__gud_mode__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = Vgud_mode; - else if (nargin == 1) - Vgud_mode = args(0).bool_value (); - else - print_usage (); - - return retval; -} - -DEFUN (filemarker, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ -Query or set the character used to separate filename from the\n\ -the subfunction names contained within the file. This can be used in\n\ -a generic manner to interact with subfunctions. For example,\n\ -\n\ -@example\n\ -help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -returns the help string associated with the subfunction @code{mysubfunc}\n\ -of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ -debugging it allows easier placement of breakpoints within subfunctions.\n\ -For example,\n\ -\n\ -@example\n\ -dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ -@end example\n\ -\n\ -@noindent\n\ -will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - char tmp = Vfilemarker; - octave_value retval = SET_INTERNAL_VARIABLE (filemarker); - - // The character passed must not be a legal character for a function name - if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) - { - Vfilemarker = tmp; - error ("filemarker: character can not be a valid character for a function name"); - } - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/input.h --- a/src/input.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,123 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -// Use the GNU readline library for command line editing and hisory. - -#if !defined (octave_input_h) -#define octave_input_h 1 - -#include - -#include - -#include "oct-time.h" -#include "oct-obj.h" -#include "pager.h" - -class octave_value; - -extern OCTINTERP_API int octave_read (char *buf, unsigned max_size); -extern OCTINTERP_API FILE *get_input_from_file (const std::string& name, int warn = 1); -extern OCTINTERP_API FILE *get_input_from_stdin (void); - -// Global pointer for eval(). -extern std::string current_eval_string; - -// TRUE means get input from current_eval_string. -extern bool get_input_from_eval_string; - -// TRUE means we haven't been asked for the input from -// current_eval_string yet. -extern bool input_from_eval_string_pending; - -// TRUE means that input is coming from a file that was named on -// the command line. -extern bool input_from_command_line_file; - -// TRUE means that stdin is a terminal, not a pipe or redirected file. -extern bool stdin_is_tty; - -// TRUE means we're parsing a function file. -extern bool reading_fcn_file; - -// Simple name of function file we are reading. -extern std::string curr_fcn_file_name; - -// Full name of file we are reading. -extern std::string curr_fcn_file_full_name; - -// TRUE means we're parsing a script file. -extern bool reading_script_file; - -// TRUE means we're parsing a classdef file. -extern bool reading_classdef_file; - -// If we are reading from an M-file, this is it. -extern FILE *ff_instream; - -// TRUE means this is an interactive shell. -extern bool interactive; - -// TRUE means the user forced this shell to be interactive (-i). -extern bool forced_interactive; - -// Should we issue a prompt? -extern int promptflag; - -// A line of input. -extern std::string current_input_line; - -// TRUE after a call to completion_matches. -extern bool octave_completion_matches_called; - -// TRUE if the plotting system has requested a call to drawnow at -// the next user prompt. -extern OCTINTERP_API bool Vdrawnow_requested; - -// TRUE if we are in debugging mode. -extern OCTINTERP_API bool Vdebugging; - -extern std::string gnu_readline (const std::string& s, bool force_readline = false); - -extern void initialize_command_input (void); - -extern bool octave_yes_or_no (const std::string& prompt); - -extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); - -extern std::string VPS4; - -extern char Vfilemarker; - -enum echo_state -{ - ECHO_OFF = 0, - ECHO_SCRIPTS = 1, - ECHO_FUNCTIONS = 2, - ECHO_CMD_LINE = 4 -}; - -extern int Vecho_executing_commands; - -extern octave_time Vlast_prompt_time; - -#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/data.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/data.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,7370 @@ +/* + +Copyright (C) 1994-2012 John W. Eaton +Copyright (C) 2009 Jaroslav Hajek +Copyright (C) 2009-2010 VZLU Prague +Copyright (C) 2012 Carlo de Falco + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#ifdef HAVE_SYS_RESOURCE_H +#include +#endif + +#include +#include + +#include +extern "C" +{ +#include +} + +#include "lo-ieee.h" +#include "lo-math.h" +#include "oct-time.h" +#include "str-vec.h" +#include "quit.h" +#include "mx-base.h" +#include "oct-binmap.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-float.h" +#include "ov-complex.h" +#include "ov-flt-complex.h" +#include "ov-cx-mat.h" +#include "ov-flt-cx-mat.h" +#include "ov-cx-sparse.h" +#include "parse.h" +#include "pt-mat.h" +#include "utils.h" +#include "variables.h" +#include "pager.h" +#include "xnorm.h" + +#if ! defined (CLOCKS_PER_SEC) +#if defined (CLK_TCK) +#define CLOCKS_PER_SEC CLK_TCK +#else +#error "no definition for CLOCKS_PER_SEC!" +#endif +#endif + +#if ! defined (HAVE_HYPOTF) && defined (HAVE__HYPOTF) +#define hypotf _hypotf +#define HAVE_HYPOTF 1 +#endif + +#define ANY_ALL(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + retval = args(0).FCN (dim); \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + else \ + error (#FCN ": expecting dimension argument to be an integer"); \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (all, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} all (@var{x})\n\ +@deftypefnx {Built-in Function} {} all (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if all elements of the vector\n\ +are nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether all of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +all ([2, 3; 1, 0]))\n\ + @result{} [ 1, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}.\n\ +@seealso{any}\n\ +@end deftypefn") +{ + ANY_ALL (all); +} + +/* +%!test +%! x = ones (3); +%! x(1,1) = 0; +%! assert (all (all (rand (3) + 1) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!test +%! x = ones (3, "single"); +%! x(1,1) = 0; +%! assert (all (all (single (rand (3) + 1)) == [1, 1, 1]) == 1); +%! assert (all (all (x) == [0, 1, 1]) == 1); +%! assert (all (x, 1) == [0, 1, 1]); +%! assert (all (x, 2) == [0; 1; 1]); + +%!error all () +%!error all (1, 2, 3) +*/ + +DEFUN (any, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} any (@var{x})\n\ +@deftypefnx {Built-in Function} {} any (@var{x}, @var{dim})\n\ +For a vector argument, return true (logical 1) if any element of the vector\n\ +is nonzero.\n\ +\n\ +For a matrix argument, return a row vector of logical ones and\n\ +zeros with each element indicating whether any of the elements of the\n\ +corresponding column of the matrix are nonzero. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4))\n\ + @result{} [ 1, 1, 0, 0 ]\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is supplied, work along dimension\n\ +@var{dim}. For example:\n\ +\n\ +@example\n\ +@group\n\ +any (eye (2, 4), 2)\n\ + @result{} [ 1; 1 ]\n\ +@end group\n\ +@end example\n\ +@seealso{all}\n\ +@end deftypefn") +{ + ANY_ALL (any); +} + +/* +%!test +%! x = zeros (3); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3)) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!test +%! x = zeros (3, "single"); +%! x(3,3) = 1; +%! assert (all (any (x) == [0, 0, 1]) == 1); +%! assert (all (any (ones (3, "single")) == [1, 1, 1]) == 1); +%! assert (any (x, 1) == [0, 0, 1]); +%! assert (any (x, 2) == [0; 0; 1]); + +%!error any () +%!error any (1, 2, 3) +*/ + +// These mapping functions may also be useful in other places, eh? + +DEFUN (atan2, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} atan2 (@var{y}, @var{x})\n\ +Compute atan (@var{y} / @var{x}) for corresponding elements of @var{y}\n\ +and @var{x}. Signal an error if @var{y} and @var{x} do not match in size\n\ +and orientation.\n\ +@seealso{tan, tand, tanh, atanh}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("atan2", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("atan2: not defined for complex numbers"); + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = atan2f (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, ::atan2f, "atan2"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = atan2 (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, ::atan2, "atan2"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, ::atan2, "atan2"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (atan2 (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (atan2 (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (atan2 (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (atan2 (1, 2)), [1, 1]) + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; +%! y = [0, rt3, 1, rt3, -rt3, -1, -rt3, 0]; +%! x = [1, 3, 1, 1, 1, 1, 3, 1]; +%! assert (atan2 (y, x), v, sqrt (eps)); + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); +%! y = single ([0, rt3, 1, rt3, -rt3, -1, -rt3, 0]); +%! x = single ([1, 3, 1, 1, 1, 1, 3, 1]); +%! assert (atan2 (y, x), v, sqrt (eps ("single"))); + +%!error atan2 () +%!error atan2 (1, 2, 3) +*/ + + +static octave_value +do_hypot (const octave_value& x, const octave_value& y) +{ + octave_value retval; + + octave_value arg0 = x, arg1 = y; + if (! arg0.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg0); + else if (! arg1.is_numeric_type ()) + gripe_wrong_type_arg ("hypot", arg1); + else + { + if (arg0.is_complex_type ()) + arg0 = arg0.abs (); + if (arg1.is_complex_type ()) + arg1 = arg1.abs (); + + if (arg0.is_single_type () || arg1.is_single_type ()) + { + if (arg0.is_scalar_type () && arg1.is_scalar_type ()) + retval = hypotf (arg0.float_value (), arg1.float_value ()); + else + { + FloatNDArray a0 = arg0.float_array_value (); + FloatNDArray a1 = arg1.float_array_value (); + retval = binmap (a0, a1, ::hypotf, "hypot"); + } + } + else + { + bool a0_scalar = arg0.is_scalar_type (); + bool a1_scalar = arg1.is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = hypot (arg0.scalar_value (), arg1.scalar_value ()); + else if ((a0_scalar || arg0.is_sparse_type ()) + && (a1_scalar || arg1.is_sparse_type ())) + { + SparseMatrix m0 = arg0.sparse_matrix_value (); + SparseMatrix m1 = arg1.sparse_matrix_value (); + retval = binmap (m0, m1, ::hypot, "hypot"); + } + else + { + NDArray a0 = arg0.array_value (); + NDArray a1 = arg1.array_value (); + retval = binmap (a0, a1, ::hypot, "hypot"); + } + } + } + + return retval; +} + +DEFUN (hypot, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} hypot (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} hypot (@var{x}, @var{y}, @var{z}, @dots{})\n\ +Compute the element-by-element square root of the sum of the squares of\n\ +@var{x} and @var{y}. This is equivalent to\n\ +@code{sqrt (@var{x}.^2 + @var{y}.^2)}, but calculated in a manner that\n\ +avoids overflows for large values of @var{x} or @var{y}.\n\ +@code{hypot} can also be called with more than 2 arguments; in this case,\n\ +the arguments are accumulated from left to right:\n\ +\n\ +@example\n\ +@group\n\ +hypot (hypot (@var{x}, @var{y}), @var{z})\n\ +hypot (hypot (hypot (@var{x}, @var{y}), @var{z}), @var{w}), etc.\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + retval = do_hypot (args(0), args(1)); + } + else if (nargin >= 3) + { + retval = args(0); + for (int i = 1; i < nargin && ! error_state; i++) + retval = do_hypot (retval, args(i)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (size (hypot (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (hypot (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (hypot (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (hypot (1, 2)), [1, 1]) +%!assert (hypot (1:10, 1:10), sqrt (2) * [1:10], 16*eps) +%!assert (hypot (single (1:10), single (1:10)), single (sqrt (2) * [1:10])) +*/ + +template +void +map_2_xlog2 (const Array& x, Array& f, Array& e) +{ + f = Array(x.dims ()); + e = Array(x.dims ()); + for (octave_idx_type i = 0; i < x.numel (); i++) + { + int exp; + f.xelem (i) = xlog2 (x(i), exp); + e.xelem (i) = exp; + } +} + +DEFUN (log2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} log2 (@var{x})\n\ +@deftypefnx {Mapping Function} {[@var{f}, @var{e}] =} log2 (@var{x})\n\ +Compute the base-2 logarithm of each element of @var{x}.\n\ +\n\ +If called with two output arguments, split @var{x} into\n\ +binary mantissa and exponent so that\n\ +@tex\n\ +${1 \\over 2} \\le \\left| f \\right| < 1$\n\ +@end tex\n\ +@ifnottex\n\ +@code{1/2 <= abs(f) < 1}\n\ +@end ifnottex\n\ +and @var{e} is an integer. If\n\ +@tex\n\ +$x = 0$, $f = e = 0$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{x = 0}, @code{f = e = 0}.\n\ +@end ifnottex\n\ +@seealso{pow2, log, log10, exp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + if (nargout < 2) + retval(0) = args(0).log2 (); + else if (args(0).is_single_type ()) + { + if (args(0).is_real_type ()) + { + FloatNDArray f; + FloatNDArray x = args(0).float_array_value (); + // FIXME -- should E be an int value? + FloatMatrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + FloatComplexNDArray f; + FloatComplexNDArray x = args(0).float_complex_array_value (); + // FIXME -- should E be an int value? + FloatNDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + } + else if (args(0).is_real_type ()) + { + NDArray f; + NDArray x = args(0).array_value (); + // FIXME -- should E be an int value? + Matrix e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else if (args(0).is_complex_type ()) + { + ComplexNDArray f; + ComplexNDArray x = args(0).complex_array_value (); + // FIXME -- should E be an int value? + NDArray e; + map_2_xlog2 (x, f, e); + retval(1) = e; + retval(0) = f; + } + else + gripe_wrong_type_arg ("log2", args(0)); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (log2 ([1/4, 1/2, 1, 2, 4]), [-2, -1, 0, 1, 2]) +%!assert (log2 (Inf), Inf) +%!assert (isnan (log2 (NaN))) +%!assert (log2 (4*i), 2 + log2 (1*i)) +%!assert (log2 (complex (0,Inf)), Inf + log2 (i)) + +%!test +%! [f, e] = log2 ([0,-1; 2,-4; Inf,-Inf]); +%! assert (f, [0,-0.5; 0.5,-0.5; Inf,-Inf]); +%! assert (e(1:2,:), [0,1;2,3]); + +%!test +%! [f, e] = log2 (complex (zeros (3, 2), [0,-1; 2,-4; Inf,-Inf])); +%! assert (f, complex (zeros (3, 2), [0,-0.5; 0.5,-0.5; Inf,-Inf])); +%! assert (e(1:2,:), [0,1; 2,3]); +*/ + +DEFUN (rem, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} rem (@var{x}, @var{y})\n\ +@deftypefnx {Mapping Function} {} fmod (@var{x}, @var{y})\n\ +Return the remainder of the division @code{@var{x} / @var{y}}, computed\n\ +using the expression\n\ +\n\ +@example\n\ +x - y .* fix (x ./ y)\n\ +@end example\n\ +\n\ +An error message is printed if the dimensions of the arguments do not\n\ +agree, or if either of the arguments is complex.\n\ +@seealso{mod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("rem", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("rem: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, rem, "rem"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("rem: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xrem (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xrem (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xrem, "rem"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xrem, "rem"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (rem ([1, 2, 3; -1, -2, -3], 2), [1, 0, 1; -1, 0, -1]) +%!assert (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3)),[1, 0, 1; -1, 0, -1]) +%!assert (rem (uint8 ([1, 2, 3; -1, -2, -3]), uint8 (2)), uint8 ([1, 0, 1; -1, 0, -1])) +%!assert (uint8 (rem ([1, 2, 3; -1, -2, -3], 2 * ones (2, 3))),uint8 ([1, 0, 1; -1, 0, -1])) + +%!error rem (uint (8), int8 (5)) +%!error rem (uint8 ([1, 2]), uint8 ([3, 4, 5])) +%!error rem () +%!error rem (1, 2, 3) +%!error rem ([1, 2], [3, 4, 5]) +%!error rem (i, 1) +*/ + +/* + +%!assert (size (fmod (zeros (0, 2), zeros (0, 2))), [0, 2]) +%!assert (size (fmod (rand (2, 3, 4), zeros (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (rand (2, 3, 4), 1)), [2, 3, 4]) +%!assert (size (fmod (1, rand (2, 3, 4))), [2, 3, 4]) +%!assert (size (fmod (1, 2)), [1, 1]) +*/ + +DEFALIAS (fmod, rem) + +DEFUN (mod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Mapping Function} {} mod (@var{x}, @var{y})\n\ +Compute the modulo of @var{x} and @var{y}. Conceptually this is given by\n\ +\n\ +@example\n\ +x - y .* floor (x ./ y)\n\ +@end example\n\ +\n\ +@noindent\n\ +and is written such that the correct modulus is returned for\n\ +integer types. This function handles negative values correctly. That\n\ +is, @code{mod (-1, 3)} is 2, not -1, as @code{rem (-1, 3)} returns.\n\ +@code{mod (@var{x}, 0)} returns @var{x}.\n\ +\n\ +An error results if the dimensions of the arguments do not agree, or if\n\ +either of the arguments is complex.\n\ +@seealso{rem}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2) + { + if (! args(0).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(0)); + else if (! args(1).is_numeric_type ()) + gripe_wrong_type_arg ("mod", args(1)); + else if (args(0).is_complex_type () || args(1).is_complex_type ()) + error ("mod: not defined for complex numbers"); + else if (args(0).is_integer_type () || args(1).is_integer_type ()) + { + builtin_type_t btyp0 = args(0).builtin_type (); + builtin_type_t btyp1 = args(1).builtin_type (); + if (btyp0 == btyp_double || btyp0 == btyp_float) + btyp0 = btyp1; + if (btyp1 == btyp_double || btyp1 == btyp_float) + btyp1 = btyp0; + + if (btyp0 == btyp1) + { + switch (btyp0) + { +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + { \ + X##NDArray a0 = args(0).X##_array_value (); \ + X##NDArray a1 = args(1).X##_array_value (); \ + retval = binmap (a0, a1, mod, "mod"); \ + } \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + panic_impossible (); + } + } + else + error ("mod: cannot combine %s and %d", + args(0).class_name ().c_str (), args(1).class_name ().c_str ()); + } + else if (args(0).is_single_type () || args(1).is_single_type ()) + { + if (args(0).is_scalar_type () && args(1).is_scalar_type ()) + retval = xmod (args(0).float_value (), args(1).float_value ()); + else + { + FloatNDArray a0 = args(0).float_array_value (); + FloatNDArray a1 = args(1).float_array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + else + { + bool a0_scalar = args(0).is_scalar_type (); + bool a1_scalar = args(1).is_scalar_type (); + if (a0_scalar && a1_scalar) + retval = xmod (args(0).scalar_value (), args(1).scalar_value ()); + else if ((a0_scalar || args(0).is_sparse_type ()) + && (a1_scalar || args(1).is_sparse_type ())) + { + SparseMatrix m0 = args(0).sparse_matrix_value (); + SparseMatrix m1 = args(1).sparse_matrix_value (); + retval = binmap (m0, m1, xmod, "mod"); + } + else + { + NDArray a0 = args(0).array_value (); + NDArray a1 = args(1).array_value (); + retval = binmap (a0, a1, xmod, "mod"); + } + } + } + else + print_usage (); + + return retval; +} + +/* +## empty input test +%!assert (isempty (mod ([], []))) + +## x mod y, y != 0 tests +%!assert (mod (5, 3), 2) +%!assert (mod (-5, 3), 1) +%!assert (mod (0, 3), 0) +%!assert (mod ([-5, 5, 0], [3, 3, 3]), [1, 2, 0]) +%!assert (mod ([-5; 5; 0], [3; 3; 3]), [1; 2; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 3 ; 3, 1]), [1, 2 ; 0, 0]) + +## x mod 0 tests +%!assert (mod (5, 0), 5) +%!assert (mod (-5, 0), -5) +%!assert (mod ([-5, 5, 0], [3, 0, 3]), [1, 5, 0]) +%!assert (mod ([-5; 5; 0], [3; 0; 3]), [1; 5; 0]) +%!assert (mod ([-5, 5; 0, 3], [3, 0 ; 3, 1]), [1, 5 ; 0, 0]) +%!assert (mod ([-5, 5; 0, 3], [0, 0 ; 0, 0]), [-5, 5; 0, 3]) + +## mixed scalar/matrix tests +%!assert (mod ([-5, 5; 0, 3], 0), [-5, 5; 0, 3]) +%!assert (mod ([-5, 5; 0, 3], 3), [1, 2; 0, 0]) +%!assert (mod (-5, [0,0; 0,0]), [-5, -5; -5, -5]) +%!assert (mod (-5, [3,0; 3,1]), [1, -5; 1, 0]) +%!assert (mod (-5, [3,2; 3,1]), [1, 1; 1, 0]) + +## integer types +%!assert (mod (uint8 (5), uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), uint8 (4)), uint8 ([1,2,3,0,1])) +%!assert (mod (uint8 ([1:5]), uint8 (0)), uint8 ([1:5])) +%!error (mod (uint8 (5), int8 (4))) + +## mixed integer/real types +%!assert (mod (uint8 (5), 4), uint8 (1)) +%!assert (mod (5, uint8 (4)), uint8 (1)) +%!assert (mod (uint8 ([1:5]), 4), uint8 ([1,2,3,0,1])) + +## non-integer real numbers +%!assert (mod (2.1, 0.1), 0) +%!assert (mod (2.1, 0.2), 0.1, eps) +*/ + +// FIXME: Need to convert the reduction functions of this file for single precision + +#define NATIVE_REDUCTION_1(FCN, TYPE, DIM) \ + (arg.is_ ## TYPE ## _type ()) \ + { \ + TYPE ## NDArray tmp = arg. TYPE ##_array_value (); \ + \ + if (! error_state) \ + { \ + retval = tmp.FCN (DIM); \ + } \ + } + +#define NATIVE_REDUCTION(FCN, BOOL_FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + bool isnative = false; \ + bool isdouble = false; \ + \ + if (nargin > 1 && args(nargin - 1).is_string ()) \ + { \ + std::string str = args(nargin - 1).string_value (); \ + \ + if (! error_state) \ + { \ + if (str == "native") \ + isnative = true; \ + else if (str == "double") \ + isdouble = true; \ + else \ + error ("sum: unrecognized string argument"); \ + nargin --; \ + } \ + } \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + if (isnative) \ + { \ + if NATIVE_REDUCTION_1 (FCN, uint8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, uint64, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int8, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int16, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int32, dim) \ + else if NATIVE_REDUCTION_1 (FCN, int64, dim) \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = boolNDArray (tmp.BOOL_FCN (dim)); \ + } \ + else if (arg.is_char_matrix ()) \ + { \ + error (#FCN, ": invalid char type"); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else if (arg.is_bool_type ()) \ + { \ + boolNDArray tmp = arg.bool_array_value (); \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (!isdouble && arg.is_single_type ()) \ + { \ + if (arg.is_real_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + FloatComplexNDArray tmp = \ + arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_real_type ()) \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_complex_type ()) \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + \ + } \ + else \ + print_usage (); \ + \ + return retval + +#define DATA_REDUCTION(FCN) \ + \ + octave_value retval; \ + \ + int nargin = args.length (); \ + \ + if (nargin == 1 || nargin == 2) \ + { \ + octave_value arg = args(0); \ + \ + int dim = (nargin == 1 ? -1 : args(1).int_value (true) - 1); \ + \ + if (! error_state) \ + { \ + if (dim >= -1) \ + { \ + if (arg.is_real_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseMatrix tmp = arg.sparse_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatNDArray tmp = arg.float_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + NDArray tmp = arg.array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else if (arg.is_complex_type ()) \ + { \ + if (arg.is_sparse_type ()) \ + { \ + SparseComplexMatrix tmp = arg.sparse_complex_matrix_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else if (arg.is_single_type ()) \ + { \ + FloatComplexNDArray tmp = arg.float_complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + else \ + { \ + ComplexNDArray tmp = arg.complex_array_value (); \ + \ + if (! error_state) \ + retval = tmp.FCN (dim); \ + } \ + } \ + else \ + { \ + gripe_wrong_type_arg (#FCN, arg); \ + return retval; \ + } \ + } \ + else \ + error (#FCN ": invalid dimension argument = %d", dim + 1); \ + } \ + } \ + else \ + print_usage (); \ + \ + return retval + +DEFUN (cumprod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumprod (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumprod (@var{x}, @var{dim})\n\ +Cumulative product of elements along dimension @var{dim}. If\n\ +@var{dim} is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +@seealso{prod, cumsum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (cumprod); +} + +/* +%!assert (cumprod ([1, 2, 3]), [1, 2, 6]) +%!assert (cumprod ([-1; -2; -3]), [-1; 2; -6]) +%!assert (cumprod ([i, 2+i, -3+2i, 4]), [i, -1+2i, -1-8i, -4-32i]) +%!assert (cumprod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i]) + +%!assert (cumprod (single ([1, 2, 3])), single ([1, 2, 6])) +%!assert (cumprod (single ([-1; -2; -3])), single ([-1; 2; -6])) +%!assert (cumprod (single ([i, 2+i, -3+2i, 4])), single ([i, -1+2i, -1-8i, -4-32i])) +%!assert (cumprod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; i, 4i, 9i; -1+i, -8+8i, -27+27i])) + +%!assert (cumprod ([2, 3; 4, 5], 1), [2, 3; 8, 15]) +%!assert (cumprod ([2, 3; 4, 5], 2), [2, 6; 4, 20]) + +%!assert (cumprod (single ([2, 3; 4, 5]), 1), single ([2, 3; 8, 15])) +%!assert (cumprod (single ([2, 3; 4, 5]), 2), single ([2, 6; 4, 20])) + +%!error cumprod () +*/ + +DEFUN (cumsum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cumsum (@var{x})\n\ +@deftypefnx {Built-in Function} {} cumsum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} cumsum (@dots{}, \"extra\")\n\ +Cumulative sum of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +See @code{sum} for an explanation of the optional parameters \"native\",\n\ +\"double\", and \"extra\".\n\ +@seealso{sum, cumprod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("cumsum: invalid dimension argument = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + retval = arg.sparse_matrix_value ().cumsum (dim); + else + retval = arg.array_value ().cumsum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + retval = arg.sparse_complex_matrix_value ().cumsum (dim); + else + retval = arg.complex_array_value ().cumsum (dim); + break; + case btyp_float: + if (isdouble) + retval = arg.array_value ().cumsum (dim); + else + retval = arg.float_array_value ().cumsum (dim); + break; + case btyp_float_complex: + if (isdouble) + retval = arg.complex_array_value ().cumsum (dim); + else + retval = arg.float_complex_array_value ().cumsum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().cumsum (dim); \ + else \ + retval = arg.array_value ().cumsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + + case btyp_bool: + if (arg.is_sparse_type ()) + { + SparseMatrix cs = arg.sparse_matrix_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + else + { + NDArray cs = arg.bool_array_value ().cumsum (dim); + if (isnative) + retval = cs != 0.0; + else + retval = cs; + } + break; + + default: + gripe_wrong_type_arg ("cumsum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (cumsum ([1, 2, 3]), [1, 3, 6]) +%!assert (cumsum ([-1; -2; -3]), [-1; -3; -6]) +%!assert (cumsum ([i, 2+i, -3+2i, 4]), [i, 2+2i, -1+4i, 3+4i]) +%!assert (cumsum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i]) + +%!assert (cumsum (single ([1, 2, 3])), single ([1, 3, 6])) +%!assert (cumsum (single ([-1; -2; -3])), single ([-1; -3; -6])) +%!assert (cumsum (single ([i, 2+i, -3+2i, 4])), single ([i, 2+2i, -1+4i, 3+4i])) +%!assert (cumsum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([1, 2, 3; 1+i, 2+2i, 3+3i; 2+2i, 4+4i, 6+6i])) + +%!assert (cumsum ([1, 2; 3, 4], 1), [1, 2; 4, 6]) +%!assert (cumsum ([1, 2; 3, 4], 2), [1, 3; 3, 7]) + +%!assert (cumsum (single ([1, 2; 3, 4]), 1), single ([1, 2; 4, 6])) +%!assert (cumsum (single ([1, 2; 3, 4]), 2), single ([1, 3; 3, 7])) + +%!error cumsum () +*/ + +DEFUN (diag, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{M} =} diag (@var{v})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{k})\n\ +@deftypefnx {Built-in Function} {@var{M} =} diag (@var{v}, @var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M})\n\ +@deftypefnx {Built-in Function} {@var{v} =} diag (@var{M}, @var{k})\n\ +Return a diagonal matrix with vector @var{v} on diagonal @var{k}. The\n\ +second argument is optional. If it is positive, the vector is placed on\n\ +the @var{k}-th super-diagonal. If it is negative, it is placed on the\n\ +@var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the\n\ +vector is placed on the main diagonal. For example:\n\ +\n\ +@example\n\ +@group\n\ +diag ([1, 2, 3], 1)\n\ + @result{} 0 1 0 0\n\ + 0 0 2 0\n\ + 0 0 0 3\n\ + 0 0 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +The 3-input form returns a diagonal matrix with vector @var{v} on the main\n\ +diagonal and the resulting matrix being of size @var{m} rows x @var{n}\n\ +columns.\n\ +\n\ +Given a matrix argument, instead of a vector, @code{diag} extracts the\n\ +@var{k}-th diagonal of the matrix.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 && args(0).is_defined ()) + retval = args(0).diag (); + else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) + { + octave_idx_type k = args(1).int_value (); + + if (error_state) + error ("diag: invalid argument K"); + else + retval = args(0).diag (k); + } + else if (nargin == 3) + { + octave_value arg0 = args(0); + + if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) + { + octave_idx_type m = args(1).int_value (); + octave_idx_type n = args(2).int_value (); + + if (! error_state) + retval = arg0.diag (m, n); + else + error ("diag: invalid dimensions"); + } + else + error ("diag: V must be a vector"); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (full (diag ([1; 2; 3])), [1, 0, 0; 0, 2, 0; 0, 0, 3]) +%!assert (diag ([1; 2; 3], 1), [0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3], 2), [0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0]) +%!assert (diag ([1; 2; 3],-1), [0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]) +%!assert (diag ([1; 2; 3],-2), [0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0]) + +%!assert (diag ([1, 0, 0; 0, 2, 0; 0, 0, 3]), [1; 2; 3]) +%!assert (diag ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0], 1), [1; 2; 3]) +%!assert (diag ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0], -1), [1; 2; 3]) +%!assert (diag (ones (1, 0), 2), zeros (2)) +%!assert (diag (1:3, 4, 2), [1, 0; 0, 2; 0, 0; 0, 0]) + +%!assert (full (diag (single ([1; 2; 3]))), single ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (single ([1; 2; 3]), 1), single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]), 2), single ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (single ([1; 2; 3]),-1), single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (single ([1; 2; 3]),-2), single ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (single ([1, 0, 0; 0, 2, 0; 0, 0, 3])), single ([1; 2; 3])) +%!assert (diag (single ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), single ([1; 2; 3])) +%!assert (diag (single ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), single ([1; 2; 3])) + +%!assert (diag (int8 ([1; 2; 3])), int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])) +%!assert (diag (int8 ([1; 2; 3]), 1), int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]), 2), int8 ([0, 0, 1, 0, 0; 0, 0, 0, 2, 0; 0, 0, 0, 0, 3; 0, 0, 0, 0, 0; 0, 0, 0, 0, 0])) +%!assert (diag (int8 ([1; 2; 3]),-1), int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0])) +%!assert (diag (int8 ([1; 2; 3]),-2), int8 ([0, 0, 0, 0, 0; 0, 0, 0, 0, 0; 1, 0, 0, 0, 0; 0, 2, 0, 0, 0; 0, 0, 3, 0, 0])) + +%!assert (diag (int8 ([1, 0, 0; 0, 2, 0; 0, 0, 3])), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 1, 0, 0; 0, 0, 2, 0; 0, 0, 0, 3; 0, 0, 0, 0]), 1), int8 ([1; 2; 3])) +%!assert (diag (int8 ([0, 0, 0, 0; 1, 0, 0, 0; 0, 2, 0, 0; 0, 0, 3, 0]), -1), int8 ([1; 2; 3])) + +## Test non-square size +%!assert (diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) +%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); +%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); +%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); + +%% Test input validation +%!error diag () +%!error diag (1,2,3,4) +%!error diag (ones (2), 3, 3) +%!error diag (1:3, -4, 3) + +%!assert (diag (1, 3, 3), diag ([1, 0, 0])) +%!assert (diag (i, 3, 3), diag ([i, 0, 0])) +%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) +%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) +%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) +%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) +%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) +%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) +*/ + +DEFUN (prod, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} prod (@var{x})\n\ +@deftypefnx {Built-in Function} {} prod (@var{x}, @var{dim})\n\ +Product of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +@seealso{cumprod, sum}\n\ +@end deftypefn") +{ + DATA_REDUCTION (prod); +} + +/* +%!assert (prod ([1, 2, 3]), 6) +%!assert (prod ([-1; -2; -3]), -6) +%!assert (prod ([i, 2+i, -3+2i, 4]), -4 - 32i) +%!assert (prod ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [-1+i, -8+8i, -27+27i]) + +%!assert (prod (single ([1, 2, 3])), single (6)) +%!assert (prod (single ([-1; -2; -3])), single (-6)) +%!assert (prod (single ([i, 2+i, -3+2i, 4])), single (-4 - 32i)) +%!assert (prod (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([-1+i, -8+8i, -27+27i])) + +%!assert (prod ([1, 2; 3, 4], 1), [3, 8]) +%!assert (prod ([1, 2; 3, 4], 2), [2; 12]) +%!assert (prod (zeros (1, 0)), 1) +%!assert (prod (zeros (1, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (1, 0), 2), 1) +%!assert (prod (zeros (0, 1)), 1) +%!assert (prod (zeros (0, 1), 1), 1) +%!assert (prod (zeros (0, 1), 2), zeros (0, 1)) +%!assert (prod (zeros (2, 0)), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 1), zeros (1, 0)) +%!assert (prod (zeros (2, 0), 2), [1; 1]) +%!assert (prod (zeros (0, 2)), [1, 1]) +%!assert (prod (zeros (0, 2), 1), [1, 1]) +%!assert (prod (zeros (0, 2), 2), zeros (0, 1)) + +%!assert (prod (single ([1, 2; 3, 4]), 1), single ([3, 8])) +%!assert (prod (single ([1, 2; 3, 4]), 2), single ([2; 12])) +%!assert (prod (zeros (1, 0, "single")), single (1)) +%!assert (prod (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (1, 0, "single"), 2), single (1)) +%!assert (prod (zeros (0, 1, "single")), single (1)) +%!assert (prod (zeros (0, 1, "single"), 1), single (1)) +%!assert (prod (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (prod (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (prod (zeros (2, 0, "single"), 2), single ([1; 1])) +%!assert (prod (zeros (0, 2, "single")), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 1), single ([1, 1])) +%!assert (prod (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) + +%!error prod () +*/ + +static bool +all_scalar_1x1 (const octave_value_list& args) +{ + int n_args = args.length (); + for (int i = 0; i < n_args; i++) + if (args(i).numel () != 1) + return false; + + return true; +} + +template +static void +single_type_concat (Array& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + if (! (equal_types::value + || equal_types::value) + && all_scalar_1x1 (args)) + { + // Optimize all scalars case. + dim_vector dv (1, 1); + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim >= 2) + dv.resize (dim+1, 1); + dv(dim) = n_args; + + result.clear (dv); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + result(j) = octave_value_extract (args(j)); + } + } + else + { + OCTAVE_LOCAL_BUFFER (Array, array_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + array_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Array::cat (dim, n_args, array_list); + } +} + +template +static void +single_type_concat (Sparse& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (Sparse, sparse_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + sparse_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = Sparse::cat (dim, n_args, sparse_list); +} + +// Dispatcher. +template +static TYPE +do_single_type_concat (const octave_value_list& args, int dim) +{ + TYPE result; + + single_type_concat (result, args, dim); + + return result; +} + +template +static void +single_type_concat_map (octave_map& result, + const octave_value_list& args, + int dim) +{ + int n_args = args.length (); + OCTAVE_LOCAL_BUFFER (MAP, map_list, n_args); + + for (int j = 0; j < n_args && ! error_state; j++) + { + octave_quit (); + + map_list[j] = octave_value_extract (args(j)); + } + + if (! error_state) + result = octave_map::cat (dim, n_args, map_list); +} + +static octave_map +do_single_type_concat_map (const octave_value_list& args, + int dim) +{ + octave_map result; + if (all_scalar_1x1 (args)) // optimize all scalars case. + single_type_concat_map (result, args, dim); + else + single_type_concat_map (result, args, dim); + + return result; +} + +static octave_value +attempt_type_conversion (const octave_value& ov, std::string dtype) +{ + octave_value retval; + + // First try to find function in the class of OV that can convert to + // the dispatch type dtype. It will have the name of the dispatch + // type. + + std::string cname = ov.class_name (); + + octave_value fcn = symbol_table::find_method (dtype, cname); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("conversion from %s to %s failed", dtype.c_str (), + cname.c_str ()); + } + else + { + // No conversion function available. Try the constructor for the + // dispatch type. + + fcn = symbol_table::find_method (dtype, dtype); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("%s constructor failed for %s argument", dtype.c_str (), + cname.c_str ()); + } + else + error ("no constructor for %s!", dtype.c_str ()); + } + + return retval; +} + +octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) +{ + octave_value retval; + + // Get dominant type for list + + std::string dtype = get_dispatch_type (ovl); + + octave_value fcn = symbol_table::find_method (cattype, dtype); + + if (fcn.is_defined ()) + { + // Have method for dominant type, so call it and let it handle + // conversions. + + octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); + + if (! error_state) + { + if (tmp2.length () > 0) + retval = tmp2(0); + else + { + error ("%s/%s method did not return a value", + dtype.c_str (), cattype.c_str ()); + goto done; + } + } + else + goto done; + } + else + { + // No method for dominant type, so attempt type conversions for + // all elements that are not of the dominant type, then do the + // default operation for octave_class values. + + octave_idx_type j = 0; + octave_idx_type len = ovl.length (); + octave_value_list tmp (len, octave_value ()); + for (octave_idx_type k = 0; k < len; k++) + { + octave_value elt = ovl(k); + + std::string t1_type = elt.class_name (); + + if (t1_type == dtype) + tmp(j++) = elt; + else if (elt.is_object () || ! elt.is_empty ()) + { + tmp(j++) = attempt_type_conversion (elt, dtype); + + if (error_state) + goto done; + } + } + + tmp.resize (j); + + octave_map m = do_single_type_concat_map (tmp, dim); + + std::string cname = tmp(0).class_name (); + std::list parents = tmp(0).parent_class_name_list (); + + retval = octave_value (new octave_class (m, cname, parents)); + } + + done: + return retval; +} + +static octave_value +do_cat (const octave_value_list& xargs, int dim, std::string fname) +{ + octave_value retval; + + // We may need to convert elements of the list to cells, so make a + // copy. This should be efficient, it is done mostly by incrementing + // reference counts. + octave_value_list args = xargs; + + int n_args = args.length (); + + if (n_args == 0) + retval = Matrix (); + else if (n_args == 1) + retval = args(0); + else if (n_args > 1) + { + std::string result_type; + + bool all_sq_strings_p = true; + bool all_dq_strings_p = true; + bool all_real_p = true; + bool all_cmplx_p = true; + bool any_sparse_p = false; + bool any_cell_p = false; + bool any_class_p = false; + + bool first_elem_is_struct = false; + + for (int i = 0; i < n_args; i++) + { + if (i == 0) + { + result_type = args(i).class_name (); + + first_elem_is_struct = args(i).is_map (); + } + else + result_type = get_concat_class (result_type, args(i).class_name ()); + + if (all_sq_strings_p && ! args(i).is_sq_string ()) + all_sq_strings_p = false; + if (all_dq_strings_p && ! args(i).is_dq_string ()) + all_dq_strings_p = false; + if (all_real_p && ! args(i).is_real_type ()) + all_real_p = false; + if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) + all_cmplx_p = false; + if (!any_sparse_p && args(i).is_sparse_type ()) + any_sparse_p = true; + if (!any_cell_p && args(i).is_cell ()) + any_cell_p = true; + if (!any_class_p && args(i).is_object ()) + any_class_p = true; + } + + if (any_cell_p && ! any_class_p && ! first_elem_is_struct) + { + for (int i = 0; i < n_args; i++) + { + if (! args(i).is_cell ()) + args(i) = Cell (args(i)); + } + } + + if (any_class_p) + { + retval = do_class_concat (args, fname, dim); + } + else if (result_type == "double") + { + if (any_sparse_p) + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + } + else if (result_type == "single") + { + if (all_real_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "char") + { + char type = all_dq_strings_p ? '"' : '\''; + + maybe_warn_string_concat (all_dq_strings_p, all_sq_strings_p); + + charNDArray result = do_single_type_concat (args, dim); + + retval = octave_value (result, type); + } + else if (result_type == "logical") + { + if (any_sparse_p) + retval = do_single_type_concat (args, dim); + else + retval = do_single_type_concat (args, dim); + } + else if (result_type == "int8") + retval = do_single_type_concat (args, dim); + else if (result_type == "int16") + retval = do_single_type_concat (args, dim); + else if (result_type == "int32") + retval = do_single_type_concat (args, dim); + else if (result_type == "int64") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint8") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint16") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint32") + retval = do_single_type_concat (args, dim); + else if (result_type == "uint64") + retval = do_single_type_concat (args, dim); + else if (result_type == "cell") + retval = do_single_type_concat (args, dim); + else if (result_type == "struct") + retval = do_single_type_concat_map (args, dim); + else + { + dim_vector dv = args(0).dims (); + + // Default concatenation. + bool (dim_vector::*concat_rule) (const dim_vector&, int) = &dim_vector::concat; + + if (dim == -1 || dim == -2) + { + concat_rule = &dim_vector::hvcat; + dim = -dim - 1; + } + + for (int i = 1; i < args.length (); i++) + { + if (! (dv.*concat_rule) (args(i).dims (), dim)) + { + // Dimensions do not match. + error ("cat: dimension mismatch"); + return retval; + } + } + + // The lines below might seem crazy, since we take a copy + // of the first argument, resize it to be empty and then resize + // it to be full. This is done since it means that there is no + // recopying of data, as would happen if we used a single resize. + // It should be noted that resize operation is also significantly + // slower than the do_cat_op function, so it makes sense to have + // an empty matrix and copy all data. + // + // We might also start with a empty octave_value using + // tmp = octave_value_typeinfo::lookup_type + // (args(1).type_name()); + // and then directly resize. However, for some types there might + // be some additional setup needed, and so this should be avoided. + + octave_value tmp = args (0); + tmp = tmp.resize (dim_vector (0,0)).resize (dv); + + if (error_state) + return retval; + + int dv_len = dv.length (); + Array ra_idx (dim_vector (dv_len, 1), 0); + + for (int j = 0; j < n_args; j++) + { + // Can't fast return here to skip empty matrices as something + // like cat (1,[],single ([])) must return an empty matrix of + // the right type. + tmp = do_cat_op (tmp, args (j), ra_idx); + + if (error_state) + return retval; + + dim_vector dv_tmp = args (j).dims (); + + if (dim >= dv_len) + { + if (j > 1) + error ("%s: indexing error", fname.c_str ()); + break; + } + else + ra_idx (dim) += (dim < dv_tmp.length () ? + dv_tmp (dim) : 1); + } + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (horzcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} horzcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the horizontal concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 2.\n\ +\n\ +Arrays may also be concatenated horizontally using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{hcat} = [ @var{array1}, @var{array2}, @dots{} ]\n\ +@end example\n\ +@seealso{cat, vertcat}\n\ +@end deftypefn") +{ + return do_cat (args, -2, "horzcat"); +} + +/* +## Test concatenation with all zero matrices +%!assert (horzcat ("", 65*ones (1,10)), "AAAAAAAAAA"); +%!assert (horzcat (65*ones (1,10), ""), "AAAAAAAAAA"); + +%!assert (class (horzcat (int64 (1), int64 (1))), "int64") +%!assert (class (horzcat (int64 (1), int32 (1))), "int64") +%!assert (class (horzcat (int64 (1), int16 (1))), "int64") +%!assert (class (horzcat (int64 (1), int8 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint64 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint32 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint16 (1))), "int64") +%!assert (class (horzcat (int64 (1), uint8 (1))), "int64") +%!assert (class (horzcat (int64 (1), single (1))), "int64") +%!assert (class (horzcat (int64 (1), double (1))), "int64") +%!assert (class (horzcat (int64 (1), cell (1))), "cell") +%!assert (class (horzcat (int64 (1), true)), "int64") +%!assert (class (horzcat (int64 (1), "a")), "char") + +%!assert (class (horzcat (int32 (1), int64 (1))), "int32") +%!assert (class (horzcat (int32 (1), int32 (1))), "int32") +%!assert (class (horzcat (int32 (1), int16 (1))), "int32") +%!assert (class (horzcat (int32 (1), int8 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint64 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint32 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint16 (1))), "int32") +%!assert (class (horzcat (int32 (1), uint8 (1))), "int32") +%!assert (class (horzcat (int32 (1), single (1))), "int32") +%!assert (class (horzcat (int32 (1), double (1))), "int32") +%!assert (class (horzcat (int32 (1), cell (1))), "cell") +%!assert (class (horzcat (int32 (1), true)), "int32") +%!assert (class (horzcat (int32 (1), "a")), "char") + +%!assert (class (horzcat (int16 (1), int64 (1))), "int16") +%!assert (class (horzcat (int16 (1), int32 (1))), "int16") +%!assert (class (horzcat (int16 (1), int16 (1))), "int16") +%!assert (class (horzcat (int16 (1), int8 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint64 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint32 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint16 (1))), "int16") +%!assert (class (horzcat (int16 (1), uint8 (1))), "int16") +%!assert (class (horzcat (int16 (1), single (1))), "int16") +%!assert (class (horzcat (int16 (1), double (1))), "int16") +%!assert (class (horzcat (int16 (1), cell (1))), "cell") +%!assert (class (horzcat (int16 (1), true)), "int16") +%!assert (class (horzcat (int16 (1), "a")), "char") + +%!assert (class (horzcat (int8 (1), int64 (1))), "int8") +%!assert (class (horzcat (int8 (1), int32 (1))), "int8") +%!assert (class (horzcat (int8 (1), int16 (1))), "int8") +%!assert (class (horzcat (int8 (1), int8 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint64 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint32 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint16 (1))), "int8") +%!assert (class (horzcat (int8 (1), uint8 (1))), "int8") +%!assert (class (horzcat (int8 (1), single (1))), "int8") +%!assert (class (horzcat (int8 (1), double (1))), "int8") +%!assert (class (horzcat (int8 (1), cell (1))), "cell") +%!assert (class (horzcat (int8 (1), true)), "int8") +%!assert (class (horzcat (int8 (1), "a")), "char") + +%!assert (class (horzcat (uint64 (1), int64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), int8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint64 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint32 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint16 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), uint8 (1))), "uint64") +%!assert (class (horzcat (uint64 (1), single (1))), "uint64") +%!assert (class (horzcat (uint64 (1), double (1))), "uint64") +%!assert (class (horzcat (uint64 (1), cell (1))), "cell") +%!assert (class (horzcat (uint64 (1), true)), "uint64") +%!assert (class (horzcat (uint64 (1), "a")), "char") + +%!assert (class (horzcat (uint32 (1), int64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), int8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint64 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint32 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint16 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), uint8 (1))), "uint32") +%!assert (class (horzcat (uint32 (1), single (1))), "uint32") +%!assert (class (horzcat (uint32 (1), double (1))), "uint32") +%!assert (class (horzcat (uint32 (1), cell (1))), "cell") +%!assert (class (horzcat (uint32 (1), true)), "uint32") +%!assert (class (horzcat (uint32 (1), "a")), "char") + +%!assert (class (horzcat (uint16 (1), int64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), int8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint64 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint32 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint16 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), uint8 (1))), "uint16") +%!assert (class (horzcat (uint16 (1), single (1))), "uint16") +%!assert (class (horzcat (uint16 (1), double (1))), "uint16") +%!assert (class (horzcat (uint16 (1), cell (1))), "cell") +%!assert (class (horzcat (uint16 (1), true)), "uint16") +%!assert (class (horzcat (uint16 (1), "a")), "char") + +%!assert (class (horzcat (uint8 (1), int64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), int8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint64 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint32 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint16 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), uint8 (1))), "uint8") +%!assert (class (horzcat (uint8 (1), single (1))), "uint8") +%!assert (class (horzcat (uint8 (1), double (1))), "uint8") +%!assert (class (horzcat (uint8 (1), cell (1))), "cell") +%!assert (class (horzcat (uint8 (1), true)), "uint8") +%!assert (class (horzcat (uint8 (1), "a")), "char") + +%!assert (class (horzcat (single (1), int64 (1))), "int64") +%!assert (class (horzcat (single (1), int32 (1))), "int32") +%!assert (class (horzcat (single (1), int16 (1))), "int16") +%!assert (class (horzcat (single (1), int8 (1))), "int8") +%!assert (class (horzcat (single (1), uint64 (1))), "uint64") +%!assert (class (horzcat (single (1), uint32 (1))), "uint32") +%!assert (class (horzcat (single (1), uint16 (1))), "uint16") +%!assert (class (horzcat (single (1), uint8 (1))), "uint8") +%!assert (class (horzcat (single (1), single (1))), "single") +%!assert (class (horzcat (single (1), double (1))), "single") +%!assert (class (horzcat (single (1), cell (1))), "cell") +%!assert (class (horzcat (single (1), true)), "single") +%!assert (class (horzcat (single (1), "a")), "char") + +%!assert (class (horzcat (double (1), int64 (1))), "int64") +%!assert (class (horzcat (double (1), int32 (1))), "int32") +%!assert (class (horzcat (double (1), int16 (1))), "int16") +%!assert (class (horzcat (double (1), int8 (1))), "int8") +%!assert (class (horzcat (double (1), uint64 (1))), "uint64") +%!assert (class (horzcat (double (1), uint32 (1))), "uint32") +%!assert (class (horzcat (double (1), uint16 (1))), "uint16") +%!assert (class (horzcat (double (1), uint8 (1))), "uint8") +%!assert (class (horzcat (double (1), single (1))), "single") +%!assert (class (horzcat (double (1), double (1))), "double") +%!assert (class (horzcat (double (1), cell (1))), "cell") +%!assert (class (horzcat (double (1), true)), "double") +%!assert (class (horzcat (double (1), "a")), "char") + +%!assert (class (horzcat (cell (1), int64 (1))), "cell") +%!assert (class (horzcat (cell (1), int32 (1))), "cell") +%!assert (class (horzcat (cell (1), int16 (1))), "cell") +%!assert (class (horzcat (cell (1), int8 (1))), "cell") +%!assert (class (horzcat (cell (1), uint64 (1))), "cell") +%!assert (class (horzcat (cell (1), uint32 (1))), "cell") +%!assert (class (horzcat (cell (1), uint16 (1))), "cell") +%!assert (class (horzcat (cell (1), uint8 (1))), "cell") +%!assert (class (horzcat (cell (1), single (1))), "cell") +%!assert (class (horzcat (cell (1), double (1))), "cell") +%!assert (class (horzcat (cell (1), cell (1))), "cell") +%!assert (class (horzcat (cell (1), true)), "cell") +%!assert (class (horzcat (cell (1), "a")), "cell") + +%!assert (class (horzcat (true, int64 (1))), "int64") +%!assert (class (horzcat (true, int32 (1))), "int32") +%!assert (class (horzcat (true, int16 (1))), "int16") +%!assert (class (horzcat (true, int8 (1))), "int8") +%!assert (class (horzcat (true, uint64 (1))), "uint64") +%!assert (class (horzcat (true, uint32 (1))), "uint32") +%!assert (class (horzcat (true, uint16 (1))), "uint16") +%!assert (class (horzcat (true, uint8 (1))), "uint8") +%!assert (class (horzcat (true, single (1))), "single") +%!assert (class (horzcat (true, double (1))), "double") +%!assert (class (horzcat (true, cell (1))), "cell") +%!assert (class (horzcat (true, true)), "logical") +%!assert (class (horzcat (true, "a")), "char") + +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", int64 (1))), "char") +%!assert (class (horzcat ("a", int32 (1))), "char") +%!assert (class (horzcat ("a", int16 (1))), "char") +%!assert (class (horzcat ("a", int8 (1))), "char") +%!assert (class (horzcat ("a", single (1))), "char") +%!assert (class (horzcat ("a", double (1))), "char") +%!assert (class (horzcat ("a", cell (1))), "cell") +%!assert (class (horzcat ("a", true)), "char") +%!assert (class (horzcat ("a", "a")), "char") + +%!assert (class (horzcat (cell (1), struct ("foo", "bar"))), "cell") + +%!error horzcat (struct ("foo", "bar"), cell (1)) +*/ + +DEFUN (vertcat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the vertical concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension 1.\n\ +\n\ +Arrays may also be concatenated vertically using the syntax for creating\n\ +new matrices. For example:\n\ +\n\ +@example\n\ +@var{vcat} = [ @var{array1}; @var{array2}; @dots{} ]\n\ +@end example\n\ +@seealso{cat, horzcat}\n\ +@end deftypefn") +{ + return do_cat (args, -1, "vertcat"); +} + +/* +%!test +%! c = {"foo"; "bar"; "bazoloa"}; +%! assert (vertcat (c, "a", "bc", "def"), {"foo"; "bar"; "bazoloa"; "a"; "bc"; "def"}); +*/ + +DEFUN (cat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ +Return the concatenation of N-D array objects, @var{array1},\n\ +@var{array2}, @dots{}, @var{arrayN} along dimension @var{dim}.\n\ +\n\ +@example\n\ +@group\n\ +A = ones (2, 2);\n\ +B = zeros (2, 2);\n\ +cat (2, A, B)\n\ + @result{} 1 1 0 0\n\ + 1 1 0 0\n\ +@end group\n\ +@end example\n\ +\n\ +Alternatively, we can concatenate @var{A} and @var{B} along the\n\ +second dimension in the following way:\n\ +\n\ +@example\n\ +@group\n\ +[A, B]\n\ +@end group\n\ +@end example\n\ +\n\ +@var{dim} can be larger than the dimensions of the N-D array objects\n\ +and the result will thus have @var{dim} dimensions as the\n\ +following example shows:\n\ +\n\ +@example\n\ +@group\n\ +cat (4, ones (2, 2), zeros (2, 2))\n\ + @result{} ans(:,:,1,1) =\n\ +\n\ + 1 1\n\ + 1 1\n\ +\n\ + ans(:,:,1,2) =\n\ +\n\ + 0 0\n\ + 0 0\n\ +@end group\n\ +@end example\n\ +@seealso{horzcat, vertcat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () > 0) + { + int dim = args(0).int_value () - 1; + + if (! error_state) + { + if (dim >= 0) + retval = do_cat (args.slice (1, args.length () - 1), dim, "cat"); + else + error ("cat: DIM must be a valid dimension"); + } + else + error ("cat: DIM must be an integer"); + } + else + print_usage (); + + return retval; +} + +/* +%!function ret = __testcat (t1, t2, tr, cmplx) +%! assert (cat (1, cast ([], t1), cast ([], t2)), cast ([], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2, t2)), cast ([1; 2], tr)); +%! assert (cat (1, cast (1, t1), cast ([2; 3], t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3, t2)), cast ([1; 2; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3; 4], t2)), cast ([1; 2; 3; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2, t2)), cast ([1, 2], tr)); +%! assert (cat (2, cast (1, t1), cast ([2, 3], t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3, t2)), cast ([1, 2, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3, 4], t2)), cast ([1, 2, 3, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2, t2)], cast ([1; 2], tr)); +%! assert ([cast(1, t1); cast([2; 3], t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3, t2)], cast ([1; 2; 3], tr)); +%! assert ([cast([1; 2], t1); cast([3; 4], t2)], cast ([1; 2; 3; 4], tr)); +%! assert ([cast(1, t1), cast(2, t2)], cast ([1, 2], tr)); +%! assert ([cast(1, t1), cast([2, 3], t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3, t2)], cast ([1, 2, 3], tr)); +%! assert ([cast([1, 2], t1), cast([3, 4], t2)], cast ([1, 2, 3, 4], tr)); +%! +%! if (nargin == 3 || cmplx) +%! assert (cat (1, cast (1i, t1), cast (2, t2)), cast ([1i; 2], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2; 3], t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3, t2)), cast ([1i; 2; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3; 4], t2)), cast ([1i; 2; 3; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2, t2)), cast ([1i, 2], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2, 3], t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3, t2)), cast ([1i, 2, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3, 4], t2)), cast ([1i, 2, 3, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2, t2)], cast ([1i; 2], tr)); +%! assert ([cast(1i, t1); cast([2; 3], t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3, t2)], cast ([1i; 2; 3], tr)); +%! assert ([cast([1i; 2], t1); cast([3; 4], t2)], cast ([1i; 2; 3; 4], tr)); +%! assert ([cast(1i, t1), cast(2, t2)], cast ([1i, 2], tr)); +%! assert ([cast(1i, t1), cast([2, 3], t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3, t2)], cast ([1i, 2, 3], tr)); +%! assert ([cast([1i, 2], t1), cast([3, 4], t2)], cast ([1i, 2, 3, 4], tr)); +%! +%! assert (cat (1, cast (1, t1), cast (2i, t2)), cast ([1; 2i], tr)); +%! assert (cat (1, cast (1, t1), cast ([2i; 3], t2)), cast ([1; 2i; 3], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast (3i, t2)), cast ([1; 2; 3i], tr)); +%! assert (cat (1, cast ([1; 2], t1), cast ([3i; 4], t2)), cast ([1; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1, t1), cast (2i, t2)), cast ([1, 2i], tr)); +%! assert (cat (2, cast (1, t1), cast ([2i, 3], t2)), cast ([1, 2i, 3], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast (3i, t2)), cast ([1, 2, 3i], tr)); +%! assert (cat (2, cast ([1, 2], t1), cast ([3i, 4], t2)), cast ([1, 2, 3i, 4], tr)); +%! +%! assert ([cast(1, t1); cast(2i, t2)], cast ([1; 2i], tr)); +%! assert ([cast(1, t1); cast([2i; 3], t2)], cast ([1; 2i; 3], tr)); +%! assert ([cast([1; 2], t1); cast(3i, t2)], cast ([1; 2; 3i], tr)); +%! assert ([cast([1; 2], t1); cast([3i; 4], t2)], cast ([1; 2; 3i; 4], tr)); +%! assert ([cast(1, t1), cast(2i, t2)], cast ([1, 2i], tr)); +%! assert ([cast(1, t1), cast([2i, 3], t2)], cast ([1, 2i, 3], tr)); +%! assert ([cast([1, 2], t1), cast(3i, t2)], cast ([1, 2, 3i], tr)); +%! assert ([cast([1, 2], t1), cast([3i, 4], t2)], cast ([1, 2, 3i, 4], tr)); +%! +%! assert (cat (1, cast (1i, t1), cast (2i, t2)), cast ([1i; 2i], tr)); +%! assert (cat (1, cast (1i, t1), cast ([2i; 3], t2)), cast ([1i; 2i; 3], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast (3i, t2)), cast ([1i; 2; 3i], tr)); +%! assert (cat (1, cast ([1i; 2], t1), cast ([3i; 4], t2)), cast ([1i; 2; 3i; 4], tr)); +%! assert (cat (2, cast (1i, t1), cast (2i, t2)), cast ([1i, 2i], tr)); +%! assert (cat (2, cast (1i, t1), cast ([2i, 3], t2)), cast ([1i, 2i, 3], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast (3i, t2)), cast ([1i, 2, 3i], tr)); +%! assert (cat (2, cast ([1i, 2], t1), cast ([3i, 4], t2)), cast ([1i, 2, 3i, 4], tr)); +%! +%! assert ([cast(1i, t1); cast(2i, t2)], cast ([1i; 2i], tr)); +%! assert ([cast(1i, t1); cast([2i; 3], t2)], cast ([1i; 2i; 3], tr)); +%! assert ([cast([1i; 2], t1); cast(3i, t2)], cast ([1i; 2; 3i], tr)); +%! assert ([cast([1i; 2], t1); cast([3i; 4], t2)], cast ([1i; 2; 3i; 4], tr)); +%! assert ([cast(1i, t1), cast(2i, t2)], cast ([1i, 2i], tr)); +%! assert ([cast(1i, t1), cast([2i, 3], t2)], cast ([1i, 2i, 3], tr)); +%! assert ([cast([1i, 2], t1), cast(3i, t2)], cast ([1i, 2, 3i], tr)); +%! assert ([cast([1i, 2], t1), cast([3i, 4], t2)], cast ([1i, 2, 3i, 4], tr)); +%! endif +%! ret = true; +%!endfunction + +%!assert (__testcat ("double", "double", "double")) +%!assert (__testcat ("single", "double", "single")) +%!assert (__testcat ("double", "single", "single")) +%!assert (__testcat ("single", "single", "single")) + +%!assert (__testcat ("double", "int8", "int8", false)) +%!assert (__testcat ("int8", "double", "int8", false)) +%!assert (__testcat ("single", "int8", "int8", false)) +%!assert (__testcat ("int8", "single", "int8", false)) +%!assert (__testcat ("int8", "int8", "int8", false)) +%!assert (__testcat ("double", "int16", "int16", false)) +%!assert (__testcat ("int16", "double", "int16", false)) +%!assert (__testcat ("single", "int16", "int16", false)) +%!assert (__testcat ("int16", "single", "int16", false)) +%!assert (__testcat ("int16", "int16", "int16", false)) +%!assert (__testcat ("double", "int32", "int32", false)) +%!assert (__testcat ("int32", "double", "int32", false)) +%!assert (__testcat ("single", "int32", "int32", false)) +%!assert (__testcat ("int32", "single", "int32", false)) +%!assert (__testcat ("int32", "int32", "int32", false)) +%!assert (__testcat ("double", "int64", "int64", false)) +%!assert (__testcat ("int64", "double", "int64", false)) +%!assert (__testcat ("single", "int64", "int64", false)) +%!assert (__testcat ("int64", "single", "int64", false)) +%!assert (__testcat ("int64", "int64", "int64", false)) + +%!assert (__testcat ("double", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "double", "uint8", false)) +%!assert (__testcat ("single", "uint8", "uint8", false)) +%!assert (__testcat ("uint8", "single", "uint8", false)) +%!assert (__testcat ("uint8", "uint8", "uint8", false)) +%!assert (__testcat ("double", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "double", "uint16", false)) +%!assert (__testcat ("single", "uint16", "uint16", false)) +%!assert (__testcat ("uint16", "single", "uint16", false)) +%!assert (__testcat ("uint16", "uint16", "uint16", false)) +%!assert (__testcat ("double", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "double", "uint32", false)) +%!assert (__testcat ("single", "uint32", "uint32", false)) +%!assert (__testcat ("uint32", "single", "uint32", false)) +%!assert (__testcat ("uint32", "uint32", "uint32", false)) +%!assert (__testcat ("double", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "double", "uint64", false)) +%!assert (__testcat ("single", "uint64", "uint64", false)) +%!assert (__testcat ("uint64", "single", "uint64", false)) +%!assert (__testcat ("uint64", "uint64", "uint64", false)) + +%!assert (cat (3, [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (3, [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [1,2;3,4], []), [1,2;3,4]) +%!assert (cat (3, [], [], []), zeros (0, 0, 3)) + +%!assert (cat (3, [], [], 1, 2), cat (3, 1, 2)) +%!assert (cat (3, [], [], [1,2;3,4]), [1,2;3,4]) +%!assert (cat (4, [], [], [1,2;3,4]), [1,2;3,4]) + +%!assert ([zeros(3,2,2); ones(1,2,2)], repmat ([0;0;0;1],[1,2,2]) ) +%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat (zeros (3,2,2), ones (1,2,2)) ) + +%!error cat (3, cat (3, [], []), [1,2;3,4]) +%!error cat (3, zeros (0, 0, 2), [1,2;3,4]) +*/ + +static octave_value +do_permute (const octave_value_list& args, bool inv) +{ + octave_value retval; + + if (args.length () == 2 && args(1).length () >= args(1).ndims ()) + { + Array vec = args(1).int_vector_value (); + + // FIXME -- maybe we should create an idx_vector object + // here and pass that to permute? + + int n = vec.length (); + + for (int i = 0; i < n; i++) + vec(i)--; + + octave_value ret = args(0).permute (vec, inv); + + if (! error_state) + retval = ret; + } + else + print_usage (); + + return retval; +} + +DEFUN (permute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} permute (@var{A}, @var{perm})\n\ +Return the generalized transpose for an N-D array object @var{A}.\n\ +The permutation vector @var{perm} must contain the elements\n\ +@code{1:ndims (A)} (in any order, but each element must appear only once).\n\ +@seealso{ipermute}\n\ +@end deftypefn") +{ + return do_permute (args, false); +} + +DEFUN (ipermute, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ipermute (@var{A}, @var{iperm})\n\ +The inverse of the @code{permute} function. The expression\n\ +\n\ +@example\n\ +ipermute (permute (A, perm), perm)\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the original array @var{A}.\n\ +@seealso{permute}\n\ +@end deftypefn") +{ + return do_permute (args, true); +} + +DEFUN (length, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} length (@var{a})\n\ +Return the \"length\" of the object @var{a}. For matrix objects, the\n\ +length is the number of rows or columns, whichever is greater (this\n\ +odd definition is used for compatibility with @sc{matlab}).\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).length (); + else + print_usage (); + + return retval; +} + +DEFUN (ndims, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ndims (@var{a})\n\ +Return the number of dimensions of @var{a}.\n\ +For any array, the result will always be larger than or equal to 2.\n\ +Trailing singleton dimensions are not counted.\n\ +\n\ +@example\n\ +@group\n\ +ndims (ones (4, 1, 2, 1))\n\ + @result{} 3\n\ +@end group\n\ +@end example\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).ndims (); + else + print_usage (); + + return retval; +} + +DEFUN (numel, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} numel (@var{a})\n\ +@deftypefnx {Built-in Function} {} numel (@var{a}, @var{idx1}, @var{idx2}, @dots{})\n\ +Return the number of elements in the object @var{a}.\n\ +Optionally, if indices @var{idx1}, @var{idx2}, @dots{} are supplied,\n\ +return the number of elements that would result from the indexing\n\ +\n\ +@example\n\ +@var{a}(@var{idx1}, @var{idx2}, @dots{})\n\ +@end example\n\ +\n\ +Note that the indices do not have to be numerical. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{a} = 1;\n\ +@var{b} = ones (2, 3);\n\ +numel (@var{a}, @var{b})\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will return 6, as this is the number of ways to index with @var{b}.\n\ +\n\ +This method is also called when an object appears as lvalue with cs-list\n\ +indexing, i.e., @code{object@{@dots{}@}} or @code{object(@dots{}).field}.\n\ +@seealso{size}\n\ +@end deftypefn") +{ + octave_value retval; + octave_idx_type nargin = args.length (); + + if (nargin == 1) + retval = args(0).numel (); + else if (nargin > 1) + { + // Don't use numel (const octave_value_list&) here as that corresponds to + // an overloaded call, not to builtin! + retval = dims_to_numel (args(0).dims (), args.slice (1, nargin-1)); + } + else + print_usage (); + + return retval; +} + +DEFUN (size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size (@var{a})\n\ +@deftypefnx {Built-in Function} {} size (@var{a}, @var{dim})\n\ +Return the number of rows and columns of @var{a}.\n\ +\n\ +With one input argument and one output argument, the result is returned\n\ +in a row vector. If there are multiple output arguments, the number of\n\ +rows is assigned to the first, and the number of columns to the second,\n\ +etc. For example:\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6])\n\ + @result{} [ 3, 2 ]\n\ +\n\ +[nr, nc] = size ([1, 2; 3, 4; 5, 6])\n\ + @result{} nr = 3\n\ + @result{} nc = 2\n\ +@end group\n\ +@end example\n\ +\n\ +If given a second argument, @code{size} will return the size of the\n\ +corresponding dimension. For example,\n\ +\n\ +@example\n\ +@group\n\ +size ([1, 2; 3, 4; 5, 6], 2)\n\ + @result{} 2\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the number of columns in the given matrix.\n\ +@seealso{numel, ndims, length, rows, columns}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1) + { + const dim_vector dimensions = args(0).dims (); + + if (nargout > 1) + { + const dim_vector rdims = dimensions.redim (nargout); + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rdims(i); + } + else + { + int ndims = dimensions.length (); + + NoAlias m (1, ndims); + + for (int i = 0; i < ndims; i++) + m(i) = dimensions(i); + + retval(0) = m; + } + } + else if (nargin == 2 && nargout < 2) + { + octave_idx_type nd = args(1).int_value (true); + + if (error_state) + error ("size: DIM must be a scalar"); + else + { + const dim_vector dv = args(0).dims (); + + if (nd > 0) + { + if (nd <= dv.length ()) + retval(0) = dv(nd-1); + else + retval(0) = 1; + } + else + error ("size: requested dimension DIM (= %d) out of range", nd); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (size_equal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} size_equal (@var{a}, @var{b}, @dots{})\n\ +Return true if the dimensions of all arguments agree.\n\ +Trailing singleton dimensions are ignored.\n\ +Called with a single or no argument, size_equal returns true.\n\ +@seealso{size, numel, ndims}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + retval = true; + + if (nargin >= 1) + { + dim_vector a_dims = args(0).dims (); + + for (int i = 1; i < nargin; ++i) + { + dim_vector b_dims = args(i).dims (); + + if (a_dims != b_dims) + { + retval = false; + break; + } + } + } + + return retval; +} + +DEFUN (nnz, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nnz (@var{a})\n\ +Return the number of non zero elements in @var{a}.\n\ +@seealso{sparse, nzmax}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nnz (); + else + print_usage (); + + return retval; +} + +DEFUN (nzmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{scalar} =} nzmax (@var{SM})\n\ +Return the amount of storage allocated to the sparse matrix @var{SM}.\n\ +Note that Octave tends to crop unused memory at the first opportunity\n\ +for sparse objects. There are some cases of user created sparse objects\n\ +where the value returned by @dfn{nzmax} will not be the same as @dfn{nnz},\n\ +but in general they will give the same result.\n\ +@seealso{nnz, spalloc, sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).nzmax (); + else + print_usage (); + + return retval; +} + +DEFUN (rows, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rows (@var{a})\n\ +Return the number of rows of @var{a}.\n\ +@seealso{columns, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).rows (); + else + print_usage (); + + return retval; +} + +DEFUN (columns, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} columns (@var{a})\n\ +Return the number of columns of @var{a}.\n\ +@seealso{rows, size, length, numel, isscalar, isvector, ismatrix}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).columns (); + else + print_usage (); + + return retval; +} + +DEFUN (sum, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sum (@var{x})\n\ +@deftypefnx {Built-in Function} {} sum (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"native\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"double\")\n\ +@deftypefnx {Built-in Function} {} sum (@dots{}, \"extra\")\n\ +Sum of elements along dimension @var{dim}. If @var{dim} is\n\ +omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +If the optional argument \"native\" is given, then the sum is performed\n\ +in the same type as the original argument, rather than in the default\n\ +double type. For example:\n\ +\n\ +@example\n\ +@group\n\ +sum ([true, true])\n\ + @result{} 2\n\ +sum ([true, true], \"native\")\n\ + @result{} true\n\ +@end group\n\ +@end example\n\ +\n\ +On the contrary, if \"double\" is given, the sum is performed in double\n\ +precision even for single precision inputs.\n\ +\n\ +For double precision inputs, \"extra\" indicates that a more accurate\n\ +algorithm than straightforward summation is to be used. For single precision\n\ +inputs, \"extra\" is the same as \"double\". Otherwise, \"extra\" has no\n\ +effect.\n\ +@seealso{cumsum, sumsq, prod}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + bool isnative = false; + bool isdouble = false; + bool isextra = false; + + if (nargin > 1 && args(nargin - 1).is_string ()) + { + std::string str = args(nargin - 1).string_value (); + + if (! error_state) + { + if (str == "native") + isnative = true; + else if (str == "double") + isdouble = true; + else if (str == "extra") + isextra = true; + else + error ("sum: unrecognized string argument"); + nargin --; + } + } + + if (error_state) + return retval; + + if (nargin == 1 || nargin == 2) + { + octave_value arg = args(0); + + int dim = -1; + if (nargin == 2) + { + dim = args(1).int_value () - 1; + if (dim < 0) + error ("sum: invalid dimension DIM = %d", dim + 1); + } + + if (! error_state) + { + switch (arg.builtin_type ()) + { + case btyp_double: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.array_value ().xsum (dim); + else + retval = arg.array_value ().sum (dim); + break; + case btyp_complex: + if (arg.is_sparse_type ()) + { + if (isextra) + warning ("sum: 'extra' not yet implemented for sparse matrices"); + retval = arg.sparse_complex_matrix_value ().sum (dim); + } + else if (isextra) + retval = arg.complex_array_value ().xsum (dim); + else + retval = arg.complex_array_value ().sum (dim); + break; + case btyp_float: + if (isdouble || isextra) + retval = arg.float_array_value ().dsum (dim); + else + retval = arg.float_array_value ().sum (dim); + break; + case btyp_float_complex: + if (isdouble || isextra) + retval = arg.float_complex_array_value ().dsum (dim); + else + retval = arg.float_complex_array_value ().sum (dim); + break; + +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + if (isnative) \ + retval = arg.X ## _array_value ().sum (dim); \ + else \ + retval = arg.X ## _array_value ().dsum (dim); \ + break + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + + case btyp_bool: + if (arg.is_sparse_type ()) + { + if (isnative) + retval = arg.sparse_bool_matrix_value ().any (dim); + else + retval = arg.sparse_bool_matrix_value ().sum (dim); + } + else if (isnative) + retval = arg.bool_array_value ().any (dim); + else + retval = arg.bool_array_value ().sum (dim); + break; + + default: + gripe_wrong_type_arg ("sum", arg); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!assert (sum ([true,true]), 2) +%!assert (sum ([true,true],"native"), true) +%!assert (sum (int8 ([127,10,-20])), 117) +%!assert (sum (int8 ([127,10,-20]),'native'), int8 (107)) + +%!assert (sum ([1, 2, 3]), 6) +%!assert (sum ([-1; -2; -3]), -6) +%!assert (sum ([i, 2+i, -3+2i, 4]), 3+4i) +%!assert (sum ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i]), [2+2i, 4+4i, 6+6i]) + +%!assert (sum (single ([1, 2, 3])), single (6)) +%!assert (sum (single ([-1; -2; -3])), single (-6)) +%!assert (sum (single ([i, 2+i, -3+2i, 4])), single (3+4i)) +%!assert (sum (single ([1, 2, 3; i, 2i, 3i; 1+i, 2+2i, 3+3i])), single ([2+2i, 4+4i, 6+6i])) + +%!assert (sum ([1, 2; 3, 4], 1), [4, 6]) +%!assert (sum ([1, 2; 3, 4], 2), [3; 7]) +%!assert (sum (zeros (1, 0)), 0) +%!assert (sum (zeros (1, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (1, 0), 2), 0) +%!assert (sum (zeros (0, 1)), 0) +%!assert (sum (zeros (0, 1), 1), 0) +%!assert (sum (zeros (0, 1), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 0)), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 1), zeros (1, 0)) +%!assert (sum (zeros (2, 0), 2), [0; 0]) +%!assert (sum (zeros (0, 2)), [0, 0]) +%!assert (sum (zeros (0, 2), 1), [0, 0]) +%!assert (sum (zeros (0, 2), 2), zeros (0, 1)) +%!assert (sum (zeros (2, 2, 0, 3)), zeros (1, 2, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 2), zeros (2, 1, 0, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 3), zeros (2, 2, 1, 3)) +%!assert (sum (zeros (2, 2, 0, 3), 4), zeros (2, 2, 0)) +%!assert (sum (zeros (2, 2, 0, 3), 7), zeros (2, 2, 0, 3)) + +%!assert (sum (single ([1, 2; 3, 4]), 1), single ([4, 6])) +%!assert (sum (single ([1, 2; 3, 4]), 2), single ([3; 7])) +%!assert (sum (zeros (1, 0, "single")), single (0)) +%!assert (sum (zeros (1, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (1, 0, "single"), 2), single (0)) +%!assert (sum (zeros (0, 1, "single")), single (0)) +%!assert (sum (zeros (0, 1, "single"), 1), single (0)) +%!assert (sum (zeros (0, 1, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 0, "single")), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 1), zeros (1, 0, "single")) +%!assert (sum (zeros (2, 0, "single"), 2), single ([0; 0])) +%!assert (sum (zeros (0, 2, "single")), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 1), single ([0, 0])) +%!assert (sum (zeros (0, 2, "single"), 2), zeros (0, 1, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single")), zeros (1, 2, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 2), zeros (2, 1, 0, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 3), zeros (2, 2, 1, 3, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 4), zeros (2, 2, 0, "single")) +%!assert (sum (zeros (2, 2, 0, 3, "single"), 7), zeros (2, 2, 0, 3, "single")) + +%!error sum () +*/ + +DEFUN (sumsq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sumsq (@var{x})\n\ +@deftypefnx {Built-in Function} {} sumsq (@var{x}, @var{dim})\n\ +Sum of squares of elements along dimension @var{dim}. If @var{dim}\n\ +is omitted, it defaults to the first non-singleton dimension.\n\ +\n\ +This function is conceptually equivalent to computing\n\ +\n\ +@example\n\ +sum (x .* conj (x), dim)\n\ +@end example\n\ +\n\ +@noindent\n\ +but it uses less memory and avoids calling @code{conj} if @var{x} is real.\n\ +@seealso{sum, prod}\n\ +@end deftypefn") +{ + DATA_REDUCTION (sumsq); +} + +/* +%!assert (sumsq ([1, 2, 3]), 14) +%!assert (sumsq ([-1; -2; 4i]), 21) +%!assert (sumsq ([1, 2, 3; 2, 3, 4; 4i, 6i, 2]), [21, 49, 29]) + +%!assert (sumsq (single ([1, 2, 3])), single (14)) +%!assert (sumsq (single ([-1; -2; 4i])), single (21)) +%!assert (sumsq (single ([1, 2, 3; 2, 3, 4; 4i, 6i, 2])), single ([21, 49, 29])) + +%!assert (sumsq ([1, 2; 3, 4], 1), [10, 20]) +%!assert (sumsq ([1, 2; 3, 4], 2), [5; 25]) + +%!assert (sumsq (single ([1, 2; 3, 4]), 1), single ([10, 20])) +%!assert (sumsq (single ([1, 2; 3, 4]), 2), single ([5; 25])) + +%!error sumsq () +*/ + +DEFUN (islogical, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} islogical (@var{x})\n\ +@deftypefnx {Built-in Function} {} isbool (@var{x})\n\ +Return true if @var{x} is a logical object.\n\ +@seealso{isfloat, isinteger, ischar, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_bool_type (); + else + print_usage (); + + return retval; +} + +DEFALIAS (isbool, islogical); + +/* +%!assert (islogical (true), true) +%!assert (islogical (false), true) +%!assert (islogical ([true, false]), true) +%!assert (islogical (1), false) +%!assert (islogical (1i), false) +%!assert (islogical ([1,1]), false) +%!assert (islogical (single (1)), false) +%!assert (islogical (single (1i)), false) +%!assert (islogical (single ([1,1])), false) +%!assert (islogical (sparse ([true, false])), true) +%!assert (islogical (sparse ([1, 0])), false) +*/ + +DEFUN (isinteger, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isinteger (@var{x})\n\ +Return true if @var{x} is an integer object (int8, uint8, int16, etc.).\n\ +Note that @w{@code{isinteger (14)}} is false because numeric constants in\n\ +Octave are double precision floating point values.\n\ +@seealso{isfloat, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_integer_type (); + else + print_usage (); + + return retval; +} + +DEFUN (iscomplex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iscomplex (@var{x})\n\ +Return true if @var{x} is a complex-valued numeric object.\n\ +@seealso{isreal, isnumeric, islogical, ischar, isfloat, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_complex_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isfloat, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isfloat (@var{x})\n\ +Return true if @var{x} is a floating-point numeric object.\n\ +Objects of class double or single are floating-point objects.\n\ +@seealso{isinteger, ischar, islogical, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_float_type (); + else + print_usage (); + + return retval; +} + +// FIXME -- perhaps this should be implemented with an +// octave_value member function? + +DEFUN (complex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} complex (@var{x})\n\ +@deftypefnx {Built-in Function} {} complex (@var{re}, @var{im})\n\ +Return a complex result from real arguments. With 1 real argument @var{x},\n\ +return the complex result @code{@var{x} + 0i}. With 2 real arguments,\n\ +return the complex result @code{@var{re} + @var{im}}. @code{complex} can\n\ +often be more convenient than expressions such as @code{a + i*b}.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +complex ([1, 2], [3, 4])\n\ + @result{} [ 1 + 3i 2 + 4i ]\n\ +@end group\n\ +@end example\n\ +@seealso{real, imag, iscomplex, abs, arg}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_complex_type ()) + retval = arg; + else + { + if (arg.is_sparse_type ()) + { + SparseComplexMatrix val = arg.sparse_complex_matrix_value (); + + if (! error_state) + retval = octave_value (new octave_sparse_complex_matrix (val)); + } + else if (arg.is_single_type ()) + { + if (arg.numel () == 1) + { + FloatComplex val = arg.float_complex_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (val)); + } + else + { + FloatComplexNDArray val = arg.float_complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex_matrix (val)); + } + } + else + { + if (arg.numel () == 1) + { + Complex val = arg.complex_value (); + + if (! error_state) + retval = octave_value (new octave_complex (val)); + } + else + { + ComplexNDArray val = arg.complex_array_value (); + + if (! error_state) + retval = octave_value (new octave_complex_matrix (val)); + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + } + else if (nargin == 2) + { + octave_value re = args(0); + octave_value im = args(1); + + if (re.is_sparse_type () && im.is_sparse_type ()) + { + const SparseMatrix re_val = re.sparse_matrix_value (); + const SparseMatrix im_val = im.sparse_matrix_value (); + + if (!error_state) + { + if (re.numel () == 1) + { + SparseComplexMatrix result; + if (re_val.nnz () == 0) + result = Complex (0, 1) * SparseComplexMatrix (im_val); + else + { + result = SparseComplexMatrix (im_val.dims (), re_val (0)); + octave_idx_type nr = im_val.rows (); + octave_idx_type nc = im_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = im_val.cidx (j); + i < im_val.cidx (j + 1); i++) + result.data (im_val.ridx (i) + off) = + result.data (im_val.ridx (i) + off) + + Complex (0, im_val.data (i)); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else if (im.numel () == 1) + { + SparseComplexMatrix result; + if (im_val.nnz () == 0) + result = SparseComplexMatrix (re_val); + else + { + result = SparseComplexMatrix (re_val.rows (), re_val.cols (), Complex (0, im_val (0))); + octave_idx_type nr = re_val.rows (); + octave_idx_type nc = re_val.cols (); + + for (octave_idx_type j = 0; j < nc; j++) + { + octave_idx_type off = j * nr; + for (octave_idx_type i = re_val.cidx (j); + i < re_val.cidx (j + 1); i++) + result.data (re_val.ridx (i) + off) = + result.data (re_val.ridx (i) + off) + + re_val.data (i); + } + } + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + { + if (re_val.dims () == im_val.dims ()) + { + SparseComplexMatrix result = SparseComplexMatrix (re_val) + + Complex (0, 1) * SparseComplexMatrix (im_val); + retval = octave_value (new octave_sparse_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + else if (re.is_single_type () || im.is_single_type ()) + { + if (re.numel () == 1) + { + float re_val = re.float_value (); + + if (im.numel () == 1) + { + float im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_float_complex (FloatComplex (re_val, im_val))); + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + FloatComplexNDArray result (im_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val, im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + } + else + { + const FloatNDArray re_val = re.float_array_value (); + + if (im.numel () == 1) + { + float im_val = im.float_value (); + + if (! error_state) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + } + else + { + const FloatNDArray im_val = im.float_array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + FloatComplexNDArray result (re_val.dims (), FloatComplex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = FloatComplex (re_val(i), im_val(i)); + + retval = octave_value (new octave_float_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + } + else if (re.numel () == 1) + { + double re_val = re.double_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + retval = octave_value (new octave_complex (Complex (re_val, im_val))); + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + ComplexNDArray result (im_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < im_val.numel (); i++) + result.xelem (i) = Complex (re_val, im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + } + else + { + const NDArray re_val = re.array_value (); + + if (im.numel () == 1) + { + double im_val = im.double_value (); + + if (! error_state) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val); + + retval = octave_value (new octave_complex_matrix (result)); + } + } + else + { + const NDArray im_val = im.array_value (); + + if (! error_state) + { + if (re_val.dims () == im_val.dims ()) + { + ComplexNDArray result (re_val.dims (), Complex ()); + + for (octave_idx_type i = 0; i < re_val.numel (); i++) + result.xelem (i) = Complex (re_val(i), im_val(i)); + + retval = octave_value (new octave_complex_matrix (result)); + } + else + error ("complex: dimension mismatch"); + } + } + } + + if (error_state) + error ("complex: invalid conversion"); + } + else + print_usage (); + + return retval; +} + +DEFUN (isreal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isreal (@var{x})\n\ +Return true if @var{x} is a non-complex matrix or scalar.\n\ +For compatibility with @sc{matlab}, this includes logical and character\n\ +matrices.\n\ +@seealso{iscomplex, isnumeric, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_real_type (); + else + print_usage (); + + return retval; +} + +DEFUN (isempty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isempty (@var{a})\n\ +Return true if @var{a} is an empty matrix (any one of its dimensions is\n\ +zero). Otherwise, return false.\n\ +@seealso{isnull, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = args(0).is_empty (); + else + print_usage (); + + return retval; +} + +DEFUN (isnumeric, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isnumeric (@var{x})\n\ +Return true if @var{x} is a numeric object, i.e., an integer, real, or\n\ +complex array. Logical and character arrays are not considered to be\n\ +numeric.\n\ +@seealso{isinteger, isfloat, isreal, iscomplex, islogical, ischar, iscell, isstruct, isa}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_numeric_type (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (1), true) +%!assert (isnumeric (1i), true) +%!assert (isnumeric ([1,1]), true) +%!assert (isnumeric (single (1)), true) +%!assert (isnumeric (single (1i)), true) +%!assert (isnumeric (single ([1,1])), true) +%!assert (isnumeric (int8 (1)), true) +%!assert (isnumeric (uint8 ([1,1])), true) +%!assert (isnumeric ("Hello World"), false) +%!assert (isnumeric (true), false) +%!assert (isnumeric (false), false) +%!assert (isnumeric ([true, false]), false) +%!assert (isnumeric (sparse ([true, false])), false) +*/ + +DEFUN (ismatrix, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ismatrix (@var{a})\n\ +Return true if @var{a} is a numeric, logical, or character matrix.\n\ +Scalars (1x1 matrices) and vectors (@nospell{1xN} or @nospell{Nx1} matrices)\n\ +are subsets of the more general N-dimensional matrix and @code{ismatrix}\n\ +will return true for these objects as well.\n\ +@seealso{isscalar, isvector, iscell, isstruct, issparse, isa}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + { + octave_value arg = args(0); + + retval = arg.is_matrix_type () || arg.is_scalar_type () || arg.is_range (); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (ismatrix ([])) +%!assert (ismatrix (1)) +%!assert (ismatrix ([1, 2, 3])) +%!assert (ismatrix ([1, 2; 3, 4])) +%!assert (ismatrix (zeros (3, 2, 4))) + +%!assert (ismatrix (single ([]))) +%!assert (ismatrix (single (1))) +%!assert (ismatrix (single ([1, 2, 3]))) +%!assert (ismatrix (single ([1, 2; 3, 4]))) + +%!assert (ismatrix ("t")) +%!assert (ismatrix ("test")) +%!assert (ismatrix (["test"; "ing"])) + +%!test +%! s.a = 1; +%! assert (ismatrix (s), false); + +%!error ismatrix () +%!error ismatrix ([1, 2; 3, 4], 2) +*/ + +static octave_value +fill_matrix (const octave_value_list& args, int val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // FIXME -- perhaps this should be made extensible by + // using the class name to lookup a function to call to create + // the new value. + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = int8NDArray (dims, val); + break; + + case oct_data_conv::dt_uint8: + retval = uint8NDArray (dims, val); + break; + + case oct_data_conv::dt_int16: + retval = int16NDArray (dims, val); + break; + + case oct_data_conv::dt_uint16: + retval = uint16NDArray (dims, val); + break; + + case oct_data_conv::dt_int32: + retval = int32NDArray (dims, val); + break; + + case oct_data_conv::dt_uint32: + retval = uint32NDArray (dims, val); + break; + + case oct_data_conv::dt_int64: + retval = int64NDArray (dims, val); + break; + + case oct_data_conv::dt_uint64: + retval = uint64NDArray (dims, val); + break; + + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, val); + break; + + case oct_data_conv::dt_double: + { + if (val == 1 && dims.length () == 2 && dims (0) == 1) + retval = Range (1.0, 0.0, dims (1)); // packed form + else + retval = NDArray (dims, val); + } + break; + + case oct_data_conv::dt_logical: + retval = boolNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, float fval, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, fval); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, double val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = NDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, const Complex& val, + const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + dim_vector dims (1, 1); + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_single: + retval = FloatComplexNDArray (dims, static_cast (val)); + break; + + case oct_data_conv::dt_double: + retval = ComplexNDArray (dims, val); + break; + + default: + error ("%s: invalid class name", fcn); + break; + } + } + } + + return retval; +} + +static octave_value +fill_matrix (const octave_value_list& args, bool val, const char *fcn) +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector dims (1, 1); + + switch (nargin) + { + case 0: + break; + + case 1: + get_dimensions (args(0), fcn, dims); + break; + + default: + { + dims.resize (nargin); + + for (int i = 0; i < nargin; i++) + { + dims(i) = args(i).is_empty () ? 0 : args(i).idx_type_value (); + + if (error_state) + { + error ("%s: expecting scalar integer arguments", fcn); + break; + } + } + } + break; + } + + if (! error_state) + { + dims.chop_trailing_singletons (); + + check_dimensions (dims, fcn); + + // Note that automatic narrowing will handle conversion from + // NDArray to scalar. + + if (! error_state) + retval = boolNDArray (dims, val); + } + + return retval; +} + +DEFUN (ones, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ones (@var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} ones (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} ones ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} ones (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 1.\n\ +If invoked with a single scalar integer argument @var{n}, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +If you need to create a matrix whose values are all the same, you should\n\ +use an expression like\n\ +\n\ +@example\n\ +val_matrix = val * ones (m, n)\n\ +@end example\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = ones (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{zeros}\n\ +@end deftypefn") +{ + return fill_matrix (args, 1, "ones"); +} + +/* +%!assert (ones (3), [1, 1, 1; 1, 1, 1; 1, 1, 1]) +%!assert (ones (2, 3), [1, 1, 1; 1, 1, 1]) +%!assert (ones (3, 2), [1, 1; 1, 1; 1, 1]) +%!assert (size (ones (3, 4, 5)), [3, 4, 5]) + +%!assert (ones (3, "single"), single ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "single"), single ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "single"), single ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (ones (3, "int8"), int8 ([1, 1, 1; 1, 1, 1; 1, 1, 1])) +%!assert (ones (2, 3, "int8"), int8 ([1, 1, 1; 1, 1, 1])) +%!assert (ones (3, 2, "int8"), int8 ([1, 1; 1, 1; 1, 1])) +%!assert (size (ones (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (zeros, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} zeros (@var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} zeros (@var{m}, @var{n}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} zeros ([@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} zeros (@dots{}, @var{class})\n\ +Return a matrix or N-dimensional array whose elements are all 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +@nospell{NxN} matrix. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +the given dimensions.\n\ +\n\ +The optional argument @var{class} specifies the class of the return array\n\ +and defaults to double. For example:\n\ +\n\ +@example\n\ +val = zeros (m,n, \"uint8\")\n\ +@end example\n\ +@seealso{ones}\n\ +@end deftypefn") +{ + return fill_matrix (args, 0, "zeros"); +} + +/* +%!assert (zeros (3), [0, 0, 0; 0, 0, 0; 0, 0, 0]) +%!assert (zeros (2, 3), [0, 0, 0; 0, 0, 0]) +%!assert (zeros (3, 2), [0, 0; 0, 0; 0, 0]) +%!assert (size (zeros (3, 4, 5)), [3, 4, 5]) + +%!assert (zeros (3, "single"), single ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "single"), single ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "single"), single ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "single")), [3, 4, 5]) + +%!assert (zeros (3, "int8"), int8 ([0, 0, 0; 0, 0, 0; 0, 0, 0])) +%!assert (zeros (2, 3, "int8"), int8 ([0, 0, 0; 0, 0, 0])) +%!assert (zeros (3, 2, "int8"), int8 ([0, 0; 0, 0; 0, 0])) +%!assert (size (zeros (3, 4, 5, "int8")), [3, 4, 5]) +*/ + +DEFUN (Inf, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex inf\n\ +\n\ +@deftypefn {Built-in Function} {} Inf\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} Inf (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} Inf (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the IEEE representation for positive infinity.\n\ +\n\ +Infinity is produced when results are too large to be represented using the\n\ +the IEEE floating point format for numbers. Two common examples which\n\ +produce infinity are division by zero and overflow.\n\ +\n\ +@example\n\ +@group\n\ +[ 1/0 e^800 ]\n\ +@result{} Inf Inf\n\ +@end group\n\ +@end example\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{Inf}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isinf, NaN}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_inf_value (), + lo_ieee_float_inf_value (), "Inf"); +} + +DEFALIAS (inf, Inf); + +/* +%!assert (inf (3), [Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (2, 3), [Inf, Inf, Inf; Inf, Inf, Inf]) +%!assert (inf (3, 2), [Inf, Inf; Inf, Inf; Inf, Inf]) +%!assert (size (inf (3, 4, 5)), [3, 4, 5]) + +%!assert (inf (3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (2, 3, "single"), single ([Inf, Inf, Inf; Inf, Inf, Inf])) +%!assert (inf (3, 2, "single"), single ([Inf, Inf; Inf, Inf; Inf, Inf])) +%!assert (size (inf (3, 4, 5, "single")), [3, 4, 5]) + +%!error (inf (3, "int8")) +%!error (inf (2, 3, "int8")) +%!error (inf (3, 2, "int8")) +%!error (inf (3, 4, 5, "int8")) +*/ + +DEFUN (NaN, args, , + "-*- texinfo -*-\n\ +@c List other form of function in documentation index\n\ +@findex nan\n\ +\n\ +@deftypefn {Built-in Function} {} NaN\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NaN (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NaN (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the IEEE symbol NaN (Not a Number).\n\ +NaN is the result of operations which do not produce a well defined numerical\n\ +result. Common operations which produce a NaN are arithmetic with infinity\n\ +@tex\n\ +($\\infty - \\infty$), zero divided by zero ($0/0$),\n\ +@end tex\n\ +@ifnottex\n\ +(Inf - Inf), zero divided by zero (0/0),\n\ +@end ifnottex\n\ +and any operation involving another NaN value (5 + NaN).\n\ +\n\ +Note that NaN always compares not equal to NaN (NaN != NaN). This behavior\n\ +is specified by the IEEE standard for floating point arithmetic. To\n\ +find NaN values, use the @code{isnan} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NaN}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isnan, Inf}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "NaN"); +} + +DEFALIAS (nan, NaN); + +/* +%!assert (NaN (3), [NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (2, 3), [NaN, NaN, NaN; NaN, NaN, NaN]) +%!assert (NaN (3, 2), [NaN, NaN; NaN, NaN; NaN, NaN]) +%!assert (size (NaN (3, 4, 5)), [3, 4, 5]) + +%!assert (NaN (3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (2, 3, "single"), single ([NaN, NaN, NaN; NaN, NaN, NaN])) +%!assert (NaN (3, 2, "single"), single ([NaN, NaN; NaN, NaN; NaN, NaN])) +%!assert (size (NaN (3, 4, 5, "single")), [3, 4, 5]) + +%!error (NaN (3, "int8")) +%!error (NaN (2, 3, "int8")) +%!error (NaN (3, 2, "int8")) +%!error (NaN (3, 4, 5, "int8")) +*/ + +DEFUN (e, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} e\n\ +@deftypefnx {Built-in Function} {} e (@var{n})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} e (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} e (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the base of natural logarithms. The constant\n\ +@tex\n\ +$e$ satisfies the equation $\\log (e) = 1$.\n\ +@end tex\n\ +@ifnottex\n\ +@samp{e} satisfies the equation @code{log} (e) = 1.\n\ +@end ifnottex\n\ +\n\ +When called with no arguments, return a scalar with the value @math{e}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{log, exp, pi, i, j}\n\ +@end deftypefn") +{ +#if defined (M_E) + double e_val = M_E; +#else + double e_val = exp (1.0); +#endif + + return fill_matrix (args, e_val, "e"); +} + +DEFUN (eps, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eps\n\ +@deftypefnx {Built-in Function} {} eps (@var{x})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} eps (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} eps (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all eps,\n\ +the machine precision. More precisely, @code{eps} is the relative spacing\n\ +between any two adjacent numbers in the machine's floating point system.\n\ +This number is obviously system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{eps} is approximately\n\ +@tex\n\ +$2.2204\\times10^{-16}$ for double precision and $1.1921\\times10^{-7}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2204e-16 for double precision and 1.1921e-07\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{eps (1.0)}.\n\ +Given a single argument @var{x}, return the distance between @var{x} and\n\ +the next largest value.\n\ +When called with more than one argument the first two arguments are taken as\n\ +the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, realmin, intmax, bitmax}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 1 && ! args(0).is_string ()) + { + if (args(0).is_single_type ()) + { + float val = args(0).float_value (); + + if (! error_state) + { + val = ::fabsf (val); + if (xisnan (val) || xisinf (val)) + retval = fill_matrix (octave_value ("single"), + lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "eps"); + else if (val < FLT_MIN) + retval = fill_matrix (octave_value ("single"), 0e0, + powf (2.0, -149e0), "eps"); + else + { + int expon; + frexpf (val, &expon); + val = std::pow (static_cast (2.0), + static_cast (expon - 24)); + retval = fill_matrix (octave_value ("single"), DBL_EPSILON, + val, "eps"); + } + } + } + else + { + double val = args(0).double_value (); + + if (! error_state) + { + val = ::fabs (val); + if (xisnan (val) || xisinf (val)) + retval = fill_matrix (octave_value_list (), + lo_ieee_nan_value (), + lo_ieee_float_nan_value (), "eps"); + else if (val < DBL_MIN) + retval = fill_matrix (octave_value_list (), + pow (2.0, -1074e0), 0e0, "eps"); + else + { + int expon; + frexp (val, &expon); + val = std::pow (static_cast (2.0), + static_cast (expon - 53)); + retval = fill_matrix (octave_value_list (), val, + FLT_EPSILON, "eps"); + } + } + } + } + else + retval = fill_matrix (args, DBL_EPSILON, FLT_EPSILON, "eps"); + + return retval; +} + +/* +%!assert (eps (1/2), 2^(-53)) +%!assert (eps (1), 2^(-52)) +%!assert (eps (2), 2^(-51)) +%!assert (eps (realmax), 2^971) +%!assert (eps (0), 2^(-1074)) +%!assert (eps (realmin/2), 2^(-1074)) +%!assert (eps (realmin/16), 2^(-1074)) +%!assert (eps (Inf), NaN) +%!assert (eps (NaN), NaN) +%!assert (eps (single (1/2)), single (2^(-24))) +%!assert (eps (single (1)), single (2^(-23))) +%!assert (eps (single (2)), single (2^(-22))) +%!assert (eps (realmax ("single")), single (2^104)) +%!assert (eps (single (0)), single (2^(-149))) +%!assert (eps (realmin ("single")/2), single (2^(-149))) +%!assert (eps (realmin ("single")/16), single (2^(-149))) +%!assert (eps (single (Inf)), single (NaN)) +%!assert (eps (single (NaN)), single (NaN)) +*/ + +DEFUN (pi, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pi\n\ +@deftypefnx {Built-in Function} {} pi (@var{n})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} pi (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} pi (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the ratio of the circumference of a circle to its\n\ +@tex\n\ +diameter($\\pi$).\n\ +@end tex\n\ +@ifnottex\n\ +diameter.\n\ +@end ifnottex\n\ +Internally, @code{pi} is computed as @samp{4.0 * atan (1.0)}.\n\ +\n\ +When called with no arguments, return a scalar with the value of\n\ +@tex\n\ +$\\pi$.\n\ +@end tex\n\ +@ifnottex\n\ +pi.\n\ +@end ifnottex\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, i, j}\n\ +@end deftypefn") +{ +#if defined (M_PI) + double pi_val = M_PI; +#else + double pi_val = 4.0 * atan (1.0); +#endif + + return fill_matrix (args, pi_val, "pi"); +} + +DEFUN (realmax, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmax\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmax (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmax (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the largest floating point number that is representable. The actual\n\ +value is system dependent. On machines that support IEEE\n\ +floating point arithmetic, @code{realmax} is approximately\n\ +@tex\n\ +$1.7977\\times10^{308}$ for double precision and $3.4028\\times10^{38}$\n\ +@end tex\n\ +@ifnottex\n\ +1.7977e+308 for double precision and 3.4028e+38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmax (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmin, intmax, bitmax, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, DBL_MAX, FLT_MAX, "realmax"); +} + +DEFUN (realmin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} realmin\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} realmin (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} realmin (@dots{}, @var{class})\n\ +Return a scalar, matrix or N-dimensional array whose elements are all equal\n\ +to the smallest normalized floating point number that is representable.\n\ +The actual value is system dependent. On machines that support\n\ +IEEE floating point arithmetic, @code{realmin} is approximately\n\ +@tex\n\ +$2.2251\\times10^{-308}$ for double precision and $1.1755\\times10^{-38}$\n\ +@end tex\n\ +@ifnottex\n\ +2.2251e-308 for double precision and 1.1755e-38\n\ +@end ifnottex\n\ +for single precision.\n\ +\n\ +When called with no arguments, return a scalar with the value\n\ +@code{realmin (\"double\")}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{realmax, intmin, eps}\n\ +@end deftypefn") +{ + return fill_matrix (args, DBL_MIN, FLT_MIN, "realmin"); +} + +DEFUN (I, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex i\n\ +@findex j\n\ +@findex J\n\ +\n\ +@deftypefn {Built-in Function} {} I\n\ +@deftypefnx {Built-in Function} {} I (@var{n})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} I (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} I (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the pure imaginary unit, defined as\n\ +@tex\n\ +$\\sqrt{-1}$.\n\ +@end tex\n\ +@ifnottex\n\ +@code{sqrt (-1)}.\n\ +@end ifnottex\n\ +\n\ +I, and its equivalents i, j, and J, are functions so any of the names may\n\ +be reused for other purposes (such as i for a counter variable).\n\ +\n\ +When called with no arguments, return a scalar with the value @math{i}. When\n\ +called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{e, pi, log, exp, i, j, J}\n\ +@end deftypefn") +{ + return fill_matrix (args, Complex (0.0, 1.0), "I"); +} + +DEFALIAS (i, I); +DEFALIAS (J, I); +DEFALIAS (j, I); + +DEFUN (NA, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} NA\n\ +@deftypefnx {Built-in Function} {} NA (@var{n})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} NA (@var{n}, @var{m}, @var{k}, @dots{})\n\ +@deftypefnx {Built-in Function} {} NA (@dots{}, @var{class})\n\ +Return a scalar, matrix, or N-dimensional array whose elements are all equal\n\ +to the special constant used to designate missing values.\n\ +\n\ +Note that NA always compares not equal to NA (NA != NA).\n\ +To find NA values, use the @code{isna} function.\n\ +\n\ +When called with no arguments, return a scalar with the value @samp{NA}.\n\ +When called with a single argument, return a square matrix with the dimension\n\ +specified. When called with more than one scalar argument the first two\n\ +arguments are taken as the number of rows and columns and any further\n\ +arguments specify additional matrix dimensions.\n\ +The optional argument @var{class} specifies the return type and may be\n\ +either \"double\" or \"single\".\n\ +@seealso{isna}\n\ +@end deftypefn") +{ + return fill_matrix (args, lo_ieee_na_value (), + lo_ieee_float_na_value (), "NA"); +} + +/* +%!assert (single (NA ("double")), NA ("single")) +%!assert (double (NA ("single")), NA ("double")) +*/ + +DEFUN (false, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} false (@var{x})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} false (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 0.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{true}\n\ +@end deftypefn") +{ + return fill_matrix (args, false, "false"); +} + +DEFUN (true, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} true (@var{x})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m})\n\ +@deftypefnx {Built-in Function} {} true (@var{n}, @var{m}, @var{k}, @dots{})\n\ +Return a matrix or N-dimensional array whose elements are all logical 1.\n\ +If invoked with a single scalar integer argument, return a square\n\ +matrix of the specified size. If invoked with two or more scalar\n\ +integer arguments, or a vector of integer values, return an array with\n\ +given dimensions.\n\ +@seealso{false}\n\ +@end deftypefn") +{ + return fill_matrix (args, true, "true"); +} + +template +octave_value +identity_matrix (int nr, int nc) +{ + octave_value retval; + + typename MT::element_type one (1); + + if (nr == 1 && nc == 1) + retval = one; + else + { + dim_vector dims (nr, nc); + + typename MT::element_type zero (0); + + MT m (dims, zero); + + if (nr > 0 && nc > 0) + { + int n = std::min (nr, nc); + + for (int i = 0; i < n; i++) + m(i,i) = one; + } + + retval = m; + } + + return retval; +} + +#define INSTANTIATE_EYE(T) \ + template octave_value identity_matrix (int, int) + +INSTANTIATE_EYE (int8NDArray); +INSTANTIATE_EYE (uint8NDArray); +INSTANTIATE_EYE (int16NDArray); +INSTANTIATE_EYE (uint16NDArray); +INSTANTIATE_EYE (int32NDArray); +INSTANTIATE_EYE (uint32NDArray); +INSTANTIATE_EYE (int64NDArray); +INSTANTIATE_EYE (uint64NDArray); +INSTANTIATE_EYE (FloatNDArray); +INSTANTIATE_EYE (NDArray); +INSTANTIATE_EYE (boolNDArray); + +static octave_value +identity_matrix (int nr, int nc, oct_data_conv::data_type dt) +{ + octave_value retval; + + // FIXME -- perhaps this should be made extensible by using + // the class name to lookup a function to call to create the new + // value. + + if (! error_state) + { + switch (dt) + { + case oct_data_conv::dt_int8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint8: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint16: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint32: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_int64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_uint64: + retval = identity_matrix (nr, nc); + break; + + case oct_data_conv::dt_single: + retval = FloatDiagMatrix (nr, nc, 1.0f); + break; + + case oct_data_conv::dt_double: + retval = DiagMatrix (nr, nc, 1.0); + break; + + case oct_data_conv::dt_logical: + retval = identity_matrix (nr, nc); + break; + + default: + error ("eye: invalid class name"); + break; + } + } + + return retval; +} + +#undef INT_EYE_MATRIX + +DEFUN (eye, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eye (@var{n})\n\ +@deftypefnx {Built-in Function} {} eye (@var{m}, @var{n})\n\ +@deftypefnx {Built-in Function} {} eye ([@var{m} @var{n}])\n\ +@deftypefnx {Built-in Function} {} eye (@dots{}, @var{class})\n\ +Return an identity matrix. If invoked with a single scalar argument @var{n},\n\ +return a square @nospell{NxN} identity matrix. If\n\ +supplied two scalar arguments (@var{m}, @var{n}), @code{eye} takes them to be\n\ +the number of rows and columns. If given a vector with two elements,\n\ +@code{eye} uses the values of the elements as the number of rows and columns,\n\ +respectively. For example:\n\ +\n\ +@example\n\ +@group\n\ +eye (3)\n\ + @result{} 1 0 0\n\ + 0 1 0\n\ + 0 0 1\n\ +@end group\n\ +@end example\n\ +\n\ +The following expressions all produce the same result:\n\ +\n\ +@example\n\ +@group\n\ +eye (2)\n\ +@equiv{}\n\ +eye (2, 2)\n\ +@equiv{}\n\ +eye (size ([1, 2; 3, 4])\n\ +@end group\n\ +@end example\n\ +\n\ +The optional argument @var{class}, allows @code{eye} to return an array of\n\ +the specified type, like\n\ +\n\ +@example\n\ +val = zeros (n,m, \"uint8\")\n\ +@end example\n\ +\n\ +Calling @code{eye} with no arguments is equivalent to calling it\n\ +with an argument of 1. Any negative dimensions are treated as zero. \n\ +These odd definitions are for compatibility with @sc{matlab}.\n\ +@seealso{speye, ones, zeros}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + oct_data_conv::data_type dt = oct_data_conv::dt_double; + + // Check for type information. + + if (nargin > 0 && args(nargin-1).is_string ()) + { + std::string nm = args(nargin-1).string_value (); + nargin--; + + dt = oct_data_conv::string_to_data_type (nm); + + if (error_state) + return retval; + } + + switch (nargin) + { + case 0: + retval = identity_matrix (1, 1, dt); + break; + + case 1: + { + octave_idx_type nr, nc; + get_dimensions (args(0), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + case 2: + { + octave_idx_type nr, nc; + get_dimensions (args(0), args(1), "eye", nr, nc); + + if (! error_state) + retval = identity_matrix (nr, nc, dt); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +/* +%!assert (full (eye (3)), [1, 0, 0; 0, 1, 0; 0, 0, 1]) +%!assert (full (eye (2, 3)), [1, 0, 0; 0, 1, 0]) + +%!assert (full (eye (3,"single")), single ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (full (eye (2, 3,"single")), single ([1, 0, 0; 0, 1, 0])) + +%!assert (eye (3, "int8"), int8 ([1, 0, 0; 0, 1, 0; 0, 0, 1])) +%!assert (eye (2, 3, "int8"), int8 ([1, 0, 0; 0, 1, 0])) + +%!error eye (1, 2, 3) +*/ + +template +static octave_value +do_linspace (const octave_value& base, const octave_value& limit, + octave_idx_type n) +{ + typedef typename MT::column_vector_type CVT; + typedef typename MT::element_type T; + + octave_value retval; + + if (base.is_scalar_type ()) + { + T bs = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + retval = linspace (bs, ls, n); + } + else + { + CVT lv = octave_value_extract (limit); + CVT bv (lv.length (), bs); + retval = linspace (bv, lv, n); + } + } + else + { + CVT bv = octave_value_extract (base); + if (limit.is_scalar_type ()) + { + T ls = octave_value_extract (limit); + CVT lv (bv.length (), ls); + retval = linspace (bv, lv, n); + } + else + { + CVT lv = octave_value_extract (limit); + retval = linspace (bv, lv, n); + } + } + + return retval; +} + +DEFUN (linspace, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} linspace (@var{base}, @var{limit})\n\ +@deftypefnx {Built-in Function} {} linspace (@var{base}, @var{limit}, @var{n})\n\ +Return a row vector with @var{n} linearly spaced elements between\n\ +@var{base} and @var{limit}. If the number of elements is greater than one,\n\ +then the endpoints @var{base} and @var{limit} are always included in\n\ +the range. If @var{base} is greater than @var{limit}, the elements are\n\ +stored in decreasing order. If the number of points is not specified, a\n\ +value of 100 is used.\n\ +\n\ +The @code{linspace} function always returns a row vector if both\n\ +@var{base} and @var{limit} are scalars. If one, or both, of them are column\n\ +vectors, @code{linspace} returns a matrix.\n\ +\n\ +For compatibility with @sc{matlab}, return the second argument (@var{limit})\n\ +if fewer than two values are requested.\n\ +@seealso{logspace}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_idx_type npoints = 100; + + if (nargin != 2 && nargin != 3) + { + print_usage (); + return retval; + } + + if (nargin == 3) + npoints = args(2).idx_type_value (); + + if (! error_state) + { + octave_value arg_1 = args(0); + octave_value arg_2 = args(1); + + if (arg_1.is_single_type () || arg_2.is_single_type ()) + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + + } + else + { + if (arg_1.is_complex_type () || arg_2.is_complex_type ()) + retval = do_linspace (arg_1, arg_2, npoints); + else + retval = do_linspace (arg_1, arg_2, npoints); + } + } + else + error ("linspace: N must be an integer"); + + return retval; +} + + +/* +%!test +%! x1 = linspace (1, 2); +%! x2 = linspace (1, 2, 10); +%! x3 = linspace (1, -2, 10); +%! assert (size (x1) == [1, 100] && x1(1) == 1 && x1(100) == 2); +%! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); +%! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); + +%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) + +%!error linspace () +%!error linspace (1, 2, 3, 4) +*/ + +// FIXME -- should accept dimensions as separate args for N-d +// arrays as well as 1-d and 2-d arrays. + +DEFUN (resize, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} resize (@var{x}, @var{m})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} resize (@var{x}, [@var{m} @var{n} @dots{}])\n\ +Resize @var{x} cutting off elements as necessary.\n\ +\n\ +In the result, element with certain indices is equal to the corresponding\n\ +element of @var{x} if the indices are within the bounds of @var{x};\n\ +otherwise, the element is set to zero.\n\ +\n\ +In other words, the statement\n\ +\n\ +@example\n\ +y = resize (x, dv)\n\ +@end example\n\ +\n\ +@noindent\n\ +is equivalent to the following code:\n\ +\n\ +@example\n\ +@group\n\ +y = zeros (dv, class (x));\n\ +sz = min (dv, size (x));\n\ +for i = 1:length (sz)\n\ + idx@{i@} = 1:sz(i);\n\ +endfor\n\ +y(idx@{:@}) = x(idx@{:@});\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +but is performed more efficiently.\n\ +\n\ +If only @var{m} is supplied, and it is a scalar, the dimension of the\n\ +result is @var{m}-by-@var{m}.\n\ +If @var{m}, @var{n}, @dots{} are all scalars, then the dimensions of\n\ +the result are @var{m}-by-@var{n}-by-@dots{}.\n\ +If given a vector as input, then the\n\ +dimensions of the result are given by the elements of that vector.\n\ +\n\ +An object can be resized to more dimensions than it has;\n\ +in such case the missing dimensions are assumed to be 1.\n\ +Resizing an object to fewer dimensions is not possible.\n\ +@seealso{reshape, postpad, prepad, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2) + { + Array vec = args(1).vector_value (); + int ndim = vec.length (); + if (ndim == 1) + { + octave_idx_type m = static_cast (vec(0)); + retval = args(0); + retval = retval.resize (dim_vector (m, m), true); + } + else + { + dim_vector dv; + dv.resize (ndim); + for (int i = 0; i < ndim; i++) + dv(i) = static_cast (vec(i)); + retval = args(0); + retval = retval.resize (dv, true); + } + } + else if (nargin > 2) + { + dim_vector dv; + dv.resize (nargin - 1); + for (octave_idx_type i = 1; i < nargin; i++) + dv(i-1) = static_cast (args(i).scalar_value ()); + if (!error_state) + { + retval = args(0); + retval = retval.resize (dv, true); + } + + } + else + print_usage (); + return retval; +} + +// FIXME -- should use octave_idx_type for dimensions. + +DEFUN (reshape, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reshape (@var{A}, @var{m}, @var{n}, @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, [@var{m} @var{n} @dots{}])\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @dots{}, [], @dots{})\n\ +@deftypefnx {Built-in Function} {} reshape (@var{A}, @var{size})\n\ +Return a matrix with the specified dimensions (@var{m}, @var{n}, @dots{})\n\ +whose elements are taken from the matrix @var{A}. The elements of the\n\ +matrix are accessed in column-major order (like Fortran arrays are stored).\n\ +\n\ +The following code demonstrates reshaping a 1x4 row vector into a 2x2 square\n\ +matrix.\n\ +\n\ +@example\n\ +@group\n\ +reshape ([1, 2, 3, 4], 2, 2)\n\ + @result{} 1 3\n\ + 2 4\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the total number of elements in the original\n\ +matrix (@code{prod (size (@var{A}))}) must match the total number of elements\n\ +in the new matrix (@code{prod ([@var{m} @var{n} @dots{}])}).\n\ +\n\ +A single dimension of the return matrix may be left unspecified and Octave\n\ +will determine its size automatically. An empty matrix ([]) is used to flag\n\ +the unspecified dimension.\n\ +@seealso{resize, vec, postpad, cat, squeeze}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + dim_vector new_dims; + + if (nargin == 2) + { + Array new_size = args(1).octave_idx_type_vector_value (); + + new_dims = dim_vector::alloc (new_size.length ()); + + for (octave_idx_type i = 0; i < new_size.length (); i++) + { + if (new_size(i) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + else + new_dims(i) = new_size(i); + } + } + else if (nargin > 2) + { + new_dims = dim_vector::alloc (nargin-1); + int empty_dim = -1; + + for (int i = 1; i < nargin; i++) + { + if (args(i).is_empty ()) + { + if (empty_dim > 0) + { + error ("reshape: only a single dimension can be unknown"); + break; + } + else + { + empty_dim = i; + new_dims(i-1) = 1; + } + } + else + { + new_dims(i-1) = args(i).idx_type_value (); + + if (error_state) + break; + else if (new_dims(i-1) < 0) + { + error ("reshape: SIZE must be non-negative"); + break; + } + } + } + + if (! error_state && (empty_dim > 0)) + { + octave_idx_type nel = new_dims.numel (); + + if (nel == 0) + new_dims(empty_dim-1) = 0; + else + { + octave_idx_type a_nel = args(0).numel (); + octave_idx_type size_empty_dim = a_nel / nel; + + if (a_nel != size_empty_dim * nel) + error ("reshape: SIZE is not divisible by the product of known dimensions (= %d)", nel); + else + new_dims(empty_dim-1) = size_empty_dim; + } + } + } + else + { + print_usage (); + return retval; + } + + if (! error_state) + retval = args(0).reshape (new_dims); + + return retval; +} + +/* +%!assert (size (reshape (ones (4, 4), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4), 60, 1)), [60, 1]) + +%!assert (size (reshape (ones (4, 4, "single"), 2, 8)), [2, 8]) +%!assert (size (reshape (ones (4, 4, "single"), 8, 2)), [8, 2]) +%!assert (size (reshape (ones (15, 4, "single"), 1, 60)), [1, 60]) +%!assert (size (reshape (ones (15, 4, "single"), 60, 1)), [60, 1]) + +%!test +%! s.a = 1; +%! fail ("reshape (s, 2, 3)"); + +%!error reshape () +%!error reshape (1, 2, 3, 4) +*/ + +DEFUN (vec, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{v} =} vec (@var{x})\n\ +@deftypefnx {Built-in Function} {@var{v} =} vec (@var{x}, @var{dim})\n\ +Return the vector obtained by stacking the columns of the matrix @var{x}\n\ +one above the other. Without @var{dim} this is equivalent to\n\ +@code{@var{x}(:)}. If @var{dim} is supplied, the dimensions of @var{v}\n\ +are set to @var{dim} with all elements along the last dimension.\n\ +This is equivalent to @code{shiftdim (@var{x}(:), 1-@var{dim})}.\n\ +@seealso{vech, resize, cat}\n\ +@end deftypefn") +{ + octave_value retval; + int dim = 1; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage () ; + + if (! error_state && nargin == 2) + { + dim = args(1).idx_type_value (); + + if (dim < 1) + error ("vec: DIM must be greater than zero"); + } + + if (! error_state) + { + octave_value colon (octave_value::magic_colon_t); + octave_value arg = args(0); + retval = arg.single_subsref ("(", colon); + + + if (! error_state && dim > 1) + { + dim_vector new_dims = dim_vector::alloc (dim); + + for (int i = 0; i < dim-1; i++) + new_dims(i) = 1; + + new_dims(dim-1) = retval.numel (); + + retval = retval.reshape (new_dims); + } + } + + return retval; +} + +/* +%!assert (vec ([1, 2; 3, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 3, 2, 4]), [1; 3; 2; 4]) +%!assert (vec ([1, 2, 3, 4], 2), [1, 2, 3, 4]) +%!assert (vec ([1, 2; 3, 4]), vec ([1, 2; 3, 4], 1)) +%!assert (vec ([1, 2; 3, 4], 1), [1; 3; 2; 4]) +%!assert (vec ([1, 2; 3, 4], 2), [1, 3, 2, 4]) +%!assert (vec ([1, 3; 2, 4], 3), reshape ([1, 2, 3, 4], 1, 1, 4)) +%!assert (vec ([1, 3; 2, 4], 3), shiftdim (vec ([1, 3; 2, 4]), -2)) + +%!error vec () +%!error vec (1, 2, 3) +%!error vec ([1, 2; 3, 4], 0) +*/ + +DEFUN (squeeze, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} squeeze (@var{x})\n\ +Remove singleton dimensions from @var{x} and return the result.\n\ +Note that for compatibility with @sc{matlab}, all objects have\n\ +a minimum of two dimensions and row vectors are left unchanged.\n\ +@seealso{reshape}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).squeeze (); + else + print_usage (); + + return retval; +} + +DEFUN (full, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{FM} =} full (@var{SM})\n\ +Return a full storage matrix from a sparse, diagonal, permutation matrix\n\ +or a range.\n\ +@seealso{sparse}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).full_value (); + else + print_usage (); + + return retval; +} + +// Compute various norms of the vector X. + +DEFUN (norm, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} norm (@var{A})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p})\n\ +@deftypefnx {Built-in Function} {} norm (@var{A}, @var{p}, @var{opt})\n\ +Compute the p-norm of the matrix @var{A}. If the second argument is\n\ +missing, @code{p = 2} is assumed.\n\ +\n\ +If @var{A} is a matrix (or sparse matrix):\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{1}\n\ +1-norm, the largest column sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{2}\n\ +Largest singular value of @var{A}.\n\ +\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@cindex infinity norm\n\ +Infinity norm, the largest row sum of the absolute values of @var{A}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +@cindex Frobenius norm\n\ +Frobenius norm of @var{A}, @code{sqrt (sum (diag (@var{A}' * @var{A})))}.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +@cindex general p-norm\n\ +maximum @code{norm (A*x, p)} such that @code{norm (x, p) == 1}\n\ +@end table\n\ +\n\ +If @var{A} is a vector or a scalar:\n\ +\n\ +@table @asis\n\ +@item @var{p} = @code{Inf} or @code{\"inf\"}\n\ +@code{max (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{-Inf}\n\ +@code{min (abs (@var{A}))}.\n\ +\n\ +@item @var{p} = @code{\"fro\"}\n\ +Frobenius norm of @var{A}, @code{sqrt (sumsq (abs (A)))}.\n\ +\n\ +@item @var{p} = 0\n\ +Hamming norm - the number of nonzero elements.\n\ +\n\ +@item other @var{p}, @code{@var{p} > 1}\n\ +p-norm of @var{A}, @code{(sum (abs (@var{A}) .^ @var{p})) ^ (1/@var{p})}.\n\ +\n\ +@item other @var{p} @code{@var{p} < 1}\n\ +the p-pseudonorm defined as above.\n\ +@end table\n\ +\n\ +If @var{opt} is the value @code{\"rows\"}, treat each row as a vector and\n\ +compute its norm. The result is returned as a column vector.\n\ +Similarly, if @var{opt} is @code{\"columns\"} or @code{\"cols\"} then compute\n\ +the norms of each column and return a row vector.\n\ +@seealso{cond, svd}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin >= 1 && nargin <= 3) + { + octave_value x_arg = args(0); + + if (x_arg.ndims () == 2) + { + enum { sfmatrix, sfcols, sfrows, sffrob, sfinf } strflag = sfmatrix; + if (nargin > 1 && args(nargin-1).is_string ()) + { + std::string str = args(nargin-1).string_value (); + if (str == "cols" || str == "columns") + strflag = sfcols; + else if (str == "rows") + strflag = sfrows; + else if (str == "fro") + strflag = sffrob; + else if (str == "inf") + strflag = sfinf; + else + error ("norm: unrecognized option: %s", str.c_str ()); + // we've handled the last parameter, so act as if it was removed + nargin --; + } + else if (nargin > 1 && ! args(1).is_scalar_type ()) + gripe_wrong_type_arg ("norm", args(1), true); + + if (! error_state) + { + octave_value p_arg = (nargin > 1) ? args(1) : octave_value (2); + switch (strflag) + { + case sfmatrix: + retval(0) = xnorm (x_arg, p_arg); + break; + case sfcols: + retval(0) = xcolnorms (x_arg, p_arg); + break; + case sfrows: + retval(0) = xrownorms (x_arg, p_arg); + break; + case sffrob: + retval(0) = xfrobnorm (x_arg); + break; + case sfinf: + retval(0) = xnorm (x_arg, octave_Inf); + break; + } + } + } + else + error ("norm: only valid for 2-D objects"); + } + else + print_usage (); + + return retval; +} + +/* +%!shared x +%! x = [1, -3, 4, 5, -7]; +%!assert (norm (x,1), 20) +%!assert (norm (x,2), 10) +%!assert (norm (x,3), 8.24257059961711, -4*eps) +%!assert (norm (x,Inf), 7) +%!assert (norm (x,-Inf), 1) +%!assert (norm (x,"inf"), 7) +%!assert (norm (x,"fro"), 10, -eps) +%!assert (norm (x), 10) +%!assert (norm ([1e200, 1]), 1e200) +%!assert (norm ([3+4i, 3-4i, sqrt(31)]), 9, -4*eps) +%!shared m +%! m = magic (4); +%!assert (norm (m,1), 34) +%!assert (norm (m,2), 34, -eps) +%!assert (norm (m,Inf), 34) +%!assert (norm (m,"inf"), 34) +%!shared m2, flo, fhi +%! m2 = [1,2;3,4]; +%! flo = 1e-300; +%! fhi = 1e+300; +%!assert (norm (flo*m2,"fro"), sqrt (30)*flo, -eps) +%!assert (norm (fhi*m2,"fro"), sqrt (30)*fhi, -eps) + +%!shared x +%! x = single ([1, -3, 4, 5, -7]); +%!assert (norm (x,1), single (20)) +%!assert (norm (x,2), single (10)) +%!assert (norm (x,3), single (8.24257059961711), -4*eps ("single")) +%!assert (norm (x,Inf), single (7)) +%!assert (norm (x,-Inf), single (1)) +%!assert (norm (x,"inf"), single (7)) +%!assert (norm (x,"fro"), single (10), -eps ("single")) +%!assert (norm (x), single (10)) +%!assert (norm (single ([1e200, 1])), single (1e200)) +%!assert (norm (single ([3+4i, 3-4i, sqrt(31)])), single (9), -4*eps ("single")) +%!shared m +%! m = single (magic (4)); +%!assert (norm (m,1), single (34)) +%!assert (norm (m,2), single (34), -eps ("single")) +%!assert (norm (m,Inf), single (34)) +%!assert (norm (m,"inf"), single (34)) +%!shared m2, flo, fhi +%! m2 = single ([1,2;3,4]); +%! flo = single (1e-300); +%! fhi = single (1e+300); +%!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) +%!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) + +%!test +%! ## Test for norm returning NaN on sparse matrix (bug #30631) +%! A = sparse (2,2); +%! A(2,1) = 1; +%! assert (norm (A), 1); +*/ + +static octave_value +unary_op_defun_body (octave_value::unary_op op, + const octave_value_list& args) +{ + octave_value retval; + if (args.length () == 1) + retval = do_unary_op (op, args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (not, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} not (@var{x})\n\ +Return the logical NOT of @var{x}. This function is equivalent to\n\ +@code{! x}.\n\ +@seealso{and, or, xor}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_not, args); +} + +DEFUN (uplus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uplus (@var{x})\n\ +This function and @w{@xcode{+ x}} are equivalent.\n\ +@seealso{uminus, plus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uplus, args); +} + +DEFUN (uminus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} uminus (@var{x})\n\ +This function and @w{@xcode{- x}} are equivalent.\n\ +@seealso{uplus, minus}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_uminus, args); +} + +DEFUN (transpose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} transpose (@var{x})\n\ +Return the transpose of @var{x}.\n\ +This function and @xcode{x.'} are equivalent.\n\ +@seealso{ctranspose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_transpose, args); +} + +/* +%!assert (2.', 2) +%!assert (2i.', 2i) +%!assert ([1:4].', [1;2;3;4]) +%!assert ([1;2;3;4].', [1:4]) +%!assert ([1,2;3,4].', [1,3;2,4]) +%!assert ([1,2i;3,4].', [1,3;2i,4]) + +%!assert (transpose ([1,2;3,4]), [1,3;2,4]) + +%!assert (single (2).', single (2)) +%!assert (single (2i).', single (2i)) +%!assert (single ([1:4]).', single ([1;2;3;4])) +%!assert (single ([1;2;3;4]).', single ([1:4])) +%!assert (single ([1,2;3,4]).', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4]).', single ([1,3;2i,4])) + +%!assert (transpose (single ([1,2;3,4])), single ([1,3;2,4])) +*/ + +DEFUN (ctranspose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ +Return the complex conjugate transpose of @var{x}.\n\ +This function and @xcode{x'} are equivalent.\n\ +@seealso{transpose}\n\ +@end deftypefn") +{ + return unary_op_defun_body (octave_value::op_hermitian, args); +} + +/* +%!assert (2', 2) +%!assert (2i', -2i) +%!assert ([1:4]', [1;2;3;4]) +%!assert ([1;2;3;4]', [1:4]) +%!assert ([1,2;3,4]', [1,3;2,4]) +%!assert ([1,2i;3,4]', [1,3;-2i,4]) + +%!assert (ctranspose ([1,2i;3,4]), [1,3;-2i,4]) + +%!assert (single (2)', single (2)) +%!assert (single (2i)', single (-2i)) +%!assert (single ([1:4])', single ([1;2;3;4])) +%!assert (single ([1;2;3;4])', single ([1:4])) +%!assert (single ([1,2;3,4])', single ([1,3;2,4])) +%!assert (single ([1,2i;3,4])', single ([1,3;-2i,4])) + +%!assert (ctranspose (single ([1,2i;3,4])), single ([1,3;-2i,4])) +*/ + +static octave_value +binary_op_defun_body (octave_value::binary_op op, + const octave_value_list& args) +{ + octave_value retval; + + if (args.length () == 2) + retval = do_binary_op (op, args(0), args(1)); + else + print_usage (); + + return retval; +} + +static octave_value +binary_assoc_op_defun_body (octave_value::binary_op op, + octave_value::assign_op aop, + const octave_value_list& args) +{ + octave_value retval; + int nargin = args.length (); + + switch (nargin) + { + case 0: + print_usage (); + break; + case 1: + retval = args(0); + break; + case 2: + retval = do_binary_op (op, args(0), args(1)); + break; + default: + retval = do_binary_op (op, args(0), args(1)); + for (int i = 2; i < nargin; i++) + retval.assign (aop, args(i)); + break; + } + + return retval; +} + +DEFUN (plus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ +This function and @w{@xcode{x + y}} are equivalent.\n\ +If more arguments are given, the summation is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 + x2) + x3) + @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{minus, uplus}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_add, + octave_value::op_add_eq, args); +} + +DEFUN (minus, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ +This function and @w{@xcode{x - y}} are equivalent.\n\ +@seealso{plus, uminus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_sub, args); +} + +DEFUN (mtimes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ +Return the matrix multiplication product of inputs.\n\ +This function and @w{@xcode{x * y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 * x2) * x3) * @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{times, plus, minus, rdivide, mrdivide, mldivide, mpower}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_mul, + octave_value::op_mul_eq, args); +} + +DEFUN (mrdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ +Return the matrix right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x / y}} are equivalent.\n\ +@seealso{mldivide, rdivide, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_div, args); +} + +DEFUN (mpower, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ +Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ +This function and @w{@xcode{x ^ y}} are equivalent.\n\ +@seealso{power, mtimes, plus, minus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_pow, args); +} + +DEFUN (mldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ +Return the matrix left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x @xbackslashchar{} y}} are equivalent.\n\ +@seealso{mrdivide, ldivide, rdivide}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ldiv, args); +} + +DEFUN (lt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} lt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x < y}}.\n\ +@seealso{le, eq, ge, gt, ne}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_lt, args); +} + +DEFUN (le, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} le (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x <= y}}.\n\ +@seealso{eq, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_le, args); +} + +DEFUN (eq, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eq (@var{x}, @var{y})\n\ +Return true if the two inputs are equal.\n\ +This function is equivalent to @w{@code{x == y}}.\n\ +@seealso{ne, isequal, le, ge, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_eq, args); +} + +DEFUN (ge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ge (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x >= y}}.\n\ +@seealso{le, eq, gt, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ge, args); +} + +DEFUN (gt, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} gt (@var{x}, @var{y})\n\ +This function is equivalent to @w{@code{x > y}}.\n\ +@seealso{le, eq, ge, ne, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_gt, args); +} + +DEFUN (ne, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ne (@var{x}, @var{y})\n\ +Return true if the two inputs are not equal.\n\ +This function is equivalent to @w{@code{x != y}}.\n\ +@seealso{eq, isequal, le, ge, lt}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_ne, args); +} + +DEFUN (times, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ +Return the element-by-element multiplication product of inputs.\n\ +This function and @w{@xcode{x .* y}} are equivalent.\n\ +If more arguments are given, the multiplication is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 .* x2) .* x3) .* @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{mtimes, rdivide}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_mul, + octave_value::op_el_mul_eq, args); +} + +DEFUN (rdivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ +Return the element-by-element right division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x ./ y}} are equivalent.\n\ +@seealso{ldivide, mrdivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_div, args); +} + +DEFUN (power, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ +Return the element-by-element operation of @var{x} raised to the\n\ +@var{y} power. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +\n\ +This function and @w{@xcode{x .^ y}} are equivalent.\n\ +@seealso{mpower, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_pow, args); +} + +DEFUN (ldivide, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ +Return the element-by-element left division of @var{x} and @var{y}.\n\ +This function and @w{@xcode{x .@xbackslashchar{} y}} are equivalent.\n\ +@seealso{rdivide, mldivide, times, plus}\n\ +@end deftypefn") +{ + return binary_op_defun_body (octave_value::op_el_ldiv, args); +} + +DEFUN (and, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} and (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} and (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical AND of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x & y}}.\n\ +If more arguments are given, the logical and is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 & x2) & x3) & @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{or, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_and, + octave_value::op_el_and_eq, args); +} + +DEFUN (or, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} or (@var{x}, @var{y})\n\ +@deftypefnx {Built-in Function} {} or (@var{x1}, @var{x2}, @dots{})\n\ +Return the logical OR of @var{x} and @var{y}.\n\ +This function is equivalent to @w{@code{x | y}}.\n\ +If more arguments are given, the logical or is applied\n\ +cumulatively from left to right:\n\ +\n\ +@example\n\ +(@dots{}((x1 | x2) | x3) | @dots{})\n\ +@end example\n\ +\n\ +At least one argument is required.\n\ +@seealso{and, not, xor}\n\ +@end deftypefn") +{ + return binary_assoc_op_defun_body (octave_value::op_el_or, + octave_value::op_el_or_eq, args); +} + +static double tic_toc_timestamp = -1.0; + +DEFUN (tic, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tic ()\n\ +@deftypefnx {Built-in Function} {@var{id} =} tic ()\n\ +@deftypefnx {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +Set or check a wall-clock timer. Calling @code{tic} without an\n\ +output argument sets the internal timer state. Subsequent calls\n\ +to @code{toc} return the number of seconds since the timer was set.\n\ +For example,\n\ +\n\ +@example\n\ +@group\n\ +tic ();\n\ +# many computations later@dots{}\n\ +elapsed_time = toc ();\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{elapsed_time} to the number of seconds since\n\ +the most recent call to the function @code{tic}.\n\ +\n\ +If called with one output argument, @code{tic} returns a scalar\n\ +of type @code{uint64} that may be later passed to @code{toc}.\n\ +\n\ +@example\n\ +@group\n\ +id = tic; sleep (5); toc (id)\n\ + @result{} 5.0010\n\ +@end group\n\ +@end example\n\ +\n\ +Calling @code{tic} and @code{toc} this way allows nested timing calls.\n\ +\n\ +If you are more interested in the CPU time that your process used, you\n\ +should use the @code{cputime} function instead. The @code{tic} and\n\ +@code{toc} functions report the actual wall clock time that elapsed\n\ +between the calls. This may include time spent processing other jobs or\n\ +doing nothing at all.\n\ +@seealso{toc, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + + octave_time now; + + double tmp = now.double_value (); + + if (nargout > 0) + { + double ip = 0.0; + double frac = modf (tmp, &ip); + uint64_t microsecs = static_cast (CLOCKS_PER_SEC * frac); + microsecs += CLOCKS_PER_SEC * static_cast (ip); + retval = octave_uint64 (microsecs); + } + else + tic_toc_timestamp = tmp; + + return retval; +} + +DEFUN (toc, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} toc ()\n\ +@deftypefnx {Built-in Function} {} toc (@var{id})\n\ +@deftypefnx {Built-in Function} {@var{val} =} toc (@dots{})\n\ +@seealso{tic, cputime}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + double start_time = tic_toc_timestamp; + + if (nargin > 1) + print_usage (); + else + { + if (nargin == 1) + { + octave_uint64 id = args(0).uint64_scalar_value (); + + if (! error_state) + { + uint64_t val = id.value (); + + start_time + = (static_cast (val / CLOCKS_PER_SEC) + + static_cast (val % CLOCKS_PER_SEC) / CLOCKS_PER_SEC); + + // FIXME -- should we also check to see whether the start + // time is after the beginning of this Octave session? + } + else + error ("toc: invalid ID"); + } + + if (! error_state) + { + if (start_time < 0) + error ("toc called before timer set"); + else + { + octave_time now; + + double tmp = now.double_value () - start_time; + + if (nargout > 0) + retval = tmp; + else + octave_stdout << "Elapsed time is " << tmp << " seconds.\n"; + } + } + } + + return retval; +} + +/* +%!shared id +%! id = tic (); +%!assert (isa (id, "uint64")) +%!assert (isa (toc (id), "double")) +*/ + +DEFUN (cputime, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{total}, @var{user}, @var{system}] =} cputime ();\n\ +Return the CPU time used by your Octave session. The first output is\n\ +the total time spent executing your process and is equal to the sum of\n\ +second and third outputs, which are the number of CPU seconds spent\n\ +executing in user mode and the number of CPU seconds spent executing in\n\ +system mode, respectively. If your system does not have a way to report\n\ +CPU time usage, @code{cputime} returns 0 for each of its output values.\n\ +Note that because Octave used some CPU time to start, it is reasonable\n\ +to check to see if @code{cputime} works by checking to see if the total\n\ +CPU time used is nonzero.\n\ +@seealso{tic, toc}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + double usr = 0.0; + double sys = 0.0; + + if (nargin != 0) + warning ("tic: ignoring extra arguments"); + +#if defined (HAVE_GETRUSAGE) + + struct rusage ru; + + getrusage (RUSAGE_SELF, &ru); + + usr = static_cast (ru.ru_utime.tv_sec) + + static_cast (ru.ru_utime.tv_usec) * 1e-6; + + sys = static_cast (ru.ru_stime.tv_sec) + + static_cast (ru.ru_stime.tv_usec) * 1e-6; + +#else + + struct tms t; + + times (&t); + + unsigned long ticks; + unsigned long seconds; + unsigned long fraction; + + ticks = t.tms_utime + t.tms_cutime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + usr = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + + ticks = t.tms_stime + t.tms_cstime; + fraction = ticks % CLOCKS_PER_SEC; + seconds = ticks / CLOCKS_PER_SEC; + + sys = static_cast (seconds) + static_cast(fraction) / + static_cast(CLOCKS_PER_SEC); + +#endif + + retval(2) = sys; + retval(1) = usr; + retval(0) = sys + usr; + + return retval; +} + +DEFUN (sort, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode})\n\ +@deftypefnx {Built-in Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode})\n\ +Return a copy of @var{x} with the elements arranged in increasing\n\ +order. For matrices, @code{sort} orders the elements within columns\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} 1 1\n\ + 2 2\n\ + 3 3\n\ +@end group\n\ +@end example\n\ +\n\ +If the optional argument @var{dim} is given, then the matrix is sorted\n\ +along the dimension defined by @var{dim}. The optional argument @code{mode}\n\ +defines the order in which the values will be sorted. Valid values of\n\ +@code{mode} are \"ascend\" or \"descend\".\n\ +\n\ +The @code{sort} function may also be used to produce a matrix\n\ +containing the original row indices of the elements in the sorted\n\ +matrix. For example:\n\ +\n\ +@example\n\ +@group\n\ +[s, i] = sort ([1, 2; 2, 3; 3, 1])\n\ + @result{} s = 1 1\n\ + 2 2\n\ + 3 3\n\ + @result{} i = 1 3\n\ + 2 1\n\ + 3 2\n\ +@end group\n\ +@end example\n\ +\n\ +For equal elements, the indices are such that equal elements are listed\n\ +in the order in which they appeared in the original list.\n\ +\n\ +Sorting of complex entries is done first by magnitude (@code{abs (@var{z})})\n\ +and for any ties by phase angle (@code{angle (z)}). For example:\n\ +\n\ +@example\n\ +@group\n\ +sort ([1+i; 1; 1-i])\n\ + @result{} 1 + 0i\n\ + 1 - 1i\n\ + 1 + 1i\n\ +@end group\n\ +@end example\n\ +\n\ +NaN values are treated as being greater than any other value and are sorted\n\ +to the end of the list.\n\ +\n\ +The @code{sort} function may also be used to sort strings and cell arrays\n\ +of strings, in which case ASCII dictionary order (uppercase 'A' precedes\n\ +lowercase 'a') of the strings is used.\n\ +\n\ +The algorithm used in @code{sort} is optimized for the sorting of partially\n\ +ordered lists.\n\ +@seealso{sortrows, issorted}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool return_idx = nargout > 1; + + octave_value arg = args(0); + + int dim = 0; + if (nargin > 1) + { + if (args(1).is_string ()) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + else + dim = args(1).nint_value () - 1; + } + + if (nargin > 2) + { + if (args(1).is_string ()) + { + print_usage (); + return retval; + } + + if (! args(2).is_string ()) + { + error ("sort: MODE must be a string"); + return retval; + } + std::string mode = args(2).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("sort: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + const dim_vector dv = arg.dims (); + if (nargin == 1 || args(1).is_string ()) + { + // Find first non singleton dimension + dim = dv.first_non_singleton (); + } + else + { + if (dim < 0) + { + error ("sort: DIM must be a valid dimension"); + return retval; + } + } + + if (return_idx) + { + retval.resize (2); + + Array sidx; + + retval(0) = arg.sort (sidx, dim, smode); + retval(1) = idx_vector (sidx, dv(dim)); // No checking, the extent is known. + } + else + retval(0) = arg.sort (dim, smode); + + return retval; +} + +/* +## Double +%!assert (sort ([NaN, 1, -1, 2, Inf]), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 1), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 3), [NaN, 1, -1, 2, Inf]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "ascend"), [-1, 1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1, -1, 2, Inf], "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([NaN, 1, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, 1, -1]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4]), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 1), [3, 1, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1, 7, 5; 8, 2, 6, 4], 2), [1, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1), 1) + +%!test +%! [v, i] = sort ([NaN, 1, -1, Inf, 1]); +%! assert (v, [-1, 1, 1, Inf, NaN]); +%! assert (i, [3, 2, 5, 4, 1]); + +## Complex +%!assert (sort ([NaN, 1i, -1, 2, Inf]), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 1), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 3), [NaN, 1i, -1, 2, Inf]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "ascend"), [1i, -1, 2, Inf, NaN]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([NaN, 1i, -1, 2, Inf], 2, "descend"), [NaN, Inf, 2, -1, 1i]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4]), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 1), [3, 1i, 6, 4; 8, 2, 7, 5]) +%!assert (sort ([3, 1i, 7, 5; 8, 2, 6, 4], 2), [1i, 3, 5, 7; 2, 4, 6, 8]) +%!assert (sort (1i), 1i) + +%!test +%! [v, i] = sort ([NaN, 1i, -1, Inf, 1, 1i]); +%! assert (v, [1, 1i, 1i, -1, Inf, NaN]); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Single +%!assert (sort (single ([NaN, 1, -1, 2, Inf])), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 1), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 3), single ([NaN, 1, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "ascend"), single ([-1, 1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([NaN, 1, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, 1, -1])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4])), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1, 7, 5; 8, 2, 6, 4]), 2), single ([1, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1)), single (1)) + +%!test +%! [v, i] = sort (single ([NaN, 1, -1, Inf, 1])); +%! assert (v, single ([-1, 1, 1, Inf, NaN])); +%! assert (i, [3, 2, 5, 4, 1]); + +## Single Complex +%!assert (sort (single ([NaN, 1i, -1, 2, Inf])), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 1), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 3), single ([NaN, 1i, -1, 2, Inf])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "ascend"), single ([1i, -1, 2, Inf, NaN])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([NaN, 1i, -1, 2, Inf]), 2, "descend"), single ([NaN, Inf, 2, -1, 1i])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4])), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 1), single ([3, 1i, 6, 4; 8, 2, 7, 5])) +%!assert (sort (single ([3, 1i, 7, 5; 8, 2, 6, 4]), 2), single ([1i, 3, 5, 7; 2, 4, 6, 8])) +%!assert (sort (single (1i)), single (1i)) + +%!test +%! [v, i] = sort (single ([NaN, 1i, -1, Inf, 1, 1i])); +%! assert (v, single ([1, 1i, 1i, -1, Inf, NaN])); +%! assert (i, [5, 2, 6, 3, 4, 1]); + +## Bool +%!assert (sort ([true, false, true, false]), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 1), [true, false, true, false]) +%!assert (sort ([true, false, true, false], 2), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 3), [true, false, true, false]) +%!assert (sort ([true, false, true, false], "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], 2, "ascend"), [false, false, true, true]) +%!assert (sort ([true, false, true, false], "descend"), [true, true, false, false]) +%!assert (sort ([true, false, true, false], 2, "descend"), [true, true, false, false]) +%!assert (sort (true), true) + +%!test +%! [v, i] = sort ([true, false, true, false]); +%! assert (v, [false, false, true, true]); +%! assert (i, [2, 4, 1, 3]); + +## Sparse Double +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf])), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "ascend"), sparse ([-1, 0, 0, 1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) +%!assert (sort (sparse ([0, NaN, 1, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, 1, 0, 0, -1])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Complex +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf])), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 1), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 3), sparse ([0, NaN, 1i, 0, -1, 2, Inf])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "ascend"), sparse ([0, 0, 1i, -1, 2, Inf, NaN])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) +%!assert (sort (sparse ([0, NaN, 1i, 0, -1, 2, Inf]), 2, "descend"), sparse ([NaN, Inf, 2, -1, 1i, 0, 0])) + +%!shared a +%! a = randn (10, 10); +%! a(a < 0) = 0; +%! a = 1i * a; +%!assert (sort (sparse (a)), sparse (sort (a))) +%!assert (sort (sparse (a), 1), sparse (sort (a, 1))) +%!assert (sort (sparse (a), 2), sparse (sort (a, 2))) +%!test +%! [v, i] = sort (a); +%! [vs, is] = sort (sparse (a)); +%! assert (vs, sparse (v)); +%! assert (is, i); + +## Sparse Bool +%!assert (sort (sparse ([true, false, true, false])), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 1), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), 2), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 3), sparse ([true, false, true, false])) +%!assert (sort (sparse ([true, false, true, false]), "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), 2, "ascend"), sparse ([false, false, true, true])) +%!assert (sort (sparse ([true, false, true, false]), "descend"), sparse ([true, true, false, false])) +%!assert (sort (sparse ([true, false, true, false]), 2, "descend"), sparse ([true, true, false, false])) + +%!test +%! [v, i] = sort (sparse ([true, false, true, false])); +%! assert (v, sparse ([false, false, true, true])); +%! assert (i, [2, 4, 1, 3]); + +## Cell string array +%!shared a, b, c +%! a = {"Alice", "Cecile", "Eric", "Barry", "David"}; +%! b = {"Alice", "Barry", "Cecile", "David", "Eric"}; +%! c = {"Eric", "David", "Cecile", "Barry", "Alice"}; +%!assert (sort (a), b) +%!assert (sort (a, 1), a) +%!assert (sort (a, 2), b) +%!assert (sort (a, 3), a) +%!assert (sort (a, "ascend"), b) +%!assert (sort (a, 2, "ascend"), b) +%!assert (sort (a, "descend"), c) +%!assert (sort (a, 2, "descend"), c) + +%!test +%! [v, i] = sort (a); +%! assert (i, [1, 4, 2, 5, 3]); + +%!error sort () +%!error sort (1, 2, 3, 4) +*/ + +// Sort the rows of the matrix @var{a} according to the order +// specified by @var{mode}, which can either be `ascend' or `descend' +// and return the index vector corresponding to the sort order. +// +// This function does not yet support sparse matrices. + +DEFUN (__sort_rows_idx__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __sort_rows_idx__ (@var{a}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + sortmode smode = ASCENDING; + + if (nargin < 1 || nargin > 2 || (nargin == 2 && ! args(1).is_string ())) + { + print_usage (); + return retval; + } + + if (nargin > 1) + { + std::string mode = args(1).string_value (); + if (mode == "ascend") + smode = ASCENDING; + else if (mode == "descend") + smode = DESCENDING; + else + { + error ("__sort_rows_idx__: MODE must be either \"ascend\" or \"descend\""); + return retval; + } + } + + octave_value arg = args(0); + + if (arg.is_sparse_type ()) + error ("__sort_rows_idx__: sparse matrices not yet supported"); + if (arg.ndims () == 2) + { + Array idx = arg.sort_rows_idx (smode); + + retval = octave_value (idx, true, true); + } + else + error ("__sort_rows_idx__: needs a 2-dimensional object"); + + return retval; +} + +static sortmode +get_sort_mode_option (const octave_value& arg, const char *argn) +{ + // FIXME -- we initialize to UNSORTED here to avoid a GCC warning + // about possibly using sortmode uninitialized. + // FIXME -- shouldn't these modes be scoped inside a class? + sortmode smode = UNSORTED; + + std::string mode = arg.string_value (); + + if (error_state) + error ("issorted: expecting %s argument to be a character string", argn); + else if (mode == "ascending") + smode = ASCENDING; + else if (mode == "descending") + smode = DESCENDING; + else if (mode == "either") + smode = UNSORTED; + else + error ("issorted: MODE must be \"ascending\", \"descending\", or \"either\""); + + return smode; +} + +DEFUN (issorted, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} issorted (@var{a})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, @var{mode})\n\ +@deftypefnx {Built-in Function} {} issorted (@var{a}, \"rows\", @var{mode})\n\ +Return true if the array is sorted according to @var{mode}, which\n\ +may be either \"ascending\", \"descending\", or \"either\". By default,\n\ + @var{mode} is \"ascending\". NaNs are treated in the same manner as\n\ +@code{sort}.\n\ +\n\ +If the optional argument \"rows\" is supplied, check whether\n\ +the array is sorted by rows as output by the function @code{sortrows}\n\ +(with no options).\n\ +\n\ +This function does not support sparse matrices.\n\ +@seealso{sort, sortrows}\n\ +@end deftypefn\n") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 3) + { + print_usage (); + return retval; + } + + bool by_rows = false; + + sortmode smode = ASCENDING; + + if (nargin > 1) + { + octave_value mode_arg; + + if (nargin == 3) + smode = get_sort_mode_option (args(2), "third"); + + std::string tmp = args(1).string_value (); + + if (! error_state) + { + if (tmp == "rows") + by_rows = true; + else + smode = get_sort_mode_option (args(1), "second"); + } + else + error ("expecting second argument to be character string"); + + if (error_state) + return retval; + } + + octave_value arg = args(0); + + if (by_rows) + { + if (arg.is_sparse_type ()) + error ("issorted: sparse matrices not yet supported"); + if (arg.ndims () == 2) + retval = arg.is_sorted_rows (smode) != UNSORTED; + else + error ("issorted: A must be a 2-dimensional object"); + } + else + { + if (arg.dims ().is_vector ()) + retval = args(0).is_sorted (smode) != UNSORTED; + else + error ("issorted: needs a vector"); + } + + return retval; +} + +/* +%!shared sm, um, sv, uv +%! sm = [1, 2; 3, 4]; +%! um = [3, 1; 2, 4]; +%! sv = [1, 2, 3, 4]; +%! uv = [2, 1, 4, 3]; +%!assert (issorted (sm, "rows")) +%!assert (!issorted (um, "rows")) +%!assert (issorted (sv)) +%!assert (!issorted (uv)) +%!assert (issorted (sv')) +%!assert (!issorted (uv')) +%!assert (issorted (sm, "rows", "ascending")) +%!assert (!issorted (um, "rows", "ascending")) +%!assert (issorted (sv, "ascending")) +%!assert (!issorted (uv, "ascending")) +%!assert (issorted (sv', "ascending")) +%!assert (!issorted (uv', "ascending")) +%!assert (!issorted (sm, "rows", "descending")) +%!assert (issorted (flipud (sm), "rows", "descending")) +%!assert (!issorted (sv, "descending")) +%!assert (issorted (fliplr (sv), "descending")) +%!assert (!issorted (sv', "descending")) +%!assert (issorted (fliplr (sv)', "descending")) +%!assert (!issorted (um, "rows", "either")) +%!assert (!issorted (uv, "either")) +%!assert (issorted (sm, "rows", "either")) +%!assert (issorted (flipud (sm), "rows", "either")) +%!assert (issorted (sv, "either")) +%!assert (issorted (fliplr (sv), "either")) +%!assert (issorted (sv', "either")) +%!assert (issorted (fliplr (sv)', "either")) +*/ + +DEFUN (nth_element, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} nth_element (@var{x}, @var{n})\n\ +@deftypefnx {Built-in Function} {} nth_element (@var{x}, @var{n}, @var{dim})\n\ +Select the n-th smallest element of a vector, using the ordering defined by\n\ +@code{sort}. In other words, the result is equivalent to\n\ +@code{sort(@var{x})(@var{n})}.\n\ +@var{n} can also be a contiguous range, either ascending @code{l:u}\n\ +or descending @code{u:-1:l}, in which case a range of elements is returned.\n\ +If @var{x} is an array, @code{nth_element} operates along the dimension\n\ +defined by @var{dim}, or the first non-singleton dimension if @var{dim} is\n\ +not given.\n\ +\n\ +nth_element encapsulates the C++ standard library algorithms nth_element and\n\ +partial_sort. On average, the complexity of the operation is O(M*log(K)),\n\ +where @w{@code{M = size (@var{x}, @var{dim})}} and\n\ +@w{@code{K = length (@var{n})}}.\n\ +This function is intended for cases where the ratio K/M is small; otherwise,\n\ +it may be better to use @code{sort}.\n\ +@seealso{sort, min, max}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_value argx = args(0); + + int dim = -1; + if (nargin == 3) + { + dim = args(2).int_value (true) - 1; + if (dim < 0) + error ("nth_element: DIM must be a valid dimension"); + } + if (dim < 0) + dim = argx.dims ().first_non_singleton (); + + idx_vector n = args(1).index_vector (); + + if (error_state) + return retval; + + switch (argx.builtin_type ()) + { + case btyp_double: + retval = argx.array_value ().nth_element (n, dim); + break; + case btyp_float: + retval = argx.float_array_value ().nth_element (n, dim); + break; + case btyp_complex: + retval = argx.complex_array_value ().nth_element (n, dim); + break; + case btyp_float_complex: + retval = argx.float_complex_array_value ().nth_element (n, dim); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = argx.X ## _array_value ().nth_element (n, dim); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + default: + if (argx.is_cellstr ()) + retval = argx.cellstr_value ().nth_element (n, dim); + else + gripe_wrong_type_arg ("nth_element", argx); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_sum (const idx_vector& idx, const NDT& vals, + octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), T ()); + + if (vals.numel () == 1) + retval.idx_add (idx, vals (0)); + else if (vals.numel () == idx.length (n)) + retval.idx_add (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +DEFUN (__accumarray_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_sum__ (@var{idx}, @var{vals}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 3 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 3) + n = args(2).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + if (vals.is_range ()) + { + Range r = vals.range_value (); + if (r.inc () == 0) + vals = r.base (); + } + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.float_complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.float_array_value (), n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumarray_sum (idx, vals.complex_array_value (), n); + else + retval = do_accumarray_sum (idx, vals.array_value (), n); + } + else + gripe_wrong_type_arg ("accumarray", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_accumarray_minmax (const idx_vector& idx, const NDT& vals, + octave_idx_type n, bool ismin, + const typename NDT::element_type& zero_val) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumarray: index out of range"); + + NDT retval (dim_vector (n, 1), zero_val); + + // Pick minimizer or maximizer. + void (MArray::*op) (const idx_vector&, const MArray&) = + ismin ? (&MArray::idx_min) : (&MArray::idx_max); + + octave_idx_type l = idx.length (n); + if (vals.numel () == 1) + (retval.*op) (idx, NDT (dim_vector (l, 1), vals(0))); + else if (vals.numel () == l) + (retval.*op) (idx, vals); + else + error ("accumarray: dimensions mismatch"); + + return retval; +} + +static octave_value_list +do_accumarray_minmax_fun (const octave_value_list& args, + bool ismin) +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 3 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1), zero = args (2); + + switch (vals.builtin_type ()) + { + case btyp_double: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.double_value ()); + break; + case btyp_float: + retval = do_accumarray_minmax (idx, vals.float_array_value (), n, ismin, + zero.float_value ()); + break; + case btyp_complex: + retval = do_accumarray_minmax (idx, vals.complex_array_value (), n, ismin, + zero.complex_value ()); + break; + case btyp_float_complex: + retval = do_accumarray_minmax (idx, vals.float_complex_array_value (), n, ismin, + zero.float_complex_value ()); + break; +#define MAKE_INT_BRANCH(X) \ + case btyp_ ## X: \ + retval = do_accumarray_minmax (idx, vals.X ## _array_value (), n, ismin, \ + zero.X ## _scalar_value ()); \ + break + + MAKE_INT_BRANCH (int8); + MAKE_INT_BRANCH (int16); + MAKE_INT_BRANCH (int32); + MAKE_INT_BRANCH (int64); + MAKE_INT_BRANCH (uint8); + MAKE_INT_BRANCH (uint16); + MAKE_INT_BRANCH (uint32); + MAKE_INT_BRANCH (uint64); +#undef MAKE_INT_BRANCH + case btyp_bool: + retval = do_accumarray_minmax (idx, vals.array_value (), n, ismin, + zero.bool_value ()); + break; + default: + gripe_wrong_type_arg ("accumarray", vals); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (__accumarray_min__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_min__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, true); +} + +DEFUN (__accumarray_max__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumarray_max__ (@var{idx}, @var{vals}, @var{zero}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return do_accumarray_minmax_fun (args, false); +} + +template +static NDT +do_accumdim_sum (const idx_vector& idx, const NDT& vals, + int dim = -1, octave_idx_type n = -1) +{ + typedef typename NDT::element_type T; + if (n < 0) + n = idx.extent (0); + else if (idx.extent (n) > n) + error ("accumdim: index out of range"); + + dim_vector vals_dim = vals.dims (), rdv = vals_dim; + + if (dim < 0) + dim = vals.dims ().first_non_singleton (); + else if (dim >= rdv.length ()) + rdv.resize (dim+1, 1); + + rdv(dim) = n; + + NDT retval (rdv, T ()); + + if (idx.length () != vals_dim(dim)) + error ("accumdim: dimension mismatch"); + + retval.idx_add_nd (idx, vals, dim); + + return retval; +} + +DEFUN (__accumdim_sum__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __accumdim_sum__ (@var{idx}, @var{vals}, @var{dim}, @var{n})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + if (nargin >= 2 && nargin <= 4 && args(0).is_numeric_type ()) + { + idx_vector idx = args(0).index_vector (); + int dim = -1; + if (nargin >= 3) + dim = args(2).int_value () - 1; + + octave_idx_type n = -1; + if (nargin == 4) + n = args(3).idx_type_value (true); + + if (! error_state) + { + octave_value vals = args(1); + + if (vals.is_single_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.float_complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.float_array_value (), dim, n); + } + else if (vals.is_numeric_type () || vals.is_bool_type ()) + { + if (vals.is_complex_type ()) + retval = do_accumdim_sum (idx, vals.complex_array_value (), dim, n); + else + retval = do_accumdim_sum (idx, vals.array_value (), dim, n); + } + else + gripe_wrong_type_arg ("accumdim", vals); + } + } + else + print_usage (); + + return retval; +} + +template +static NDT +do_merge (const Array& mask, + const NDT& tval, const NDT& fval) +{ + typedef typename NDT::element_type T; + dim_vector dv = mask.dims (); + NDT retval (dv); + + bool tscl = tval.numel () == 1, fscl = fval.numel () == 1; + + if ((! tscl && tval.dims () != dv) + || (! fscl && fval.dims () != dv)) + error ("merge: MASK, TVAL, and FVAL dimensions must match"); + else + { + T *rv = retval.fortran_vec (); + octave_idx_type n = retval.numel (); + + const T *tv = tval.data (), *fv = fval.data (); + const bool *mv = mask.data (); + + if (tscl) + { + if (fscl) + { + T ts = tv[0], fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fs; + } + else + { + T ts = tv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? ts : fv[i]; + } + } + else + { + if (fscl) + { + T fs = fv[0]; + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fs; + } + else + { + for (octave_idx_type i = 0; i < n; i++) + rv[i] = mv[i] ? tv[i] : fv[i]; + } + } + } + + return retval; +} + +#define MAKE_INT_BRANCH(INTX) \ + else if (tval.is_ ## INTX ## _type () && fval.is_ ## INTX ## _type ()) \ + { \ + retval = do_merge (mask, \ + tval.INTX ## _array_value (), \ + fval.INTX ## _array_value ()); \ + } + +DEFUN (merge, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} merge (@var{mask}, @var{tval}, @var{fval})\n\ +@deftypefnx {Built-in Function} {} ifelse (@var{mask}, @var{tval}, @var{fval})\n\ +Merge elements of @var{true_val} and @var{false_val}, depending on the\n\ +value of @var{mask}. If @var{mask} is a logical scalar, the other two\n\ +arguments can be arbitrary values. Otherwise, @var{mask} must be a logical\n\ +array, and @var{tval}, @var{fval} should be arrays of matching class, or\n\ +cell arrays. In the scalar mask case, @var{tval} is returned if @var{mask}\n\ +is true, otherwise @var{fval} is returned.\n\ +\n\ +In the array mask case, both @var{tval} and @var{fval} must be either\n\ +scalars or arrays with dimensions equal to @var{mask}. The result is\n\ +constructed as follows:\n\ +\n\ +@example\n\ +@group\n\ +result(mask) = tval(mask);\n\ +result(! mask) = fval(! mask);\n\ +@end group\n\ +@end example\n\ +\n\ +@var{mask} can also be arbitrary numeric type, in which case\n\ +it is first converted to logical.\n\ +@seealso{logical, diff}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin == 3 && (args(0).is_bool_type () || args(0).is_numeric_type ())) + { + octave_value mask_val = args(0); + + if (mask_val.is_scalar_type ()) + retval = mask_val.is_true () ? args(1) : args(2); + else + { + boolNDArray mask = mask_val.bool_array_value (); + octave_value tval = args(1), fval = args(2); + if (tval.is_double_type () && fval.is_double_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.complex_array_value (), + fval.complex_array_value ()); + else + retval = do_merge (mask, + tval.array_value (), + fval.array_value ()); + } + else if (tval.is_single_type () && fval.is_single_type ()) + { + if (tval.is_complex_type () || fval.is_complex_type ()) + retval = do_merge (mask, + tval.float_complex_array_value (), + fval.float_complex_array_value ()); + else + retval = do_merge (mask, + tval.float_array_value (), + fval.float_array_value ()); + } + else if (tval.is_string () && fval.is_string ()) + { + bool sq_string = tval.is_sq_string () || fval.is_sq_string (); + retval = octave_value (do_merge (mask, + tval.char_array_value (), + fval.char_array_value ()), + sq_string ? '\'' : '"'); + } + else if (tval.is_cell () && fval.is_cell ()) + { + retval = do_merge (mask, + tval.cell_value (), + fval.cell_value ()); + } + + MAKE_INT_BRANCH (int8) + MAKE_INT_BRANCH (int16) + MAKE_INT_BRANCH (int32) + MAKE_INT_BRANCH (int64) + MAKE_INT_BRANCH (uint8) + MAKE_INT_BRANCH (uint16) + MAKE_INT_BRANCH (uint32) + MAKE_INT_BRANCH (uint64) + + else + error ("merge: cannot merge %s with %s with array mask", + tval.class_name ().c_str (), + fval.class_name ().c_str ()); + } + } + else + print_usage (); + + return retval; +} + +DEFALIAS (ifelse, merge); + +#undef MAKE_INT_BRANCH + +template +static SparseT +do_sparse_diff (const SparseT& array, octave_idx_type order, + int dim) +{ + SparseT retval = array; + if (dim == 1) + { + octave_idx_type k = retval.columns (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (col1, sl1)) - SparseT (retval.index (col2, sl2)); + assert (retval.columns () == k-1); + order--; + k--; + } + } + else + { + octave_idx_type k = retval.rows (); + while (order > 0 && k > 0) + { + idx_vector col1 (':'), col2 (':'), sl1 (1, k), sl2 (0, k-1); + retval = SparseT (retval.index (sl1, col1)) - SparseT (retval.index (sl2, col2)); + assert (retval.rows () == k-1); + order--; + k--; + } + } + + return retval; +} + +static octave_value +do_diff (const octave_value& array, octave_idx_type order, + int dim = -1) +{ + octave_value retval; + + const dim_vector& dv = array.dims (); + if (dim == -1) + { + dim = array.dims ().first_non_singleton (); + + // Bother Matlab. This behavior is really wicked. + if (dv(dim) <= order) + { + if (dv(dim) == 1) + retval = array.resize (dim_vector (0, 0)); + else + { + retval = array; + while (order > 0) + { + if (dim == dv.length ()) + { + retval = do_diff (array, order, dim - 1); + order = 0; + } + else if (dv(dim) == 1) + dim++; + else + { + retval = do_diff (array, dv(dim) - 1, dim); + order -= dv(dim) - 1; + dim++; + } + } + } + + return retval; + } + } + + if (array.is_integer_type ()) + { + if (array.is_int8_type ()) + retval = array.int8_array_value ().diff (order, dim); + else if (array.is_int16_type ()) + retval = array.int16_array_value ().diff (order, dim); + else if (array.is_int32_type ()) + retval = array.int32_array_value ().diff (order, dim); + else if (array.is_int64_type ()) + retval = array.int64_array_value ().diff (order, dim); + else if (array.is_uint8_type ()) + retval = array.uint8_array_value ().diff (order, dim); + else if (array.is_uint16_type ()) + retval = array.uint16_array_value ().diff (order, dim); + else if (array.is_uint32_type ()) + retval = array.uint32_array_value ().diff (order, dim); + else if (array.is_uint64_type ()) + retval = array.uint64_array_value ().diff (order, dim); + else + panic_impossible (); + } + else if (array.is_sparse_type ()) + { + if (array.is_complex_type ()) + retval = do_sparse_diff (array.sparse_complex_matrix_value (), order, dim); + else + retval = do_sparse_diff (array.sparse_matrix_value (), order, dim); + } + else if (array.is_single_type ()) + { + if (array.is_complex_type ()) + retval = array.float_complex_array_value ().diff (order, dim); + else + retval = array.float_array_value ().diff (order, dim); + } + else + { + if (array.is_complex_type ()) + retval = array.complex_array_value ().diff (order, dim); + else + retval = array.array_value ().diff (order, dim); + } + + return retval; +} + +DEFUN (diff, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} diff (@var{x})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k})\n\ +@deftypefnx {Built-in Function} {} diff (@var{x}, @var{k}, @var{dim})\n\ +If @var{x} is a vector of length @math{n}, @code{diff (@var{x})} is the\n\ +vector of first differences\n\ +@tex\n\ + $x_2 - x_1, \\ldots{}, x_n - x_{n-1}$.\n\ +@end tex\n\ +@ifnottex\n\ + @var{x}(2) - @var{x}(1), @dots{}, @var{x}(n) - @var{x}(n-1).\n\ +@end ifnottex\n\ +\n\ +If @var{x} is a matrix, @code{diff (@var{x})} is the matrix of column\n\ +differences along the first non-singleton dimension.\n\ +\n\ +The second argument is optional. If supplied, @code{diff (@var{x},\n\ +@var{k})}, where @var{k} is a non-negative integer, returns the\n\ +@var{k}-th differences. It is possible that @var{k} is larger than\n\ +the first non-singleton dimension of the matrix. In this case,\n\ +@code{diff} continues to take the differences along the next\n\ +non-singleton dimension.\n\ +\n\ +The dimension along which to take the difference can be explicitly\n\ +stated with the optional variable @var{dim}. In this case the\n\ +@var{k}-th order differences are calculated along this dimension.\n\ +In the case where @var{k} exceeds @code{size (@var{x}, @var{dim})}\n\ +an empty matrix is returned.\n\ +@seealso{sort, merge}\n\ +@end deftypefn") +{ + int nargin = args.length (); + octave_value retval; + + if (nargin < 1 || nargin > 3) + print_usage (); + else if (! (args(0).is_numeric_type () || args(0).is_bool_type ())) + error ("diff: X must be numeric or logical"); + + if (! error_state) + { + int dim = -1; + octave_idx_type order = 1; + if (nargin > 1) + { + if (args(1).is_scalar_type ()) + order = args(1).idx_type_value (true, false); + else if (! args(1).is_zero_by_zero ()) + error ("order K must be a scalar or []"); + if (! error_state && order < 0) + error ("order K must be non-negative"); + } + + if (nargin > 2) + { + dim = args(2).int_value (true, false); + if (! error_state && (dim < 1 || dim > args(0).ndims ())) + error ("DIM must be a valid dimension"); + else + dim -= 1; + } + + if (! error_state) + retval = do_diff (args(0), order, dim); + } + + return retval; +} + +/* +%!assert (diff ([1, 2, 3, 4]), [1, 1, 1]) +%!assert (diff ([1, 3, 7, 19], 2), [2, 8]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1]), [4, 2; 3, 3; 1, -1; -6, -5]) +%!assert (diff ([1, 2; 5, 4; 8, 7; 9, 6; 3, 1], 3), [-1, -5; -5, 0]) +%!assert (isempty (diff (1))) + +%!error diff () +%!error diff (1, 2, 3, 4) +%!error diff ("foo") +%!error diff ([1, 2; 3, 4], -1) +*/ + +template +static Array +do_repelems (const Array& src, const Array& rep) +{ + Array retval; + + assert (rep.ndims () == 2 && rep.rows () == 2); + + octave_idx_type n = rep.columns (), l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + if (k < 0) + { + error ("repelems: second row must contain non-negative numbers"); + return retval; + } + + l += k; + } + + retval.clear (1, l); + T *dest = retval.fortran_vec (); + l = 0; + for (octave_idx_type i = 0; i < n; i++) + { + octave_idx_type k = rep(1, i); + std::fill_n (dest, k, src.checkelem (rep(0, i) - 1)); + dest += k; + } + + return retval; +} + +DEFUN (repelems, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} repelems (@var{x}, @var{r})\n\ +Construct a vector of repeated elements from @var{x}. @var{r}\n\ +is a 2x@var{N} integer matrix specifying which elements to repeat and\n\ +how often to repeat each element.\n\ +\n\ +Entries in the first row, @var{r}(1,j), select an element to repeat.\n\ +The corresponding entry in the second row, @var{r}(2,j), specifies\n\ +the repeat count. If @var{x} is a matrix then the columns of @var{x} are\n\ +imagined to be stacked on top of each other for purposes of the selection\n\ +index. A row vector is always returned.\n\ +\n\ +Conceptually the result is calculated as follows:\n\ +\n\ +@example\n\ +@group\n\ +y = [];\n\ +for i = 1:columns (@var{r})\n\ + y = [y, @var{x}(@var{r}(1,i)*ones(1, @var{r}(2,i)))];\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{repmat, cat}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + octave_value x = args(0); + + const Matrix rm = args(1).matrix_value (); + if (error_state) + return retval; + else if (rm.rows () != 2 || rm.ndims () != 2) + { + error ("repelems: R must be a matrix with two rows"); + return retval; + } + else + { + NoAlias< Array > r (rm.dims ()); + + for (octave_idx_type i = 0; i < rm.numel (); i++) + { + octave_idx_type rx = rm(i); + if (static_cast (rx) != rm(i)) + { + error ("repelems: R must be a matrix of integers"); + return retval; + } + + r(i) = rx; + } + + switch (x.builtin_type ()) + { +#define BTYP_BRANCH(X, EX) \ + case btyp_ ## X: \ + retval = do_repelems (x.EX ## _value (), r); \ + break + + BTYP_BRANCH (double, array); + BTYP_BRANCH (float, float_array); + BTYP_BRANCH (complex, complex_array); + BTYP_BRANCH (float_complex, float_complex_array); + BTYP_BRANCH (bool, bool_array); + BTYP_BRANCH (char, char_array); + + BTYP_BRANCH (int8, int8_array); + BTYP_BRANCH (int16, int16_array); + BTYP_BRANCH (int32, int32_array); + BTYP_BRANCH (int64, int64_array); + BTYP_BRANCH (uint8, uint8_array); + BTYP_BRANCH (uint16, uint16_array); + BTYP_BRANCH (uint32, uint32_array); + BTYP_BRANCH (uint64, uint64_array); + + BTYP_BRANCH (cell, cell); + //BTYP_BRANCH (struct, map);//FIXME +#undef BTYP_BRANCH + + default: + gripe_wrong_type_arg ("repelems", x); + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (base64_encode, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{s} =} base64_encode (@var{x})\n\ +Encode a double matrix or array @var{x} into the base64 format string\n\ +@var{s}.\n\ +\n\ +@strong{Warning:} Encoding different numeric types, such as single or\n\ +integer, is not currently supported. Any non-double input will be converted\n\ +to type double before encoding.\n\ +@seealso{base64_decode}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + const Array in = args(0).array_value (); + if (! error_state) + { + const char* inc = reinterpret_cast (in.data ()); + size_t inlen = in.numel () * sizeof (double) / sizeof (char); + char* out; + size_t outlen = base64_encode_alloc (inc, inlen, &out); + + if (! out && outlen == 0 && inlen != 0) + error ("base64_encode: input array too large"); + else if (! out) + error ("base64_encode: memory allocation error"); + else + retval(0) = octave_value (out); + } + } + + return retval; +} + +/* +%!assert (base64_encode (single (pi)), "AAAAYPshCUA=") +%!assert (base64_encode (uint8 (pi)), base64_encode (double (uint8 (pi)))) + +%!error base64_encode () +%!error base64_encode (1,2) +%!error base64_encode ("A string") +*/ + +DEFUN (base64_decode, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{x} =} base64_decode (@var{s})\n\ +@deftypefnx {Built-in Function} {@var{x} =} base64_decode (@var{s}, @var{dims})\n\ +Decode the double matrix or array @var{x} from the base64 format string\n\ +@var{s}. The optional input parameter @var{dims} should be a vector\n\ +containing the dimensions of the decoded array.\n\ +@seealso{base64_encode}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2) + print_usage (); + else + { + dim_vector new_dims; + Array res; + + if (nargin > 1) + { + const Array new_size = + args(1).octave_idx_type_vector_value (); + if (! error_state) + { + new_dims = dim_vector::alloc (new_size.length ()); + for (octave_idx_type i = 0; i < new_size.length (); i++) + new_dims(i) = new_size(i); + } + } + + const std::string in = args(0).string_value (); + + if (! error_state) + { + const char *inc = &(in[0]); + char *out; + size_t inlen = in.length (), outlen; + + bool ok = base64_decode_alloc (inc, inlen, &out, &outlen); + + if (! ok) + error ("base64_decode: input was not valid base64"); + else if (! out) + error ("base64_decode: memory allocation error"); + else + { + if ((outlen % (sizeof (double) / sizeof (char))) != 0) + error ("base64_decode: incorrect input size"); + else + { + octave_idx_type l; + l = (outlen * sizeof (char)) / sizeof (double); + res.resize1 (l); + double *dout = reinterpret_cast (out); + std::copy (dout, dout + l, res.fortran_vec ()); + + if (nargin > 1) + retval(0) = octave_value (res).reshape (new_dims); + else + retval(0) = octave_value (res); + } + } + } + } + + return retval; +} + +/* +%!assert (base64_decode (base64_encode (pi)), pi) +%! +%!test +%! in = randn (10); +%! outv = base64_decode (base64_encode (in)); +%! outm = base64_decode (base64_encode (in), size (in)); +%! assert (outv, in(:).'); +%! assert (outm, in); + +%!error base64_decode () +%!error base64_decode (1,2,3) +%!error base64_decode (1, "this is not a valid set of dimensions") +%!error base64_decode (1) +%!error base64_decode ("AQ=") +%!error base64_decode ("AQ==") +*/ diff -r 069c552587a0 -r 959953dba519 src/interpfcn/data.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/data.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_data_h) +#define octave_data_h 1 + +#include + +class octave_value; +class octave_value_list; + +extern OCTINTERP_API octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/debug.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/debug.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1268 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp +Copyright (C) 2007-2009 John Swensen + +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 3 of the License, 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, see +. + +*/ +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include +#include + +#include "file-stat.h" +#include "singleton-cleanup.h" + +#include "defun.h" +#include "error.h" +#include "help.h" +#include "input.h" +#include "pager.h" +#include "oct-obj.h" +#include "utils.h" +#include "parse.h" +#include "symtab.h" +#include "gripes.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "ov-fcn.h" +#include "ov-struct.h" +#include "pt-pr-code.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +#include "debug.h" + +// Initialize the singleton object +bp_table *bp_table::instance = 0; + +static std::string +snarf_file (const std::string& fname) +{ + std::string retval; + + file_stat fs (fname); + + if (fs) + { + size_t sz = fs.size (); + + std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); + + if (file) + { + std::string buf (sz+1, 0); + + file.read (&buf[0], sz+1); + + if (file.eof ()) + { + // Expected to read the entire file. + + retval = buf; + } + else + error ("error reading file %s", fname.c_str ()); + } + } + + return retval; +} + +static std::deque +get_line_offsets (const std::string& buf) +{ + // This could maybe be smarter. Is deque the right thing to use + // here? + + std::deque offsets; + + offsets.push_back (0); + + size_t len = buf.length (); + + for (size_t i = 0; i < len; i++) + { + char c = buf[i]; + + if (c == '\r' && ++i < len) + { + c = buf[i]; + + if (c == '\n') + offsets.push_back (i+1); + else + offsets.push_back (i); + } + else if (c == '\n') + offsets.push_back (i+1); + } + + offsets.push_back (len); + + return offsets; +} + +std::string +get_file_line (const std::string& fname, size_t line) +{ + std::string retval; + + static std::string last_fname; + + static std::string buf; + + static std::deque offsets; + + if (fname != last_fname) + { + buf = snarf_file (fname); + + offsets = get_line_offsets (buf); + } + + if (line > 0) + line--; + + if (line < offsets.size () - 1) + { + size_t bol = offsets[line]; + size_t eol = offsets[line+1]; + + while (eol > 0 && eol > bol && (buf[eol-1] == '\n' || buf[eol-1] == '\r')) + eol--; + + retval = buf.substr (bol, eol - bol); + } + + return retval; +} + +// Return a pointer to the user-defined function FNAME. If FNAME is +// empty, search backward for the first user-defined function in the +// current call stack. + +static octave_user_code * +get_user_code (const std::string& fname = std::string ()) +{ + octave_user_code *dbg_fcn = 0; + + if (fname.empty ()) + dbg_fcn = octave_call_stack::caller_user_code (); + else + { + octave_value fcn = symbol_table::find_function (fname); + + if (fcn.is_defined () && fcn.is_user_code ()) + dbg_fcn = fcn.user_code_value (); + } + + return dbg_fcn; +} + +static void +parse_dbfunction_params (const char *who, const octave_value_list& args, + std::string& symbol_name, bp_table::intmap& lines) +{ + int nargin = args.length (); + int idx = 0; + int list_idx = 0; + symbol_name = std::string (); + lines = bp_table::intmap (); + + if (args.length () == 0) + return; + + // If we are already in a debugging function. + if (octave_call_stack::caller_user_code ()) + { + idx = 0; + symbol_name = get_user_code ()->name (); + } + else if (args(0).is_map ()) + { + // Problem because parse_dbfunction_params() can only pass out a + // single function + } + else if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + if (error_state) + return; + idx = 1; + } + else + error ("%s: invalid parameter specified", who); + + for (int i = idx; i < nargin; i++ ) + { + if (args(i).is_string ()) + { + int line = atoi (args(i).string_value ().c_str ()); + if (error_state) + break; + lines[list_idx++] = line; + } + else if (args(i).is_map ()) + octave_stdout << who << ": accepting a struct" << std::endl; + else + { + const NDArray arg = args(i).array_value (); + + if (error_state) + break; + + for (octave_idx_type j = 0; j < arg.nelem (); j++) + { + int line = static_cast (arg.elem (j)); + if (error_state) + break; + lines[list_idx++] = line; + } + + if (error_state) + break; + } + } +} + +bool +bp_table::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new bp_table (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create breakpoint table!"); + retval = false; + } + + return retval; +} + +bp_table::intmap +bp_table::do_add_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + intmap retval; + + octave_idx_type len = line.size (); + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + for (int i = 0; i < len; i++) + { + const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + + retval[i] = cmds->set_breakpoint (lineno); + + if (retval[i] != 0) + { + bp_set.insert (fname); + } + } + } + } + } + else + error ("add_breakpoint: unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + + +int +bp_table::do_remove_breakpoint (const std::string& fname, + const bp_table::intmap& line) +{ + int retval = 0; + + octave_idx_type len = line.size (); + + if (len == 0) + { + intmap results = remove_all_breakpoints_in_file (fname); + retval = results.size (); + } + else + { + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + octave_value_list results = cmds->list_breakpoints (); + + if (results.length () > 0) + { + for (int i = 0; i < len; i++) + { + const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + cmds->delete_breakpoint (p->second); + } + + results = cmds->list_breakpoints (); + + bp_set_iterator it = bp_set.find (fname); + if (results.length () == 0 && it != bp_set.end ()) + bp_set.erase (it); + + } + + retval = results.length (); + } + } + else + error ("remove_breakpoint: unable to find the requested function\n"); + } + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + + +bp_table::intmap +bp_table::do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent) +{ + intmap retval; + + octave_user_code *dbg_fcn = get_user_code (fname); + + if (dbg_fcn) + { + tree_statement_list *cmds = dbg_fcn->body (); + + if (cmds) + { + octave_value_list bkpts = cmds->list_breakpoints (); + + for (int i = 0; i < bkpts.length (); i++) + { + int lineno = static_cast (bkpts(i).int_value ()); + cmds->delete_breakpoint (lineno); + retval[i] = lineno; + } + + bp_set_iterator it = bp_set.find (fname); + if (it != bp_set.end ()) + bp_set.erase (it); + + } + } + else if (! silent) + error ("remove_all_breakpoint_in_file: " + "unable to find the requested function\n"); + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; + + return retval; +} + +void +bp_table::do_remove_all_breakpoints (void) +{ + for (const_bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + remove_all_breakpoints_in_file (*it); + + + tree_evaluator::debug_mode = bp_table::have_breakpoints () || Vdebugging; +} + +std::string +do_find_bkpt_list (octave_value_list slist, + std::string match) +{ + std::string retval; + + for (int i = 0; i < slist.length (); i++) + { + if (slist (i).string_value () == match) + { + retval = slist(i).string_value (); + break; + } + } + + return retval; +} + + +bp_table::fname_line_map +bp_table::do_get_breakpoint_list (const octave_value_list& fname_list) +{ + fname_line_map retval; + + for (bp_set_iterator it = bp_set.begin (); it != bp_set.end (); it++) + { + if (fname_list.length () == 0 + || do_find_bkpt_list (fname_list, *it) != "") + { + octave_user_code *f = get_user_code (*it); + + if (f) + { + tree_statement_list *cmds = f->body (); + + if (cmds) + { + octave_value_list bkpts = cmds->list_breakpoints (); + octave_idx_type len = bkpts.length (); + + if (len > 0) + { + bp_table::intmap bkpts_vec; + + for (int i = 0; i < len; i++) + bkpts_vec[i] = bkpts (i).double_value (); + + std::string symbol_name = f->name (); + + retval[symbol_name] = bkpts_vec; + } + } + } + } + } + + return retval; +} + +static octave_value +intmap_to_ov (const bp_table::intmap& line) +{ + int idx = 0; + + NDArray retval (dim_vector (1, line.size ())); + + for (size_t i = 0; i < line.size (); i++) + { + bp_table::const_intmap_iterator p = line.find (i); + + if (p != line.end ()) + { + int lineno = p->second; + retval(idx++) = lineno; + } + } + + retval.resize (dim_vector (1, idx)); + + return retval; +} + +DEFUN (dbstop, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {@var{rline} =} dbstop (\"@var{func}\", @var{line}, @dots{})\n\ +Set a breakpoint in function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this should be left out and only the line should be given.\n\ +\n\ +@item line\n\ +Line number where the breakpoint should be set. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called with a single argument @var{func}, the breakpoint\n\ +is set at the first executable line in the named function.\n\ +\n\ +The optional output @var{rline} is the real line number where the\n\ +breakpoint was set. This can differ from specified line if\n\ +the line is not executable. For example, if a breakpoint attempted on a\n\ +blank line then Octave will set the real breakpoint at the\n\ +next executable line.\n\ +@seealso{dbclear, dbstatus, dbstep, debug_on_error, debug_on_warning, debug_on_interrupt}\n\ +@end deftypefn") +{ + bp_table::intmap retval; + std::string symbol_name; + bp_table::intmap lines; + + parse_dbfunction_params ("dbstop", args, symbol_name, lines); + + if (lines.size () == 0) + lines[0] = 1; + + if (! error_state) + retval = bp_table::add_breakpoint (symbol_name, lines); + + return intmap_to_ov (retval); +} + +DEFUN (dbclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbclear (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {} dbclear (\"@var{func}\", @var{line}, @dots{})\n\ +Delete a breakpoint in the function @var{func}.\n\ +\n\ +Arguments are\n\ +\n\ +@table @var\n\ +@item func\n\ +Function name as a string variable. When already in debug\n\ +mode this should be left out and only the line should be given.\n\ +\n\ +@item line\n\ +Line number from which to remove a breakpoint. Multiple\n\ +lines may be given as separate arguments or as a vector.\n\ +@end table\n\ +\n\ +When called without a line number specification all breakpoints\n\ +in the named function are cleared.\n\ +\n\ +If the requested line is not a breakpoint no action is performed.\n\ +@seealso{dbstop, dbstatus, dbwhere}\n\ +@end deftypefn") +{ + octave_value retval; + std::string symbol_name = ""; + bp_table::intmap lines; + + parse_dbfunction_params ("dbclear", args, symbol_name, lines); + + if (! error_state) + bp_table::remove_breakpoint (symbol_name, lines); + + return retval; +} + +DEFUN (dbstatus, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus ()\n\ +@deftypefnx {Built-in Function} {@var{brk_list} =} dbstatus (\"@var{func}\")\n\ +Report the location of active breakpoints.\n\ +\n\ +When called with no input or output arguments, print the list of\n\ +all functions with breakpoints and the line numbers where those\n\ +breakpoints are set.\n\ +If a function name @var{func} is specified then only report breakpoints\n\ +for the named function.\n\ +\n\ +The optional return argument @var{brk_list} is a struct array with the\n\ +following fields.\n\ +\n\ +@table @asis\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item line\n\ +A line number, or vector of line numbers, with a breakpoint.\n\ +@end table\n\ +\n\ +@seealso{dbclear, dbwhere}\n\ +@end deftypefn") +{ + octave_map retval; + int nargin = args.length (); + octave_value_list fcn_list; + bp_table::fname_line_map bp_list; + std::string symbol_name; + + if (nargin != 0 && nargin != 1) + { + error ("dbstatus: only zero or one arguments accepted\n"); + return octave_value (); + } + + if (nargin == 1) + { + if (args(0).is_string ()) + { + symbol_name = args(0).string_value (); + fcn_list(0) = symbol_name; + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + else + gripe_wrong_type_arg ("dbstatus", args(0)); + } + else + { + octave_user_code *dbg_fcn = get_user_code (); + if (dbg_fcn) + { + symbol_name = dbg_fcn->name (); + fcn_list(0) = symbol_name; + } + + bp_list = bp_table::get_breakpoint_list (fcn_list); + } + + if (nargout == 0) + { + // Print out the breakpoint information. + + for (bp_table::fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + bp_table::intmap m = it->second; + + size_t nel = m.size (); + + octave_stdout << "breakpoint in " << it->first; + if (nel > 1) + octave_stdout << " at lines "; + else + octave_stdout << " at line "; + + for (size_t j = 0; j < nel; j++) + octave_stdout << m[j] << ((j < nel - 1) ? ", " : "."); + + if (nel > 0) + octave_stdout << std::endl; + } + return octave_value (); + } + else + { + // Fill in an array for return. + + int i = 0; + Cell names (dim_vector (bp_list.size (), 1)); + Cell file (dim_vector (bp_list.size (), 1)); + Cell line (dim_vector (bp_list.size (), 1)); + + for (bp_table::const_fname_line_map_iterator it = bp_list.begin (); + it != bp_list.end (); it++) + { + names(i) = it->first; + line(i) = intmap_to_ov (it->second); + file(i) = do_which (it->first); + i++; + } + + retval.assign ("name", names); + retval.assign ("file", file); + retval.assign ("line", line); + + return octave_value (retval); + } +} + +DEFUN (dbwhere, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbwhere ()\n\ +In debugging mode, report the current file and line number where\n\ +execution is stopped.\n\ +@seealso{dbstatus, dbcont, dbstep, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + octave_user_code *dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + bool have_file = true; + + std::string name = dbg_fcn->fcn_file_name (); + + if (name.empty ()) + { + have_file = false; + + name = dbg_fcn->name (); + } + + octave_stdout << "stopped in " << name << " at "; + + int l = octave_call_stack::caller_user_code_line (); + + if (l > 0) + { + octave_stdout << " line " << l << std::endl; + + if (have_file) + { + std::string line = get_file_line (name, l); + + if (! line.empty ()) + octave_stdout << l << ": " << line << std::endl; + } + } + else + octave_stdout << " " << std::endl; + } + else + error ("dbwhere: must be inside a user function to use dbwhere\n"); + + return retval; +} + +// Copied and modified from the do_type command in help.cc +// Maybe we could share some code? +void +do_dbtype (std::ostream& os, const std::string& name, int start, int end) +{ + std::string ff = fcn_file_in_path (name); + + if (! ff.empty ()) + { + std::ifstream fs (ff.c_str (), std::ios::in); + + if (fs) + { + char ch; + int line = 1; + + if (line >= start && line <= end) + os << line << "\t"; + + while (fs.get (ch)) + { + if (line >= start && line <= end) + { + os << ch; + } + + if (ch == '\n') + { + line++; + if (line >= start && line <= end) + os << line << "\t"; + } + } + } + else + os << "dbtype: unable to open `" << ff << "' for reading!\n"; + } + else + os << "dbtype: unknown function " << name << "\n"; + + os.flush (); +} + +DEFUN (dbtype, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbtype ()\n\ +@deftypefnx {Built-in Function} {} dbtype (\"startl:endl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"startl:end\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:endl\")\n\ +@deftypefnx {Built-in Function} {} dbtype (\"@var{func}\", \"startl:end\")\n\ +When in debugging mode and called with no arguments, list the script file\n\ +being debugged with line numbers. An optional range specification,\n\ +specified as a string, can be used to list only a portion of the file.\n\ +The special keyword \"end\" is a valid line number specification.\n\ +\n\ +When called with the name of a function, list that script file\n\ +with line numbers.\n\ +@seealso{dbstatus, dbstop}\n\ +@end deftypefn") +{ + octave_value retval; + octave_user_code *dbg_fcn; + + int nargin = args.length (); + string_vector argv = args.make_argv ("dbtype"); + + if (! error_state) + { + switch (nargin) + { + case 0: // dbtype + dbg_fcn = get_user_code (); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); + else + error ("dbtype: must be inside a user function to give no arguments to dbtype\n"); + break; + + case 1: // (dbtype func) || (dbtype start:end) + { + std::string arg = argv[1]; + + size_t ind = arg.find (':'); + + if (ind != std::string::npos) // (dbtype start:end) + { + dbg_fcn = get_user_code (); + + if (dbg_fcn) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + int start, end; + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = INT_MAX; + else + end = atoi (end_str.c_str ()); + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + } + else // (dbtype func) + { + dbg_fcn = get_user_code (arg); + + if (dbg_fcn) + do_dbtype (octave_stdout, dbg_fcn->name (), 0, INT_MAX); + else + error ("dbtype: function <%s> not found\n", arg.c_str ()); + } + } + break; + + case 2: // (dbtype func start:end) , (dbtype func start) + dbg_fcn = get_user_code (argv[1]); + + if (dbg_fcn) + { + std::string arg = argv[2]; + int start, end; + size_t ind = arg.find (':'); + + if (ind != std::string::npos) + { + std::string start_str = arg.substr (0, ind); + std::string end_str = arg.substr (ind + 1); + + start = atoi (start_str.c_str ()); + if (end_str == "end") + end = INT_MAX; + else + end = atoi (end_str.c_str ()); + } + else + { + start = atoi (arg.c_str ()); + end = start; + } + + if (std::min (start, end) <= 0) + error ("dbtype: start and end lines must be >= 1\n"); + + if (start <= end) + do_dbtype (octave_stdout, dbg_fcn->name (), start, end); + else + error ("dbtype: start line must be less than end line\n"); + } + else + error ("dbtype: function <%s> not found\n", argv[1].c_str ()); + + break; + + default: + error ("dbtype: expecting zero, one, or two arguments\n"); + } + } + + return retval; +} + +static octave_value_list +do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) +{ + octave_value_list retval; + + unwind_protect frame; + + octave_idx_type curr_frame = -1; + + size_t nskip = 0; + + if (args.length () == 1) + { + int n = 0; + + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + + if (n > 0) + nskip = n; + else + error ("dbstack: N must be a non-negative integer"); + } + + if (! error_state) + { + octave_map stk = octave_call_stack::backtrace (nskip, curr_frame); + + if (nargout == 0) + { + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + os << "stopped in:\n\n"; + + Cell names = stk.contents ("name"); + Cell files = stk.contents ("file"); + Cell lines = stk.contents ("line"); + + bool show_top_level = true; + + size_t max_name_len = 0; + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + + max_name_len = std::max (name.length (), max_name_len); + } + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + std::string name = names(i).string_value (); + std::string file = files(i).string_value (); + int line = lines(i).int_value (); + + if (show_top_level && i == curr_frame) + show_top_level = false; + + os << (i == curr_frame ? " --> " : " ") + << std::setw (max_name_len) << name + << " at line " << line + << " [" << file << "]" + << std::endl; + } + + if (show_top_level) + os << " --> top level" << std::endl; + } + } + else + { + retval(1) = curr_frame < 0 ? 1 : curr_frame + 1; + retval(0) = stk; + } + } + + return retval; +} + +// A function that can be easily called from a debugger print the Octave +// stack. This can be useful for finding what line of code the +// interpreter is currently executing when the debugger is stopped in +// some C++ function, for example. + +void +show_octave_dbstack (void) +{ + do_dbstack (octave_value_list (), 0, std::cerr); +} + +DEFUN (dbstack, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbstack ()\n\ +@deftypefnx {Built-in Function} {} dbstack (@var{n})\n\ +@deftypefnx {Built-in Function} {[@var{stack}, @var{idx}] =} dbstack (@dots{})\n\ +Display or return current debugging function stack information.\n\ +With optional argument @var{n}, omit the @var{n} innermost stack frames.\n\ +\n\ +The optional return argument @var{stack} is a struct array with the\n\ +following fields:\n\ +\n\ +@table @asis\n\ +@item file\n\ +The name of the m-file where the function code is located.\n\ +\n\ +@item name\n\ +The name of the function with a breakpoint.\n\ +\n\ +@item line\n\ +The line number of an active breakpoint.\n\ +\n\ +@item column\n\ +The column number of the line where the breakpoint begins.\n\ +\n\ +@item scope\n\ +Undocumented.\n\ +\n\ +@item context\n\ +Undocumented.\n\ +@end table\n\ +\n\ +The return argument @var{idx} specifies which element of the @var{stack}\n\ +struct array is currently active.\n\ +@seealso{dbup, dbdown, dbwhere, dbstatus}\n\ +@end deftypefn") +{ + return do_dbstack (args, nargout, octave_stdout); +} + +static void +do_dbupdown (const octave_value_list& args, const std::string& who) +{ + int n = 1; + + if (args.length () == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + n = atoi (s_arg.c_str ()); + } + else + n = args(0).int_value (); + } + + if (! error_state) + { + if (who == "dbup") + n = -n; + + if (! octave_call_stack::goto_frame_relative (n, true)) + error ("%s: invalid stack frame", who.c_str ()); + } +} + +DEFUN (dbup, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbup\n\ +@deftypefnx {Built-in Function} {} dbup (@var{n})\n\ +In debugging mode, move up the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move up one frame.\n\ +@seealso{dbstack, dbdown}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbup"); + + return retval; +} + +DEFUN (dbdown, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dbdown\n\ +@deftypefnx {Built-in Function} {} dbdown (@var{n})\n\ +In debugging mode, move down the execution stack @var{n} frames.\n\ +If @var{n} is omitted, move down one frame.\n\ +@seealso{dbstack, dbup}\n\ +@end deftypefn") +{ + octave_value retval; + + do_dbupdown (args, "dbdown"); + + return retval; +} + +DEFUN (dbstep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbstep\n\ +@deftypefnx {Command} {} dbstep @var{n}\n\ +@deftypefnx {Command} {} dbstep in\n\ +@deftypefnx {Command} {} dbstep out\n\ +@deftypefnx {Command} {} dbnext @dots{}\n\ +In debugging mode, execute the next @var{n} lines of code.\n\ +If @var{n} is omitted, execute the next single line of code.\n\ +If the next line of code is itself defined in terms of an m-file remain in\n\ +the existing function.\n\ +\n\ +Using @code{dbstep in} will cause execution of the next line to step into\n\ +any m-files defined on the next line. Using @code{dbstep out} will cause\n\ +execution to continue until the current function returns.\n\ +\n\ +@code{dbnext} is an alias for @code{dbstep}.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + int nargin = args.length (); + + if (nargin > 1) + print_usage (); + else if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + if (arg == "in") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -1; + } + else if (arg == "out") + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = -2; + } + else + { + int n = atoi (arg.c_str ()); + + if (n > 0) + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = n; + } + else + error ("dbstep: invalid argument"); + } + } + } + else + error ("dbstep: input argument must be a character string"); + } + else + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = 1; + } + } + else + error ("dbstep: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFALIAS (dbnext, dbstep); + +DEFUN (dbcont, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbcont\n\ +Leave command-line debugging mode and continue code execution normally.\n\ +@seealso{dbstep, dbquit}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + } + else + print_usage (); + } + else + error ("dbcont: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (dbquit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} dbquit\n\ +Quit debugging mode immediately without further code execution and\n\ +return to the Octave prompt.\n\ +@seealso{dbcont, dbstep}\n\ +@end deftypefn") +{ + if (Vdebugging) + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::reset_debug_state (); + + octave_throw_interrupt_exception (); + } + else + print_usage (); + } + else + error ("dbquit: can only be called in debug mode"); + + return octave_value_list (); +} + +DEFUN (isdebugmode, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isdebugmode ()\n\ +Return true if in debugging mode, otherwise false.\n\ +@seealso{dbwhere, dbstack, dbstatus}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Vdebugging; + else + print_usage (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/debug.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/debug.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,134 @@ +/* + +Copyright (C) 2001-2012 Ben Sapp + +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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_debug_h) +#define octave_debug_h 1 + +#include +#include +#include "ov.h" +#include "dRowVector.h" + +class octave_value_list; +class octave_user_code; + +// Interface to breakpoints,. + +class +OCTINTERP_API +bp_table +{ +private: + + bp_table (void) : bp_set () { } + + ~bp_table (void) { } + +public: + + typedef std::map intmap; + + typedef intmap::const_iterator const_intmap_iterator; + typedef intmap::iterator intmap_iterator; + + typedef std::map fname_line_map; + + typedef fname_line_map::const_iterator const_fname_line_map_iterator; + typedef fname_line_map::iterator fname_line_map_iterator; + + static bool instance_ok (void); + + // Add a breakpoint at the nearest executable line. + static intmap add_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_add_breakpoint (fname, lines) : intmap (); + } + + // Remove a breakpoint from a line in file. + static int remove_breakpoint (const std::string& fname = "", + const intmap& lines = intmap ()) + { + return instance_ok () + ? instance->do_remove_breakpoint (fname, lines) : 0; + } + + // Remove all the breakpoints in a specified file. + static intmap remove_all_breakpoints_in_file (const std::string& fname, + bool silent = false) + { + return instance_ok () + ? instance->do_remove_all_breakpoints_in_file (fname, silent) : intmap (); + } + + // Remove all the breakpoints registered with octave. + static void remove_all_breakpoints (void) + { + if (instance_ok ()) + instance->do_remove_all_breakpoints (); + } + + // Return all breakpoints. Each element of the map is a vector + // containing the breakpoints corresponding to a given function name. + static fname_line_map + get_breakpoint_list (const octave_value_list& fname_list) + { + return instance_ok () + ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); + } + + static bool + have_breakpoints (void) + { + return instance_ok () ? instance->do_have_breakpoints () : 0; + } + +private: + + typedef std::set::const_iterator const_bp_set_iterator; + typedef std::set::iterator bp_set_iterator; + + // Set of function names containing at least one breakpoint. + std::set bp_set; + + static bp_table *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + intmap do_add_breakpoint (const std::string& fname, const intmap& lines); + + int do_remove_breakpoint (const std::string&, const intmap& lines); + + intmap do_remove_all_breakpoints_in_file (const std::string& fname, + bool silent); + + void do_remove_all_breakpoints (void); + + fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); + + bool do_have_breakpoints (void) { return (! bp_set.empty ()); } +}; + +std::string get_file_line (const std::string& fname, size_t line); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/defaults.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defaults.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,557 @@ +/* + +Copyright (C) 1996-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include + +#include +#include + +#include "dir-ops.h" +#include "oct-env.h" +#include "file-stat.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "file-ops.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" +#include + +std::string Voctave_home; + +std::string Vbin_dir; +std::string Vinfo_dir; +std::string Vdata_dir; +std::string Vlibexec_dir; +std::string Varch_lib_dir; +std::string Vlocal_arch_lib_dir; +std::string Vlocal_api_arch_lib_dir; +std::string Vlocal_ver_arch_lib_dir; + +std::string Vlocal_ver_oct_file_dir; +std::string Vlocal_api_oct_file_dir; +std::string Vlocal_oct_file_dir; + +std::string Vlocal_ver_fcn_file_dir; +std::string Vlocal_api_fcn_file_dir; +std::string Vlocal_fcn_file_dir; + +std::string Voct_file_dir; +std::string Vfcn_file_dir; + +std::string Vimage_dir; + +// The path that will be searched for programs that we execute. +// (--exec-path path) +static std::string VEXEC_PATH; + +// Name of the editor to be invoked by the edit_history command. +std::string VEDITOR; + +static std::string VIMAGE_PATH; + +std::string Vlocal_site_defaults_file; +std::string Vsite_defaults_file; + +std::string +subst_octave_home (const std::string& s) +{ + std::string retval; + + std::string prefix = OCTAVE_PREFIX; + + retval = s; + + if (Voctave_home != prefix) + { + octave_idx_type len = prefix.length (); + + if (s.substr (0, len) == prefix) + retval.replace (0, len, Voctave_home); + } + + if (file_ops::dir_sep_char () != '/') + std::replace (retval.begin (), retval.end (), '/', + file_ops::dir_sep_char ()); + + return retval; +} + +static void +set_octave_home (void) +{ + std::string oh = octave_env::getenv ("OCTAVE_HOME"); + + Voctave_home = oh.empty () ? std::string (OCTAVE_PREFIX) : oh; +} + +static void +set_default_info_dir (void) +{ + Vinfo_dir = subst_octave_home (OCTAVE_INFODIR); +} + +static void +set_default_data_dir (void) +{ + Vdata_dir = subst_octave_home (OCTAVE_DATADIR); +} + +static void +set_default_libexec_dir (void) +{ + Vlibexec_dir = subst_octave_home (OCTAVE_LIBEXECDIR); +} + +static void +set_default_arch_lib_dir (void) +{ + Varch_lib_dir = subst_octave_home (OCTAVE_ARCHLIBDIR); +} + +static void +set_default_local_arch_lib_dir (void) +{ + Vlocal_arch_lib_dir = subst_octave_home (OCTAVE_LOCALARCHLIBDIR); +} + +static void +set_default_local_api_arch_lib_dir (void) +{ + Vlocal_api_arch_lib_dir = subst_octave_home (OCTAVE_LOCALAPIARCHLIBDIR); +} + +static void +set_default_local_ver_arch_lib_dir (void) +{ + Vlocal_ver_arch_lib_dir = subst_octave_home (OCTAVE_LOCALVERARCHLIBDIR); +} + +static void +set_default_local_ver_oct_file_dir (void) +{ + Vlocal_ver_oct_file_dir = subst_octave_home (OCTAVE_LOCALVEROCTFILEDIR); +} + +static void +set_default_local_api_oct_file_dir (void) +{ + Vlocal_api_oct_file_dir = subst_octave_home (OCTAVE_LOCALAPIOCTFILEDIR); +} + +static void +set_default_local_oct_file_dir (void) +{ + Vlocal_oct_file_dir = subst_octave_home (OCTAVE_LOCALOCTFILEDIR); +} + +static void +set_default_local_ver_fcn_file_dir (void) +{ + Vlocal_ver_fcn_file_dir = subst_octave_home (OCTAVE_LOCALVERFCNFILEDIR); +} + +static void +set_default_local_api_fcn_file_dir (void) +{ + Vlocal_api_fcn_file_dir = subst_octave_home (OCTAVE_LOCALAPIFCNFILEDIR); +} + +static void +set_default_local_fcn_file_dir (void) +{ + Vlocal_fcn_file_dir = subst_octave_home (OCTAVE_LOCALFCNFILEDIR); +} + +static void +set_default_fcn_file_dir (void) +{ + Vfcn_file_dir = subst_octave_home (OCTAVE_FCNFILEDIR); +} + +static void +set_default_image_dir (void) +{ + Vimage_dir = subst_octave_home (OCTAVE_IMAGEDIR); +} + +static void +set_default_oct_file_dir (void) +{ + Voct_file_dir = subst_octave_home (OCTAVE_OCTFILEDIR); +} + +static void +set_default_bin_dir (void) +{ + Vbin_dir = subst_octave_home (OCTAVE_BINDIR); +} + +void +set_exec_path (const std::string& path_arg) +{ + std::string tpath = path_arg; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_EXEC_PATH"); + + if (tpath.empty ()) + tpath = Vlocal_ver_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_api_arch_lib_dir + dir_path::path_sep_str () + + Vlocal_arch_lib_dir + dir_path::path_sep_str () + + Varch_lib_dir + dir_path::path_sep_str () + + Vbin_dir; + + VEXEC_PATH = tpath; + + // FIXME -- should we really be modifying PATH in the environment? + // The way things are now, Octave will ignore directories set in the + // PATH with calls like + // + // setenv ("PATH", "/my/path"); + // + // To fix this, I think Octave should be searching the combination of + // PATH and EXEC_PATH for programs that it executes instead of setting + // the PATH in the environment and relying on the shell to do the + // searching. + + // This is static so that even if set_exec_path is called more than + // once, shell_path is the original PATH from the environment, + // before we start modifying it. + static std::string shell_path = octave_env::getenv ("PATH"); + + if (! shell_path.empty ()) + tpath = shell_path + dir_path::path_sep_str () + tpath; + + octave_env::putenv ("PATH", tpath); +} + +void +set_image_path (const std::string& path) +{ + VIMAGE_PATH = "."; + + std::string tpath = path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_IMAGE_PATH"); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; + + tpath = genpath (Vimage_dir, ""); + + if (! tpath.empty ()) + VIMAGE_PATH += dir_path::path_sep_str () + tpath; +} + +static void +set_default_doc_cache_file (void) +{ + std::string def_file = subst_octave_home (OCTAVE_DOC_CACHE_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_DOC_CACHE_FILE"); + + Vdoc_cache_file = env_file.empty () ? def_file : env_file; +} + +static void +set_default_texi_macros_file (void) +{ + std::string def_file = subst_octave_home (OCTAVE_TEXI_MACROS_FILE); + + std::string env_file = octave_env::getenv ("OCTAVE_TEXI_MACROS_FILE"); + + Vtexi_macros_file = env_file.empty () ? def_file : env_file; +} + +static void +set_default_info_file (void) +{ + std::string std_info_file = subst_octave_home (OCTAVE_INFOFILE); + + std::string oct_info_file = octave_env::getenv ("OCTAVE_INFO_FILE"); + + Vinfo_file = oct_info_file.empty () ? std_info_file : oct_info_file; +} + +static void +set_default_info_prog (void) +{ + std::string oct_info_prog = octave_env::getenv ("OCTAVE_INFO_PROGRAM"); + + if (oct_info_prog.empty ()) + Vinfo_program = "info"; + else + Vinfo_program = std::string (oct_info_prog); +} + +static void +set_default_editor (void) +{ + VEDITOR = "emacs"; + + std::string env_editor = octave_env::getenv ("EDITOR"); + + if (! env_editor.empty ()) + VEDITOR = env_editor; +} + +static void +set_local_site_defaults_file (void) +{ + std::string lsf = octave_env::getenv ("OCTAVE_SITE_INITFILE"); + + if (lsf.empty ()) + { + Vlocal_site_defaults_file = subst_octave_home (OCTAVE_LOCALSTARTUPFILEDIR); + Vlocal_site_defaults_file.append ("/octaverc"); + } + else + Vlocal_site_defaults_file = lsf; +} + +static void +set_site_defaults_file (void) +{ + std::string sf = octave_env::getenv ("OCTAVE_VERSION_INITFILE"); + + if (sf.empty ()) + { + Vsite_defaults_file = subst_octave_home (OCTAVE_STARTUPFILEDIR); + Vsite_defaults_file.append ("/octaverc"); + } + else + Vsite_defaults_file = sf; +} + +void +install_defaults (void) +{ + // OCTAVE_HOME must be set first! + + set_octave_home (); + + set_default_info_dir (); + + set_default_data_dir (); + + set_default_libexec_dir (); + + set_default_arch_lib_dir (); + + set_default_local_ver_arch_lib_dir (); + set_default_local_api_arch_lib_dir (); + set_default_local_arch_lib_dir (); + + set_default_local_ver_oct_file_dir (); + set_default_local_api_oct_file_dir (); + set_default_local_oct_file_dir (); + + set_default_local_ver_fcn_file_dir (); + set_default_local_api_fcn_file_dir (); + set_default_local_fcn_file_dir (); + + set_default_fcn_file_dir (); + set_default_oct_file_dir (); + + set_default_image_dir (); + + set_default_bin_dir (); + + set_exec_path (); + + set_image_path (); + + set_default_doc_cache_file (); + + set_default_texi_macros_file (); + + set_default_info_file (); + + set_default_info_prog (); + + set_default_editor (); + + set_local_site_defaults_file (); + + set_site_defaults_file (); +} + +DEFUN (EDITOR, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EDITOR ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EDITOR (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EDITOR (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the editor to\n\ +use with the @code{edit_history} command. The default value is taken from\n\ +the environment variable @w{@env{EDITOR}} when Octave starts. If the\n\ +environment variable is not initialized, @w{@env{EDITOR}} will be set to\n\ +@code{\"emacs\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); +} + +/* +%!test +%! orig_val = EDITOR (); +%! old_val = EDITOR ("X"); +%! assert (orig_val, old_val); +%! assert (EDITOR (), "X"); +%! EDITOR (orig_val); +%! assert (EDITOR (), orig_val); + +%!error (EDITOR (1, 2)) +*/ + +DEFUN (EXEC_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} EXEC_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} EXEC_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories to append to the shell PATH when executing external\n\ +programs. The initial value of is taken from the environment variable\n\ +@w{@env{OCTAVE_EXEC_PATH}}, but that value can be overridden by\n\ +the command line argument @option{--exec-path PATH}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + octave_value retval = SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EXEC_PATH); + + if (args.length () > 0) + set_exec_path (VEXEC_PATH); + + return retval; +} + +/* +%!test +%! orig_val = EXEC_PATH (); +%! old_val = EXEC_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (EXEC_PATH (), "X"); +%! EXEC_PATH (orig_val); +%! assert (EXEC_PATH (), orig_val); + +%!error (EXEC_PATH (1, 2)) +*/ + +DEFUN (IMAGE_PATH, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} IMAGE_PATH (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} IMAGE_PATH (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies a colon separated\n\ +list of directories in which to search for image files.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); +} + +/* +%!test +%! orig_val = IMAGE_PATH (); +%! old_val = IMAGE_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (IMAGE_PATH (), "X"); +%! IMAGE_PATH (orig_val); +%! assert (IMAGE_PATH (), orig_val); + +%!error (IMAGE_PATH (1, 2)) +*/ + +DEFUN (OCTAVE_HOME, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ +Return the name of the top-level Octave installation directory.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = Voctave_home; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_HOME ())) +%!error OCTAVE_HOME (1) +*/ + +DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ +Return the version number of Octave, as a string.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = OCTAVE_VERSION; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (OCTAVE_VERSION ())) +%!error OCTAVE_VERSION (1) +*/ diff -r 069c552587a0 -r 959953dba519 src/interpfcn/defaults.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defaults.in.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,218 @@ +// DO NOT EDIT! Generated automatically from defaults.in.h by configure +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_defaults_h) +#define octave_defaults_h 1 + +#include + +#include "pathsearch.h" + +#ifndef OCTAVE_CANONICAL_HOST_TYPE +#define OCTAVE_CANONICAL_HOST_TYPE %OCTAVE_CANONICAL_HOST_TYPE% +#endif + +#ifndef OCTAVE_DEFAULT_PAGER +#define OCTAVE_DEFAULT_PAGER %OCTAVE_DEFAULT_PAGER% +#endif + +#ifndef OCTAVE_ARCHLIBDIR +#define OCTAVE_ARCHLIBDIR %OCTAVE_ARCHLIBDIR% +#endif + +#ifndef OCTAVE_BINDIR +#define OCTAVE_BINDIR %OCTAVE_BINDIR% +#endif + +#ifndef OCTAVE_DATADIR +#define OCTAVE_DATADIR %OCTAVE_DATADIR% +#endif + +#ifndef OCTAVE_DATAROOTDIR +#define OCTAVE_DATAROOTDIR %OCTAVE_DATAROOTDIR% +#endif + +#ifndef OCTAVE_DOC_CACHE_FILE +#define OCTAVE_DOC_CACHE_FILE %OCTAVE_DOC_CACHE_FILE% +#endif + +#ifndef OCTAVE_TEXI_MACROS_FILE +#define OCTAVE_TEXI_MACROS_FILE %OCTAVE_TEXI_MACROS_FILE% +#endif + +#ifndef OCTAVE_EXEC_PREFIX +#define OCTAVE_EXEC_PREFIX %OCTAVE_EXEC_PREFIX% +#endif + +#ifndef OCTAVE_FCNFILEDIR +#define OCTAVE_FCNFILEDIR %OCTAVE_FCNFILEDIR% +#endif + +#ifndef OCTAVE_IMAGEDIR +#define OCTAVE_IMAGEDIR %OCTAVE_IMAGEDIR% +#endif + +#ifndef OCTAVE_INCLUDEDIR +#define OCTAVE_INCLUDEDIR %OCTAVE_INCLUDEDIR% +#endif + +#ifndef OCTAVE_INFODIR +#define OCTAVE_INFODIR %OCTAVE_INFODIR% +#endif + +#ifndef OCTAVE_INFOFILE +#define OCTAVE_INFOFILE %OCTAVE_INFOFILE% +#endif + +#ifndef OCTAVE_LIBDIR +#define OCTAVE_LIBDIR %OCTAVE_LIBDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LIBEXECDIR +#define OCTAVE_LIBEXECDIR %OCTAVE_LIBEXECDIR% +#endif + +#ifndef OCTAVE_LOCALAPIFCNFILEDIR +#define OCTAVE_LOCALAPIFCNFILEDIR %OCTAVE_LOCALAPIFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIOCTFILEDIR +#define OCTAVE_LOCALAPIOCTFILEDIR %OCTAVE_LOCALAPIOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALARCHLIBDIR +#define OCTAVE_LOCALARCHLIBDIR %OCTAVE_LOCALARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALFCNFILEDIR +#define OCTAVE_LOCALFCNFILEDIR %OCTAVE_LOCALFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALOCTFILEDIR +#define OCTAVE_LOCALOCTFILEDIR %OCTAVE_LOCALOCTFILEDIR% +#endif + +#ifndef OCTAVE_LOCALSTARTUPFILEDIR +#define OCTAVE_LOCALSTARTUPFILEDIR %OCTAVE_LOCALSTARTUPFILEDIR% +#endif + +#ifndef OCTAVE_LOCALAPIARCHLIBDIR +#define OCTAVE_LOCALAPIARCHLIBDIR %OCTAVE_LOCALAPIARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERARCHLIBDIR +#define OCTAVE_LOCALVERARCHLIBDIR %OCTAVE_LOCALVERARCHLIBDIR% +#endif + +#ifndef OCTAVE_LOCALVERFCNFILEDIR +#define OCTAVE_LOCALVERFCNFILEDIR %OCTAVE_LOCALVERFCNFILEDIR% +#endif + +#ifndef OCTAVE_LOCALVEROCTFILEDIR +#define OCTAVE_LOCALVEROCTFILEDIR %OCTAVE_LOCALVEROCTFILEDIR% +#endif + +#ifndef OCTAVE_MAN1DIR +#define OCTAVE_MAN1DIR %OCTAVE_MAN1DIR% +#endif + +#ifndef OCTAVE_MAN1EXT +#define OCTAVE_MAN1EXT %OCTAVE_MAN1EXT% +#endif + +#ifndef OCTAVE_MANDIR +#define OCTAVE_MANDIR %OCTAVE_MANDIR% +#endif + +#ifndef OCTAVE_OCTFILEDIR +#define OCTAVE_OCTFILEDIR %OCTAVE_OCTFILEDIR% +#endif + +#ifndef OCTAVE_OCTETCDIR +#define OCTAVE_OCTETCDIR %OCTAVE_OCTETCDIR% +#endif + +#ifndef OCTAVE_OCTINCLUDEDIR +#define OCTAVE_OCTINCLUDEDIR %OCTAVE_OCTINCLUDEDIR% +#endif + +#ifndef OCTAVE_OCTLIBDIR +#define OCTAVE_OCTLIBDIR %OCTAVE_OCTLIBDIR% +#endif + +#ifndef OCTAVE_PREFIX +#define OCTAVE_PREFIX %OCTAVE_PREFIX% +#endif + +#ifndef OCTAVE_STARTUPFILEDIR +#define OCTAVE_STARTUPFILEDIR %OCTAVE_STARTUPFILEDIR% +#endif + +#ifndef OCTAVE_RELEASE +#define OCTAVE_RELEASE %OCTAVE_RELEASE% +#endif + +extern std::string Voctave_home; + +extern std::string Vbin_dir; +extern std::string Vinfo_dir; +extern std::string Vdata_dir; +extern std::string Vlibexec_dir; +extern std::string Varch_lib_dir; +extern std::string Vlocal_arch_lib_dir; +extern std::string Vlocal_ver_arch_lib_dir; + +extern std::string Vlocal_ver_oct_file_dir; +extern std::string Vlocal_api_oct_file_dir; +extern std::string Vlocal_oct_file_dir; + +extern std::string Vlocal_ver_fcn_file_dir; +extern std::string Vlocal_api_fcn_file_dir; +extern std::string Vlocal_fcn_file_dir; + +extern std::string Voct_file_dir; +extern std::string Vfcn_file_dir; + +extern std::string Vimage_dir; + +// Name of the editor to be invoked by the edit_history command. +extern std::string VEDITOR; + +extern std::string Vlocal_site_defaults_file; +extern std::string Vsite_defaults_file; + +// Name of the FFTW wisdom program. +extern OCTINTERP_API std::string Vfftw_wisdom_program; + +extern std::string subst_octave_home (const std::string&); + +extern void install_defaults (void); + +extern void set_exec_path (const std::string& path = std::string ()); +extern void set_image_path (const std::string& path = std::string ()); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/defun.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defun.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,200 @@ +/* + +Copyright (C) 1996-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "defun.h" +#include "dynamic-ld.h" +#include "error.h" +#include "help.h" +#include "ov.h" +#include "ov-builtin.h" +#include "ov-dld-fcn.h" +#include "ov-fcn.h" +#include "ov-mex-fcn.h" +#include "ov-usr-fcn.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "symtab.h" +#include "toplev.h" +#include "variables.h" +#include "parse.h" + +// Print the usage part of the doc string of FCN (user-defined or DEFUN). +void +print_usage (void) +{ + const octave_function *cur = octave_call_stack::current (); + if (cur) + print_usage (cur->name ()); + else + error ("print_usage: invalid function"); +} + +void +print_usage (const std::string& name) +{ + feval ("print_usage", octave_value (name), 0); +} + +void +check_version (const std::string& version, const std::string& fcn) +{ + if (version != OCTAVE_API_VERSION) + { + error ("API version %s found in .oct file function `%s'\n" + " does not match the running Octave (API version %s)\n" + " this can lead to incorrect results or other failures\n" + " you can fix this problem by recompiling this .oct file", + version.c_str (), fcn.c_str (), OCTAVE_API_VERSION); + } +} + +// Install variables and functions in the symbol tables. + +void +install_builtin_function (octave_builtin::fcn f, const std::string& name, + const std::string& file, const std::string& doc, + bool /* can_hide_function -- not yet implemented */) +{ + octave_value fcn (new octave_builtin (f, name, file, doc)); + + symbol_table::install_built_in_function (name, fcn); +} + +void +install_dld_function (octave_dld_function::fcn f, const std::string& name, + const octave_shlib& shl, const std::string& doc, + bool relative) +{ + octave_dld_function *fcn = new octave_dld_function (f, shl, name, doc); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +install_mex_function (void *fptr, bool fmex, const std::string& name, + const octave_shlib& shl, bool relative) +{ + octave_mex_function *fcn = new octave_mex_function (fptr, fmex, shl, name); + + if (relative) + fcn->mark_relative (); + + octave_value fval (fcn); + + symbol_table::install_built_in_function (name, fval); +} + +void +alias_builtin (const std::string& alias, const std::string& name) +{ + symbol_table::alias_built_in_function (alias, name); +} + +octave_shlib +get_current_shlib (void) +{ + octave_shlib retval; + + octave_function *curr_fcn = octave_call_stack::current (); + if (curr_fcn) + { + if (curr_fcn->is_dld_function ()) + { + octave_dld_function *dld = dynamic_cast (curr_fcn); + retval = dld->get_shlib (); + } + else if (curr_fcn->is_mex_function ()) + { + octave_mex_function *mex = dynamic_cast (curr_fcn); + retval = mex->get_shlib (); + } + } + + return retval; +} + +bool defun_isargout (int nargout, int iout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (iout >= std::max (nargout, 1)) + return false; + else if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end (); p++) + { + if (k == iout) + return ! p->is_black_hole (); + k += p->numel (); + if (k > iout) + break; + } + + return true; + } + else + return true; +} + +void defun_isargout (int nargout, int nout, bool *isargout) +{ + const std::list *lvalue_list = octave_builtin::curr_lvalue_list; + if (lvalue_list) + { + int k = 0; + for (std::list::const_iterator p = lvalue_list->begin (); + p != lvalue_list->end () && k < nout; p++) + { + if (p->is_black_hole ()) + isargout[k++] = false; + else + { + int l = std::min (k + p->numel (), + static_cast (nout)); + while (k < l) + isargout[k++] = true; + } + } + } + else + for (int i = 0; i < nout; i++) + isargout[i] = true; + + for (int i = std::max (nargout, 1); i < nout; i++) + isargout[i] = false; +} + diff -r 069c552587a0 -r 959953dba519 src/interpfcn/defun.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/defun.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,66 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_defun_h) +#define octave_defun_h 1 + +#if defined (octave_defun_dld_h) +#error defun.h and defun-dld.h both included in same file! +#endif + +#include "defun-int.h" + +// Define a builtin function. +// +// name is the name of the function, unqouted. +// +// args_name is the name of the octave_value_list variable used to pass +// the argument list to this function. +// +// nargout_name is the name of the int variable used to pass the +// number of output arguments this function is expected to produce. +// +// doc is the simple help text for the function. + +#define DEFUN(name, args_name, nargout_name, doc) \ + DEFUN_INTERNAL (name, args_name, nargout_name, doc) + +// This one can be used when `name' cannot be used directly (if it is +// already defined as a macro). In that case, name is already a +// quoted string, and the internal name of the function must be passed +// too (the convention is to use a prefix of "F", so "foo" becomes "Ffoo"). + +#define DEFUNX(name, fname, args_name, nargout_name, doc) \ + DEFUNX_INTERNAL (name, fname, args_name, nargout_name, doc) + +// This is a function with a name that can't be hidden by a variable. +#define DEFCONSTFUN(name, args_name, nargout_name, doc) \ + DEFCONSTFUN_INTERNAL (name, args_name, nargout_name, doc) + +// Make alias another name for the existing function name. This macro +// must be used in the same file where name is defined, after the +// definition for name. + +#define DEFALIAS(alias, name) \ + DEFALIAS_INTERNAL (alias, name) + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/dirfns.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/dirfns.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,783 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "dir-ops.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means we ask for confirmation before recursively removing a +// directory tree. +static bool Vconfirm_recursive_rmdir = true; + +// The time we last time we changed directories. +octave_time Vlast_chdir_time = 0.0; + +static int +octave_change_to_directory (const std::string& newdir) +{ + int cd_ok = octave_env::chdir (file_ops::tilde_expand (newdir)); + + if (cd_ok) + { + Vlast_chdir_time.stamp (); + + // FIXME -- should this be handled as a list of functions + // to call so users can add their own chdir handlers? + + load_path::update (); + } + else + error ("%s: %s", newdir.c_str (), gnulib::strerror (errno)); + + return cd_ok; +} + +DEFUN (cd, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} cd dir\n\ +@deftypefnx {Command} {} chdir dir\n\ +Change the current working directory to @var{dir}. If @var{dir} is\n\ +omitted, the current directory is changed to the user's home\n\ +directory. For example,\n\ +\n\ +@example\n\ +cd ~/octave\n\ +@end example\n\ +\n\ +@noindent\n\ +changes the current working directory to @file{~/octave}. If the\n\ +directory does not exist, an error message is printed and the working\n\ +directory is not changed.\n\ +@seealso{mkdir, rmdir, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("cd"); + + if (error_state) + return retval; + + if (argc > 1) + { + std::string dirname = argv[1]; + + if (dirname.length () > 0 + && ! octave_change_to_directory (dirname)) + { + return retval; + } + } + else + { + // Behave like Unixy shells for "cd" by itself, but be Matlab + // compatible if doing "current_dir = cd". + + if (nargout == 0) + { + std::string home_dir = octave_env::get_home_directory (); + + if (home_dir.empty () || ! octave_change_to_directory (home_dir)) + return retval; + } + else + retval = octave_value (octave_env::get_current_directory ()); + } + + return retval; +} + +DEFALIAS (chdir, cd); + +DEFUN (pwd, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pwd ()\n\ +Return the current working directory.\n\ +@seealso{dir, ls}\n\ +@end deftypefn") +{ + return octave_value (octave_env::get_current_directory ()); +} + +DEFUN (readdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{files}, @var{err}, @var{msg}] =} readdir (@var{dir})\n\ +Return names of the files in the directory @var{dir} as a cell array of\n\ +strings. If an error occurs, return an empty cell array in @var{files}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir, glob}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = Cell (); + + if (args.length () == 1) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readdir", args(0)); + else + { + dir_entry dir (dirname); + + if (dir) + { + string_vector dirlist = dir.read (); + retval(1) = 0.0; + retval(0) = Cell (dirlist.sort ()); + } + else + { + retval(2) = dir.error (); + } + } + } + else + print_usage (); + + return retval; +} + +// FIXME -- should maybe also allow second arg to specify +// mode? OTOH, that might cause trouble with compatibility later... + +DEFUNX ("mkdir", Fmkdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} mkdir (@var{parent}, @var{dir})\n\ +Create a directory named @var{dir} in the directory @var{parent}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +@seealso{rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + std::string dirname; + + if (nargin == 2) + { + std::string parent = args(0).string_value (); + std::string dir = args(1).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + else + dirname = file_ops::concat (parent, dir); + } + else if (nargin == 1) + { + dirname = args(0).string_value (); + + if (error_state) + { + gripe_wrong_type_arg ("mkdir", args(0)); + return retval; + } + } + + if (nargin == 1 || nargin == 2) + { + std::string msg; + + dirname = file_ops::tilde_expand (dirname); + + file_stat fs (dirname); + + if (fs && fs.is_dir ()) + { + // For compatibility with Matlab, we return true when the + // directory already exists. + + retval(2) = "mkdir"; + retval(1) = "directory exists"; + retval(0) = true; + } + else + { + int status = octave_mkdir (dirname, 0777, msg); + + if (status < 0) + { + retval(2) = "mkdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rmdir", Frmdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{msg}, @var{msgid}] =} rmdir (@var{dir}, \"s\")\n\ +Remove the directory named @var{dir}.\n\ +\n\ +If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty\n\ +character strings. Otherwise, @var{status} is 0, @var{msg} contains a\n\ +system-dependent error message, and @var{msgid} contains a unique\n\ +message identifier.\n\ +\n\ +If the optional second parameter is supplied with value @code{\"s\"},\n\ +recursively remove all subdirectories as well.\n\ +@seealso{mkdir, confirm_recursive_rmdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string dirname = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rmdir", args(0)); + else + { + std::string fulldir = file_ops::tilde_expand (dirname); + int status = -1; + std::string msg; + + if (nargin == 2) + { + if (args(1).string_value () == "s") + { + bool doit = true; + + if (interactive && Vconfirm_recursive_rmdir) + { + std::string prompt + = "remove entire contents of " + fulldir + "? "; + + doit = octave_yes_or_no (prompt); + } + + if (doit) + status = octave_recursive_rmdir (fulldir, msg); + } + else + error ("rmdir: expecting second argument to be \"s\""); + } + else + status = octave_rmdir (fulldir, msg); + + if (status < 0) + { + retval(2) = "rmdir"; + retval(1) = msg; + } + else + retval(0) = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("link", Flink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} link (@var{old}, @var{new})\n\ +Create a new link (also known as a hard link) to an existing file.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("link", args(1)); + else + { + std::string msg; + + int status = octave_link (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("symlink", Fsymlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} symlink (@var{old}, @var{new})\n\ +Create a symbolic link @var{new} which contains the string @var{old}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, readlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("symlink", args(1)); + else + { + std::string msg; + + int status = octave_symlink (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("readlink", Freadlink, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{result}, @var{err}, @var{msg}] =} readlink (@var{symlink})\n\ +Read the value of the symbolic link @var{symlink}.\n\ +\n\ +If successful, @var{result} contains the contents of the symbolic link\n\ +@var{symlink}, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{link, symlink}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = -1.0; + retval(0) = std::string (); + + if (args.length () == 1) + { + std::string symlink = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("readlink", args(0)); + else + { + std::string result; + std::string msg; + + int status = octave_readlink (symlink, result, msg); + + if (status < 0) + retval(2) = msg; + retval(1) = status; + retval(0) = result; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("rename", Frename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} rename (@var{old}, @var{new})\n\ +Change the name of file @var{old} to @var{new}.\n\ +\n\ +If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ +Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{ls, dir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1.0; + + if (args.length () == 2) + { + std::string from = args(0).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(0)); + else + { + std::string to = args(1).string_value (); + + if (error_state) + gripe_wrong_type_arg ("rename", args(1)); + else + { + std::string msg; + + int status = octave_rename (from, to, msg); + + retval(0) = status; + + if (status < 0) + retval(1) = msg; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (glob, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} glob (@var{pattern})\n\ +Given an array of pattern strings (as a char array or a cell array) in\n\ +@var{pattern}, return a cell array of file names that match any of\n\ +them, or an empty cell array if no patterns match. The pattern strings are\n\ +interpreted as filename globbing patterns (as they are used by Unix shells).\n\ +Within a pattern\n\ +\n\ +@table @code\n\ +@itemx *\n\ +matches any string, including the null string,\n\ +@itemx ?\n\ +matches any single character, and\n\ +\n\ +@item [@dots{}]\n\ +matches any of the enclosed characters.\n\ +@end table\n\ +\n\ +Tilde expansion\n\ +is performed on each of the patterns before looking for matching file\n\ +names. For example:\n\ +\n\ +@example\n\ +ls\n\ + @result{}\n\ + file1 file2 file3 myfile1 myfile1b\n\ +glob (\"*file1\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = myfile1\n\ + @}\n\ +glob (\"myfile?\")\n\ + @result{}\n\ + @{\n\ + [1,1] = myfile1\n\ + @}\n\ +glob (\"file[12]\")\n\ + @result{}\n\ + @{\n\ + [1,1] = file1\n\ + [2,1] = file2\n\ + @}\n\ +@end example\n\ +@seealso{ls, dir, readdir}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + string_vector pat = args(0).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("glob", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = Cell (pattern.glob ()); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! tmpdir = tmpnam; +%! filename = {"file1", "file2", "file3", "myfile1", "myfile1b"}; +%! if (mkdir (tmpdir)) +%! cwd = pwd; +%! cd (tmpdir); +%! if strcmp (canonicalize_file_name (pwd), canonicalize_file_name (tmpdir)) +%! a = 0; +%! for n = 1:5 +%! save (filename{n}, "a"); +%! endfor +%! else +%! rmdir (tmpdir); +%! error ("Couldn't change to temporary dir"); +%! endif +%! else +%! error ("Couldn't create temporary directory"); +%! endif +%! result1 = glob ("*file1"); +%! result2 = glob ("myfile?"); +%! result3 = glob ("file[12]"); +%! for n = 1:5 +%! delete (filename{n}); +%! endfor +%! cd (cwd); +%! rmdir (tmpdir); +%! assert (result1, {"file1"; "myfile1"}); +%! assert (result2, {"myfile1"}); +%! assert (result3, {"file1"; "file2"}); +*/ + +DEFUNX ("fnmatch", Ffnmatch, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fnmatch (@var{pattern}, @var{string})\n\ +Return 1 or zero for each element of @var{string} that matches any of\n\ +the elements of the string array @var{pattern}, using the rules of\n\ +filename pattern matching. For example:\n\ +\n\ +@example\n\ +@group\n\ +fnmatch (\"a*b\", @{\"ab\"; \"axyzb\"; \"xyzab\"@})\n\ + @result{} [ 1; 1; 0 ]\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 2) + { + string_vector pat = args(0).all_strings (); + string_vector str = args(1).all_strings (); + + if (error_state) + gripe_wrong_type_arg ("fnmatch", args(0)); + else + { + glob_match pattern (file_ops::tilde_expand (pat)); + + retval = pattern.match (str); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (filesep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} filesep ()\n\ +@deftypefnx {Built-in Function} {} filesep (\"all\")\n\ +Return the system-dependent character used to separate directory names.\n\ +\n\ +If \"all\" is given, the function returns all valid file separators in\n\ +the form of a string. The list of file separators is system-dependent.\n\ +It is @samp{/} (forward slash) under UNIX or @w{Mac OS X}, @samp{/} and\n\ +@samp{\\} (forward and backward slashes) under Windows.\n\ +@seealso{pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = file_ops::dir_sep_str (); + else if (args.length () == 1) + { + std::string s = args(0).string_value (); + + if (! error_state) + { + if (s == "all") + retval = file_ops::dir_sep_chars (); + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + gripe_wrong_type_arg ("filesep", args(0)); + } + else + print_usage (); + + return retval; +} + +DEFUN (pathsep, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} pathsep ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} pathsep (@var{new_val})\n\ +Query or set the character used to separate directories in a path.\n\ +@seealso{filesep}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = dir_path::path_sep_str (); + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + dir_path::path_sep_char (sval[0]); + break; + + case 0: + dir_path::path_sep_char ('\0'); + break; + + default: + error ("pathsep: argument must be a single character"); + break; + } + } + else + error ("pathsep: argument must be a single character"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +DEFUN (confirm_recursive_rmdir, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} confirm_recursive_rmdir ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} confirm_recursive_rmdir (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} confirm_recursive_rmdir (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will ask for confirmation before recursively removing a directory tree.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (confirm_recursive_rmdir); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/dirfns.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/dirfns.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,35 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_dirfns_h) +#define octave_dirfns_h 1 + +#include + +#include + +#include "oct-time.h" + +// The time we last time we changed directories. +extern octave_time Vlast_chdir_time; + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/error.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/error.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1887 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "defun.h" +#include "error.h" +#include "input.h" +#include "pager.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "utils.h" +#include "ov.h" +#include "ov-usr-fcn.h" +#include "pt-pr-code.h" +#include "pt-stmt.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "variables.h" + +// TRUE means that Octave will try to beep obnoxiously before printing +// error messages. +static bool Vbeep_on_error = false; + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +bool Vdebug_on_error = false; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +bool Vdebug_on_warning = false; + +// TRUE means that Octave will try to display a stack trace when a +// warning is encountered. +static bool Vbacktrace_on_warning = false; + +// TRUE means that Octave will print a verbose warning. Currently unused. +static bool Vverbose_warning; + +// TRUE means that Octave will print no warnings, but lastwarn will be +//updated +static bool Vquiet_warning = false; + +// A structure containing (most of) the current state of warnings. +static octave_map warning_options; + +// The text of the last error message. +static std::string Vlast_error_message; + +// The text of the last warning message. +static std::string Vlast_warning_message; + +// The last warning message id. +static std::string Vlast_warning_id; + +// The last error message id. +static std::string Vlast_error_id; + +// The last file in which an error occured +static octave_map Vlast_error_stack; + +// Current error state. +// +// Valid values: +// +// -2: an error has occurred, but don't print any messages. +// -1: an error has occurred, we are printing a traceback +// 0: no error +// 1: an error has occurred +// +int error_state = 0; + +// Current warning state. +// +// Valid values: +// +// 0: no warning +// 1: a warning has occurred +// +int warning_state = 0; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the `unwind_protect' statement. +int buffer_error_messages = 0; + +// TRUE means error messages are turned off. +bool discard_error_messages = false; + +// TRUE means warning messages are turned off. +bool discard_warning_messages = false; + +void +reset_error_handler (void) +{ + error_state = 0; + warning_state = 0; + buffer_error_messages = 0; + discard_error_messages = false; +} + +static void +initialize_warning_options (const std::string& state) +{ + octave_scalar_map initw; + + initw.setfield ("identifier", "all"); + initw.setfield ("state", state); + + warning_options = initw; +} + +static octave_map +initialize_last_error_stack (void) +{ + return octave_call_stack::empty_backtrace (); +} + +// Warning messages are never buffered. + +static void +vwarning (const char *name, const char *id, const char *fmt, va_list args) +{ + if (discard_warning_messages) + return; + + flush_octave_stdout (); + + std::ostringstream output_buf; + + if (name) + output_buf << name << ": "; + + octave_vformat (output_buf, fmt, args); + + output_buf << std::endl; + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::string msg_string = output_buf.str (); + + if (! warning_state) + { + // This is the first warning in a possible series. + + Vlast_warning_id = id; + Vlast_warning_message = msg_string; + } + + if (! Vquiet_warning) + { + octave_diary << msg_string; + + std::cerr << msg_string; + } +} + +static void +verror (bool save_last_error, std::ostream& os, + const char *name, const char *id, const char *fmt, va_list args, + bool with_cfn = false) +{ + if (discard_error_messages) + return; + + if (! buffer_error_messages) + flush_octave_stdout (); + + // FIXME -- we really want to capture the message before it + // has all the formatting goop attached to it. We probably also + // want just the message, not the traceback information. + + std::ostringstream output_buf; + + octave_vformat (output_buf, fmt, args); + + std::string base_msg = output_buf.str (); + + bool to_beep_or_not_to_beep_p = Vbeep_on_error && ! error_state; + + std::string msg_string; + + if (to_beep_or_not_to_beep_p) + msg_string = "\a"; + + if (name) + msg_string += std::string (name) + ": "; + + // If with_fcn is specified, we'll attempt to prefix the message with the name + // of the current executing function. But we'll do so only if: + // 1. the name is not empty (anonymous function) + // 2. it is not already there (including the following colon) + if (with_cfn) + { + octave_function *curfcn = octave_call_stack::current (); + if (curfcn) + { + std::string cfn = curfcn->name (); + if (! cfn.empty ()) + { + cfn += ':'; + if (cfn.length () > base_msg.length () + || base_msg.compare (0, cfn.length (), cfn) != 0) + { + msg_string += cfn + ' '; + } + } + } + } + + msg_string += base_msg + "\n"; + + if (! error_state && save_last_error) + { + // This is the first error in a possible series. + + Vlast_error_id = id; + Vlast_error_message = base_msg; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + octave_idx_type curr_frame = -1; + + Vlast_error_stack = octave_call_stack::backtrace (0, curr_frame); + } + else + Vlast_error_stack = initialize_last_error_stack (); + } + + if (! buffer_error_messages) + { + octave_diary << msg_string; + os << msg_string; + } +} + +// Note that we don't actually print any message if the error string +// is just "" or "\n". This allows error ("") and error ("\n") to +// just set the error state. + +static void +error_1 (std::ostream& os, const char *name, const char *id, + const char *fmt, va_list args, bool with_cfn = false) +{ + if (error_state != -2) + { + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (true, os, name, id, tmp_fmt, args, with_cfn); + delete [] tmp_fmt; + } + + error_state = -2; + } + else + { + verror (true, os, name, id, fmt, args, with_cfn); + + if (! error_state) + error_state = 1; + } + } + } + } + else + panic ("error_1: invalid format"); + } +} + +void +vmessage (const char *name, const char *fmt, va_list args) +{ + verror (false, std::cerr, name, "", fmt, args); +} + +void +message (const char *name, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage (name, fmt, args); + va_end (args); +} + +void +vmessage_with_id (const char *name, const char *id, const char *fmt, + va_list args) +{ + verror (false, std::cerr, name, id, fmt, args); +} + +void +message_with_id (const char *name, const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vmessage_with_id (name, id, fmt, args); + va_end (args); +} + +void +usage_1 (const char *id, const char *fmt, va_list args) +{ + verror (true, std::cerr, "usage", id, fmt, args); + error_state = -1; +} + +void +vusage (const char *fmt, va_list args) +{ + usage_1 ("", fmt, args); +} + +void +usage (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage (fmt, args); + va_end (args); +} + +void +vusage_with_id (const char *id, const char *fmt, va_list args) +{ + usage_1 (id, fmt, args); +} + +void +usage_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vusage_with_id (id, fmt, args); + va_end (args); +} + +static void +pr_where_2 (const char *fmt, va_list args) +{ + if (fmt) + { + if (*fmt) + { + size_t len = strlen (fmt); + + if (len > 0) + { + if (fmt[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_fmt = strsave (fmt); + tmp_fmt[len - 1] = '\0'; + verror (false, std::cerr, 0, "", tmp_fmt, args); + delete [] tmp_fmt; + } + } + else + verror (false, std::cerr, 0, "", fmt, args); + } + } + } + else + panic ("pr_where_2: invalid format"); +} + +static void +pr_where_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + pr_where_2 (fmt, args); + va_end (args); +} + +static void +pr_where (const char *who) +{ + octave_idx_type curr_frame = -1; + + octave_map stk = octave_call_stack::backtrace (0, curr_frame); + + octave_idx_type nframes_to_display = stk.numel (); + + if (nframes_to_display > 0) + { + pr_where_1 ("%s: called from\n", who); + + Cell names = stk.contents ("name"); + Cell lines = stk.contents ("line"); + Cell columns = stk.contents ("column"); + + for (octave_idx_type i = 0; i < nframes_to_display; i++) + { + octave_value name = names(i); + octave_value line = lines(i); + octave_value column = columns(i); + + std::string nm = name.string_value (); + + pr_where_1 (" %s at line %d column %d\n", nm.c_str (), + line.int_value (), column.int_value ()); + } + } +} + +static void +error_2 (const char *id, const char *fmt, va_list args, bool with_cfn = false) +{ + int init_state = error_state; + + error_1 (std::cerr, "error", id, fmt, args, with_cfn); + + if ((interactive || forced_interactive) + && Vdebug_on_error && init_state == 0 + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_error); + Vdebug_on_error = false; + + error_state = 0; + + pr_where ("error"); + + do_keyboard (octave_value_list ()); + } +} + +void +verror (const char *fmt, va_list args) +{ + error_2 ("", fmt, args); +} + +void +error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror (fmt, args); + va_end (args); +} + +void +verror_with_cfn (const char *fmt, va_list args) +{ + error_2 ("", fmt, args, true); +} + +void +error_with_cfn (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_cfn (fmt, args); + va_end (args); +} + +void +verror_with_id (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args); +} + +void +error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id (id, fmt, args); + va_end (args); +} + +void +verror_with_id_cfn (const char *id, const char *fmt, va_list args) +{ + error_2 (id, fmt, args, true); +} + +void +error_with_id_cfn (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + verror_with_id_cfn (id, fmt, args); + va_end (args); +} + +static int +check_state (const std::string& state) +{ + // -1: not found + // 0: found, "off" + // 1: found, "on" + // 2: found, "error" + + if (state == "off") + return 0; + else if (state == "on") + return 1; + else if (state == "error") + return 2; + else + return -1; +} + +// For given warning ID, return 0 if warnings are disabled, 1 if +// enabled, and 2 if the given ID should be an error instead of a +// warning. + +int +warning_enabled (const std::string& id) +{ + int retval = 0; + + int all_state = -1; + int id_state = -1; + + octave_idx_type nel = warning_options.numel (); + + if (nel > 0) + { + Cell identifier = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + bool all_found = false; + bool id_found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value ov = identifier(i); + std::string ovs = ov.string_value (); + + if (! all_found && ovs == "all") + { + all_state = check_state (state(i).string_value ()); + + if (all_state >= 0) + all_found = true; + } + + if (! id_found && ovs == id) + { + id_state = check_state (state(i).string_value ()); + + if (id_state >= 0) + id_found = true; + } + + if (all_found && id_found) + break; + } + } + + // If "all" is not present, assume warnings are enabled. + if (all_state == -1) + all_state = 1; + + if (all_state == 0) + { + if (id_state >= 0) + retval = id_state; + } + else if (all_state == 1) + { + if (id_state == 0 || id_state == 2) + retval = id_state; + else + retval = all_state; + } + else if (all_state == 2) + { + if (id_state == 0) + retval= id_state; + else + retval = all_state; + } + + return retval; +} + +static void +warning_1 (const char *id, const char *fmt, va_list args) +{ + int warn_opt = warning_enabled (id); + + if (warn_opt == 2) + { + // Handle this warning as an error. + + error_2 (id, fmt, args); + } + else if (warn_opt == 1) + { + vwarning ("warning", id, fmt, args); + + if (! symbol_table::at_top_level () + && Vbacktrace_on_warning + && ! warning_state + && ! discard_warning_messages) + pr_where ("warning"); + + warning_state = 1; + + if ((interactive || forced_interactive) + && Vdebug_on_warning + && octave_call_stack::caller_user_code ()) + { + unwind_protect frame; + frame.protect_var (Vdebug_on_warning); + Vdebug_on_warning = false; + + do_keyboard (octave_value_list ()); + } + } +} + +void +vwarning (const char *fmt, va_list args) +{ + warning_1 ("", fmt, args); +} + +void +warning (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning (fmt, args); + va_end (args); +} + +void +vwarning_with_id (const char *id, const char *fmt, va_list args) +{ + warning_1 (id, fmt, args); +} + +void +warning_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vwarning_with_id (id, fmt, args); + va_end (args); +} + +void +vparse_error (const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, "", fmt, args); +} + +void +parse_error (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error (fmt, args); + va_end (args); +} + +void +vparse_error_with_id (const char *id, const char *fmt, va_list args) +{ + error_1 (std::cerr, 0, id, fmt, args); +} + +void +parse_error_with_id (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + vparse_error_with_id (id, fmt, args); + va_end (args); +} + +void +rethrow_error (const char *id, const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (std::cerr, 0, id, fmt, args); + va_end (args); +} + +void +panic (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + buffer_error_messages = 0; + discard_error_messages = false; + verror (false, std::cerr, "panic", "", fmt, args); + va_end (args); + abort (); +} + +static void +defun_usage_message_1 (const char *fmt, ...) +{ + va_list args; + va_start (args, fmt); + error_1 (octave_stdout, 0, "", fmt, args); + va_end (args); +} + +void +defun_usage_message (const std::string& msg) +{ + defun_usage_message_1 ("%s", msg.c_str ()); +} + +typedef void (*error_fun)(const char *, const char *, ...); + +extern octave_value_list Fsprintf (const octave_value_list&, int); + +static std::string +handle_message (error_fun f, const char *id, const char *msg, + const octave_value_list& args, bool have_fmt) +{ + std::string retval; + + std::string tstr; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value arg; + + if (have_fmt) + { + octave_value_list tmp = Fsprintf (args, 1); + arg = tmp(0); + } + else + arg = args(0); + + if (arg.is_defined ()) + { + if (arg.is_string ()) + { + tstr = arg.string_value (); + msg = tstr.c_str (); + + if (! msg) + return retval; + } + else if (arg.is_empty ()) + return retval; + } + } + +// Ugh. + + size_t len = strlen (msg); + + if (len > 0) + { + if (msg[len - 1] == '\n') + { + if (len > 1) + { + char *tmp_msg = strsave (msg); + tmp_msg[len - 1] = '\0'; + f (id, "%s\n", tmp_msg); + retval = tmp_msg; + delete [] tmp_msg; + } + } + else + { + f (id, "%s", msg); + retval = msg; + } + } + + return retval; +} + +DEFUN (rethrow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rethrow (@var{err})\n\ +Reissue a previous error as defined by @var{err}. @var{err} is a structure\n\ +that must contain at least the 'message' and 'identifier' fields. @var{err}\n\ +can also contain a field 'stack' that gives information on the assumed\n\ +location of the error. Typically @var{err} is returned from\n\ +@code{lasterror}.\n\ +@seealso{lasterror, lasterr, error}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + const octave_scalar_map err = args(0).scalar_map_value (); + + if (! error_state) + { + if (err.contains ("message") && err.contains ("identifier")) + { + std::string msg = err.contents ("message").string_value (); + std::string id = err.contents ("identifier").string_value (); + int len = msg.length (); + + std::string file; + std::string nm; + int l = -1; + int c = -1; + + octave_map err_stack = initialize_last_error_stack (); + + if (err.contains ("stack")) + { + err_stack = err.contents ("stack").map_value (); + + if (err_stack.numel () > 0) + { + if (err_stack.contains ("file")) + file = err_stack.contents ("file")(0).string_value (); + + if (err_stack.contains ("name")) + nm = err_stack.contents ("name")(0).string_value (); + + if (err_stack.contains ("line")) + l = err_stack.contents ("line")(0).nint_value (); + + if (err_stack.contains ("column")) + c = err_stack.contents ("column")(0).nint_value (); + } + } + + // Ugh. + char *tmp_msg = strsave (msg.c_str ()); + if (tmp_msg[len-1] == '\n') + { + if (len > 1) + { + tmp_msg[len - 1] = '\0'; + rethrow_error (id.c_str (), "%s\n", tmp_msg); + } + } + else + rethrow_error (id.c_str (), "%s", tmp_msg); + delete [] tmp_msg; + + // FIXME -- is this the right thing to do for + // Vlast_error_stack? Should it be saved and restored + // with unwind_protect? + + Vlast_error_stack = err_stack; + + if (err.contains ("stack")) + { + if (file.empty ()) + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: near line %d, column %d", + l, c); + else + pr_where_1 ("error: near line %d", l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from `%s' near line %d, column %d", + nm.c_str (), l, c); + else + pr_where_1 ("error: called from `%d' near line %d", nm.c_str (), l); + } + } + } + else + { + if (nm.empty ()) + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: in file %s near line %d, column %d", + file.c_str (), l, c); + else + pr_where_1 ("error: in file %s near line %d", file.c_str (), l); + } + } + else + { + if (l > 0) + { + if (c > 0) + pr_where_1 ("error: called from `%s' in file %s near line %d, column %d", + nm.c_str (), file.c_str (), l, c); + else + pr_where_1 ("error: called from `%d' in file %s near line %d", nm.c_str (), file.c_str (), l); + } + } + } + } + } + else + error ("rethrow: ERR structure must contain the fields 'message and 'identifier'"); + } + } + return retval; +} + +// Determine whether the first argument to error or warning function +// should be handled as the message identifier or as the format string. + +static bool +maybe_extract_message_id (const std::string& caller, + const octave_value_list& args, + octave_value_list& nargs, + std::string& id) +{ + nargs = args; + id = std::string (); + + int nargin = args.length (); + + bool have_fmt = nargin > 1; + + if (nargin > 0) + { + std::string arg1 = args(0).string_value (); + + if (! error_state) + { + // For compatibility with Matlab, an identifier must contain + // ':', but not at the beginning or the end, and it must not + // contain '%' (even if it is not a valid conversion + // operator) or whitespace. + + if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos + && arg1.find (':') != std::string::npos + && arg1[0] != ':' + && arg1[arg1.length ()-1] != ':') + { + if (nargin > 1) + { + id = arg1; + + nargs.resize (nargin-1); + + for (int i = 1; i < nargin; i++) + nargs(i-1) = args(i); + } + else + nargs(0) = "call to " + caller + + " with message identifier requires message"; + } + } + } + + return have_fmt; +} + +DEFUN (error, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} error (@var{id}, @var{template}, @dots{})\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{error: }.\n\ +\n\ +Calling @code{error} also sets Octave's internal error state such that\n\ +control will return to the top level without evaluating any more\n\ +commands. This is useful for aborting from functions or scripts.\n\ +\n\ +If the error message does not end with a new line character, Octave will\n\ +print a traceback of all the function calls leading to the error. For\n\ +example, given the following function definitions:\n\ +\n\ +@example\n\ +@group\n\ +function f () g (); end\n\ +function g () h (); end\n\ +function h () nargin == 1 || error (\"nargin != 1\"); end\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calling the function @code{f} will result in a list of messages that\n\ +can help you to quickly locate the exact location of the error:\n\ +\n\ +@example\n\ +@group\n\ +f ()\n\ +error: nargin != 1\n\ +error: called from:\n\ +error: error at line -1, column -1\n\ +error: h at line 1, column 27\n\ +error: g at line 1, column 15\n\ +error: f at line 1, column 15\n\ +@end group\n\ +@end example\n\ +\n\ +If the error message ends in a new line character, Octave will print the\n\ +message but will not display any traceback messages as it returns\n\ +control to the top level. For example, modifying the error message\n\ +in the previous example to end in a new line causes Octave to only print\n\ +a single message:\n\ +\n\ +@example\n\ +@group\n\ +function h () nargin == 1 || error (\"nargin != 1\\n\"); end\n\ +f ()\n\ +error: nargin != 1\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + octave_value_list nargs = args; + + std::string id; + + if (nargin == 0) + print_usage (); + else + { + bool have_fmt = false; + + if (nargin == 1 && args(0).is_map ()) + { + // empty struct is not an error. return and resume calling function. + if (args(0).is_empty ()) + return retval; + + octave_value_list tmp; + + octave_scalar_map m = args(0).scalar_map_value (); + + // empty struct is not an error. return and resume calling function. + if (m.nfields () == 0) + return retval; + + if (m.contains ("message")) + { + octave_value c = m.getfield ("message"); + + if (c.is_string ()) + nargs(0) = c.string_value (); + } + + if (m.contains ("identifier")) + { + octave_value c = m.getfield ("identifier"); + + if (c.is_string ()) + id = c.string_value (); + } + + // FIXME -- also need to handle "stack" field in error + // structure, but that will require some more significant + // surgery on handle_message, error_with_id, etc. + } + else + { + have_fmt = maybe_extract_message_id ("error", args, nargs, id); + + if (error_state) + return retval; + } + + handle_message (error_with_id, id.c_str (), "unspecified error", + nargs, have_fmt); + } + + return retval; +} + +DEFUN (warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warning (@var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (@var{id}, @var{template}, @dots{})\n\ +@deftypefnx {Built-in Function} {} warning (\"on\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"off\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"query\", @var{id})\n\ +@deftypefnx {Built-in Function} {} warning (\"error\", @var{id})\n\ +Format the optional arguments under the control of the template string\n\ +@var{template} using the same rules as the @code{printf} family of\n\ +functions (@pxref{Formatted Output}) and print the resulting message\n\ +on the @code{stderr} stream. The message is prefixed by the character\n\ +string @samp{warning: }.\n\ +You should use this function when you want to notify the user\n\ +of an unusual condition, but only when it makes sense for your program\n\ +to go on.\n\ +\n\ +The optional message identifier allows users to enable or disable\n\ +warnings tagged by @var{id}. The special identifier @samp{\"all\"} may\n\ +be used to set the state of all warnings.\n\ +\n\ +If the first argument is @samp{\"on\"} or @samp{\"off\"}, set the state\n\ +of a particular warning using the identifier @var{id}. If the first\n\ +argument is @samp{\"query\"}, query the state of this warning instead.\n\ +If the identifier is omitted, a value of @samp{\"all\"} is assumed. If\n\ +you set the state of a warning to @samp{\"error\"}, the warning named by\n\ +@var{id} is handled as if it were an error instead. So, for example, the\n\ +following handles all warnings as errors:\n\ +\n\ +@example\n\ +@group\n\ +warning (\"error\");\n\ +@end group\n\ +@end example\n\ +@seealso{warning_ids}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + int argc = nargin + 1; + + bool done = false; + + if (argc > 1 && args.all_strings_p ()) + { + string_vector argv = args.make_argv ("warning"); + + if (! error_state) + { + std::string arg1 = argv(1); + std::string arg2 = "all"; + + if (argc == 3) + arg2 = argv(2); + + if (arg1 == "on" || arg1 == "off" || arg1 == "error") + { + octave_map old_warning_options = warning_options; + + if (arg2 == "all") + { + octave_map tmp; + + Cell id (1, 1); + Cell st (1, 1); + + id(0) = arg2; + st(0) = arg1; + + // Since internal Octave functions are not + // compatible, turning all warnings into errors + // should leave the state of + // Octave:matlab-incompatible alone. + + if (arg1 == "error" + && warning_options.contains ("identifier")) + { + octave_idx_type n = 1; + + Cell tid = warning_options.contents ("identifier"); + Cell tst = warning_options.contents ("state"); + + for (octave_idx_type i = 0; i < tid.numel (); i++) + { + octave_value vid = tid(i); + + if (vid.is_string ()) + { + std::string key = vid.string_value (); + + if (key == "Octave:matlab-incompatible" + || key == "Octave:single-quote-string") + { + id.resize (dim_vector (1, n+1)); + st.resize (dim_vector (1, n+1)); + + id(n) = tid(i); + st(n) = tst(i); + + n++; + } + } + } + } + + tmp.assign ("identifier", id); + tmp.assign ("state", st); + + warning_options = tmp; + + done = true; + } + else if (arg2 == "backtrace") + { + if (arg1 != "error") + { + Vbacktrace_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "debug") + { + if (arg1 != "error") + { + Vdebug_on_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "verbose") + { + if (arg1 != "error") + { + Vverbose_warning = (arg1 == "on"); + done = true; + } + } + else if (arg2 == "quiet") + { + if (arg1 != "error") + { + Vquiet_warning = (arg1 == "on"); + done = true; + } + } + else + { + if (arg2 == "last") + arg2 = Vlast_warning_id; + + if (arg2 == "all") + initialize_warning_options (arg1); + else + { + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == arg2) + { + // FIXME -- if state for "all" is + // same as arg1, we can simply remove the + // item from the list. + + state(i) = arg1; + warning_options.assign ("state", state); + found = true; + break; + } + } + + if (! found) + { + // FIXME -- if state for "all" is + // same as arg1, we don't need to do anything. + + ident.resize (dim_vector (1, nel+1)); + state.resize (dim_vector (1, nel+1)); + + ident(nel) = arg2; + state(nel) = arg1; + + warning_options.clear (); + + warning_options.assign ("identifier", ident); + warning_options.assign ("state", state); + } + } + + done = true; + } + + if (done && nargout > 0) + retval = old_warning_options; + } + else if (arg1 == "query") + { + if (arg2 == "all") + retval = warning_options; + else if (arg2 == "backtrace" || arg2 == "debug" + || arg2 == "verbose" || arg2 == "quiet") + { + octave_scalar_map tmp; + tmp.assign ("identifier", arg2); + if (arg2 == "backtrace") + tmp.assign ("state", Vbacktrace_on_warning ? "on" : "off"); + else if (arg2 == "debug") + tmp.assign ("state", Vdebug_on_warning ? "on" : "off"); + else if (arg2 == "verbose") + tmp.assign ("state", Vverbose_warning ? "on" : "off"); + else + tmp.assign ("state", Vquiet_warning ? "on" : "off"); + + retval = tmp; + } + else + { + if (arg2 == "last") + arg2 = Vlast_warning_id; + + Cell ident = warning_options.contents ("identifier"); + Cell state = warning_options.contents ("state"); + + octave_idx_type nel = ident.numel (); + + bool found = false; + + std::string val; + + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == arg2) + { + val = state(i).string_value (); + found = true; + break; + } + } + + if (! found) + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (ident(i).string_value () == "all") + { + val = state(i).string_value (); + found = true; + break; + } + } + } + + if (found) + { + octave_scalar_map tmp; + + tmp.assign ("identifier", arg2); + tmp.assign ("state", val); + + retval = tmp; + } + else + error ("warning: unable to find default warning state!"); + } + + done = true; + } + } + } + else if (argc == 1) + { + retval = warning_options; + + done = true; + } + else if (argc == 2) + { + octave_value arg = args(0); + + octave_map old_warning_options = warning_options; + + if (arg.is_map ()) + { + octave_map m = arg.map_value (); + + if (m.contains ("identifier") && m.contains ("state")) + warning_options = m; + else + error ("warning: expecting structure with fields `identifier' and `state'"); + + done = true; + + if (nargout > 0) + retval = old_warning_options; + } + } + + if (! (error_state || done)) + { + octave_value_list nargs = args; + + std::string id; + + bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); + + if (error_state) + return retval; + + std::string prev_msg = Vlast_warning_message; + + std::string curr_msg = handle_message (warning_with_id, id.c_str (), + "unspecified warning", nargs, + have_fmt); + + if (nargout > 0) + retval = prev_msg; + } + + return retval; +} + +octave_value_list +set_warning_state (const std::string& id, const std::string& state) +{ + octave_value_list args; + + args(1) = id; + args(0) = state; + + return Fwarning (args, 1); +} + +octave_value_list +set_warning_state (const octave_value_list& args) +{ + return Fwarning (args, 1); +} + +void +disable_warning (const std::string& id) +{ + set_warning_state (id, "off"); +} + +void +initialize_default_warning_state (void) +{ + initialize_warning_options ("on"); + + // Most people will want to have the following disabled. + + disable_warning ("Octave:array-to-scalar"); + disable_warning ("Octave:array-to-vector"); + disable_warning ("Octave:imag-to-real"); + disable_warning ("Octave:matlab-incompatible"); + disable_warning ("Octave:missing-semicolon"); + disable_warning ("Octave:neg-dim-as-zero"); + disable_warning ("Octave:resize-on-range-error"); + disable_warning ("Octave:separator-insert"); + disable_warning ("Octave:single-quote-string"); + disable_warning ("Octave:str-to-num"); + disable_warning ("Octave:mixed-string-concat"); + disable_warning ("Octave:variable-switch-label"); + + // This should be an error unless we are in maximum braindamage mode. + // FIXME: Not quite right. This sets the error state even for braindamage + // mode. Also, this error is not triggered in normal mode because another + // error handler catches it first and gives: + // error: subscript indices must be either positive integers or logicals + set_warning_state ("Octave:noninteger-range-as-index", "error"); + +} + +DEFUN (lasterror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{lasterr} =} lasterror ()\n\ +@deftypefnx {Built-in Function} {} lasterror (@var{err})\n\ +@deftypefnx {Built-in Function} {} lasterror (\"reset\")\n\ +Query or set the last error message structure. When called without\n\ +arguments, return a structure containing the last error message and other\n\ +information related to this error. The elements of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'message'\n\ +The text of the last error message\n\ +\n\ +@item 'identifier'\n\ +The message identifier of this error message\n\ +\n\ +@item 'stack'\n\ +A structure containing information on where the message occurred. This may\n\ +be an empty structure if the information cannot\n\ +be obtained. The fields of the structure are:\n\ +\n\ +@table @asis\n\ +@item 'file'\n\ +The name of the file where the error occurred\n\ +\n\ +@item 'name'\n\ +The name of function in which the error occurred\n\ +\n\ +@item 'line'\n\ +The line number at which the error occurred\n\ +\n\ +@item 'column'\n\ +An optional field with the column number at which the error occurred\n\ +@end table\n\ +@end table\n\ +\n\ +The last error structure may be set by passing a scalar structure, @var{err},\n\ +as input. Any fields of @var{err} that match those above are set while any\n\ +unspecified fields are initialized with default values.\n\ +\n\ +If @code{lasterror} is called with the argument \"reset\", all fields are\n\ +set to their default values.\n\ +@seealso{lasterr}\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + if (nargin < 2) + { + octave_scalar_map err; + + err.assign ("message", Vlast_error_message); + err.assign ("identifier", Vlast_error_id); + + err.assign ("stack", octave_value (Vlast_error_stack)); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + if (args(0).string_value () == "reset") + { + Vlast_error_message = std::string (); + Vlast_error_id = std::string (); + + Vlast_error_stack = initialize_last_error_stack (); + } + else + error ("lasterror: unrecognized string argument"); + } + else if (args(0).is_map ()) + { + octave_scalar_map new_err = args(0).scalar_map_value (); + std::string new_error_message; + std::string new_error_id; + std::string new_error_file; + std::string new_error_name; + int new_error_line = -1; + int new_error_column = -1; + + if (! error_state && new_err.contains ("message")) + { + const std::string tmp = + new_err.getfield ("message").string_value (); + new_error_message = tmp; + } + + if (! error_state && new_err.contains ("identifier")) + { + const std::string tmp = + new_err.getfield ("identifier").string_value (); + new_error_id = tmp; + } + + if (! error_state && new_err.contains ("stack")) + { + octave_scalar_map new_err_stack = + new_err.getfield ("stack").scalar_map_value (); + + if (! error_state && new_err_stack.contains ("file")) + { + const std::string tmp = + new_err_stack.getfield ("file").string_value (); + new_error_file = tmp; + } + + if (! error_state && new_err_stack.contains ("name")) + { + const std::string tmp = + new_err_stack.getfield ("name").string_value (); + new_error_name = tmp; + } + + if (! error_state && new_err_stack.contains ("line")) + { + const int tmp = + new_err_stack.getfield ("line").nint_value (); + new_error_line = tmp; + } + + if (! error_state && new_err_stack.contains ("column")) + { + const int tmp = + new_err_stack.getfield ("column").nint_value (); + new_error_column = tmp; + } + } + + if (! error_state) + { + Vlast_error_message = new_error_message; + Vlast_error_id = new_error_id; + + octave_idx_type curr_frame = -1; + + Vlast_error_stack + = octave_call_stack::backtrace (0, curr_frame); + } + } + else + error ("lasterror: argument must be a structure or a string"); + } + + if (! error_state) + retval = err; + } + else + print_usage (); + + return retval; +} + +DEFUN (lasterr, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lasterr ()\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg})\n\ +@deftypefnx {Built-in Function} {} lasterr (@var{msg}, @var{msgid})\n\ +Query or set the last error message. When called without input arguments,\n\ +return the last error message and message identifier. With one\n\ +argument, set the last error message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@seealso{lasterror}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + frame.protect_var (error_state); + error_state = 0; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lasterr"); + + if (! error_state) + { + std::string prev_error_id = Vlast_error_id; + std::string prev_error_message = Vlast_error_message; + + if (argc > 2) + Vlast_error_id = argv(2); + + if (argc > 1) + Vlast_error_message = argv(1); + + if (argc == 1 || nargout > 0) + { + retval(1) = prev_error_id; + retval(0) = prev_error_message; + } + } + else + error ("lasterr: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (lastwarn, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\ +Without any arguments, return the last warning message. With one\n\ +argument, set the last warning message to @var{msg}. With two arguments,\n\ +also set the last message identifier.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + if (argc < 4) + { + string_vector argv = args.make_argv ("lastwarn"); + + if (! error_state) + { + std::string prev_warning_id = Vlast_warning_id; + std::string prev_warning_message = Vlast_warning_message; + + if (argc > 2) + Vlast_warning_id = argv(2); + + if (argc > 1) + Vlast_warning_message = argv(1); + + if (argc == 1 || nargout > 0) + { + warning_state = 0; + retval(1) = prev_warning_id; + retval(0) = prev_warning_message; + } + } + else + error ("lastwarn: expecting arguments to be character strings"); + } + else + print_usage (); + + return retval; +} + +DEFUN (usage, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usage (@var{msg})\n\ +Print the message @var{msg}, prefixed by the string @samp{usage: }, and\n\ +set Octave's internal error state such that control will return to the\n\ +top level without evaluating any more commands. This is useful for\n\ +aborting from functions.\n\ +\n\ +After @code{usage} is evaluated, Octave will print a traceback of all\n\ +the function calls leading to the usage message.\n\ +\n\ +You should use this function for reporting problems errors that result\n\ +from an improper call to a function, such as calling a function with an\n\ +incorrect number of arguments, or with arguments of the wrong type. For\n\ +example, most functions distributed with Octave begin with code like\n\ +this\n\ +\n\ +@example\n\ +@group\n\ +if (nargin != 2)\n\ + usage (\"foo (a, b)\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +to check for the proper number of arguments.\n\ +@end deftypefn") +{ + octave_value_list retval; + handle_message (usage_with_id, "", "unknown", args, true); + return retval; +} + +DEFUN (beep_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} beep_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} beep_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} beep_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to ring the terminal bell before printing an error message.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (beep_on_error); +} + +DEFUN (debug_on_error, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_error ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_error (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_error (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when an error is encountered. This will also\n\ +inhibit printing of the normal traceback message (you will only see\n\ +the top-level error message).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_error); +} + +DEFUN (debug_on_warning, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_warning ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_warning (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_warning (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter the debugger when a warning is encountered.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_warning); +} + +std::string +last_error_message (void) +{ + return Vlast_error_message; +} + +std::string +last_error_id (void) +{ + return Vlast_error_id; +} + +std::string +last_warning_message (void) +{ + return Vlast_warning_message; +} + +std::string +last_warning_id (void) +{ + return Vlast_warning_id; +} + +void +interpreter_try (unwind_protect& frame) +{ + frame.protect_var (error_state); + frame.protect_var (buffer_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + buffer_error_messages++; + Vdebug_on_error = false; + Vdebug_on_warning = false; +} + + diff -r 069c552587a0 -r 959953dba519 src/interpfcn/error.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/error.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,142 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_error_h) +#define octave_error_h 1 + +#include +#include + +class octave_value_list; +class unwind_protect; + +#define panic_impossible() \ + panic ("impossible state reached in file `%s' at line %d", \ + __FILE__, __LINE__) + +extern OCTINTERP_API void reset_error_handler (void); + +extern OCTINTERP_API int warning_enabled (const std::string& id); + +extern OCTINTERP_API void vmessage (const char *name, const char *fmt, va_list args); +extern OCTINTERP_API void message (const char *name, const char *fmt, ...); + +extern OCTINTERP_API void vusage (const char *fmt, va_list args); +extern OCTINTERP_API void usage (const char *fmt, ...); + +extern OCTINTERP_API void vwarning (const char *fmt, va_list args); +extern OCTINTERP_API void warning (const char *fmt, ...); + +extern OCTINTERP_API void verror (const char *fmt, va_list args); +extern OCTINTERP_API void error (const char *fmt, ...); + +extern OCTINTERP_API void verror_with_cfn (const char *fmt, va_list args); +extern OCTINTERP_API void error_with_cfn (const char *fmt, ...); + +extern OCTINTERP_API void vparse_error (const char *fmt, va_list args); +extern OCTINTERP_API void parse_error (const char *fmt, ...); + +extern OCTINTERP_API void +vmessage_with_id (const char *id, const char *name, const char *fmt, va_list args); + +extern OCTINTERP_API void +message_with_id (const char *id, const char *name, const char *fmt, ...); + +extern OCTINTERP_API void +vusage_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +usage_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vwarning_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +warning_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +verror_with_id_cfn (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +error_with_id_cfn (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void +vparse_error_with_id (const char *id, const char *fmt, va_list args); + +extern OCTINTERP_API void +parse_error_with_id (const char *id, const char *fmt, ...); + +extern OCTINTERP_API void panic (const char *fmt, ...) GCC_ATTR_NORETURN; + +// Helper function for print_usage defined in defun.cc. +extern OCTINTERP_API void defun_usage_message (const std::string& msg); + +extern OCTINTERP_API octave_value_list +set_warning_state (const std::string& id, const std::string& state); + +extern OCTINTERP_API octave_value_list +set_warning_state (const octave_value_list& args); + +extern OCTINTERP_API void disable_warning (const std::string& id); +extern OCTINTERP_API void initialize_default_warning_state (void); + +// TRUE means that Octave will try to enter the debugger when an error +// is encountered. This will also inhibit printing of the normal +// traceback message (you will only see the top-level error message). +extern OCTINTERP_API bool Vdebug_on_error; + +// TRUE means that Octave will try to enter the debugger when a warning +// is encountered. +extern OCTINTERP_API bool Vdebug_on_warning; + +// Current error state. +extern OCTINTERP_API int error_state; + +// Current warning state. +extern OCTINTERP_API int warning_state; + +// Tell the error handler whether to print messages, or just store +// them for later. Used for handling errors in eval() and +// the `unwind_protect' statement. +extern OCTINTERP_API int buffer_error_messages; + +// TRUE means error messages are turned off. +extern OCTINTERP_API bool discard_error_messages; + +// TRUE means warning messages are turned off. +extern OCTINTERP_API bool discard_warning_messages; + +// Helper functions to pass last error and warning messages and ids +extern OCTINTERP_API std::string last_error_message (void); +extern OCTINTERP_API std::string last_error_id (void); +extern OCTINTERP_API std::string last_warning_message (void); +extern OCTINTERP_API std::string last_warning_id (void); + +extern OCTINTERP_API void interpreter_try (unwind_protect&); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/file-io.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/file-io.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2335 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +// Originally written by John C. Campbell +// +// Thomas Baier added the original versions of +// the following functions: +// +// popen +// pclose +// execute (now popen2.m) +// sync_system (now merged with system) +// async_system (now merged with system) + +// Extensively revised by John W. Eaton , +// April 1996. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include +#include +#include + +#ifdef HAVE_ZLIB_H +#include +#endif + +#include "error.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-ieee.h" +#include "oct-env.h" +#include "oct-locbuf.h" + +#include "defun.h" +#include "file-io.h" +#include "load-path.h" +#include "oct-fstrm.h" +#include "oct-iostrm.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "oct-prcstrm.h" +#include "oct-stream.h" +#include "oct-strstrm.h" +#include "pager.h" +#include "sysdep.h" +#include "utils.h" +#include "variables.h" + +static octave_value stdin_file; +static octave_value stdout_file; +static octave_value stderr_file; + +static octave_stream stdin_stream; +static octave_stream stdout_stream; +static octave_stream stderr_stream; + +void +initialize_file_io (void) +{ + stdin_stream = octave_istream::create (&std::cin, "stdin"); + + // This uses octave_stdout (see pager.h), not std::cout so that Octave's + // standard output stream will pass through the pager. + + stdout_stream = octave_ostream::create (&octave_stdout, "stdout"); + + stderr_stream = octave_ostream::create (&std::cerr, "stderr"); + + stdin_file = octave_stream_list::insert (stdin_stream); + stdout_file = octave_stream_list::insert (stdout_stream); + stderr_file = octave_stream_list::insert (stderr_stream); +} + +void +close_files (void) +{ + octave_stream_list::clear (); +} + +// List of files to delete when we exit or crash. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack tmp_files; + +void +mark_for_deletion (const std::string& file) +{ + tmp_files.push (file); +} + +void +cleanup_tmp_files (void) +{ + while (! tmp_files.empty ()) + { + std::string filename = tmp_files.top (); + tmp_files.pop (); + gnulib::unlink (filename.c_str ()); + } +} + +static std::ios::openmode +fopen_mode_to_ios_mode (const std::string& mode_arg) +{ + std::ios::openmode retval = std::ios::in; + + if (! mode_arg.empty ()) + { + // Could probably be faster, but does it really matter? + + std::string mode = mode_arg; + + // 'W' and 'R' are accepted as 'w' and 'r', but we warn about + // them because Matlab says they perform "automatic flushing" + // but we don't know precisely what action that implies. + + size_t pos = mode.find ('W'); + + if (pos != std::string::npos) + { + warning ("fopen: treating mode \"W\" as equivalent to \"w\""); + mode[pos] = 'w'; + } + + pos = mode.find ('R'); + + if (pos != std::string::npos) + { + warning ("fopen: treating mode \"R\" as equivalent to \"r\""); + mode[pos] = 'r'; + } + + pos = mode.find ('z'); + + if (pos != std::string::npos) + { +#if defined (HAVE_ZLIB) + mode.erase (pos, 1); +#else + error ("this version of Octave does not support gzipped files"); +#endif + } + + if (! error_state) + { + if (mode == "rt") + retval = std::ios::in; + else if (mode == "wt") + retval = std::ios::out | std::ios::trunc; + else if (mode == "at") + retval = std::ios::out | std::ios::app; + else if (mode == "r+t" || mode == "rt+") + retval = std::ios::in | std::ios::out; + else if (mode == "w+t" || mode == "wt+") + retval = std::ios::in | std::ios::out | std::ios::trunc; + else if (mode == "a+t" || mode == "at+") + retval = std::ios::in | std::ios::out | std::ios::app; + else if (mode == "rb" || mode == "r") + retval = std::ios::in | std::ios::binary; + else if (mode == "wb" || mode == "w") + retval = std::ios::out | std::ios::trunc | std::ios::binary; + else if (mode == "ab" || mode == "a") + retval = std::ios::out | std::ios::app | std::ios::binary; + else if (mode == "r+b" || mode == "rb+" || mode == "r+") + retval = std::ios::in | std::ios::out | std::ios::binary; + else if (mode == "w+b" || mode == "wb+" || mode == "w+") + retval = (std::ios::in | std::ios::out | std::ios::trunc + | std::ios::binary); + else if (mode == "a+b" || mode == "ab+" || mode == "a+") + retval = (std::ios::in | std::ios::out | std::ios::app + | std::ios::binary); + else + ::error ("invalid mode specified"); + } + } + + return retval; +} + +DEFUN (fclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclose (@var{fid})\n\ +@deftypefnx {Built-in Function} {} fclose (\"all\")\n\ +Close the specified file. If successful, @code{fclose} returns 0,\n\ +otherwise, it returns -1. The second form of the @code{fclose} call closes\n\ +all open files except @code{stdout}, @code{stderr}, and @code{stdin}.\n\ +@seealso{fopen, freport}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "fclose"); + else + print_usage (); + + return retval; +} + +DEFUN (fclear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fclear (@var{fid})\n\ +Clear the stream state for the specified file.\n\ +@seealso{fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fclear"); + + if (! error_state) + os.clearerr (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fflush, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fflush (@var{fid})\n\ +Flush output to @var{fid}. This is useful for ensuring that all\n\ +pending output makes it to the screen before some other event occurs.\n\ +For example, it is always a good idea to flush the standard output\n\ +stream before calling @code{input}.\n\ +\n\ +@code{fflush} returns 0 on success and an OS dependent error value\n\ +(@minus{}1 on Unix) on error.\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + // FIXME -- any way to avoid special case for stdout? + + int fid = octave_stream_list::get_file_number (args (0)); + + if (fid == 1) + { + flush_octave_stdout (); + + retval = 0; + } + else + { + octave_stream os = octave_stream_list::lookup (fid, "fflush"); + + if (! error_state) + retval = os.flush (); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgetl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgetl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgetl (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, excluding\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgetl} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgetl} returns @minus{}1.\n\ +\n\ +To read a line and return the terminating newline see @code{fgets}.\n\ +@seealso{fgets, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgetl"; + + octave_value_list retval; + + retval(1) = 0; + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.getl (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fgets, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{str} =} fgets (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{str} =} fgets (@var{fid}, @var{len})\n\ +Read characters from a file, stopping after a newline, or EOF,\n\ +or @var{len} characters have been read. The characters read, including\n\ +the possible trailing newline, are returned as a string.\n\ +\n\ +If @var{len} is omitted, @code{fgets} reads until the next newline\n\ +character.\n\ +\n\ +If there are no more characters to read, @code{fgets} returns @minus{}1.\n\ +\n\ +To read a line and discard the terminating newline see @code{fgetl}.\n\ +@seealso{fputs, fgetl, fscanf, fread, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fgets"; + + octave_value_list retval; + + retval(1) = 0.0; + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value len_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + std::string tmp = os.gets (len_arg, err, who); + + if (! (error_state || err)) + { + retval(1) = tmp.length (); + retval(0) = tmp; + } + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fskipl, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{nlines} =} fskipl (@var{fid})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, @var{count})\n\ +@deftypefnx {Built-in Function} {@var{nlines} =} fskipl (@var{fid}, Inf)\n\ +Read and skip @var{count} lines from the file descriptor @var{fid}.\n\ +@code{fskipl} discards characters until an end-of-line is encountered exactly\n\ +@var{count}-times, or until the end-of-file marker is found.\n\ +\n\ +If @var{count} is omitted, it defaults to 1. @var{count} may also be\n\ +@code{Inf}, in which case lines are skipped until the end of the file.\n\ +This form is suitable for counting the number of lines in a file.\n\ +\n\ +Returns the number of lines skipped (end-of-line sequences encountered).\n\ +@seealso{fgetl, fgets, fscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fskipl"; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + octave_value count_arg = (nargin == 2) ? args(1) : octave_value (); + + bool err = false; + + long tmp = os.skipl (count_arg, err, who); + + if (! (error_state || err)) + retval = tmp; + } + } + else + print_usage (); + + return retval; +} + + +static octave_stream +do_stream_open (const std::string& name, const std::string& mode, + const std::string& arch, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::ios::openmode md = fopen_mode_to_ios_mode (mode); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt = + oct_mach_info::string_to_float_format (arch); + + if (! error_state) + { + std::string fname = file_ops::tilde_expand (name); + + file_stat fs (fname); + + if (! (md & std::ios::out + || octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + if (! fs.exists ()) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:fopen-file-in-path", + "fopen: file found in load path"); + fname = tmp; + } + } + } + + if (! fs.is_dir ()) + { + std::string tmode = mode; + + // Use binary mode if 't' is not specified, but don't add + // 'b' if it is already present. + + size_t bpos = tmode.find ('b'); + size_t tpos = tmode.find ('t'); + + if (bpos == std::string::npos && tpos == std::string::npos) + tmode += 'b'; + +#if defined (HAVE_ZLIB) + size_t pos = tmode.find ('z'); + + if (pos != std::string::npos) + { + tmode.erase (pos, 1); + + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); + + int fd = fileno (fptr); + + gzFile gzf = ::gzdopen (fd, tmode.c_str ()); + + if (fptr) + retval = octave_zstdiostream::create (fname, gzf, fd, + md, flt_fmt); + else + retval.error (gnulib::strerror (errno)); + } + else +#endif + { + FILE *fptr = gnulib::fopen (fname.c_str (), tmode.c_str ()); + + retval = octave_stdiostream::create (fname, fptr, md, flt_fmt); + + if (! fptr) + retval.error (gnulib::strerror (errno)); + } + + } + } + } + + return retval; +} + +static octave_stream +do_stream_open (const octave_value& tc_name, const octave_value& tc_mode, + const octave_value& tc_arch, const char *fcn, int& fid) +{ + octave_stream retval; + + fid = -1; + + std::string name = tc_name.string_value (); + + if (! error_state) + { + std::string mode = tc_mode.string_value (); + + if (! error_state) + { + std::string arch = tc_arch.string_value (); + + if (! error_state) + retval = do_stream_open (name, mode, arch, fid); + else + ::error ("%s: architecture type must be a string", fcn); + } + else + ::error ("%s: file mode must be a string", fcn); + } + else + ::error ("%s: file name must be a string", fcn); + + return retval; +} + +DEFUN (fopen, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} fopen (@var{name}, @var{mode}, @var{arch})\n\ +@deftypefnx {Built-in Function} {@var{fid_list} =} fopen (\"all\")\n\ +@deftypefnx {Built-in Function} {[@var{file}, @var{mode}, @var{arch}] =} fopen (@var{fid})\n\ +The first form of the @code{fopen} function opens the named file with\n\ +the specified mode (read-write, read-only, etc.) and architecture\n\ +interpretation (IEEE big endian, IEEE little endian, etc.), and returns\n\ +an integer value that may be used to refer to the file later. If an\n\ +error occurs, @var{fid} is set to @minus{}1 and @var{msg} contains the\n\ +corresponding system error message. The @var{mode} is a one or two\n\ +character string that specifies whether the file is to be opened for\n\ +reading, writing, or both.\n\ +\n\ +The second form of the @code{fopen} function returns a vector of file ids\n\ +corresponding to all the currently open files, excluding the\n\ +@code{stdin}, @code{stdout}, and @code{stderr} streams.\n\ +\n\ +The third form of the @code{fopen} function returns information about the\n\ +open file given its file id.\n\ +\n\ +For example,\n\ +\n\ +@example\n\ +myfile = fopen (\"splat.dat\", \"r\", \"ieee-le\");\n\ +@end example\n\ +\n\ +@noindent\n\ +opens the file @file{splat.dat} for reading. If necessary, binary\n\ +numeric values will be read assuming they are stored in IEEE format with\n\ +the least significant bit first, and then converted to the native\n\ +representation.\n\ +\n\ +Opening a file that is already open simply opens it again and returns a\n\ +separate file id. It is not an error to open a file several times,\n\ +though writing to the same file through several different file ids may\n\ +produce unexpected results.\n\ +\n\ +The possible values @samp{mode} may have are\n\ +\n\ +@table @asis\n\ +@item @samp{r}\n\ +Open a file for reading.\n\ +\n\ +@item @samp{w}\n\ +Open a file for writing. The previous contents are discarded.\n\ +\n\ +@item @samp{a}\n\ +Open or create a file for writing at the end of the file.\n\ +\n\ +@item @samp{r+}\n\ +Open an existing file for reading and writing.\n\ +\n\ +@item @samp{w+}\n\ +Open a file for reading or writing. The previous contents are\n\ +discarded.\n\ +\n\ +@item @samp{a+}\n\ +Open or create a file for reading or writing at the end of the\n\ +file.\n\ +@end table\n\ +\n\ +Append a \"t\" to the mode string to open the file in text mode or a\n\ +\"b\" to open in binary mode. On Windows and Macintosh systems, text\n\ +mode reading and writing automatically converts linefeeds to the\n\ +appropriate line end character for the system (carriage-return linefeed\n\ +on Windows, carriage-return on Macintosh). The default if no mode is\n\ +specified is binary mode.\n\ +\n\ +Additionally, you may append a \"z\" to the mode string to open a\n\ +gzipped file for reading or writing. For this to be successful, you\n\ +must also open the file in binary mode.\n\ +\n\ +The parameter @var{arch} is a string specifying the default data format\n\ +for the file. Valid values for @var{arch} are:\n\ +\n\ +@table @asis\n\ +@samp{native}\n\ +The format of the current machine (this is the default).\n\ +\n\ +@samp{ieee-be}\n\ +IEEE big endian format.\n\ +\n\ +@samp{ieee-le}\n\ +IEEE little endian format.\n\ +\n\ +@samp{vaxd}\n\ +VAX D floating format.\n\ +\n\ +@samp{vaxg}\n\ +VAX G floating format.\n\ +\n\ +@samp{cray}\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +however, conversions are currently only supported for @samp{native}\n\ +@samp{ieee-be}, and @samp{ieee-le} formats.\n\ +@seealso{fclose, fgets, fgetl, fscanf, fread, fputs, fdisp, fprintf, fwrite, fskipl, fseek, frewind, ftell, feof, ferror, fclear, fflush, freport}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(0) = -1.0; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + // If there is only one argument and it is a string but it + // is not the string "all", we assume it is a file to open + // with MODE = "r". To open a file called "all", you have + // to supply more than one argument. + + if (nargout < 2 && args(0).string_value () == "all") + return octave_stream_list::open_file_numbers (); + } + else + { + string_vector tmp = octave_stream_list::get_info (args(0)); + + if (! error_state) + { + retval(2) = tmp(2); + retval(1) = tmp(1); + retval(0) = tmp(0); + } + + return retval; + } + } + + if (nargin > 0 && nargin < 4) + { + octave_value mode = (nargin == 2 || nargin == 3) + ? args(1) : octave_value ("r"); + + octave_value arch = (nargin == 3) + ? args(2) : octave_value ("native"); + + int fid = -1; + + octave_stream os = do_stream_open (args(0), mode, arch, "fopen", fid); + + if (os && ! error_state) + { + retval(1) = ""; + retval(0) = octave_stream_list::insert (os); + } + else + { + int error_number = 0; + + retval(1) = os.error (false, error_number); + retval(0) = -1.0; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (freport, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} freport ()\n\ +Print a list of which files have been opened, and whether they are open\n\ +for reading, writing, or both. For example:\n\ +\n\ +@example\n\ +@group\n\ +freport ()\n\ +\n\ + @print{} number mode name\n\ + @print{}\n\ + @print{} 0 r stdin\n\ + @print{} 1 w stdout\n\ + @print{} 2 w stderr\n\ + @print{} 3 r myfile\n\ +@end group\n\ +@end example\n\ +@seealso{fopen, fclose}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + warning ("freport: ignoring extra arguments"); + + octave_stdout << octave_stream_list::list_open_files (); + + return retval; +} + +DEFUN (frewind, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} frewind (@var{fid})\n\ +Move the file pointer to the beginning of the file @var{fid}, returning\n\ +0 for success, and -1 if an error was encountered. It is equivalent to\n\ +@code{fseek (@var{fid}, 0, SEEK_SET)}.\n\ +@seealso{fseek, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "frewind"); + + if (! error_state) + result = os.rewind (); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fseek, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fseek (@var{fid}, @var{offset})\n\ +@deftypefnx {Built-in Function} {} fseek (@var{fid}, @var{offset}, @var{origin})\n\ +@deftypefnx {Built-in Function} {@var{status} =} fseek (@dots{})\n\ +Set the file pointer to any location within the file @var{fid}.\n\ +\n\ +The pointer is positioned @var{offset} characters from the @var{origin},\n\ +which may be one of the predefined variables @w{@code{SEEK_CUR}} (current\n\ +position), @w{@code{SEEK_SET}} (beginning), or @w{@code{SEEK_END}} (end of\n\ +file) or strings \"cof\", \"bof\" or \"eof\". If @var{origin} is omitted,\n\ +@w{@code{SEEK_SET}} is assumed. @var{offset} may be positive, negative, or zero but not all combinations of @var{origin} and @var{offset} can be realized.\n\ +\n\ +Return 0 on success and -1 on error.\n\ +@seealso{fskipl, frewind, ftell, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), "fseek"); + + if (! error_state) + { + octave_value origin_arg = (nargin == 3) + ? args(2) : octave_value (-1.0); + + retval = os.seek (args(1), origin_arg); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (ftell, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ftell (@var{fid})\n\ +Return the position of the file pointer as the number of characters\n\ +from the beginning of the file @var{fid}.\n\ +@seealso{fseek, feof, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "ftell"); + + if (! error_state) + retval = os.tell (); + } + else + print_usage (); + + return retval; +} + +DEFUN (fprintf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fprintf (@var{fid}, @var{template}, @dots{})\n\ +This function is just like @code{printf}, except that the output is\n\ +written to the stream @var{fid} instead of @code{stdout}.\n\ +If @var{fid} is omitted, the output is written to @code{stdout}.\n\ +@seealso{fputs, fdisp, fwrite, fscanf, printf, sprintf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fprintf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 1 || (nargin > 0 && args(0).is_string ())) + { + octave_stream os; + int fmt_n = 0; + + if (args(0).is_string ()) + { + os = octave_stream_list::lookup (1, who); + } + else + { + fmt_n = 1; + os = octave_stream_list::lookup (args(0), who); + } + + if (! error_state) + { + if (args(fmt_n).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1 + fmt_n) + { + tmp_args.resize (nargin-fmt_n-1, octave_value ()); + + for (int i = fmt_n + 1; i < nargin; i++) + tmp_args(i-fmt_n-1) = args(i); + } + + result = os.printf (args(fmt_n), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (printf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} printf (@var{template}, @dots{})\n\ +Print optional arguments under the control of the template string\n\ +@var{template} to the stream @code{stdout} and return the number of\n\ +characters printed.\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Output section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fprintf, sprintf, scanf}\n\ +@end deftypefn") +{ + static std::string who = "printf"; + + octave_value retval; + + int result = -1; + + int nargin = args.length (); + + if (nargin > 0) + { + if (args(0).is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + result = stdout_stream.printf (args(0), tmp_args, who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + print_usage (); + + if (nargout > 0) + retval = result; + + return retval; +} + +DEFUN (fputs, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fputs (@var{fid}, @var{string})\n\ +Write a string to a file with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fdisp, fprintf, fwrite, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fputs"; + + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + retval = os.puts (args(1), who); + } + else + print_usage (); + + return retval; +} + +DEFUN (puts, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} puts (@var{string})\n\ +Write a string to the standard output with no formatting.\n\ +\n\ +Return a non-negative number on success and EOF on error.\n\ +@seealso{fputs, disp}\n\ +@end deftypefn") +{ + static std::string who = "puts"; + + octave_value retval = -1; + + if (args.length () == 1) + retval = stdout_stream.puts (args(0), who); + else + print_usage (); + + return retval; +} + +DEFUN (sprintf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sprintf (@var{template}, @dots{})\n\ +This is like @code{printf}, except that the output is returned as a\n\ +string. Unlike the C library function, which requires you to provide a\n\ +suitably sized string as an argument, Octave's @code{sprintf} function\n\ +returns the string, automatically sized to hold all of the items\n\ +converted.\n\ +@seealso{printf, fprintf, sscanf}\n\ +@end deftypefn") +{ + static std::string who = "sprintf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + retval(2) = -1.0; + retval(1) = "unknown error"; + retval(0) = ""; + + octave_ostrstream *ostr = new octave_ostrstream (); + + octave_stream os (ostr); + + if (os.is_valid ()) + { + octave_value fmt_arg = args(0); + + if (fmt_arg.is_string ()) + { + octave_value_list tmp_args; + + if (nargin > 1) + { + tmp_args.resize (nargin-1, octave_value ()); + + for (int i = 1; i < nargin; i++) + tmp_args(i-1) = args(i); + } + + retval(2) = os.printf (fmt_arg, tmp_args, who); + retval(1) = os.error (); + retval(0) = octave_value (ostr->str (), + fmt_arg.is_sq_string () ? '\'' : '"'); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create output buffer", who.c_str ()); + } + else + print_usage (); + + return retval; +} + +DEFUN (fscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{locale})\n\ +In the first form, read from @var{fid} according to @var{template},\n\ +returning the result in the matrix @var{val}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +A string is returned if @var{template} specifies only character\n\ +conversions.\n\ +\n\ +The number of items successfully read is returned in @var{count}.\n\ +\n\ +If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ +\n\ +In the second form, read from @var{fid} according to @var{template},\n\ +with each conversion specifier in @var{template} corresponding to a\n\ +single scalar return value. This form is more `C-like', and also\n\ +compatible with previous versions of Octave. The number of successful\n\ +conversions is returned in @var{count}. It permits to explicitly\n\ +specify a locale to take into account language specific features, \n\ +such as decimal separator. This operation restores the previous locales\n\ +setting at the end of the conversion.\n\ +@ifclear OCTAVE_MANUAL\n\ +\n\ +See the Formatted Input section of the GNU Octave manual for a\n\ +complete description of the syntax of the template string.\n\ +@end ifclear\n\ +@seealso{fgets, fgetl, fread, scanf, sscanf, fopen}\n\ +@end deftypefn") +{ + static std::string who = "fscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + { + std::locale oldloc; + try + { + // Use args(2) val as the new locale setting. Keep + // old val for restoring afterwards. + oldloc = + os.imbue (std::locale (args(2).string_value ().c_str ())); + + } + catch (std::runtime_error) + { + // Display a warning if the specified locale is unknown + warning ("fscanf: invalid locale. Try `locale -a' for a list of supported values."); + oldloc = std::locale::classic (); + } + retval = os.oscanf (args(1), who); + os.imbue (oldloc); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + } + else + { + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + if (nargin == 2 || nargin == 3) + { + octave_stream os = octave_stream_list::lookup (args(0), who); + + if (! error_state) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), lo_ieee_inf_value ()); + + if (! error_state) + { + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + retval(2) = os.error (); + retval(1) = count; + retval(0) = tmp; + } + } + } + else + ::error ("%s: format must be a string", who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +static std::string +get_sscanf_data (const octave_value& val) +{ + std::string retval; + + if (val.is_string ()) + { + octave_value tmp = val.reshape (dim_vector (1, val.numel ())); + + retval = tmp.string_value (); + } + else + ::error ("sscanf: argument STRING must be a string"); + + return retval; +} + +DEFUN (sscanf, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, @var{locale})\n\ +This is like @code{fscanf}, except that the characters are taken from the\n\ +string @var{string} instead of from a stream. Reaching the end of the\n\ +string is treated as an end-of-file condition. In addition to the values\n\ +returned by @code{fscanf}, the index of the next character to be read\n\ +is returned in @var{pos}.\n\ +@seealso{fscanf, scanf, sprintf}\n\ +@end deftypefn") +{ + static std::string who = "sscanf"; + + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3 && args(2).is_string ()) + { + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + { + // Use args(2) val as the new locale setting. As the os + // object is short lived, we don't need to restore + // locale afterwards. + try + { + os.imbue (std::locale (args(2).string_value ().c_str ())); + } + catch (std::runtime_error) + { + // Display a warning if the specified locale is unknown + warning ("sscanf: invalid locale. Try `locale -a' for a list of supported values."); + } + retval = os.oscanf (args(1), who); + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + else + ::error ("%s: argument STRING must be a string", who.c_str ()); + } + else + { + if (nargin == 2 || nargin == 3) + { + retval(3) = -1.0; + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); + + std::string data = get_sscanf_data (args(0)); + + if (! error_state) + { + octave_stream os = octave_istrstream::create (data); + + if (os.is_valid ()) + { + if (args(1).is_string ()) + { + octave_idx_type count = 0; + + Array size = (nargin == 3) + ? args(2).vector_value () + : Array (dim_vector (1, 1), + lo_ieee_inf_value ()); + + octave_value tmp = os.scanf (args(1), size, count, who); + + if (! error_state) + { + // FIXME -- is this the right thing to do? + // Extract error message first, because getting + // position will clear it. + std::string errmsg = os.error (); + + retval(3) + = (os.eof () ? data.length () : os.tell ()) + 1; + retval(2) = errmsg; + retval(1) = count; + retval(0) = tmp; + } + } + else + ::error ("%s: format TEMPLATE must be a string", who.c_str ()); + } + else + ::error ("%s: unable to create temporary input buffer", + who.c_str ()); + } + } + else + print_usage (); + } + + return retval; +} + +/* +%!test +%! assert (sscanf ("1,2", "%f", "C"), 1) +%! assert (sscanf ("1,2", "%f", "fr_FR"), 1.2) +*/ + +DEFUN (scanf, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} scanf (@var{template}, @var{locale})\n\ +This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ +\n\ +It is currently not useful to call @code{scanf} in interactive\n\ +programs.\n\ +@seealso{fscanf, sscanf, printf}\n\ +@end deftypefn") +{ + int nargin = args.length (); + + octave_value_list tmp_args (nargin+1, octave_value ()); + + tmp_args (0) = 0.0; + for (int i = 0; i < nargin; i++) + tmp_args (i+1) = args (i); + + return Ffscanf (tmp_args, nargout); +} + +static octave_value +do_fread (octave_stream& os, const octave_value& size_arg, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg, octave_idx_type& count) +{ + octave_value retval; + + count = -1; + + Array size = size_arg.vector_value (); + + if (! error_state) + { + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type input_type; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, + input_type, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.read (size, block_size, input_type, + output_type, skip, flt_fmt, count); + } + else + ::error ("fread: ARCH architecture type must be a string"); + } + else + ::error ("fread: SKIP must be an integer"); + } + else + ::error ("fread: invalid PRECISION specified"); + } + else + ::error ("fread: PRECISION must be a string"); + } + else + ::error ("fread: invalid SIZE specified"); + + return retval; +} + +DEFUN (fread, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fread (@var{fid}, @var{size}, @var{precision}, @var{skip}, @var{arch})\n\ +Read binary data of type @var{precision} from the specified file ID\n\ +@var{fid}.\n\ +\n\ +The optional argument @var{size} specifies the amount of data to read\n\ +and may be one of\n\ +\n\ +@table @code\n\ +@item Inf\n\ +Read as much as possible, returning a column vector.\n\ +\n\ +@item @var{nr}\n\ +Read up to @var{nr} elements, returning a column vector.\n\ +\n\ +@item [@var{nr}, Inf]\n\ +Read as much as possible, returning a matrix with @var{nr} rows. If the\n\ +number of elements read is not an exact multiple of @var{nr}, the last\n\ +column is padded with zeros.\n\ +\n\ +@item [@var{nr}, @var{nc}]\n\ +Read up to @code{@var{nr} * @var{nc}} elements, returning a matrix with\n\ +@var{nr} rows. If the number of elements read is not an exact multiple\n\ +of @var{nr}, the last column is padded with zeros.\n\ +@end table\n\ +\n\ +@noindent\n\ +If @var{size} is omitted, a value of @code{Inf} is assumed.\n\ +\n\ +The optional argument @var{precision} is a string specifying the type of\n\ +data to read and may be one of\n\ +\n\ +@table @asis\n\ +@item \"schar\"\n\ +@itemx \"signed char\"\n\ +Signed character.\n\ +\n\ +@item \"uchar\"\n\ +@itemx \"unsigned char\"\n\ +Unsigned character.\n\ +\n\ +@item \"int8\"\n\ +@itemx \"integer*1\"\n\ +\n\ +8-bit signed integer.\n\ +\n\ +@item \"int16\"\n\ +@itemx \"integer*2\"\n\ +16-bit signed integer.\n\ +\n\ +@item \"int32\"\n\ +@itemx \"integer*4\"\n\ +32-bit signed integer.\n\ +\n\ +@item \"int64\"\n\ +@itemx \"integer*8\"\n\ +64-bit signed integer.\n\ +\n\ +@item \"uint8\"\n\ +8-bit unsigned integer.\n\ +\n\ +@item \"uint16\"\n\ +16-bit unsigned integer.\n\ +\n\ +@item \"uint32\"\n\ +32-bit unsigned integer.\n\ +\n\ +@item \"uint64\"\n\ +64-bit unsigned integer.\n\ +\n\ +@item \"single\"\n\ +@itemx \"float32\"\n\ +@itemx \"real*4\"\n\ +32-bit floating point number.\n\ +\n\ +@item \"double\"\n\ +@itemx \"float64\"\n\ +@itemx \"real*8\"\n\ +64-bit floating point number.\n\ +\n\ +@item \"char\"\n\ +@itemx \"char*1\"\n\ +Single character.\n\ +\n\ +@item \"short\"\n\ +Short integer (size is platform dependent).\n\ +\n\ +@item \"int\"\n\ +Integer (size is platform dependent).\n\ +\n\ +@item \"long\"\n\ +Long integer (size is platform dependent).\n\ +\n\ +@item \"ushort\"\n\ +@itemx \"unsigned short\"\n\ +Unsigned short integer (size is platform dependent).\n\ +\n\ +@item \"uint\"\n\ +@itemx \"unsigned int\"\n\ +Unsigned integer (size is platform dependent).\n\ +\n\ +@item \"ulong\"\n\ +@itemx \"unsigned long\"\n\ +Unsigned long integer (size is platform dependent).\n\ +\n\ +@item \"float\"\n\ +Single precision floating point number (size is platform dependent).\n\ +@end table\n\ +\n\ +@noindent\n\ +The default precision is @code{\"uchar\"}.\n\ +\n\ +The @var{precision} argument may also specify an optional repeat\n\ +count. For example, @samp{32*single} causes @code{fread} to read\n\ +a block of 32 single precision floating point numbers. Reading in\n\ +blocks is useful in combination with the @var{skip} argument.\n\ +\n\ +The @var{precision} argument may also specify a type conversion.\n\ +For example, @samp{int16=>int32} causes @code{fread} to read 16-bit\n\ +integer values and return an array of 32-bit integer values. By\n\ +default, @code{fread} returns a double precision array. The special\n\ +form @samp{*TYPE} is shorthand for @samp{TYPE=>TYPE}.\n\ +\n\ +The conversion and repeat counts may be combined. For example, the\n\ +specification @samp{32*single=>single} causes @code{fread} to read\n\ +blocks of single precision floating point values and return an array\n\ +of single precision values instead of the default array of double\n\ +precision values.\n\ +\n\ +The optional argument @var{skip} specifies the number of bytes to skip\n\ +after each element (or block of elements) is read. If it is not\n\ +specified, a value of 0 is assumed. If the final block read is not\n\ +complete, the final skip is omitted. For example,\n\ +\n\ +@example\n\ +fread (f, 10, \"3*single=>single\", 8)\n\ +@end example\n\ +\n\ +@noindent\n\ +will omit the final 8-byte skip because the last read will not be\n\ +a complete block of 3 values.\n\ +\n\ +The optional argument @var{arch} is a string specifying the data format\n\ +for the file. Valid values are\n\ +\n\ +@table @code\n\ +@item \"native\"\n\ +The format of the current machine.\n\ +\n\ +@item \"ieee-be\"\n\ +IEEE big endian.\n\ +\n\ +@item \"ieee-le\"\n\ +IEEE little endian.\n\ +\n\ +@item \"vaxd\"\n\ +VAX D floating format.\n\ +\n\ +@item \"vaxg\"\n\ +VAX G floating format.\n\ +\n\ +@item \"cray\"\n\ +Cray floating format.\n\ +@end table\n\ +\n\ +@noindent\n\ +Conversions are currently only supported for @code{\"ieee-be\"} and\n\ +@code{\"ieee-le\"} formats.\n\ +\n\ +The data read from the file is returned in @var{val}, and the number of\n\ +values read is returned in @code{count}\n\ +@seealso{fwrite, fgets, fgetl, fscanf, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 6) + { + retval(1) = -1.0; + retval(0) = Matrix (); + + octave_stream os = octave_stream_list::lookup (args(0), "fread"); + + if (! error_state) + { + octave_value size = lo_ieee_inf_value (); + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + if (nargin > idx && ! args(idx).is_string ()) + size = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + octave_idx_type count = -1; + + octave_value tmp = do_fread (os, size, prec, skip, arch, count); + + retval(1) = count; + retval(0) = tmp; + } + } + else + print_usage (); + + return retval; +} + +static int +do_fwrite (octave_stream& os, const octave_value& data, + const octave_value& prec_arg, const octave_value& skip_arg, + const octave_value& arch_arg) +{ + int retval = -1; + + std::string prec = prec_arg.string_value (); + + if (! error_state) + { + int block_size = 1; + oct_data_conv::data_type output_type; + + oct_data_conv::string_to_data_type (prec, block_size, output_type); + + if (! error_state) + { + int skip = skip_arg.int_value (true); + + if (! error_state) + { + std::string arch = arch_arg.string_value (); + + if (! error_state) + { + oct_mach_info::float_format flt_fmt + = oct_mach_info::string_to_float_format (arch); + + if (! error_state) + retval = os.write (data, block_size, output_type, + skip, flt_fmt); + } + else + ::error ("fwrite: ARCH architecture type must be a string"); + } + else + ::error ("fwrite: SKIP must be an integer"); + } + else + ::error ("fwrite: invalid PRECISION specified"); + } + else + ::error ("fwrite: PRECISION must be a string"); + + return retval; +} + +DEFUN (fwrite, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{count} =} fwrite (@var{fid}, @var{data}, @var{precision}, @var{skip}, @var{arch})\n\ +Write data in binary form of type @var{precision} to the specified file\n\ +ID @var{fid}, returning the number of values successfully written to the\n\ +file.\n\ +\n\ +The argument @var{data} is a matrix of values that are to be written to\n\ +the file. The values are extracted in column-major order.\n\ +\n\ +The remaining arguments @var{precision}, @var{skip}, and @var{arch} are\n\ +optional, and are interpreted as described for @code{fread}.\n\ +\n\ +The behavior of @code{fwrite} is undefined if the values in @var{data}\n\ +are too large to fit in the specified precision.\n\ +@seealso{fread, fputs, fprintf, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin > 1 && nargin < 6) + { + octave_stream os = octave_stream_list::lookup (args(0), "fwrite"); + + if (! error_state) + { + octave_value prec = "uchar"; + octave_value skip = 0; + octave_value arch = "unknown"; + + int idx = 1; + + octave_value data = args(idx++); + + if (nargin > idx) + prec = args(idx++); + + if (nargin > idx) + skip = args(idx++); + + if (nargin > idx) + arch = args(idx++); + else if (skip.is_string ()) + { + arch = skip; + skip = 0; + } + + double status = do_fwrite (os, data, prec, skip, arch); + + retval = status; + } + } + else + print_usage (); + + return retval; +} + +DEFUNX ("feof", Ffeof, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feof (@var{fid})\n\ +Return 1 if an end-of-file condition has been encountered for a given\n\ +file and 0 otherwise. Note that it will only return 1 if the end of the\n\ +file has already been encountered, not if the next read operation will\n\ +result in an end-of-file condition.\n\ +@seealso{fread, fopen}\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_stream os = octave_stream_list::lookup (args(0), "feof"); + + if (! error_state) + retval = os.eof () ? 1.0 : 0.0; + } + else + print_usage (); + + return retval; +} + +DEFUNX ("ferror", Fferror, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid})\n\ +@deftypefnx {Built-in Function} {[@var{err}, @var{msg}] =} ferror (@var{fid}, \"clear\")\n\ +Return 1 if an error condition has been encountered for the file ID\n\ +@var{fid} and 0 otherwise. Note that it will only return 1 if an error\n\ +has already been encountered, not if the next operation will result in\n\ +an error condition.\n\ +\n\ +The second argument is optional. If it is supplied, also clear the\n\ +error condition.\n\ +@seealso{fclear, fopen}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_stream os = octave_stream_list::lookup (args(0), "ferror"); + + if (! error_state) + { + bool clear = false; + + if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state) + clear = (opt == "clear"); + else + return retval; + } + + int error_number = 0; + + std::string error_message = os.error (clear, error_number); + + retval(1) = error_number; + retval(0) = error_message; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (popen, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{fid} =} popen (@var{command}, @var{mode})\n\ +Start a process and create a pipe. The name of the command to run is\n\ +given by @var{command}. The file identifier corresponding to the input\n\ +or output stream of the process is returned in @var{fid}. The argument\n\ +@var{mode} may be\n\ +\n\ +@table @code\n\ +@item \"r\"\n\ +The pipe will be connected to the standard output of the process, and\n\ +open for reading.\n\ +\n\ +@item \"w\"\n\ +The pipe will be connected to the standard input of the process, and\n\ +open for writing.\n\ +@end table\n\ +\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +fid = popen (\"ls -ltr / | tail -3\", \"r\");\n\ +while (ischar (s = fgets (fid)))\n\ + fputs (stdout, s);\n\ +endwhile\n\ +\n\ + @print{} drwxr-xr-x 33 root root 3072 Feb 15 13:28 etc\n\ + @print{} drwxr-xr-x 3 root root 1024 Feb 15 13:28 lib\n\ + @print{} drwxrwxrwt 15 root root 2048 Feb 17 14:53 tmp\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string mode = args(1).string_value (); + + if (! error_state) + { + if (mode == "r") + { + octave_stream ips = octave_iprocstream::create (name); + + retval = octave_stream_list::insert (ips); + } + else if (mode == "w") + { + octave_stream ops = octave_oprocstream::create (name); + + retval = octave_stream_list::insert (ops); + } + else + ::error ("popen: invalid MODE specified"); + } + else + ::error ("popen: MODE must be a string"); + } + else + ::error ("popen: COMMAND must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (pclose, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pclose (@var{fid})\n\ +Close a file identifier that was opened by @code{popen}. You may also\n\ +use @code{fclose} for the same purpose.\n\ +@end deftypefn") +{ + octave_value retval = -1; + + int nargin = args.length (); + + if (nargin == 1) + retval = octave_stream_list::remove (args(0), "pclose"); + else + print_usage (); + + return retval; +} + +DEFUNX ("tmpnam", Ftmpnam, args, , + "-*- texinfo -*-\n\ +@c List other forms of function in documentation index\n\ +@findex octave_tmp_file_name\n\ +\n\ +@deftypefn {Built-in Function} {} tmpnam ()\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir})\n\ +@deftypefnx {Built-in Function} {} tmpnam (@var{dir}, @var{prefix})\n\ +Return a unique temporary file name as a string.\n\ +\n\ +If @var{prefix} is omitted, a value of @code{\"oct-\"} is used.\n\ +If @var{dir} is also omitted, the default directory for temporary files\n\ +is used. If @var{dir} is provided, it must exist, otherwise the default\n\ +directory for temporary files is used. Since the named file is not\n\ +opened, by @code{tmpnam}, it is possible (though relatively unlikely)\n\ +that it will not be available by the time your program attempts to open it.\n\ +@seealso{tmpfile, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value retval; + + int len = args.length (); + + if (len < 3) + { + std::string dir = len > 0 ? args(0).string_value () : std::string (); + + if (! error_state) + { + std::string pfx + = len > 1 ? args(1).string_value () : std::string ("oct-"); + + if (! error_state) + retval = octave_tempnam (dir, pfx); + else + ::error ("PREFIX must be a string"); + } + else + ::error ("DIR argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (octave_tmp_file_name, tmpnam); + +DEFUN (tmpfile, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} tmpfile ()\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name. The file is opened in binary read/write (@code{\"w+b\"}) mode.\n\ +The file will be deleted automatically when it is closed or when Octave\n\ +exits.\n\ +\n\ +If successful, @var{fid} is a valid file ID and @var{msg} is an empty\n\ +string. Otherwise, @var{fid} is -1 and @var{msg} contains a\n\ +system-dependent error message.\n\ +@seealso{tmpnam, mkstemp, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 0) + { + FILE *fid = gnulib::tmpfile (); + + if (fid) + { + std::string nm; + + std::ios::openmode md = fopen_mode_to_ios_mode ("w+b"); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + retval(0) = octave_stream_list::insert (s); + else + error ("tmpfile: failed to create octave_stdiostream object"); + + } + else + { + retval(1) = gnulib::strerror (errno); + retval(0) = -1; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (mkstemp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{fid}, @var{name}, @var{msg}] =} mkstemp (@var{template}, @var{delete})\n\ +Return the file ID corresponding to a new temporary file with a unique\n\ +name created from @var{template}. The last six characters of @var{template}\n\ +must be @code{XXXXXX} and these are replaced with a string that makes the\n\ +filename unique. The file is then created with mode read/write and\n\ +permissions that are system dependent (on GNU/Linux systems, the permissions\n\ +will be 0600 for versions of glibc 2.0.7 and later). The file is opened\n\ +in binary mode and with the @w{@code{O_EXCL}} flag.\n\ +\n\ +If the optional argument @var{delete} is supplied and is true,\n\ +the file will be deleted automatically when Octave exits, or when\n\ +the function @code{purge_tmp_files} is called.\n\ +\n\ +If successful, @var{fid} is a valid file ID, @var{name} is the name of\n\ +the file, and @var{msg} is an empty string. Otherwise, @var{fid}\n\ +is -1, @var{name} is empty, and @var{msg} contains a system-dependent\n\ +error message.\n\ +@seealso{tmpfile, tmpnam, P_tmpdir}\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(2) = std::string (); + retval(1) = std::string (); + retval(0) = -1; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string tmpl8 = args(0).string_value (); + + if (! error_state) + { + OCTAVE_LOCAL_BUFFER (char, tmp, tmpl8.size () + 1); + strcpy (tmp, tmpl8.c_str ()); + + int fd = gnulib::mkostemp (tmp, O_BINARY); + + if (fd < 0) + { + retval(2) = gnulib::strerror (errno); + retval(0) = fd; + } + else + { + const char *fopen_mode = "w+b"; + + FILE *fid = fdopen (fd, fopen_mode); + + if (fid) + { + std::string nm = tmp; + + std::ios::openmode md = fopen_mode_to_ios_mode (fopen_mode); + + octave_stream s = octave_stdiostream::create (nm, fid, md); + + if (s) + { + retval(1) = nm; + retval(0) = octave_stream_list::insert (s); + + if (nargin == 2 && args(1).is_true ()) + mark_for_deletion (nm); + } + else + error ("mkstemp: failed to create octave_stdiostream object"); + } + else + { + retval(2) = gnulib::strerror (errno); + retval(0) = -1; + } + } + } + else + error ("mkstemp: TEMPLATE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +static int +convert (int x, int ibase, int obase) +{ + int retval = 0; + + int tmp = x % obase; + + if (tmp > ibase - 1) + ::error ("umask: invalid digit"); + else + { + retval = tmp; + int mult = ibase; + while ((x = (x - tmp) / obase)) + { + tmp = x % obase; + if (tmp > ibase - 1) + { + ::error ("umask: invalid digit"); + break; + } + retval += mult * tmp; + mult *= ibase; + } + } + + return retval; +} + +DEFUNX ("umask", Fumask, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} umask (@var{mask})\n\ +Set the permission mask for file creation. The parameter @var{mask}\n\ +is an integer, interpreted as an octal number. If successful,\n\ +returns the previous value of the mask (as an integer to be\n\ +interpreted as an octal number); otherwise an error message is printed.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int status = 0; + + if (args.length () == 1) + { + int mask = args(0).int_value (true); + + if (! error_state) + { + if (mask < 0) + { + status = -1; + ::error ("umask: MASK must be a positive integer value"); + } + else + { + int oct_mask = convert (mask, 8, 10); + + if (! error_state) + status = convert (octave_umask (oct_mask), 10, 8); + } + } + else + { + status = -1; + ::error ("umask: MASK must be an integer"); + } + } + else + print_usage (); + + if (status >= 0) + retval(0) = status; + + return retval; +} + +static octave_value +const_value (const char *, const octave_value_list& args, int val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("P_tmpdir", FP_tmpdir, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} P_tmpdir ()\n\ +Return the default name of the directory for temporary files on\n\ +this system. The name of this directory is system dependent.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = get_P_tmpdir (); + else + print_usage (); + + return retval; +} + +// NOTE: the values of SEEK_SET, SEEK_CUR, and SEEK_END have to be +// this way for Matlab compatibility. + +DEFUNX ("SEEK_SET", FSEEK_SET, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_SET ()\n\ +@deftypefnx {Built-in Function} {} SEEK_CUR ()\n\ +@deftypefnx {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to perform\n\ +one of the following actions:\n\ +\n\ +@table @code\n\ +@item SEEK_SET\n\ +Position file relative to the beginning.\n\ +\n\ +@item SEEK_CUR\n\ +Position file relative to the current position.\n\ +\n\ +@item SEEK_END\n\ +Position file relative to the end.\n\ +@end table\n\ +@seealso{fseek}\n\ +@end deftypefn") +{ + return const_value ("SEEK_SET", args, -1); +} + +DEFUNX ("SEEK_CUR", FSEEK_CUR, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_CUR ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the current position.\n\ +@seealso{SEEK_SET, SEEK_END}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_CUR", args, 0); +} + +DEFUNX ("SEEK_END", FSEEK_END, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SEEK_END ()\n\ +Return the numerical value to pass to @code{fseek} to\n\ +position the file pointer relative to the end of the file.\n\ +@seealso{SEEK_SET, SEEK_CUR}.\n\ +@end deftypefn") +{ + return const_value ("SEEK_END", args, 1); +} + +static octave_value +const_value (const char *, const octave_value_list& args, + const octave_value& val) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = val; + else + print_usage (); + + return retval; +} + +DEFUNX ("stdin", Fstdin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdin ()\n\ +Return the numeric value corresponding to the standard input stream.\n\ +When Octave is used interactively, this is filtered through the command\n\ +line editing functions.\n\ +@seealso{stdout, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdin", args, stdin_file); +} + +DEFUNX ("stdout", Fstdout, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stdout ()\n\ +Return the numeric value corresponding to the standard output stream.\n\ +Data written to the standard output is normally filtered through the pager.\n\ +@seealso{stdin, stderr}\n\ +@end deftypefn") +{ + return const_value ("stdout", args, stdout_file); +} + +DEFUNX ("stderr", Fstderr, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} stderr ()\n\ +Return the numeric value corresponding to the standard error stream.\n\ +Even if paging is turned on, the standard error is not sent to the\n\ +pager. It is useful for error messages and prompts.\n\ +@seealso{stdin, stdout}\n\ +@end deftypefn") +{ + return const_value ("stderr", args, stderr_file); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/file-io.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/file-io.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,36 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +// Written by John C. Campbell + +#if !defined (octave_file_io_h) +#define octave_file_io_h 1 + +extern OCTINTERP_API void initialize_file_io (void); + +extern OCTINTERP_API void close_files (void); + +extern OCTINTERP_API void mark_for_deletion (const std::string&); + +extern OCTINTERP_API void cleanup_tmp_files (void); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/graphics.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/graphics.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,10278 @@ +/* + +Copyright (C) 2007-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-locbuf.h" +#include "singleton-cleanup.h" + +#include "cutils.h" +#include "defun.h" +#include "display.h" +#include "error.h" +#include "graphics.h" +#include "input.h" +#include "ov.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-fcn-handle.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "txt-eng-ft.h" +#include "unwind-prot.h" + +// forward declarations +static octave_value xget (const graphics_handle& h, const caseless_str& name); + +static void +gripe_set_invalid (const std::string& pname) +{ + error ("set: invalid value for %s property", pname.c_str ()); +} + +// Check to see that PNAME matches just one of PNAMES uniquely. +// Return the full name of the match, or an empty caseless_str object +// if there is no match, or the match is ambiguous. + +static caseless_str +validate_property_name (const std::string& who, const std::string& what, + const std::set& pnames, + const caseless_str& pname) +{ + size_t len = pname.length (); + std::set matches; + + for (std::set::const_iterator p = pnames.begin (); + p != pnames.end (); p++) + { + if (pname.compare (*p, len)) + { + if (len == p->length ()) + { + // Exact match. + return pname; + } + + matches.insert (*p); + } + } + + size_t num_matches = matches.size (); + + if (num_matches == 0) + { + error ("%s: unknown %s property %s", + who.c_str (), what.c_str (), pname.c_str ()); + } + else if (num_matches > 1) + { + string_vector sv (matches); + + std::ostringstream os; + + sv.list_in_columns (os); + + std::string match_list = os.str (); + + error ("%s: ambiguous %s property name %s; possible matches:\n\n%s", + who.c_str (), what.c_str (), pname.c_str (), match_list.c_str ()); + } + else if (num_matches == 1) + { + // Exact match was handled above. + + std::string possible_match = *(matches.begin ()); + + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s property %s", + who.c_str (), pname.c_str (), what.c_str (), + possible_match.c_str ()); + + return possible_match; + } + + return caseless_str (); +} + +static Matrix +jet_colormap (void) +{ + Matrix cmap (64, 3, 0.0); + + for (octave_idx_type i = 0; i < 64; i++) + { + // This is the jet colormap. It would be nice to be able + // to feval the jet function but since there is a static + // property object that includes a colormap_property + // object, we need to initialize this before main is even + // called, so calling an interpreted function is not + // possible. + + double x = i / 63.0; + + if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,0) = 4.0 * x - 3.0/2.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,0) = 1.0; + else if (x >= 7.0/8.0) + cmap(i,0) = -4.0 * x + 9.0/2.0; + + if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,1) = 4.0 * x - 1.0/2.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,1) = 1.0; + else if (x >= 5.0/8.0 && x < 7.0/8.0) + cmap(i,1) = -4.0 * x + 7.0/2.0; + + if (x < 1.0/8.0) + cmap(i,2) = 4.0 * x + 1.0/2.0; + else if (x >= 1.0/8.0 && x < 3.0/8.0) + cmap(i,2) = 1.0; + else if (x >= 3.0/8.0 && x < 5.0/8.0) + cmap(i,2) = -4.0 * x + 5.0/2.0; + } + + return cmap; +} + +static double +default_screendepth (void) +{ + return display_info::depth (); +} + +static Matrix +default_screensize (void) +{ + Matrix retval (1, 4, 1.0); + + retval(2) = display_info::width (); + retval(3) = display_info::height (); + + return retval; +} + +static double +default_screenpixelsperinch (void) +{ + return (display_info::x_dpi () + display_info::y_dpi ()) / 2; +} + +static Matrix +default_colororder (void) +{ + Matrix retval (7, 3, 0.0); + + retval(0,2) = 1.0; + + retval(1,1) = 0.5; + + retval(2,0) = 1.0; + + retval(3,1) = 0.75; + retval(3,2) = 0.75; + + retval(4,0) = 0.75; + retval(4,2) = 0.75; + + retval(5,0) = 0.75; + retval(5,1) = 0.75; + + retval(6,0) = 0.25; + retval(6,1) = 0.25; + retval(6,2) = 0.25; + + return retval; +} + +static Matrix +default_lim (bool logscale = false) +{ + Matrix m (1, 2, 0); + + if (logscale) + { + m(0) = 0.1; + m(1) = 1.0; + } + else + m(1) = 1; + + return m; +} + +static Matrix +default_data (void) +{ + Matrix retval (1, 2); + + retval(0) = 0; + retval(1) = 1; + + return retval; +} + +static Matrix +default_axes_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.13; + m(1) = 0.11; + m(2) = 0.775; + m(3) = 0.815; + return m; +} + +static Matrix +default_axes_outerposition (void) +{ + Matrix m (1, 4, 0.0); + m(2) = m(3) = 1.0; + return m; +} + +static Matrix +default_axes_tick (void) +{ + Matrix m (1, 6, 0.0); + m(0) = 0.0; + m(1) = 0.2; + m(2) = 0.4; + m(3) = 0.6; + m(4) = 0.8; + m(5) = 1.0; + return m; +} + +static Matrix +default_axes_ticklength (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 0.01; + m(1) = 0.025; + return m; +} + +static Matrix +default_figure_position (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 300; + m(1) = 200; + m(2) = 560; + m(3) = 420; + return m; +} + +static Matrix +default_figure_papersize (void) +{ + Matrix m (1, 2, 0.0); + m(0) = 8.5; + m(1) = 11.0; + return m; +} + +static Matrix +default_figure_paperposition (void) +{ + Matrix m (1, 4, 0.0); + m(0) = 0.25; + m(1) = 2.50; + m(2) = 8.00; + m(3) = 6.00; + return m; +} + +static Matrix +default_control_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 80; + retval(3) = 30; + + return retval; +} + +static Matrix +default_control_sliderstep (void) +{ + Matrix retval (1, 2, 0.0); + + retval(0) = 0.01; + retval(1) = 0.1; + + return retval; +} + +static Matrix +default_panel_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 0.5; + retval(3) = 0.5; + + return retval; +} + +static double +convert_font_size (double font_size, const caseless_str& from_units, + const caseless_str& to_units, double parent_height = 0) +{ + // Simple case where from_units == to_units + + if (from_units.compare (to_units)) + return font_size; + + // Converts the given fontsize using the following transformation: + // => points => + + double points_size = 0; + double res = 0; + + if (from_units.compare ("points")) + points_size = font_size; + else + { + res = xget (0, "screenpixelsperinch").double_value (); + + if (from_units.compare ("pixels")) + points_size = font_size * 72.0 / res; + else if (from_units.compare ("inches")) + points_size = font_size * 72.0; + else if (from_units.compare ("centimeters")) + points_size = font_size * 72.0 / 2.54; + else if (from_units.compare ("normalized")) + points_size = font_size * parent_height * 72.0 / res; + } + + double new_font_size = 0; + + if (to_units.compare ("points")) + new_font_size = points_size; + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + if (to_units.compare ("pixels")) + new_font_size = points_size * res / 72.0; + else if (to_units.compare ("inches")) + new_font_size = points_size / 72.0; + else if (to_units.compare ("centimeters")) + new_font_size = points_size * 2.54 / 72.0; + else if (to_units.compare ("normalized")) + { + // Avoid setting font size to (0/0) = NaN + + if (parent_height > 0) + new_font_size = points_size * res / (parent_height * 72.0); + } + } + + return new_font_size; +} + +static Matrix +convert_position (const Matrix& pos, const caseless_str& from_units, + const caseless_str& to_units, const Matrix& parent_dim) +{ + Matrix retval (1, pos.numel ()); + double res = 0; + bool is_rectangle = (pos.numel () == 4); + bool is_2d = (pos.numel () == 2); + + if (from_units.compare ("pixels")) + retval = pos; + else if (from_units.compare ("normalized")) + { + retval(0) = pos(0) * parent_dim(0) + 1; + retval(1) = pos(1) * parent_dim(1) + 1; + if (is_rectangle) + { + retval(2) = pos(2) * parent_dim(0); + retval(3) = pos(3) * parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (from_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + // FIXME -- this assumes the system font is Helvetica 10pt + // (for which "x" requires 6x12 pixels at 74.951 pixels/inch) + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 0.5 * pos(0) * f; + retval(1) = pos(1) * f; + if (is_rectangle) + { + retval(2) = 0.5 * pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (from_units.compare ("points")) + f = res / 72.0; + else if (from_units.compare ("inches")) + f = res; + else if (from_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = pos(0) * f + 1; + retval(1) = pos(1) * f + 1; + if (is_rectangle) + { + retval(2) = pos(2) * f; + retval(3) = pos(3) * f; + } + else if (! is_2d) + retval(2) = 0; + } + } + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("normalized")) + { + retval(0) = (retval(0) - 1) / parent_dim(0); + retval(1) = (retval(1) - 1) / parent_dim(1); + if (is_rectangle) + { + retval(2) /= parent_dim(0); + retval(3) /= parent_dim(1); + } + else if (! is_2d) + retval(2) = 0; + } + else if (to_units.compare ("characters")) + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + f = 12.0 * res / 74.951; + + if (f > 0) + { + retval(0) = 2 * retval(0) / f; + retval(1) = retval(1) / f; + if (is_rectangle) + { + retval(2) = 2 * retval(2) / f; + retval(3) = retval(3) / f; + } + else if (! is_2d) + retval(2) = 0; + } + } + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + double f = 0.0; + + if (to_units.compare ("points")) + f = res / 72.0; + else if (to_units.compare ("inches")) + f = res; + else if (to_units.compare ("centimeters")) + f = res / 2.54; + + if (f > 0) + { + retval(0) = (retval(0) - 1) / f; + retval(1) = (retval(1) - 1) / f; + if (is_rectangle) + { + retval(2) /= f; + retval(3) /= f; + } + else if (! is_2d) + retval(2) = 0; + } + } + } + else if (! is_rectangle && ! is_2d) + retval(2) = 0; + + return retval; +} + +static Matrix +convert_text_position (const Matrix& pos, const text::properties& props, + const caseless_str& from_units, + const caseless_str& to_units) +{ + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object ax = go.get_ancestor ("axes"); + + Matrix retval; + + if (ax.valid_object ()) + { + const axes::properties& ax_props = + dynamic_cast (ax.get_properties ()); + graphics_xform ax_xform = ax_props.get_transform (); + bool is_rectangle = (pos.numel () == 4); + Matrix ax_bbox = ax_props.get_boundingbox (true), + ax_size = ax_bbox.extract_n (0, 2, 1, 2); + + if (from_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.transform (pos(0), pos(1), 0), + v2 = ax_xform.transform (pos(0) + pos(2), + pos(1) + pos(3), 0); + + retval.resize (1, 4); + + retval(0) = v1(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v1(1) + 1; + retval(2) = v2(0) - v1(0); + retval(3) = v1(1) - v2(1); + } + else + { + ColumnVector v = ax_xform.transform (pos(0), pos(1), pos(2)); + + retval.resize (1, 3); + + retval(0) = v(0) - ax_bbox(0) + 1; + retval(1) = ax_bbox(1) + ax_bbox(3) - v(1) + 1; + retval(2) = 0; + } + } + else + retval = convert_position (pos, from_units, "pixels", ax_size); + + if (! to_units.compare ("pixels")) + { + if (to_units.compare ("data")) + { + if (is_rectangle) + { + ColumnVector v1 = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1), + v2 = ax_xform.untransform (retval(0) + retval(2) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - (retval(1) + retval(3)) + 1); + + retval.resize (1, 4); + + retval(0) = v1(0); + retval(1) = v1(1); + retval(2) = v2(0) - v1(0); + retval(3) = v2(1) - v1(1); + } + else + { + ColumnVector v = ax_xform.untransform (retval(0) + ax_bbox(0) - 1, + ax_bbox(1) + ax_bbox(3) - retval(1) + 1); + + retval.resize (1, 3); + + retval(0) = v(0); + retval(1) = v(1); + retval(2) = v(2); + } + } + else + retval = convert_position (retval, "pixels", to_units, ax_size); + } + } + + return retval; +} + +// This function always returns the screensize in pixels +static Matrix +screen_size_pixels (void) +{ + graphics_object obj = gh_manager::get_object (0); + Matrix sz = obj.get ("screensize").matrix_value (); + return convert_position (sz, obj.get ("units").string_value (), "pixels", sz.extract_n (0, 2, 1, 2)).extract_n (0, 2, 1, 2); +} + +static void +convert_cdata_2 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, double x, octave_idx_type lda, + octave_idx_type nc, octave_idx_type i, double *av) +{ + if (is_scaled) + x = xround ((nc - 1) * (x - clim_0) / (clim_1 - clim_0)); + else + x = xround (x - 1); + + if (xisnan (x)) + { + av[i] = x; + av[i+lda] = x; + av[i+2*lda] = x; + } + else + { + if (x < 0) + x = 0; + else if (x >= nc) + x = (nc - 1); + + octave_idx_type idx = static_cast (x); + + av[i] = cmapv[idx]; + av[i+lda] = cmapv[idx+nc]; + av[i+2*lda] = cmapv[idx+2*nc]; + } +} + +template +void +convert_cdata_1 (bool is_scaled, double clim_0, double clim_1, + const double *cmapv, const T *cv, octave_idx_type lda, + octave_idx_type nc, double *av) +{ + for (octave_idx_type i = 0; i < lda; i++) + convert_cdata_2 (is_scaled, clim_0, clim_1, cmapv, cv[i], lda, nc, i, av); +} + +static octave_value +convert_cdata (const base_properties& props, const octave_value& cdata, + bool is_scaled, int cdim) +{ + dim_vector dv (cdata.dims ()); + + if (dv.length () == cdim && dv(cdim-1) == 3) + return cdata; + + Matrix cmap (1, 3, 0.0); + Matrix clim (1, 2, 0.0); + + graphics_object go = gh_manager::get_object (props.get___myhandle__ ()); + graphics_object fig = go.get_ancestor ("figure"); + + if (fig.valid_object ()) + { + Matrix _cmap = fig.get (caseless_str ("colormap")).matrix_value (); + + if (! error_state) + cmap = _cmap; + } + + if (is_scaled) + { + graphics_object ax = go.get_ancestor ("axes"); + + if (ax.valid_object ()) + { + Matrix _clim = ax.get (caseless_str ("clim")).matrix_value (); + + if (! error_state) + clim = _clim; + } + } + + dv.resize (cdim); + dv(cdim-1) = 3; + + NDArray a (dv); + + octave_idx_type lda = a.numel () / static_cast (3); + octave_idx_type nc = cmap.rows (); + + double *av = a.fortran_vec (); + const double *cmapv = cmap.data (); + + double clim_0 = clim(0); + double clim_1 = clim(1); + +#define CONVERT_CDATA_1(ARRAY_T, VAL_FN) \ + do \ + { \ + ARRAY_T tmp = cdata. VAL_FN ## array_value (); \ + \ + convert_cdata_1 (is_scaled, clim_0, clim_1, cmapv, \ + tmp.data (), lda, nc, av); \ + } \ + while (0) + + if (cdata.is_uint8_type ()) + CONVERT_CDATA_1 (uint8NDArray, uint8_); + else if (cdata.is_single_type ()) + CONVERT_CDATA_1 (FloatNDArray, float_); + else if (cdata.is_double_type ()) + CONVERT_CDATA_1 (NDArray, ); + else + error ("unsupported type for cdata (= %s)", cdata.type_name ().c_str ()); + +#undef CONVERT_CDATA_1 + + return octave_value (a); +} + +template +static void +get_array_limits (const Array& m, double& emin, double& emax, + double& eminp, double& emaxp) +{ + const T *data = m.data (); + octave_idx_type n = m.numel (); + + for (octave_idx_type i = 0; i < n; i++) + { + double e = double (data[i]); + + // Don't need to test for NaN here as NaN>x and NaN emax) + emax = e; + + if (e > 0 && e < eminp) + eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; + } + } +} + +static bool +lookup_object_name (const caseless_str& name, caseless_str& go_name, + caseless_str& rest) +{ + int len = name.length (); + int offset = 0; + bool result = false; + + if (len >= 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len >= 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len >= 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len >= 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len >= 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len >= 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len >= 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len >= 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + go_name = pfx; + rest = name.substr (offset); + result = true; + } + } + + return result; +} + +static base_graphics_object* +make_graphics_object_from_type (const caseless_str& type, + const graphics_handle& h = graphics_handle (), + const graphics_handle& p = graphics_handle ()) +{ + base_graphics_object *go = 0; + + if (type.compare ("figure")) + go = new figure (h, p); + else if (type.compare ("axes")) + go = new axes (h, p); + else if (type.compare ("line")) + go = new line (h, p); + else if (type.compare ("text")) + go = new text (h, p); + else if (type.compare ("image")) + go = new image (h, p); + else if (type.compare ("patch")) + go = new patch (h, p); + else if (type.compare ("surface")) + go = new surface (h, p); + else if (type.compare ("hggroup")) + go = new hggroup (h, p); + else if (type.compare ("uimenu")) + go = new uimenu (h, p); + else if (type.compare ("uicontrol")) + go = new uicontrol (h, p); + else if (type.compare ("uipanel")) + go = new uipanel (h, p); + else if (type.compare ("uicontextmenu")) + go = new uicontextmenu (h, p); + else if (type.compare ("uitoolbar")) + go = new uitoolbar (h, p); + else if (type.compare ("uipushtool")) + go = new uipushtool (h, p); + else if (type.compare ("uitoggletool")) + go = new uitoggletool (h, p); + return go; +} + +// --------------------------------------------------------------------- + +bool +base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) +{ + if (do_set (v)) + { + + // Notify graphics toolkit. + if (id >= 0 && do_notify_toolkit) + { + graphics_object go = gh_manager::get_object (parent); + if (go) + go.update (id); + } + + // run listeners + if (do_run && ! error_state) + run_listeners (POSTSET); + + return true; + } + + return false; +} + + +void +base_property::run_listeners (listener_mode mode) +{ + const octave_value_list& l = listeners[mode]; + + for (int i = 0; i < l.length (); i++) + { + gh_manager::execute_listener (parent, l(i)); + + if (error_state) + break; + } +} + +radio_values::radio_values (const std::string& opt_string) + : default_val (), possible_vals () +{ + size_t beg = 0; + size_t len = opt_string.length (); + bool done = len == 0; + + while (! done) + { + size_t end = opt_string.find ('|', beg); + + if (end == std::string::npos) + { + end = len; + done = true; + } + + std::string t = opt_string.substr (beg, end-beg); + + // Might want more error checking here... + if (t[0] == '{') + { + t = t.substr (1, t.length () - 2); + default_val = t; + } + else if (beg == 0) // ensure default value + default_val = t; + + possible_vals.insert (t); + + beg = end + 1; + } +} + +std::string +radio_values::values_as_string (void) const +{ + std::string retval; + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + { + if (retval == "") + { + if (*it == default_value ()) + retval = "{" + *it + "}"; + else + retval = *it; + } + else + { + if (*it == default_value ()) + retval += " | {" + *it + "}"; + else + retval += " | " + *it; + } + } + if (retval != "") + retval = "[ " + retval + " ]"; + return retval; +} + +Cell +radio_values::values_as_cell (void) const +{ + octave_idx_type i = 0; + Cell retval (nelem (), 1); + for (std::set::const_iterator it = possible_vals.begin (); + it != possible_vals.end (); it++) + retval(i++) = std::string (*it); + return retval; +} + +bool +color_values::str2rgb (std::string str) +{ + double tmp_rgb[3] = {0, 0, 0}; + bool retval = true; + unsigned int len = str.length (); + + std::transform (str.begin (), str.end (), str.begin (), tolower); + + if (str.compare (0, len, "blue", 0, len) == 0) + tmp_rgb[2] = 1; + else if (str.compare (0, len, "black", 0, len) == 0 + || str.compare (0, len, "k", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 0; + else if (str.compare (0, len, "red", 0, len) == 0) + tmp_rgb[0] = 1; + else if (str.compare (0, len, "green", 0, len) == 0) + tmp_rgb[1] = 1; + else if (str.compare (0, len, "yellow", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = 1; + else if (str.compare (0, len, "magenta", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "cyan", 0, len) == 0) + tmp_rgb[1] = tmp_rgb[2] = 1; + else if (str.compare (0, len, "white", 0, len) == 0 + || str.compare (0, len, "w", 0, len) == 0) + tmp_rgb[0] = tmp_rgb[1] = tmp_rgb[2] = 1; + else + retval = false; + + if (retval) + { + for (int i = 0; i < 3; i++) + xrgb(i) = tmp_rgb[i]; + } + + return retval; +} + +bool +color_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + + if (! s.empty ()) + { + std::string match; + + if (radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + { + color_values col (s); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + else + error ("invalid value for color property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_numeric_type ()) + { + Matrix m = val.matrix_value (); + + if (m.numel () == 3) + { + color_values col (m(0), m(1), m(2)); + if (! error_state) + { + if (current_type != color_t || col != color_val) + { + color_val = col; + current_type = color_t; + return true; + } + } + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + } + else + error ("invalid value for color property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +double_radio_property::do_set (const octave_value& val) +{ + if (val.is_string ()) + { + std::string s = val.string_value (); + std::string match; + + if (! s.empty () && radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + current_type = radio_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + } + else if (val.is_scalar_type () && val.is_real_type ()) + { + double new_dval = val.double_value (); + + if (current_type != double_t || new_dval != dval) + { + dval = new_dval; + current_type = double_t; + return true; + } + } + else + error ("invalid value for double_radio property \"%s\"", + get_name ().c_str ()); + + return false; +} + +bool +array_property::validate (const octave_value& v) +{ + bool xok = false; + + // FIXME -- should we always support []? + if (v.is_empty () && v.is_numeric_type ()) + return true; + + // check value type + if (type_constraints.size () > 0) + { + if(type_constraints.find (v.class_name()) != type_constraints.end()) + xok = true; + + // check if complex is allowed (it's also of class "double", so + // checking that alone is not enough to ensure real type) + if (type_constraints.find ("real") != type_constraints.end () + && v.is_complex_type ()) + xok = false; + } + else + xok = v.is_numeric_type (); + + if (xok) + { + dim_vector vdims = v.dims (); + int vlen = vdims.length (); + + xok = false; + + // check value size + if (size_constraints.size () > 0) + for (std::list::const_iterator it = size_constraints.begin (); + ! xok && it != size_constraints.end (); ++it) + { + dim_vector itdims = (*it); + + if (itdims.length () == vlen) + { + xok = true; + + for (int i = 0; xok && i < vlen; i++) + if (itdims(i) >= 0 && itdims(i) != vdims(i)) + xok = false; + } + } + else + return true; + } + + return xok; +} + +bool +array_property::is_equal (const octave_value& v) const +{ + if (data.type_name () == v.type_name ()) + { + if (data.dims () == v.dims ()) + { + +#define CHECK_ARRAY_EQUAL(T,F,A) \ + { \ + if (data.numel () == 1) \ + return data.F ## scalar_value () == \ + v.F ## scalar_value (); \ + else \ + { \ + /* Keep copy of array_value to allow sparse/bool arrays */ \ + /* that are converted, to not be deallocated early */ \ + const A m1 = data.F ## array_value (); \ + const T* d1 = m1.data (); \ + const A m2 = v.F ## array_value (); \ + const T* d2 = m2.data ();\ + \ + bool flag = true; \ + \ + for (int i = 0; flag && i < data.numel (); i++) \ + if (d1[i] != d2[i]) \ + flag = false; \ + \ + return flag; \ + } \ + } + + if (data.is_double_type () || data.is_bool_type ()) + CHECK_ARRAY_EQUAL (double, , NDArray) + else if (data.is_single_type ()) + CHECK_ARRAY_EQUAL (float, float_, FloatNDArray) + else if (data.is_int8_type ()) + CHECK_ARRAY_EQUAL (octave_int8, int8_, int8NDArray) + else if (data.is_int16_type ()) + CHECK_ARRAY_EQUAL (octave_int16, int16_, int16NDArray) + else if (data.is_int32_type ()) + CHECK_ARRAY_EQUAL (octave_int32, int32_, int32NDArray) + else if (data.is_int64_type ()) + CHECK_ARRAY_EQUAL (octave_int64, int64_, int64NDArray) + else if (data.is_uint8_type ()) + CHECK_ARRAY_EQUAL (octave_uint8, uint8_, uint8NDArray) + else if (data.is_uint16_type ()) + CHECK_ARRAY_EQUAL (octave_uint16, uint16_, uint16NDArray) + else if (data.is_uint32_type ()) + CHECK_ARRAY_EQUAL (octave_uint32, uint32_, uint32NDArray) + else if (data.is_uint64_type ()) + CHECK_ARRAY_EQUAL (octave_uint64, uint64_, uint64NDArray) + } + } + + return false; +} + +void +array_property::get_data_limits (void) +{ + xmin = xminp = octave_Inf; + xmax = xmaxp = -octave_Inf; + + if (! data.is_empty ()) + { + if (data.is_integer_type ()) + { + if (data.is_int8_type ()) + get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint8_type ()) + get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int16_type ()) + get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint16_type ()) + get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int32_type ()) + get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint32_type ()) + get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_int64_type ()) + get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); + else if (data.is_uint64_type ()) + get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); + } + else + get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); + } +} + +bool +handle_property::do_set (const octave_value& v) +{ + double dv = v.double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (dv); + + if (xisnan (gh.value ()) || gh.ok ()) + { + if (current_val != gh) + { + current_val = gh; + return true; + } + } + else + error ("set: invalid graphics handle (= %g) for property \"%s\"", + dv, get_name ().c_str ()); + } + else + error ("set: invalid graphics handle for property \"%s\"", + get_name ().c_str ()); + + return false; +} + +Matrix +children_property::do_get_children (bool return_hidden) const +{ + Matrix retval (children_list.size (), 1); + octave_idx_type k = 0; + + graphics_object go = gh_manager::get_object (0); + + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + if (! props.is_showhiddenhandles ()) + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_handle kid = *p; + + if (gh_manager::is_handle_visible (kid)) + { + if (! return_hidden) + retval(k++) = *p; + } + else if (return_hidden) + retval(k++) = *p; + } + + retval.resize (k, 1); + } + else + { + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(k++) = *p; + } + + return retval; +} + +void +children_property::do_delete_children (bool clear) +{ + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + graphics_object go = gh_manager::get_object (*p); + + if (go.valid_object ()) + gh_manager::free (*p); + + } + + if (clear) + children_list.clear (); +} + +bool +callback_property::validate (const octave_value& v) const +{ + // case 1: function handle + // case 2: cell array with first element being a function handle + // case 3: string corresponding to known function name + // case 4: evaluatable string + // case 5: empty matrix + + if (v.is_function_handle ()) + return true; + else if (v.is_string ()) + // complete validation will be done at execution-time + return true; + else if (v.is_cell () && v.length () > 0 + && (v.rows () == 1 || v.columns () == 1) + && v.cell_value ()(0).is_function_handle ()) + return true; + else if (v.is_empty ()) + return true; + + return false; +} + +// If TRUE, we are executing any callback function, or the functions it +// calls. Used to determine handle visibility inside callback +// functions. +static bool executing_callback = false; + +void +callback_property::execute (const octave_value& data) const +{ + unwind_protect frame; + + // We are executing the callback function associated with this + // callback property. When set to true, we avoid recursive calls to + // callback routines. + frame.protect_var (executing); + + // We are executing a callback function, so allow handles that have + // their handlevisibility property set to "callback" to be visible. + frame.protect_var (executing_callback); + + if (! executing) + { + executing = true; + executing_callback = true; + + if (callback.is_defined () && ! callback.is_empty ()) + gh_manager::execute_callback (get_parent (), callback, data); + } +} + +// Used to cache dummy graphics objects from which dynamic +// properties can be cloned. +static std::map dprop_obj_map; + +property +property::create (const std::string& name, const graphics_handle& h, + const caseless_str& type, const octave_value_list& args) +{ + property retval; + + if (type.compare ("string")) + { + std::string val = (args.length () > 0 ? args(0).string_value () : ""); + + if (! error_state) + retval = property (new string_property (name, h, val)); + } + else if (type.compare ("any")) + { + octave_value val = + (args.length () > 0 ? args(0) : octave_value (Matrix ())); + + retval = property (new any_property (name, h, val)); + } + else if (type.compare ("radio")) + { + if (args.length () > 0) + { + std::string vals = args(0).string_value (); + + if (! error_state) + { + retval = property (new radio_property (name, h, vals)); + + if (args.length () > 1) + retval.set (args(1)); + } + else + error ("addproperty: invalid argument for radio property, expected a string value"); + } + else + error ("addproperty: missing possible values for radio property"); + } + else if (type.compare ("double")) + { + double d = (args.length () > 0 ? args(0).double_value () : 0); + + if (! error_state) + retval = property (new double_property (name, h, d)); + } + else if (type.compare ("handle")) + { + double hh = (args.length () > 0 ? args(0).double_value () : octave_NaN); + + if (! error_state) + { + graphics_handle gh (hh); + + retval = property (new handle_property (name, h, gh)); + } + } + else if (type.compare ("boolean")) + { + retval = property (new bool_property (name, h, false)); + + if (args.length () > 0) + retval.set (args(0)); + } + else if (type.compare ("data")) + { + retval = property (new array_property (name, h, Matrix ())); + + if (args.length () > 0) + { + retval.set (args(0)); + + // FIXME -- additional argument could define constraints, + // but is this really useful? + } + } + else if (type.compare ("color")) + { + color_values cv (0, 0, 0); + radio_values rv; + + if (args.length () > 1) + rv = radio_values (args(1).string_value ()); + + if (! error_state) + { + retval = property (new color_property (name, h, cv, rv)); + + if (! error_state) + { + if (args.length () > 0 && ! args(0).is_empty ()) + retval.set (args(0)); + else + retval.set (rv.default_value ()); + } + } + } + else + { + caseless_str go_name, go_rest; + + if (lookup_object_name (type, go_name, go_rest)) + { + graphics_object go; + + std::map::const_iterator it = + dprop_obj_map.find (go_name); + + if (it == dprop_obj_map.end ()) + { + base_graphics_object *bgo = + make_graphics_object_from_type (go_name); + + if (bgo) + { + go = graphics_object (bgo); + + dprop_obj_map[go_name] = go; + } + } + else + go = it->second; + + if (go.valid_object ()) + { + property prop = go.get_properties ().get_property (go_rest); + + if (! error_state) + { + retval = prop.clone (); + + retval.set_parent (h); + retval.set_name (name); + + if (args.length () > 0) + retval.set (args(0)); + } + } + else + error ("addproperty: invalid object type (= %s)", + go_name.c_str ()); + } + else + error ("addproperty: unsupported type for dynamic property (= %s)", + type.c_str ()); + } + + return retval; +} + +static void +finalize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + for (int k = 0; k < children.numel (); k++) + finalize_r (children(k)); + + go.finalize (); + } +} + +static void +initialize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + go.initialize (); + + for (int k = 0; k < children.numel (); k++) + initialize_r (children(k)); + } +} + +void +figure::properties::set_toolkit (const graphics_toolkit& b) +{ + if (toolkit) + finalize_r (get___myhandle__ ()); + + toolkit = b; + __graphics_toolkit__ = b.get_name (); + __plot_stream__ = Matrix (); + + if (toolkit) + initialize_r (get___myhandle__ ()); + + mark_modified (); +} + +// --------------------------------------------------------------------- + +void +property_list::set (const caseless_str& name, const octave_value& val) +{ + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoogletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + // FIXME -- should we validate property names and values here? + + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + bool has_property = false; + if (pfx == "axes") + has_property = axes::properties::has_core_property (pname); + else if (pfx == "line") + has_property = line::properties::has_core_property (pname); + else if (pfx == "text") + has_property = text::properties::has_core_property (pname); + else if (pfx == "image") + has_property = image::properties::has_core_property (pname); + else if (pfx == "patch") + has_property = patch::properties::has_core_property (pname); + else if (pfx == "figure") + has_property = figure::properties::has_core_property (pname); + else if (pfx == "surface") + has_property = surface::properties::has_core_property (pname); + else if (pfx == "hggroup") + has_property = hggroup::properties::has_core_property (pname); + else if (pfx == "uimenu") + has_property = uimenu::properties::has_core_property (pname); + else if (pfx == "uicontrol") + has_property = uicontrol::properties::has_core_property (pname); + else if (pfx == "uipanel") + has_property = uipanel::properties::has_core_property (pname); + else if (pfx == "uicontextmenu") + has_property = uicontextmenu::properties::has_core_property (pname); + else if (pfx == "uitoolbar") + has_property = uitoolbar::properties::has_core_property (pname); + else if (pfx == "uipushtool") + has_property = uipushtool::properties::has_core_property (pname); + + if (has_property) + { + bool remove = false; + if (val.is_string ()) + { + caseless_str tval = val.string_value (); + + remove = tval.compare ("remove"); + } + + pval_map_type& pval_map = plist_map[pfx]; + + if (remove) + { + pval_map_iterator p = pval_map.find (pname); + + if (p != pval_map.end ()) + pval_map.erase (p); + } + else + pval_map[pname] = val; + } + else + error ("invalid %s property `%s'", pfx.c_str (), pname.c_str ()); + } + } + + if (! error_state && offset == 0) + error ("invalid default property specification"); +} + +octave_value +property_list::lookup (const caseless_str& name) const +{ + octave_value retval; + + size_t offset = 0; + + size_t len = name.length (); + + if (len > 4) + { + caseless_str pfx = name.substr (0, 4); + + if (pfx.compare ("axes") || pfx.compare ("line") + || pfx.compare ("text")) + offset = 4; + else if (len > 5) + { + pfx = name.substr (0, 5); + + if (pfx.compare ("image") || pfx.compare ("patch")) + offset = 5; + else if (len > 6) + { + pfx = name.substr (0, 6); + + if (pfx.compare ("figure") || pfx.compare ("uimenu")) + offset = 6; + else if (len > 7) + { + pfx = name.substr (0, 7); + + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) + offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } + } + } + } + + if (offset > 0) + { + std::string pname = name.substr (offset); + + std::transform (pfx.begin (), pfx.end (), pfx.begin (), tolower); + std::transform (pname.begin (), pname.end (), pname.begin (), tolower); + + plist_map_const_iterator p = find (pfx); + + if (p != end ()) + { + const pval_map_type& pval_map = p->second; + + pval_map_const_iterator q = pval_map.find (pname); + + if (q != pval_map.end ()) + retval = q->second; + } + } + } + + return retval; +} + +octave_scalar_map +property_list::as_struct (const std::string& prefix_arg) const +{ + octave_scalar_map m; + + for (plist_map_const_iterator p = begin (); p != end (); p++) + { + std::string prefix = prefix_arg + p->first; + + const pval_map_type pval_map = p->second; + + for (pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + m.assign (prefix + q->first, q->second); + } + + return m; +} + +graphics_handle::graphics_handle (const octave_value& a) + : val (octave_NaN) +{ + if (a.is_empty ()) + /* do nothing */; + else + { + double tval = a.double_value (); + + if (! error_state) + val = tval; + else + error ("invalid graphics handle"); + } +} + +// Set properties given as a cs-list of name, value pairs. + +void +graphics_object::set (const octave_value_list& args) +{ + int nargin = args.length (); + + if (nargin == 0) + error ("graphics_object::set: Nothing to set"); + else if (nargin % 2 == 0) + { + for (int i = 0; i < nargin; i += 2) + { + caseless_str name = args(i).string_value (); + + if (! error_state) + { + octave_value val = args(i+1); + + set_value_or_default (name, val); + + if (error_state) + break; + } + else + error ("set: expecting argument %d to be a property name", i); + } + } + else + error ("set: invalid number of arguments"); +} + +/* +## test set with name, value pairs +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, "linewidth", 10, "marker", "x"); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +*/ + +// Set properties given in two cell arrays containing names and values. +void +graphics_object::set (const Array& names, + const Cell& values, octave_idx_type row) +{ + if (names.numel () != values.columns ()) + { + error ("set: number of names must match number of value columns (%d != %d)", + names.numel (), values.columns ()); + } + + octave_idx_type k = names.columns (); + + for (octave_idx_type column = 0; column < k; column++) + { + caseless_str name = names(column); + octave_value val = values(row, column); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set with cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); + +## test set with multiple handles and cell array arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"}); +%! assert (get (h, "linewidth"), {10; 5}); +%! assert (get (h, "marker"), {"x"; "o"}); +%! set (h, {"linewidth", "marker"}, {10, "x"}); +%! assert (get (h, "linewidth"), {10; 10}); +%! assert (get (h, "marker"), {"x"; "x"}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth", "marker"}, {10, "x"; 5, "o"; 7, "."}); + +%!error +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, {"linewidth"}, {10, "x"; 5, "o"}); +*/ + +// Set properties given in a struct array +void +graphics_object::set (const octave_map& m) +{ + for (octave_map::const_iterator p = m.begin (); + p != m.end (); p++) + { + caseless_str name = m.key (p); + + octave_value val = octave_value (m.contents (p).elem (m.numel () - 1)); + + set_value_or_default (name, val); + + if (error_state) + break; + } +} + +/* +## test set with struct arguments +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (h, struct ("linewidth", 10, "marker", "x")); +%! assert (get (h, "linewidth"), 10); +%! assert (get (h, "marker"), "x"); +%! h = plot (1:10, 10:-1:1, 1:10, 1:10); +%! set (h, struct ("linewidth", {5, 10})); +%! assert (get (h, "linewidth"), {10; 10}); +*/ + +// Set a property to a value or to its (factory) default value. + +void +graphics_object::set_value_or_default (const caseless_str& name, + const octave_value& val) +{ + if (val.is_string ()) + { + caseless_str tval = val.string_value (); + + octave_value default_val; + + if (tval.compare ("default")) + { + default_val = get_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else if (tval.compare ("factory")) + { + default_val = get_factory_default (name); + + if (error_state) + return; + + rep->set (name, default_val); + } + else + rep->set (name, val); + } + else + rep->set (name, val); +} + +/* +## test setting of default values +%!test +%! set (gcf, "visible", "off"); +%! h = plot (1:10, 10:-1:1); +%! set (0, "defaultlinelinewidth", 20); +%! set (h, "linewidth", "default"); +%! assert (get (h, "linewidth"), 20); +%! set (h, "linewidth", "factory"); +%! assert (get (h, "linewidth"), 0.5); +*/ + +static double +make_handle_fraction (void) +{ + static double maxrand = RAND_MAX + 2.0; + + return (rand () + 1.0) / maxrand; +} + +graphics_handle +gh_manager::do_get_handle (bool integer_figure_handle) +{ + graphics_handle retval; + + if (integer_figure_handle) + { + // Figure handles are positive integers corresponding to the + // figure number. + + // We always want the lowest unused figure number. + + retval = 1; + + while (handle_map.find (retval) != handle_map.end ()) + retval++; + } + else + { + // Other graphics handles are negative integers plus some random + // fractional part. To avoid running out of integers, we + // recycle the integer part but tack on a new random part each + // time. + + free_list_iterator p = handle_free_list.begin (); + + if (p != handle_free_list.end ()) + { + retval = *p; + handle_free_list.erase (p); + } + else + { + retval = graphics_handle (next_handle); + + next_handle = std::ceil (next_handle) - 1.0 - make_handle_fraction (); + } + } + + return retval; +} + +void +gh_manager::do_free (const graphics_handle& h) +{ + if (h.ok ()) + { + if (h.value () != 0) + { + iterator p = handle_map.find (h); + + if (p != handle_map.end ()) + { + base_properties& bp = p->second.get_properties (); + + bp.set_beingdeleted (true); + + bp.delete_children (); + + octave_value val = bp.get_deletefcn (); + + bp.execute_deletefcn (); + + // Notify graphics toolkit. + p->second.finalize (); + + // Note: this will be valid only for first explicitly + // deleted object. All its children will then have an + // unknown graphics toolkit. + + // Graphics handles for non-figure objects are negative + // integers plus some random fractional part. To avoid + // running out of integers, we recycle the integer part + // but tack on a new random part each time. + + handle_map.erase (p); + + if (h.value () < 0) + handle_free_list.insert (std::ceil (h.value ()) - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", h.value ()); + } + else + error ("graphics_handle::free: can't delete root figure"); + } +} + +void +gh_manager::do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) +{ + iterator p = handle_map.find (old_gh); + + if (p != handle_map.end ()) + { + graphics_object go = p->second; + + handle_map.erase (p); + + handle_map[new_gh] = go; + + if (old_gh.value () < 0) + handle_free_list.insert (std::ceil (old_gh.value ()) + - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", old_gh.value ()); + + for (figure_list_iterator q = figure_list.begin (); + q != figure_list.end (); q++) + { + if (*q == old_gh) + { + *q = new_gh; + break; + } + } +} + +gh_manager *gh_manager::instance = 0; + +static void +xset (const graphics_handle& h, const caseless_str& name, + const octave_value& val) +{ + graphics_object obj = gh_manager::get_object (h); + obj.set (name, val); +} + +static void +xset (const graphics_handle& h, const octave_value_list& args) +{ + if (args.length () > 0) + { + graphics_object obj = gh_manager::get_object (h); + obj.set (args); + } +} + +static octave_value +xget (const graphics_handle& h, const caseless_str& name) +{ + graphics_object obj = gh_manager::get_object (h); + return obj.get (name); +} + +static graphics_handle +reparent (const octave_value& ov, const std::string& who, + const std::string& property, const graphics_handle& new_parent, + bool adopt = true) +{ + graphics_handle h = octave_NaN; + + double val = ov.double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = gh_manager::get_object (parent_h); + + parent_obj.remove_child (h); + + if (adopt) + obj.set ("parent", new_parent.value ()); + else + obj.reparent (new_parent); + } + else + error ("%s: invalid graphics handle (= %g) for %s", + who.c_str (), val, property.c_str ()); + } + else + error ("%s: expecting %s to be a graphics handle", + who.c_str (), property.c_str ()); + + return h; +} + +// This function is NOT equivalent to the scripting language function gcf. +graphics_handle +gcf (void) +{ + octave_value val = xget (0, "currentfigure"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +// This function is NOT equivalent to the scripting language function gca. +graphics_handle +gca (void) +{ + octave_value val = xget (gcf (), "currentaxes"); + + return val.is_empty () ? octave_NaN : val.double_value (); +} + +static void +delete_graphics_object (const graphics_handle& h) +{ + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + // Don't do recursive deleting, due to callbacks + if (! obj.get_properties ().is_beingdeleted ()) + { + graphics_handle parent_h = obj.get_parent (); + + graphics_object parent_obj = + gh_manager::get_object (parent_h); + + // NOTE: free the handle before removing it from its + // parent's children, such that the object's + // state is correct when the deletefcn callback + // is executed + + gh_manager::free (h); + + // A callback function might have already deleted + // the parent + if (parent_obj.valid_object ()) + parent_obj.remove_child (h); + + Vdrawnow_requested = true; + } + } +} + +static void +delete_graphics_object (double val) +{ + delete_graphics_object (gh_manager::lookup (val)); +} + +static void +delete_graphics_objects (const NDArray vals) +{ + for (octave_idx_type i = 0; i < vals.numel (); i++) + delete_graphics_object (vals.elem (i)); +} + +static void +close_figure (const graphics_handle& handle) +{ + octave_value closerequestfcn = xget (handle, "closerequestfcn"); + + OCTAVE_SAFE_CALL (gh_manager::execute_callback, (handle, closerequestfcn)); +} + +static void +force_close_figure (const graphics_handle& handle) +{ + // Remove the deletefcn and closerequestfcn callbacks and delete the + // object directly. + + xset (handle, "deletefcn", Matrix ()); + xset (handle, "closerequestfcn", Matrix ()); + + delete_graphics_object (handle); +} + +void +gh_manager::do_close_all_figures (void) +{ + // FIXME -- should we process or discard pending events? + + event_queue.clear (); + + // Don't use figure_list_iterator because we'll be removing elements + // from the list elsewhere. + + Matrix hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + close_figure (h); + } + + // They should all be closed now. If not, force them to close. + + hlist = do_figure_handle_list (true); + + for (octave_idx_type i = 0; i < hlist.numel (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok ()) + force_close_figure (h); + } + + // None left now, right? + + hlist = do_figure_handle_list (true); + + assert (hlist.numel () == 0); + + // Clear all callback objects from our list. + + callback_objects.clear (); +} + +static void +adopt (const graphics_handle& p, const graphics_handle& h) +{ + graphics_object parent_obj = gh_manager::get_object (p); + parent_obj.adopt (h); +} + +static bool +is_handle (const graphics_handle& h) +{ + return h.ok (); +} + +static bool +is_handle (double val) +{ + graphics_handle h = gh_manager::lookup (val); + + return h.ok (); +} + +static octave_value +is_handle (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle (handles (i)); + + retval = result; + } + } + + return retval; +} + +static bool +is_figure (double val) +{ + graphics_object obj = gh_manager::get_object (val); + + return obj && obj.isa ("figure"); +} + +static void +xcreatefcn (const graphics_handle& h) +{ + graphics_object obj = gh_manager::get_object (h); + obj.get_properties ().execute_createfcn (); +} + +static void +xinitialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + go.initialize (); +} + +// --------------------------------------------------------------------- + +void +base_graphics_toolkit::update (const graphics_handle& h, int id) +{ + graphics_object go = gh_manager::get_object (h); + + update (go, id); +} + +bool +base_graphics_toolkit::initialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + return initialize (go); +} + +void +base_graphics_toolkit::finalize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + finalize (go); +} + +// --------------------------------------------------------------------- + +void +base_properties::set_from_list (base_graphics_object& obj, + property_list& defaults) +{ + std::string go_name = graphics_object_name (); + + property_list::plist_map_const_iterator p = defaults.find (go_name); + + if (p != defaults.end ()) + { + const property_list::pval_map_type pval_map = p->second; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string pname = q->first; + + obj.set (pname, q->second); + + if (error_state) + { + error ("error setting default property %s", pname.c_str ()); + break; + } + } + } +} + +octave_value +base_properties::get_dynamic (const caseless_str& name) const +{ + octave_value retval; + + std::map::const_iterator it = all_props.find (name); + + if (it != all_props.end ()) + retval = it->second.get (); + else + error ("get: unknown property \"%s\"", name.c_str ()); + + return retval; +} + +octave_value +base_properties::get_dynamic (bool all) const +{ + octave_scalar_map m; + + for (std::map::const_iterator it = all_props.begin (); + it != all_props.end (); ++it) + if (all || ! it->second.is_hidden ()) + m.assign (it->second.get_name (), it->second.get ()); + + return m; +} + +std::set +base_properties::dynamic_property_names (void) const +{ + return dynamic_properties; +} + +bool +base_properties::has_dynamic_property (const std::string& pname) +{ + const std::set& dynprops = dynamic_property_names (); + + if (dynprops.find (pname) != dynprops.end ()) + return true; + else + return all_props.find (pname) != all_props.end (); +} + +void +base_properties::set_dynamic (const caseless_str& pname, + const octave_value& val) +{ + std::map::iterator it = all_props.find (pname); + + if (it != all_props.end ()) + it->second.set (val); + else + error ("set: unknown property \"%s\"", pname.c_str ()); + + if (! error_state) + { + dynamic_properties.insert (pname); + + mark_modified (); + } +} + +property +base_properties::get_property_dynamic (const caseless_str& name) +{ + std::map::const_iterator it = all_props.find (name); + + if (it == all_props.end ()) + { + error ("get_property: unknown property \"%s\"", name.c_str ()); + return property (); + } + else + return it->second; +} + +void +base_properties::set_parent (const octave_value& val) +{ + double tmp = val.double_value (); + + graphics_handle new_parent = octave_NaN; + + if (! error_state) + { + new_parent = gh_manager::lookup (tmp); + + if (new_parent.ok ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + parent_obj.remove_child (__myhandle__); + + parent = new_parent.as_octave_value (); + + ::adopt (parent.handle_value (), __myhandle__); + } + else + error ("set: invalid graphics handle (= %g) for parent", tmp); + } + else + error ("set: expecting parent to be a graphics handle"); +} + +void +base_properties::mark_modified (void) +{ + __modified__ = "on"; + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj) + parent_obj.mark_modified (); +} + +void +base_properties::override_defaults (base_graphics_object& obj) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.override_defaults (obj); +} + +void +base_properties::update_axis_limits (const std::string& axis_type) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type); +} + +void +base_properties::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + obj.update_axis_limits (axis_type, h); +} + +bool +base_properties::is_handle_visible (void) const +{ + return (handlevisibility.is ("on") + || (executing_callback && ! handlevisibility.is ("off"))); +} + +graphics_toolkit +base_properties::get_toolkit (void) const +{ + graphics_object go = gh_manager::get_object (get_parent ()); + + if (go) + return go.get_toolkit (); + else + return graphics_toolkit (); +} + +void +base_properties::update_boundingbox (void) +{ + Matrix kids = get_children (); + + for (int i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + + if (go.valid_object ()) + go.get_properties ().update_boundingbox (); + } +} + +void +base_properties::update_autopos (const std::string& elem_type) +{ + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj.valid_object ()) + parent_obj.get_properties ().update_autopos (elem_type); +} + +void +base_properties::add_listener (const caseless_str& nm, const octave_value& v, + listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.add_listener (v, mode); +} + +void +base_properties::delete_listener (const caseless_str& nm, + const octave_value& v, listener_mode mode) +{ + property p = get_property (nm); + + if (! error_state && p.ok ()) + p.delete_listener (v, mode); +} + +// --------------------------------------------------------------------- + +void +base_graphics_object::update_axis_limits (const std::string& axis_type) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (valid_object ()) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + + if (parent_obj) + parent_obj.update_axis_limits (axis_type, h); + } + else + error ("base_graphics_object::update_axis_limits: invalid graphics object"); +} + +void +base_graphics_object::remove_all_listeners (void) +{ + octave_map m = get (true).map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + // FIXME -- there has to be a better way. I think we want to + // ask whether it is OK to delete the listener for the given + // property. How can we know in advance that it will be OK? + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (discard_error_messages); + frame.protect_var (Vdebug_on_error); + frame.protect_var (Vdebug_on_warning); + + discard_error_messages = true; + Vdebug_on_error = false; + Vdebug_on_warning = false; + + property p = get_properties ().get_property (pa->first); + + if (! error_state && p.ok ()) + p.delete_listener (); + } +} + +std::string +base_graphics_object::values_as_string (void) +{ + std::string retval; + + if (valid_object ()) + { + octave_map m = get ().map_value (); + + for (octave_map::const_iterator pa = m.begin (); pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + retval += "\n\t" + std::string (pa->first) + ": "; + if (p.is_radio ()) + retval += p.values_as_string (); + } + } + } + if (retval != "") + retval += "\n"; + } + else + error ("base_graphics_object::values_as_string: invalid graphics object"); + + return retval; +} + +octave_scalar_map +base_graphics_object::values_as_struct (void) +{ + octave_scalar_map retval; + + if (valid_object ()) + { + octave_scalar_map m = get ().scalar_map_value (); + + for (octave_scalar_map::const_iterator pa = m.begin (); + pa != m.end (); pa++) + { + if (pa->first != "children") + { + property p = get_properties ().get_property (pa->first); + + if (p.ok () && ! p.is_hidden ()) + { + if (p.is_radio ()) + retval.assign (p.get_name (), p.values_as_cell ()); + else + retval.assign (p.get_name (), Cell ()); + } + } + } + } + else + error ("base_graphics_object::values_as_struct: invalid graphics object"); + + return retval; +} + +graphics_object +graphics_object::get_ancestor (const std::string& obj_type) const +{ + if (valid_object ()) + { + if (isa (obj_type)) + return *this; + else + return gh_manager::get_object (get_parent ()).get_ancestor (obj_type); + } + else + return graphics_object (); +} + +// --------------------------------------------------------------------- + +#include "graphics-props.cc" + +// --------------------------------------------------------------------- + +void +root_figure::properties::set_currentfigure (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + { + currentfigure = val; + + if (val.ok ()) + gh_manager::push_figure (val); + } + else + gripe_set_invalid ("currentfigure"); +} + +void +root_figure::properties::set_callbackobject (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ())) + { + if (! cbo_stack.empty ()) + { + val = cbo_stack.front (); + + cbo_stack.pop_front (); + } + + callbackobject = val; + } + else if (is_handle (val)) + { + if (get_callbackobject ().ok ()) + cbo_stack.push_front (get_callbackobject ()); + + callbackobject = val; + } + else + gripe_set_invalid ("callbackobject"); +} + +void +figure::properties::set_integerhandle (const octave_value& val) +{ + if (! error_state) + { + if (integerhandle.set (val, true)) + { + bool int_fig_handle = integerhandle.is_on (); + + graphics_object this_go = gh_manager::get_object (__myhandle__); + + graphics_handle old_myhandle = __myhandle__; + + __myhandle__ = gh_manager::get_handle (int_fig_handle); + + gh_manager::renumber_figure (old_myhandle, __myhandle__); + + graphics_object parent_go = gh_manager::get_object (get_parent ()); + + base_properties& props = parent_go.get_properties (); + + props.renumber_child (old_myhandle, __myhandle__); + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object kid = gh_manager::get_object (kids(i)); + + kid.get_properties ().renumber_parent (__myhandle__); + } + + graphics_handle cf = gh_manager::current_figure (); + + if (__myhandle__ == cf) + xset (0, "currentfigure", __myhandle__.value ()); + + this_go.update (integerhandle.get_id ()); + + mark_modified (); + } + } +} + +// FIXME This should update monitorpositions and pointerlocation, but +// as these properties are yet used, and so it doesn't matter that they +// aren't set yet. +void +root_figure::properties::update_units (void) +{ + caseless_str xunits = get_units (); + + Matrix ss = default_screensize (); + + double dpi = get_screenpixelsperinch (); + + if (xunits.compare ("inches")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) /= dpi; + ss(3) /= dpi; + } + else if (xunits.compare ("centimeters")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 2.54 / dpi; + ss(3) *= 2.54 / dpi; + } + else if (xunits.compare ("normalized")) + { + ss = Matrix (1, 4, 1.0); + ss(0) = 0; + ss(1) = 0; + } + else if (xunits.compare ("points")) + { + ss(0) = 0; + ss(1) = 0; + ss(2) *= 72 / dpi; + ss(3) *= 72 / dpi; + } + + set_screensize (ss); +} + +Matrix +root_figure::properties::get_boundingbox (bool, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = Matrix (1, 4, 0); + pos(2) = screen_size(0); + pos(3) = screen_size(1); + return pos; +} + +/* +%!test +%! set (0, "units", "pixels"); +%! sz = get (0, "screensize") - [1, 1, 0, 0]; +%! dpi = get (0, "screenpixelsperinch"); +%! set (0, "units", "inches"); +%! assert (get (0, "screensize"), sz / dpi, 0.5 / dpi); +%! set (0, "units", "centimeters"); +%! assert (get (0, "screensize"), sz / dpi * 2.54, 0.5 / dpi * 2.54); +%! set (0, "units", "points"); +%! assert (get (0, "screensize"), sz / dpi * 72, 0.5 / dpi * 72); +%! set (0, "units", "normalized"); +%! assert (get (0, "screensize"), [0.0, 0.0, 1.0, 1.0]); +%! set (0, "units", "pixels"); +%! assert (get (0, "screensize"), sz + [1, 1, 0, 0]); +*/ + +void +root_figure::properties::remove_child (const graphics_handle& gh) +{ + gh_manager::pop_figure (gh); + + graphics_handle cf = gh_manager::current_figure (); + + xset (0, "currentfigure", cf.value ()); + + base_properties::remove_child (gh); +} + +property_list +root_figure::factory_properties = root_figure::init_factory_properties (); + +static void +reset_default_properties (property_list& default_properties) +{ + property_list new_defaults; + + for (property_list::plist_map_const_iterator p = default_properties.begin (); + p != default_properties.end (); p++) + { + const property_list::pval_map_type pval_map = p->second; + std::string prefix = p->first; + + for (property_list::pval_map_const_iterator q = pval_map.begin (); + q != pval_map.end (); + q++) + { + std::string s = q->first; + + if (prefix == "axes" && (s == "position" || s == "units")) + new_defaults.set (prefix + s, q->second); + else if (prefix == "figure" && (s == "position" || s == "units" + || s == "windowstyle" + || s == "paperunits")) + new_defaults.set (prefix + s, q->second); + } + } + + default_properties = new_defaults; +} + +void +root_figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +figure::properties::set_currentaxes (const octave_value& v) +{ + graphics_handle val (v); + + if (error_state) + return; + + if (xisnan (val.value ()) || is_handle (val)) + currentaxes = val; + else + gripe_set_invalid ("currentaxes"); +} + +void +figure::properties::remove_child (const graphics_handle& gh) +{ + base_properties::remove_child (gh); + + if (gh == currentaxes.handle_value ()) + { + graphics_handle new_currentaxes; + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_handle kid = kids(i); + + graphics_object go = gh_manager::get_object (kid); + + if (go.isa ("axes")) + { + new_currentaxes = kid; + break; + } + } + + currentaxes = new_currentaxes; + } +} + +void +figure::properties::set_visible (const octave_value& val) +{ + std::string s = val.string_value (); + + if (! error_state) + { + if (s == "on") + xset (0, "currentfigure", __myhandle__.value ()); + + visible = val; + } +} + +Matrix +figure::properties::get_boundingbox (bool internal, const Matrix&) const +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = (internal ? + get_position ().matrix_value () : + get_outerposition ().matrix_value ()); + + pos = convert_position (pos, get_units (), "pixels", screen_size); + + pos(0)--; + pos(1)--; + pos(1) = screen_size(1) - pos(1) - pos(3); + + return pos; +} + +void +figure::properties::set_boundingbox (const Matrix& bb, bool internal, + bool do_notify_toolkit) +{ + Matrix screen_size = screen_size_pixels (); + Matrix pos = bb; + + pos(1) = screen_size(1) - pos(1) - pos(3); + pos(1)++; + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), screen_size); + + if (internal) + set_position (pos, do_notify_toolkit); + else + set_outerposition (pos, do_notify_toolkit); +} + +Matrix +figure::properties::map_from_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos(1) = bb(3) - pos(1); + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), + bb.extract_n (0, 2, 1, 2)); + + return pos; +} + +Matrix +figure::properties::map_to_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos = convert_position (pos, get_units (), "pixels", + bb.extract_n (0, 2, 1, 2)); + pos(0)--; + pos(1) = bb(3) - pos(1); + + return pos; +} + +void +figure::properties::set_position (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + Matrix old_bb, new_bb; + bool modified = false; + + old_bb = get_boundingbox (true); + modified = position.set (v, false, do_notify_toolkit); + new_bb = get_boundingbox (true); + + if (old_bb != new_bb) + { + if (old_bb(2) != new_bb(2) || old_bb(3) != new_bb(3)) + { + execute_resizefcn (); + update_boundingbox (); + } + } + + if (modified) + { + position.run_listeners (POSTSET); + mark_modified (); + } + } +} + +void +figure::properties::set_outerposition (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + if (outerposition.set (v, true, do_notify_toolkit)) + { + mark_modified (); + } + } +} + +void +figure::properties::set_paperunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = get_papertype (); + caseless_str punits = v.string_value (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + caseless_str old_paperunits = get_paperunits (); + if (paperunits.set (v, true)) + { + update_paperunits (old_paperunits); + mark_modified (); + } + } + } + } +} + +void +figure::properties::set_papertype (const octave_value& v) +{ + if (! error_state) + { + caseless_str typ = v.string_value (); + caseless_str punits = get_paperunits (); + if (! error_state) + { + if (punits.compare ("normalized") && typ.compare ("")) + error ("set: can't set the paperunits to normalized when the papertype is custom"); + else + { + if (papertype.set (v, true)) + { + update_papertype (); + mark_modified (); + } + } + } + } +} + +static Matrix +papersize_from_type (const caseless_str punits, const caseless_str typ) +{ + Matrix ret (1, 2, 1.0); + + if (! punits.compare ("normalized")) + { + double in2units; + double mm2units; + + if (punits.compare ("inches")) + { + in2units = 1.0; + mm2units = 1 / 25.4 ; + } + else if (punits.compare ("centimeters")) + { + in2units = 2.54; + mm2units = 1 / 10.0; + } + else // points + { + in2units = 72.0; + mm2units = 72.0 / 25.4; + } + + if (typ.compare ("usletter")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("uslegal")) + { + ret (0) = 8.5 * in2units; + ret (1) = 14.0 * in2units; + } + else if (typ.compare ("tabloid")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("a0")) + { + ret (0) = 841.0 * mm2units; + ret (1) = 1189.0 * mm2units; + } + else if (typ.compare ("a1")) + { + ret (0) = 594.0 * mm2units; + ret (1) = 841.0 * mm2units; + } + else if (typ.compare ("a2")) + { + ret (0) = 420.0 * mm2units; + ret (1) = 594.0 * mm2units; + } + else if (typ.compare ("a3")) + { + ret (0) = 297.0 * mm2units; + ret (1) = 420.0 * mm2units; + } + else if (typ.compare ("a4")) + { + ret (0) = 210.0 * mm2units; + ret (1) = 297.0 * mm2units; + } + else if (typ.compare ("a5")) + { + ret (0) = 148.0 * mm2units; + ret (1) = 210.0 * mm2units; + } + else if (typ.compare ("b0")) + { + ret (0) = 1029.0 * mm2units; + ret (1) = 1456.0 * mm2units; + } + else if (typ.compare ("b1")) + { + ret (0) = 728.0 * mm2units; + ret (1) = 1028.0 * mm2units; + } + else if (typ.compare ("b2")) + { + ret (0) = 514.0 * mm2units; + ret (1) = 728.0 * mm2units; + } + else if (typ.compare ("b3")) + { + ret (0) = 364.0 * mm2units; + ret (1) = 514.0 * mm2units; + } + else if (typ.compare ("b4")) + { + ret (0) = 257.0 * mm2units; + ret (1) = 364.0 * mm2units; + } + else if (typ.compare ("b5")) + { + ret (0) = 182.0 * mm2units; + ret (1) = 257.0 * mm2units; + } + else if (typ.compare ("arch-a")) + { + ret (0) = 9.0 * in2units; + ret (1) = 12.0 * in2units; + } + else if (typ.compare ("arch-b")) + { + ret (0) = 12.0 * in2units; + ret (1) = 18.0 * in2units; + } + else if (typ.compare ("arch-c")) + { + ret (0) = 18.0 * in2units; + ret (1) = 24.0 * in2units; + } + else if (typ.compare ("arch-d")) + { + ret (0) = 24.0 * in2units; + ret (1) = 36.0 * in2units; + } + else if (typ.compare ("arch-e")) + { + ret (0) = 36.0 * in2units; + ret (1) = 48.0 * in2units; + } + else if (typ.compare ("a")) + { + ret (0) = 8.5 * in2units; + ret (1) = 11.0 * in2units; + } + else if (typ.compare ("b")) + { + ret (0) = 11.0 * in2units; + ret (1) = 17.0 * in2units; + } + else if (typ.compare ("c")) + { + ret (0) = 17.0 * in2units; + ret (1) = 22.0 * in2units; + } + else if (typ.compare ("d")) + { + ret (0) = 22.0 * in2units; + ret (1) = 34.0 * in2units; + } + else if (typ.compare ("e")) + { + ret (0) = 34.0 * in2units; + ret (1) = 43.0 * in2units; + } + } + + return ret; +} + +void +figure::properties::update_paperunits (const caseless_str& old_paperunits) +{ + Matrix pos = get_paperposition ().matrix_value (); + Matrix sz = get_papersize ().matrix_value (); + + pos(0) /= sz(0); + pos(1) /= sz(1); + pos(2) /= sz(0); + pos(3) /= sz(1); + + std::string porient = get_paperorientation (); + caseless_str punits = get_paperunits (); + caseless_str typ = get_papertype (); + + if (typ.compare ("")) + { + if (old_paperunits.compare ("centimeters")) + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (old_paperunits.compare ("points")) + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + + if (punits.compare ("centimeters")) + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits.compare ("points")) + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + } + else + { + sz = papersize_from_type (punits, typ); + if (porient == "landscape") + std::swap (sz(0), sz(1)); + } + + pos(0) *= sz(0); + pos(1) *= sz(1); + pos(2) *= sz(0); + pos(3) *= sz(1); + + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); +} + +void +figure::properties::update_papertype (void) +{ + caseless_str typ = get_papertype (); + if (! typ.compare ("")) + { + Matrix sz = papersize_from_type (get_paperunits (), typ); + if (get_paperorientation () == "landscape") + std::swap (sz(0), sz(1)); + // Call papersize.set rather than set_papersize to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + } +} + +void +figure::properties::update_papersize (void) +{ + Matrix sz = get_papersize ().matrix_value (); + if (sz(0) > sz(1)) + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + paperorientation.set (octave_value ("landscape")); + } + else + { + paperorientation.set ("portrait"); + } + std::string punits = get_paperunits (); + if (punits == "centimeters") + { + sz(0) /= 2.54; + sz(1) /= 2.54; + } + else if (punits == "points") + { + sz(0) /= 72.0; + sz(1) /= 72.0; + } + if (punits == "normalized") + { + caseless_str typ = get_papertype (); + if (get_papertype () == "") + error ("set: can't set the papertype to when the paperunits is normalized"); + } + else + { + // TODO - the papersizes info is also in papersize_from_type(). + // Both should be rewritten to avoid the duplication. + std::string typ = ""; + const double mm2in = 1.0 / 25.4; + const double tol = 0.01; + + if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "usletter"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 14.0) < tol) + typ = "uslegal"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "tabloid"; + else if (std::abs (sz(0) - 841.0 * mm2in) + std::abs (sz(1) - 1198.0 * mm2in) < tol) + typ = "a0"; + else if (std::abs (sz(0) - 594.0 * mm2in) + std::abs (sz(1) - 841.0 * mm2in) < tol) + typ = "a1"; + else if (std::abs (sz(0) - 420.0 * mm2in) + std::abs (sz(1) - 594.0 * mm2in) < tol) + typ = "a2"; + else if (std::abs (sz(0) - 297.0 * mm2in) + std::abs (sz(1) - 420.0 * mm2in) < tol) + typ = "a3"; + else if (std::abs (sz(0) - 210.0 * mm2in) + std::abs (sz(1) - 297.0 * mm2in) < tol) + typ = "a4"; + else if (std::abs (sz(0) - 148.0 * mm2in) + std::abs (sz(1) - 210.0 * mm2in) < tol) + typ = "a5"; + else if (std::abs (sz(0) - 1029.0 * mm2in) + std::abs (sz(1) - 1456.0 * mm2in) < tol) + typ = "b0"; + else if (std::abs (sz(0) - 728.0 * mm2in) + std::abs (sz(1) - 1028.0 * mm2in) < tol) + typ = "b1"; + else if (std::abs (sz(0) - 514.0 * mm2in) + std::abs (sz(1) - 728.0 * mm2in) < tol) + typ = "b2"; + else if (std::abs (sz(0) - 364.0 * mm2in) + std::abs (sz(1) - 514.0 * mm2in) < tol) + typ = "b3"; + else if (std::abs (sz(0) - 257.0 * mm2in) + std::abs (sz(1) - 364.0 * mm2in) < tol) + typ = "b4"; + else if (std::abs (sz(0) - 182.0 * mm2in) + std::abs (sz(1) - 257.0 * mm2in) < tol) + typ = "b5"; + else if (std::abs (sz(0) - 9.0) + std::abs (sz(1) - 12.0) < tol) + typ = "arch-a"; + else if (std::abs (sz(0) - 12.0) + std::abs (sz(1) - 18.0) < tol) + typ = "arch-b"; + else if (std::abs (sz(0) - 18.0) + std::abs (sz(1) - 24.0) < tol) + typ = "arch-c"; + else if (std::abs (sz(0) - 24.0) + std::abs (sz(1) - 36.0) < tol) + typ = "arch-d"; + else if (std::abs (sz(0) - 36.0) + std::abs (sz(1) - 48.0) < tol) + typ = "arch-e"; + else if (std::abs (sz(0) - 8.5) + std::abs (sz(1) - 11.0) < tol) + typ = "a"; + else if (std::abs (sz(0) - 11.0) + std::abs (sz(1) - 17.0) < tol) + typ = "b"; + else if (std::abs (sz(0) - 17.0) + std::abs (sz(1) - 22.0) < tol) + typ = "c"; + else if (std::abs (sz(0) - 22.0) + std::abs (sz(1) - 34.0) < tol) + typ = "d"; + else if (std::abs (sz(0) - 34.0) + std::abs (sz(1) - 43.0) < tol) + typ = "e"; + // Call papertype.set rather than set_papertype to avoid loops between + // update_papersize and update_papertype + papertype.set (typ); + } + if (punits == "centimeters") + { + sz(0) *= 2.54; + sz(1) *= 2.54; + } + else if (punits == "points") + { + sz(0) *= 72.0; + sz(1) *= 72.0; + } + if (get_paperorientation () == "landscape") + { + std::swap (sz(0), sz(1)); + papersize.set (octave_value (sz)); + } +} + +/* +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]) +%! set (1, "paperunits", "points"); +%! assert (get (1, "papersize"), [5, 4] * 72, 1) +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize) +%! assert (get (1, "papersize"), [5, 4] * 72, 1) +%! close (1) +%!test +%! figure (1, "visible", "off"); +%! set (1, "paperunits", "inches"); +%! set (1, "papersize", [5, 4]) +%! set (1, "paperunits", "centimeters"); +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) +%! papersize = get (gcf, "papersize"); +%! set (1, "papersize", papersize + 1); +%! set (1, "papersize", papersize) +%! assert (get (1, "papersize"), [5, 4] * 2.54, 2.54/72) +%! close (1) +*/ + +void +figure::properties::update_paperorientation (void) +{ + std::string porient = get_paperorientation (); + Matrix sz = get_papersize ().matrix_value (); + Matrix pos = get_paperposition ().matrix_value (); + if ((sz(0) > sz(1) && porient == "portrait") + || (sz(0) < sz(1) && porient == "landscape")) + { + std::swap (sz(0), sz(1)); + std::swap (pos(0), pos(1)); + std::swap (pos(2), pos(3)); + // Call papertype.set rather than set_papertype to avoid loops + // between update_papersize and update_papertype + papersize.set (octave_value (sz)); + paperposition.set (octave_value (pos)); + } +} + +/* +%!test +%! figure (1, "visible", false); +%! tol = 100 * eps (); +%! ## UPPER case and MiXed case is part of test and should not be changed. +%! set (gcf (), "paperorientation", "PORTRAIT"); +%! set (gcf (), "paperunits", "inches"); +%! set (gcf (), "papertype", "USletter"); +%! assert (get (gcf (), "papersize"), [8.5, 11.0], tol); +%! set (gcf (), "paperorientation", "Landscape"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5], tol); +%! set (gcf (), "paperunits", "centimeters"); +%! assert (get (gcf (), "papersize"), [11.0, 8.5] * 2.54, tol); +%! set (gcf (), "papertype", "a4"); +%! assert (get (gcf (), "papersize"), [29.7, 21.0], tol); +%! set (gcf (), "paperunits", "inches", "papersize", [8.5, 11.0]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "portrait"); +%! set (gcf (), "papersize", [11.0, 8.5]); +%! assert (get (gcf (), "papertype"), "usletter"); +%! assert (get (gcf (), "paperorientation"), "landscape"); +*/ + +void +figure::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +figure::properties::update_units (const caseless_str& old_units) +{ + position.set (convert_position (get_position ().matrix_value (), old_units, + get_units (), screen_size_pixels ()), false); +} + +/* +%!test +%! figure (1, "visible", false); +%! set (0, "units", "pixels"); +%! rsz = get (0, "screensize"); +%! set (gcf (), "units", "pixels"); +%! fsz = get (gcf (), "position"); +%! set (gcf (), "units", "normalized"); +%! assert (get (gcf (), "position"), (fsz - [1, 1, 0, 0]) ./ rsz([3, 4, 3, 4])); +*/ + +std::string +figure::properties::get_title (void) const +{ + if (is_numbertitle ()) + { + std::ostringstream os; + std::string nm = get_name (); + + os << "Figure " << __myhandle__.value (); + if (! nm.empty ()) + os << ": " << get_name (); + + return os.str (); + } + else + return get_name (); +} + +octave_value +figure::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +figure::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +void +axes::properties::init (void) +{ + position.add_constraint (dim_vector (1, 4)); + position.add_constraint (dim_vector (0, 0)); + outerposition.add_constraint (dim_vector (1, 4)); + colororder.add_constraint (dim_vector (-1, 3)); + dataaspectratio.add_constraint (dim_vector (1, 3)); + plotboxaspectratio.add_constraint (dim_vector (1, 3)); + xlim.add_constraint (2); + ylim.add_constraint (2); + zlim.add_constraint (2); + clim.add_constraint (2); + alim.add_constraint (2); + xtick.add_constraint (dim_vector (1, -1)); + ytick.add_constraint (dim_vector (1, -1)); + ztick.add_constraint (dim_vector (1, -1)); + Matrix vw (1, 2, 0); + vw(1) = 90; + view = vw; + view.add_constraint (dim_vector (1, 2)); + cameraposition.add_constraint (dim_vector (1, 3)); + Matrix upv (1, 3, 0.0); + upv(2) = 1.0; + cameraupvector = upv; + cameraupvector.add_constraint (dim_vector (1, 3)); + currentpoint.add_constraint (dim_vector (2, 3)); + ticklength.add_constraint (dim_vector (1, 2)); + tightinset.add_constraint (dim_vector (1, 4)); + looseinset.add_constraint (dim_vector (1, 4)); + update_font (); + + x_zlim.resize (1, 2); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "cap"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + Matrix tlooseinset = default_axes_position (); + tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); + tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); + looseinset = tlooseinset; +} + +Matrix +axes::properties::calc_tightbox (const Matrix& init_pos) +{ + Matrix pos = init_pos; + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true); + Matrix ext = get_extent (true, true); + ext(1) = parent_bb(3) - ext(1) - ext(3); + ext(0)++; + ext(1)++; + ext = convert_position (ext, "pixels", get_units (), + parent_bb.extract_n (0, 2, 1, 2)); + if (ext(0) < pos(0)) + { + pos(2) += pos(0)-ext(0); + pos(0) = ext(0); + } + if (ext(0)+ext(2) > pos(0)+pos(2)) + pos(2) = ext(0)+ext(2)-pos(0); + + if (ext(1) < pos(1)) + { + pos(3) += pos(1)-ext(1); + pos(1) = ext(1); + } + if (ext(1)+ext(3) > pos(1)+pos(3)) + pos(3) = ext(1)+ext(3)-pos(1); + return pos; +} + +void +axes::properties::sync_positions (void) +{ + Matrix ref_linset = looseinset.get ().matrix_value (); + if (autopos_tag_is ("subplot")) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj.isa ("figure")) + { + // FIXME: temporarily changed units should be protected + // from interrupts + std::string fig_units = parent_obj.get ("units").string_value (); + parent_obj.set ("units", "pixels"); + + Matrix ref_outbox = outerposition.get ().matrix_value (); + ref_outbox(2) += ref_outbox(0); + ref_outbox(3) += ref_outbox(1); + + // Find those subplots that are left, right, bottom and top aligned + // with the current subplot + Matrix kids = parent_obj.get_properties ().get_children (); + std::vector aligned; + std::vector l_aligned, b_aligned, r_aligned, t_aligned; + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + if (go.isa ("axes")) + { + axes::properties& props = + dynamic_cast (go.get_properties ()); + if (props.autopos_tag_is ("subplot")) + { + Matrix outpos = go.get ("outerposition").matrix_value (); + bool l_align = (std::abs (outpos(0)-ref_outbox(0)) < 1e-15); + bool b_align = (std::abs (outpos(1)-ref_outbox(1)) < 1e-15); + bool r_align = (std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); + bool t_align = (std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); + if (l_align || b_align || r_align || t_align) + { + aligned.push_back (kids(i)); + l_aligned.push_back (l_align); + b_aligned.push_back (b_align); + r_aligned.push_back (r_align); + t_aligned.push_back (t_align); + // FIXME: the temporarily deleted tags should be + // protected from interrupts + props.set_autopos_tag ("none"); + } + } + } + } + // Determine a minimum box which aligns the subplots + Matrix ref_box (1, 4, 0.); + ref_box(2) = 1.; + ref_box(3) = 1.; + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = std::min (0., linset(0)-0.01); + if (b_aligned[i]) + linset(1) = std::min (0., linset(1)-0.01); + if (r_aligned[i]) + linset(2) = std::min (0., linset(2)-0.01); + if (t_aligned[i]) + linset(3) = std::min (0., linset(3)-0.01); + props.set_looseinset (linset); + Matrix pos = props.get_position ().matrix_value (); + if (l_aligned[i]) + ref_box(0) = std::max (ref_box(0), pos(0)); + if (b_aligned[i]) + ref_box(1) = std::max (ref_box(1), pos(1)); + if (r_aligned[i]) + ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); + if (t_aligned[i]) + ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); + } + // Set common looseinset values for all aligned subplots and + // revert their tag values + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast (go.get_properties ()); + Matrix outpos = props.get_outerposition ().matrix_value (); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = (ref_box(0)-outpos(0))/outpos(2); + if (b_aligned[i]) + linset(1) = (ref_box(1)-outpos(1))/outpos(3); + if (r_aligned[i]) + linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); + if (t_aligned[i]) + linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); + props.set_looseinset (linset); + props.set_autopos_tag ("subplot"); + } + parent_obj.set ("units", fig_units); + } + } + else + sync_positions (ref_linset); +} + +void +axes::properties::sync_positions (const Matrix& linset) +{ + Matrix pos = position.get ().matrix_value (); + Matrix outpos = outerposition.get ().matrix_value (); + double lratio = linset(0); + double bratio = linset(1); + double wratio = 1-linset(0)-linset(2); + double hratio = 1-linset(1)-linset(3); + if (activepositionproperty.is ("outerposition")) + { + pos = outpos; + pos(0) = outpos(0)+lratio*outpos(2); + pos(1) = outpos(1)+bratio*outpos(3); + pos(2) = wratio*outpos(2); + pos(3) = hratio*outpos(3); + + position = pos; + update_transform (); + Matrix tightpos = calc_tightbox (pos); + + double thrshldx = 0.005*outpos(2); + double thrshldy = 0.005*outpos(3); + double minsizex = 0.2*outpos(2); + double minsizey = 0.2*outpos(3); + bool updatex = true, updatey = true; + for (int i = 0; i < 10; i++) + { + double dt; + bool modified = false; + dt = outpos(0)+outpos(2)-tightpos(0)-tightpos(2); + if (dt < -thrshldx && updatex) + { + pos(2) += dt; + modified = true; + } + dt = outpos(1)+outpos(3)-tightpos(1)-tightpos(3); + if (dt < -thrshldy && updatey) + { + pos(3) += dt; + modified = true; + } + dt = outpos(0)-tightpos(0); + if (dt > thrshldx && updatex) + { + pos(0) += dt; + pos(2) -= dt; + modified = true; + } + dt = outpos(1)-tightpos(1); + if (dt > thrshldy && updatey) + { + pos(1) += dt; + pos(3) -= dt; + modified = true; + } + + // Note: checking limit for minimum axes size + if (pos(2) < minsizex) + { + pos(0) -= 0.5*(minsizex-pos(2)); + pos(2) = minsizex; + updatex = false; + } + if (pos(3) < minsizey) + { + pos(1) -= 0.5*(minsizey-pos(3)); + pos(3) = minsizey; + updatey = false; + } + + if (modified) + { + position = pos; + update_transform (); + tightpos = calc_tightbox (pos); + } + else + break; + } + } + else + { + update_transform (); + + outpos(0) = pos(0)-pos(2)*lratio/wratio; + outpos(1) = pos(1)-pos(3)*bratio/hratio; + outpos(2) = pos(2)/wratio; + outpos(3) = pos(3)/hratio; + + outerposition = calc_tightbox (outpos); + } + + Matrix inset (1, 4, 1.0); + inset(0) = pos(0)-outpos(0); + inset(1) = pos(1)-outpos(1); + inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); + inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); + + tightinset = inset; +} + +void +axes::properties::set_text_child (handle_property& hp, + const std::string& who, + const octave_value& v) +{ + graphics_handle val; + + if (v.is_string ()) + { + val = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (val, "string", v); + } + else + { + graphics_object go = gh_manager::get_object (gh_manager::lookup (v)); + + if (go.isa ("text")) + val = ::reparent (v, "set", who, __myhandle__, false); + else + { + std::string cname = v.class_name (); + + error ("set: expecting text graphics object or character string for %s property, found %s", + who.c_str (), cname.c_str ()); + } + } + + if (! error_state) + { + xset (val, "handlevisibility", "off"); + + gh_manager::free (hp.handle_value ()); + + base_properties::remove_child (hp.handle_value ()); + + hp = val; + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::set_xlabel (const octave_value& v) +{ + set_text_child (xlabel, "xlabel", v); + xset (xlabel.handle_value (), "positionmode", "auto"); + xset (xlabel.handle_value (), "rotationmode", "auto"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (xlabel.handle_value (), "clipping", "off"); + xset (xlabel.handle_value (), "color", get_xcolor ()); + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + update_xlabel_position (); +} + +void +axes::properties::set_ylabel (const octave_value& v) +{ + set_text_child (ylabel, "ylabel", v); + xset (ylabel.handle_value (), "positionmode", "auto"); + xset (ylabel.handle_value (), "rotationmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "color", get_ycolor ()); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + update_ylabel_position (); +} + +void +axes::properties::set_zlabel (const octave_value& v) +{ + set_text_child (zlabel, "zlabel", v); + xset (zlabel.handle_value (), "positionmode", "auto"); + xset (zlabel.handle_value (), "rotationmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "color", get_zcolor ()); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + update_zlabel_position (); +} + +void +axes::properties::set_title (const octave_value& v) +{ + set_text_child (title, "title", v); + xset (title.handle_value (), "positionmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "clipping", "off"); + xset (title.handle_value (), "autopos_tag", "title"); + update_title_position (); +} + +void +axes::properties::set_defaults (base_graphics_object& obj, + const std::string& mode) +{ + box = "on"; + colororder = default_colororder (); + dataaspectratio = Matrix (1, 3, 1.0); + dataaspectratiomode = "auto"; + layer = "bottom"; + + Matrix tlim (1, 2, 0.0); + tlim(1) = 1; + xlim = tlim; + ylim = tlim; + zlim = tlim; + + Matrix cl (1, 2, 0); + cl(1) = 1; + clim = cl; + + xlimmode = "auto"; + ylimmode = "auto"; + zlimmode = "auto"; + climmode = "auto"; + + xgrid = "off"; + ygrid = "off"; + zgrid = "off"; + xminorgrid = "off"; + yminorgrid = "off"; + zminorgrid = "off"; + xtick = Matrix (); + ytick = Matrix (); + ztick = Matrix (); + xtickmode = "auto"; + ytickmode = "auto"; + ztickmode = "auto"; + xticklabel = ""; + yticklabel = ""; + zticklabel = ""; + xticklabelmode = "auto"; + yticklabelmode = "auto"; + zticklabelmode = "auto"; + color = color_values ("white"); + xcolor = color_values ("black"); + ycolor = color_values ("black"); + zcolor = color_values ("black"); + xscale = "linear"; + yscale = "linear"; + zscale = "linear"; + xdir = "normal"; + ydir = "normal"; + zdir = "normal"; + yaxislocation = "left"; + xaxislocation = "bottom"; + + // Note: camera properties will be set through update_transform + camerapositionmode = "auto"; + cameratargetmode = "auto"; + cameraupvectormode = "auto"; + cameraviewanglemode = "auto"; + plotboxaspectratio = Matrix (1, 3, 1.0); + drawmode = "normal"; + gridlinestyle = ":"; + linestyleorder = "-"; + linewidth = 0.5; + minorgridlinestyle = ":"; + // Note: plotboxaspectratio will be set through update_aspectratiors + plotboxaspectratiomode = "auto"; + projection = "orthographic"; + tickdir = "in"; + tickdirmode = "auto"; + ticklength = default_axes_ticklength (); + tightinset = Matrix (1, 4, 0.0); + + sx = "linear"; + sy = "linear"; + sz = "linear"; + + Matrix tview (1, 2, 0.0); + tview(1) = 90; + view = tview; + + visible = "on"; + nextplot = "replace"; + + if (mode != "replace") + { + fontangle = "normal"; + fontname = OCTAVE_DEFAULT_FONTNAME; + fontsize = 10; + fontunits = "points"; + fontweight = "normal"; + + Matrix touterposition (1, 4, 0.0); + touterposition(2) = 1; + touterposition(3) = 1; + outerposition = touterposition; + + position = default_axes_position (); + + Matrix tlooseinset = default_axes_position (); + tlooseinset(2) = 1-tlooseinset(0)-tlooseinset(2); + tlooseinset(3) = 1-tlooseinset(1)-tlooseinset(3); + looseinset = tlooseinset; + + activepositionproperty = "outerposition"; + } + + delete_children (true); + + xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + title = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (xlabel.handle_value (), "handlevisibility", "off"); + xset (ylabel.handle_value (), "handlevisibility", "off"); + xset (zlabel.handle_value (), "handlevisibility", "off"); + xset (title.handle_value (), "handlevisibility", "off"); + + xset (xlabel.handle_value (), "horizontalalignment", "center"); + xset (xlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (ylabel.handle_value (), "horizontalalignment", "center"); + xset (ylabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (zlabel.handle_value (), "horizontalalignment", "right"); + xset (zlabel.handle_value (), "horizontalalignmentmode", "auto"); + xset (title.handle_value (), "horizontalalignment", "center"); + xset (title.handle_value (), "horizontalalignmentmode", "auto"); + + xset (xlabel.handle_value (), "verticalalignment", "cap"); + xset (xlabel.handle_value (), "verticalalignmentmode", "auto"); + xset (ylabel.handle_value (), "verticalalignment", "bottom"); + xset (ylabel.handle_value (), "verticalalignmentmode", "auto"); + xset (title.handle_value (), "verticalalignment", "bottom"); + xset (title.handle_value (), "verticalalignmentmode", "auto"); + + xset (ylabel.handle_value (), "rotation", 90.0); + xset (ylabel.handle_value (), "rotationmode", "auto"); + + xset (zlabel.handle_value (), "visible", "off"); + + xset (xlabel.handle_value (), "clipping", "off"); + xset (ylabel.handle_value (), "clipping", "off"); + xset (zlabel.handle_value (), "clipping", "off"); + xset (title.handle_value (), "clipping", "off"); + + xset (xlabel.handle_value (), "autopos_tag", "xlabel"); + xset (ylabel.handle_value (), "autopos_tag", "ylabel"); + xset (zlabel.handle_value (), "autopos_tag", "zlabel"); + xset (title.handle_value (), "autopos_tag", "title"); + + adopt (xlabel.handle_value ()); + adopt (ylabel.handle_value ()); + adopt (zlabel.handle_value ()); + adopt (title.handle_value ()); + + update_transform (); + + override_defaults (obj); +} + +void +axes::properties::delete_text_child (handle_property& hp) +{ + graphics_handle h = hp.handle_value (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + if (go.valid_object ()) + gh_manager::free (h); + + base_properties::remove_child (h); + } + + // FIXME -- is it necessary to check whether the axes object is + // being deleted now? I think this function is only called when an + // individual child object is delete and not when the parent axes + // object is deleted. + + if (! is_beingdeleted ()) + { + hp = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + xset (hp.handle_value (), "handlevisibility", "off"); + + adopt (hp.handle_value ()); + } +} + +void +axes::properties::remove_child (const graphics_handle& h) +{ + if (xlabel.handle_value ().ok () && h == xlabel.handle_value ()) + delete_text_child (xlabel); + else if (ylabel.handle_value ().ok () && h == ylabel.handle_value ()) + delete_text_child (ylabel); + else if (zlabel.handle_value ().ok () && h == zlabel.handle_value ()) + delete_text_child (zlabel); + else if (title.handle_value ().ok () && h == title.handle_value ()) + delete_text_child (title); + else + base_properties::remove_child (h); +} + +inline Matrix +xform_matrix (void) +{ + Matrix m (4, 4, 0.0); + for (int i = 0; i < 4; i++) + m(i,i) = 1; + return m; +} + +inline ColumnVector +xform_vector (void) +{ + ColumnVector v (4, 0.0); + v(3) = 1; + return v; +} + +inline ColumnVector +xform_vector (double x, double y, double z) +{ + ColumnVector v (4, 1.0); + v(0) = x; v(1) = y; v(2) = z; + return v; +} + +inline ColumnVector +transform (const Matrix& m, double x, double y, double z) +{ + return (m * xform_vector (x, y, z)); +} + +inline Matrix +xform_scale (double x, double y, double z) +{ + Matrix m (4, 4, 0.0); + m(0,0) = x; m(1,1) = y; m(2,2) = z; m(3,3) = 1; + return m; +} + +inline Matrix +xform_translate (double x, double y, double z) +{ + Matrix m = xform_matrix (); + m(0,3) = x; m(1,3) = y; m(2,3) = z; m(3,3) = 1; + return m; +} + +inline void +scale (Matrix& m, double x, double y, double z) +{ + m = m * xform_scale (x, y, z); +} + +inline void +translate (Matrix& m, double x, double y, double z) +{ + m = m * xform_translate (x, y, z); +} + +inline void +xform (ColumnVector& v, const Matrix& m) +{ + v = m*v; +} + +inline void +scale (ColumnVector& v, double x, double y, double z) +{ + v(0) *= x; + v(1) *= y; + v(2) *= z; +} + +inline void +translate (ColumnVector& v, double x, double y, double z) +{ + v(0) += x; + v(1) += y; + v(2) += z; +} + +inline void +normalize (ColumnVector& v) +{ + double fact = 1.0 / sqrt (v(0)*v(0)+v(1)*v(1)+v(2)*v(2)); + scale (v, fact, fact, fact); +} + +inline double +dot (const ColumnVector& v1, const ColumnVector& v2) +{ + return (v1(0)*v2(0)+v1(1)*v2(1)+v1(2)*v2(2)); +} + +inline double +norm (const ColumnVector& v) +{ + return sqrt (dot (v, v)); +} + +inline ColumnVector +cross (const ColumnVector& v1, const ColumnVector& v2) +{ + ColumnVector r = xform_vector (); + r(0) = v1(1)*v2(2)-v1(2)*v2(1); + r(1) = v1(2)*v2(0)-v1(0)*v2(2); + r(2) = v1(0)*v2(1)-v1(1)*v2(0); + return r; +} + +inline Matrix +unit_cube (void) +{ + static double data[32] = { + 0,0,0,1, + 1,0,0,1, + 0,1,0,1, + 0,0,1,1, + 1,1,0,1, + 1,0,1,1, + 0,1,1,1, + 1,1,1,1}; + Matrix m (4, 8); + memcpy (m.fortran_vec (), data, sizeof (double)*32); + return m; +} + +inline ColumnVector +cam2xform (const Array& m) +{ + ColumnVector retval (4, 1.0); + memcpy (retval.fortran_vec (), m.fortran_vec (), sizeof (double)*3); + return retval; +} + +inline RowVector +xform2cam (const ColumnVector& v) +{ + return v.extract_n (0, 3).transpose (); +} + +void +axes::properties::update_camera (void) +{ + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + Matrix xlimits = sx.scale (get_xlim ().matrix_value ()); + Matrix ylimits = sy.scale (get_ylim ().matrix_value ()); + Matrix zlimits = sz.scale (get_zlim ().matrix_value ()); + + double xo = xlimits(xd > 0 ? 0 : 1); + double yo = ylimits(yd > 0 ? 0 : 1); + double zo = zlimits(zd > 0 ? 0 : 1); + + Matrix pb = get_plotboxaspectratio ().matrix_value (); + + bool autocam = (camerapositionmode_is ("auto") + && cameratargetmode_is ("auto") + && cameraupvectormode_is ("auto") + && cameraviewanglemode_is ("auto")); + bool dowarp = (autocam && dataaspectratiomode_is ("auto") + && plotboxaspectratiomode_is ("auto")); + + ColumnVector c_eye (xform_vector ()); + ColumnVector c_center (xform_vector ()); + ColumnVector c_upv (xform_vector ()); + + if (cameratargetmode_is ("auto")) + { + c_center(0) = (xlimits(0)+xlimits(1))/2; + c_center(1) = (ylimits(0)+ylimits(1))/2; + c_center(2) = (zlimits(0)+zlimits(1))/2; + + cameratarget = xform2cam (c_center); + } + else + c_center = cam2xform (get_cameratarget ().matrix_value ()); + + if (camerapositionmode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + double d = 5 * sqrt (pb(0)*pb(0)+pb(1)*pb(1)+pb(2)*pb(2)); + + if (el == 90 || el == -90) + c_eye(2) = d*signum (el); + else + { + az *= M_PI/180.0; + el *= M_PI/180.0; + c_eye(0) = d * cos (el) * sin (az); + c_eye(1) = -d* cos (el) * cos (az); + c_eye(2) = d * sin (el); + } + c_eye(0) = c_eye(0)*(xlimits(1)-xlimits(0))/(xd*pb(0))+c_center(0); + c_eye(1) = c_eye(1)*(ylimits(1)-ylimits(0))/(yd*pb(1))+c_center(1); + c_eye(2) = c_eye(2)*(zlimits(1)-zlimits(0))/(zd*pb(2))+c_center(2); + + cameraposition = xform2cam (c_eye); + } + else + c_eye = cam2xform (get_cameraposition ().matrix_value ()); + + if (cameraupvectormode_is ("auto")) + { + Matrix tview = get_view ().matrix_value (); + double az = tview(0), el = tview(1); + + if (el == 90 || el == -90) + { + c_upv(0) = + -signum (el) *sin (az*M_PI/180.0)*(xlimits(1)-xlimits(0))/pb(0); + c_upv(1) = + signum (el) * cos (az*M_PI/180.0)*(ylimits(1)-ylimits(0))/pb(1); + } + else + c_upv(2) = 1; + + cameraupvector = xform2cam (c_upv); + } + else + c_upv = cam2xform (get_cameraupvector ().matrix_value ()); + + Matrix x_view = xform_matrix (); + Matrix x_projection = xform_matrix (); + Matrix x_viewport = xform_matrix (); + Matrix x_normrender = xform_matrix (); + Matrix x_pre = xform_matrix (); + + x_render = xform_matrix (); + x_render_inv = xform_matrix (); + + scale (x_pre, pb(0), pb(1), pb(2)); + translate (x_pre, -0.5, -0.5, -0.5); + scale (x_pre, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_pre, -xo, -yo, -zo); + + xform (c_eye, x_pre); + xform (c_center, x_pre); + scale (c_upv, pb(0)/(xlimits(1)-xlimits(0)), pb(1)/(ylimits(1)-ylimits(0)), + pb(2)/(zlimits(1)-zlimits(0))); + translate (c_center, -c_eye(0), -c_eye(1), -c_eye(2)); + + ColumnVector F (c_center), f (F), UP (c_upv); + normalize (f); + normalize (UP); + + if (std::abs (dot (f, UP)) > 1e-15) + { + double fa = 1 / sqrt(1-f(2)*f(2)); + scale (UP, fa, fa, fa); + } + + ColumnVector s = cross (f, UP); + ColumnVector u = cross (s, f); + + scale (x_view, 1, 1, -1); + Matrix l = xform_matrix (); + l(0,0) = s(0); l(0,1) = s(1); l(0,2) = s(2); + l(1,0) = u(0); l(1,1) = u(1); l(1,2) = u(2); + l(2,0) = -f(0); l(2,1) = -f(1); l(2,2) = -f(2); + x_view = x_view * l; + translate (x_view, -c_eye(0), -c_eye(1), -c_eye(2)); + scale (x_view, pb(0), pb(1), pb(2)); + translate (x_view, -0.5, -0.5, -0.5); + + Matrix x_cube = x_view * unit_cube (); + ColumnVector cmin = x_cube.row_min (), cmax = x_cube.row_max (); + double xM = cmax(0)-cmin(0); + double yM = cmax(1)-cmin(1); + + Matrix bb = get_boundingbox (true); + + double v_angle; + + if (cameraviewanglemode_is ("auto")) + { + double af; + + // FIXME -- was this really needed? When compared to Matlab, it + // does not seem to be required. Need investigation with concrete + // graphics toolkit to see results visually. + if (false && dowarp) + af = 1.0 / (xM > yM ? xM : yM); + else + { + if ((bb(2)/bb(3)) > (xM/yM)) + af = 1.0 / yM; + else + af = 1.0 / xM; + } + v_angle = 2 * (180.0 / M_PI) * atan (1 / (2 * af * norm (F))); + + cameraviewangle = v_angle; + } + else + v_angle = get_cameraviewangle (); + + double pf = 1 / (2 * tan ((v_angle / 2) * M_PI / 180.0) * norm (F)); + scale (x_projection, pf, pf, 1); + + if (dowarp) + { + xM *= pf; + yM *= pf; + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, bb(2)/xM, -bb(3)/yM, 1); + } + else + { + double pix = 1; + if (autocam) + { + if ((bb(2)/bb(3)) > (xM/yM)) + pix = bb(3); + else + pix = bb(2); + } + else + pix = (bb(2) < bb(3) ? bb(2) : bb(3)); + translate (x_viewport, bb(0)+bb(2)/2, bb(1)+bb(3)/2, 0); + scale (x_viewport, pix, -pix, 1); + } + + x_normrender = x_viewport * x_projection * x_view; + + x_cube = x_normrender * unit_cube (); + cmin = x_cube.row_min (); + cmax = x_cube.row_max (); + x_zlim.resize (1, 2); + x_zlim(0) = cmin(2); + x_zlim(1) = cmax(2); + + x_render = x_normrender; + scale (x_render, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_render, -xo, -yo, -zo); + + x_viewtransform = x_view; + x_projectiontransform = x_projection; + x_viewporttransform = x_viewport; + x_normrendertransform = x_normrender; + x_rendertransform = x_render; + + x_render_inv = x_render.inverse (); + + // Note: these matrices are a slight modified version of the regular + // matrices, more suited for OpenGL rendering (x_gl_mat1 => light + // => x_gl_mat2) + x_gl_mat1 = x_view; + scale (x_gl_mat1, xd/(xlimits(1)-xlimits(0)), yd/(ylimits(1)-ylimits(0)), + zd/(zlimits(1)-zlimits(0))); + translate (x_gl_mat1, -xo, -yo, -zo); + x_gl_mat2 = x_viewport * x_projection; +} + +static bool updating_axes_layout = false; + +void +axes::properties::update_axes_layout (void) +{ + if (updating_axes_layout) + return; + + graphics_xform xform = get_transform (); + + double xd = (xdir_is ("normal") ? 1 : -1); + double yd = (ydir_is ("normal") ? 1 : -1); + double zd = (zdir_is ("normal") ? 1 : -1); + + const Matrix xlims = xform.xscale (get_xlim ().matrix_value ()); + const Matrix ylims = xform.yscale (get_ylim ().matrix_value ()); + const Matrix zlims = xform.zscale (get_zlim ().matrix_value ()); + double x_min = xlims(0), x_max = xlims(1); + double y_min = ylims(0), y_max = ylims(1); + double z_min = zlims(0), z_max = zlims(1); + + ColumnVector p1, p2, dir (3); + + xstate = ystate = zstate = AXE_ANY_DIR; + + p1 = xform.transform (x_min, (y_min+y_max)/2, (z_min+z_max)/2, false); + p2 = xform.transform (x_max, (y_min+y_max)/2, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + xstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + xstate = AXE_VERT_DIR; + else if (dir(1) == 0) + xstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + xPlane = (dir(0) > 0 ? x_max : x_min); + else + xPlane = (dir(1) < 0 ? x_max : x_min); + } + else + xPlane = (dir(2) < 0 ? x_min : x_max); + + xPlaneN = (xPlane == x_min ? x_max : x_min); + fx = (x_max-x_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, y_min, (z_min+z_max)/2, false); + p2 = xform.transform ((x_min+x_max)/2, y_max, (z_min+z_max)/2, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + ystate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + ystate = AXE_VERT_DIR; + else if (dir(1) == 0) + ystate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + yPlane = (dir(0) > 0 ? y_max : y_min); + else + yPlane = (dir(1) < 0 ? y_max : y_min); + } + else + yPlane = (dir(2) < 0 ? y_min : y_max); + + yPlaneN = (yPlane == y_min ? y_max : y_min); + fy = (y_max-y_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + p1 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_min, false); + p2 = xform.transform ((x_min+x_max)/2, (y_min+y_max)/2, z_max, false); + dir(0) = xround (p2(0)-p1(0)); + dir(1) = xround (p2(1)-p1(1)); + dir(2) = (p2(2)-p1(2)); + if (dir(0) == 0 && dir(1) == 0) + zstate = AXE_DEPTH_DIR; + else if (dir(2) == 0) + { + if (dir(0) == 0) + zstate = AXE_VERT_DIR; + else if (dir(1) == 0) + zstate = AXE_HORZ_DIR; + } + + if (dir(2) == 0) + { + if (dir(1) == 0) + zPlane = (dir(0) > 0 ? z_min : z_max); + else + zPlane = (dir(1) < 0 ? z_min : z_max); + } + else + zPlane = (dir(2) < 0 ? z_min : z_max); + + zPlaneN = (zPlane == z_min ? z_max : z_min); + fz = (z_max-z_min) / sqrt (dir(0)*dir(0)+dir(1)*dir(1)); + + unwind_protect frame; + frame.protect_var (updating_axes_layout); + updating_axes_layout = true; + + xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); + zSign = (zd*(zPlane-zPlaneN) <= 0); + xyzSym = zSign ? xySym : !xySym; + xpTick = (zSign ? xPlaneN : xPlane); + ypTick = (zSign ? yPlaneN : yPlane); + zpTick = (zSign ? zPlane : zPlaneN); + xpTickN = (zSign ? xPlane : xPlaneN); + ypTickN = (zSign ? yPlane : yPlaneN); + zpTickN = (zSign ? zPlaneN : zPlane); + + /* 2D mode */ + x2Dtop = false; + y2Dright = false; + layer2Dtop = false; + if (xstate == AXE_HORZ_DIR && ystate == AXE_VERT_DIR) + { + if (xaxislocation_is ("top")) + { + double tmp = yPlane; + yPlane = yPlaneN; + yPlaneN = tmp; + x2Dtop = true; + } + ypTick = yPlaneN; + ypTickN = yPlane; + if (yaxislocation_is ("right")) + { + double tmp = xPlane; + xPlane = xPlaneN; + xPlaneN = tmp; + y2Dright = true; + } + xpTick = xPlaneN; + xpTickN = xPlane; + if (layer_is ("top")) + { + zpTick = zPlaneN; + layer2Dtop = true; + } + else + zpTick = zPlane; + } + + Matrix viewmat = get_view ().matrix_value (); + nearhoriz = std::abs (viewmat(1)) <= 5; + + update_ticklength (); +} + +void +axes::properties::update_ticklength (void) +{ + bool mode2d = (((xstate > AXE_DEPTH_DIR ? 1 : 0) + + (ystate > AXE_DEPTH_DIR ? 1 : 0) + + (zstate > AXE_DEPTH_DIR ? 1 : 0)) == 2); + + if (tickdirmode_is ("auto")) + tickdir.set (mode2d ? "in" : "out", true); + + double ticksign = (tickdir_is ("in") ? -1 : 1); + + Matrix bbox = get_boundingbox (true); + Matrix ticklen = get_ticklength ().matrix_value (); + ticklen(0) = ticklen(0) * std::max (bbox(2), bbox(3)); + ticklen(1) = ticklen(1) * std::max (bbox(2), bbox(3)); + + xticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + yticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + zticklen = ticksign * (mode2d ? ticklen(0) : ticklen(1)); + + xtickoffset = (mode2d ? std::max (0., xticklen) : std::abs (xticklen)) + 5; + ytickoffset = (mode2d ? std::max (0., yticklen) : std::abs (yticklen)) + 5; + ztickoffset = (mode2d ? std::max (0., zticklen) : std::abs (zticklen)) + 5; + + update_xlabel_position (); + update_ylabel_position (); + update_zlabel_position (); + update_title_position (); +} + +/* +## FIXME: A demo can't be called in a C++ file. This should be made a test +## or moved to a .m file where it can be called. +%!demo +%! clf; +%! subplot (2,1,1); +%! plot (rand (3)); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +%! subplot (2,1,2); +%! plot (rand (3)); +%! set (gca, "ticklength", get (gca, "ticklength") * 2, "tickdir", "out"); +%! xlabel xlabel; +%! ylabel ylabel; +%! title title; +*/ + +static bool updating_xlabel_position = false; + +void +axes::properties::update_xlabel_position (void) +{ + if (updating_xlabel_position) + return; + + text::properties& xlabel_props = reinterpret_cast + (gh_manager::get_object (get_xlabel ()).get_properties ()); + + bool is_empty = xlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_xlabel_position); + updating_xlabel_position = true; + + if (! is_empty) + { + if (xlabel_props.horizontalalignmentmode_is ("auto")) + { + xlabel_props.set_horizontalalignment + (xstate > AXE_DEPTH_DIR + ? "center" : (xyzSym ? "left" : "right")); + + xlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (xlabel_props.verticalalignmentmode_is ("auto")) + { + xlabel_props.set_verticalalignment + (xstate == AXE_VERT_DIR || x2Dtop ? "bottom" : "top"); + + xlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (xlabel_props.positionmode_is ("auto") + || xlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector ((xpTickN+xpTick)/2, ypTick, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fy); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*xtickoffset); + else + p(1) += (signum (ypTick-ypTickN)*fy*xtickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (xstate) + { + case AXE_ANY_DIR: + p(0) += (xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += (x2Dtop ? -hmax : hmax); + break; + } + + if (xlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + xlabel_props.set_position (p.extract_n (0, 3).transpose ()); + xlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && xlabel_props.rotationmode_is ("auto")) + { + xlabel_props.set_rotation (angle); + xlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_ylabel_position = false; + +void +axes::properties::update_ylabel_position (void) +{ + if (updating_ylabel_position) + return; + + text::properties& ylabel_props = reinterpret_cast + (gh_manager::get_object (get_ylabel ()).get_properties ()); + + bool is_empty = ylabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_ylabel_position); + updating_ylabel_position = true; + + if (! is_empty) + { + if (ylabel_props.horizontalalignmentmode_is ("auto")) + { + ylabel_props.set_horizontalalignment + (ystate > AXE_DEPTH_DIR + ? "center" : (!xyzSym ? "left" : "right")); + + ylabel_props.set_horizontalalignmentmode ("auto"); + } + + if (ylabel_props.verticalalignmentmode_is ("auto")) + { + ylabel_props.set_verticalalignment + (ystate == AXE_VERT_DIR && !y2Dright ? "bottom" : "top"); + + ylabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (ylabel_props.positionmode_is ("auto") + || ylabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_ytick ().matrix_value (), + get_yticklabel ().all_strings (), + get_ylim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p = + graphics_xform::xform_vector (xpTick, (ypTickN+ypTick)/2, zpTick); + + bool tick_along_z = nearhoriz || xisinf (fx); + if (tick_along_z) + p(2) += (signum (zpTick-zpTickN)*fz*ytickoffset); + else + p(0) += (signum (xpTick-xpTickN)*fx*ytickoffset); + + p = xform.transform (p(0), p(1), p(2), false); + + switch (ystate) + { + case AXE_ANY_DIR: + p(0) += (!xyzSym ? wmax : -wmax); + p(1) += hmax; + break; + + case AXE_VERT_DIR: + p(0) += (y2Dright ? wmax : -wmax); + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (ylabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + ylabel_props.set_position (p.extract_n (0, 3).transpose ()); + ylabel_props.set_positionmode ("auto"); + } + + if (! is_empty && ylabel_props.rotationmode_is ("auto")) + { + ylabel_props.set_rotation (angle); + ylabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_zlabel_position = false; + +void +axes::properties::update_zlabel_position (void) +{ + if (updating_zlabel_position) + return; + + text::properties& zlabel_props = reinterpret_cast + (gh_manager::get_object (get_zlabel ()).get_properties ()); + + bool camAuto = cameraupvectormode_is ("auto"); + bool is_empty = zlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_zlabel_position); + updating_zlabel_position = true; + + if (! is_empty) + { + if (zlabel_props.horizontalalignmentmode_is ("auto")) + { + zlabel_props.set_horizontalalignment + ((zstate > AXE_DEPTH_DIR || camAuto) ? "center" : "right"); + + zlabel_props.set_horizontalalignmentmode ("auto"); + } + + if (zlabel_props.verticalalignmentmode_is ("auto")) + { + zlabel_props.set_verticalalignment + (zstate == AXE_VERT_DIR + ? "bottom" : ((zSign || camAuto) ? "bottom" : "top")); + + zlabel_props.set_verticalalignmentmode ("auto"); + } + } + + if (zlabel_props.positionmode_is ("auto") + || zlabel_props.rotationmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_ztick ().matrix_value (), + get_zticklabel ().all_strings (), + get_zlim ().matrix_value ()); + + double wmax = ext(0), hmax = ext(1), angle = 0; + ColumnVector p; + + if (xySym) + { + p = graphics_xform::xform_vector (xPlaneN, yPlane, + (zpTickN+zpTick)/2); + if (xisinf (fy)) + p(0) += (signum (xPlaneN-xPlane)*fx*ztickoffset); + else + p(1) += (signum (yPlane-yPlaneN)*fy*ztickoffset); + } + else + { + p = graphics_xform::xform_vector (xPlane, yPlaneN, + (zpTickN+zpTick)/2); + if (xisinf (fx)) + p(1) += (signum (yPlaneN-yPlane)*fy*ztickoffset); + else + p(0) += (signum (xPlane-xPlaneN)*fx*ztickoffset); + } + + p = xform.transform (p(0), p(1), p(2), false); + + switch (zstate) + { + case AXE_ANY_DIR: + if (camAuto) + { + p(0) -= wmax; + angle = 90; + } + + // FIXME -- what's the correct offset? + // + // p[0] += (!xySym ? wmax : -wmax); + // p[1] += (zSign ? hmax : -hmax); + + break; + + case AXE_VERT_DIR: + p(0) -= wmax; + angle = 90; + break; + + case AXE_HORZ_DIR: + p(1) += hmax; + break; + } + + if (zlabel_props.positionmode_is ("auto")) + { + p = xform.untransform (p(0), p(1), p(2), true); + zlabel_props.set_position (p.extract_n (0, 3).transpose ()); + zlabel_props.set_positionmode ("auto"); + } + + if (! is_empty && zlabel_props.rotationmode_is ("auto")) + { + zlabel_props.set_rotation (angle); + zlabel_props.set_rotationmode ("auto"); + } + } +} + +static bool updating_title_position = false; + +void +axes::properties::update_title_position (void) +{ + if (updating_title_position) + return; + + text::properties& title_props = reinterpret_cast + (gh_manager::get_object (get_title ()).get_properties ()); + + unwind_protect frame; + frame.protect_var (updating_title_position); + updating_title_position = true; + + if (title_props.positionmode_is ("auto")) + { + graphics_xform xform = get_transform (); + + // FIXME: bbox should be stored in axes::properties + Matrix bbox = get_extent (false); + + ColumnVector p = + graphics_xform::xform_vector (bbox(0)+bbox(2)/2, + bbox(1)-10, + (x_zlim(0)+x_zlim(1))/2); + + if (x2Dtop) + { + Matrix ext (1, 2, 0.0); + ext = get_ticklabel_extents (get_xtick ().matrix_value (), + get_xticklabel ().all_strings (), + get_xlim ().matrix_value ()); + p(1) -= ext(1); + } + + p = xform.untransform (p(0), p(1), p(2), true); + + title_props.set_position (p.extract_n (0, 3).transpose ()); + title_props.set_positionmode ("auto"); + } +} + +void +axes::properties::update_autopos (const std::string& elem_type) +{ + if (elem_type == "xlabel") + update_xlabel_position (); + else if (elem_type == "ylabel") + update_ylabel_position (); + else if (elem_type == "zlabel") + update_zlabel_position (); + else if (elem_type == "title") + update_title_position (); + else if (elem_type == "sync") + sync_positions (); +} + +static void +normalized_aspectratios (Matrix& aspectratios, const Matrix& scalefactors, + double xlength, double ylength, double zlength) +{ + double xval = xlength/scalefactors(0); + double yval = ylength/scalefactors(1); + double zval = zlength/scalefactors(2); + + double minval = xmin (xmin (xval, yval), zval); + + aspectratios(0) = xval/minval; + aspectratios(1) = yval/minval; + aspectratios(2) = zval/minval; +} + +static void +max_axes_scale (double& s, Matrix& limits, const Matrix& kids, + double pbfactor, double dafactor, char limit_type, bool tight) +{ + if (tight) + { + double minval = octave_Inf; + double maxval = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); + if (!xisinf (minval) && !xisnan (minval) + && !xisinf (maxval) && !xisnan (maxval)) + { + limits(0) = minval; + limits(1) = maxval; + s = xmax(s, (maxval - minval) / (pbfactor * dafactor)); + } + } + else + s = xmax(s, (limits(1) - limits(0)) / (pbfactor * dafactor)); +} + +static bool updating_aspectratios = false; + +void +axes::properties::update_aspectratios (void) +{ + if (updating_aspectratios) + return; + + Matrix xlimits = get_xlim ().matrix_value (); + Matrix ylimits = get_ylim ().matrix_value (); + Matrix zlimits = get_zlim ().matrix_value (); + + double dx = (xlimits(1)-xlimits(0)); + double dy = (ylimits(1)-ylimits(0)); + double dz = (zlimits(1)-zlimits(0)); + + Matrix da = get_dataaspectratio ().matrix_value (); + Matrix pba = get_plotboxaspectratio ().matrix_value (); + + if (dataaspectratiomode_is ("auto")) + { + if (plotboxaspectratiomode_is ("auto")) + { + pba = Matrix (1, 3, 1.0); + plotboxaspectratio.set (pba, false); + } + + normalized_aspectratios (da, pba, dx, dy, dz); + dataaspectratio.set (da, false); + } + else if (plotboxaspectratiomode_is ("auto")) + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + else + { + double s = -octave_Inf; + bool modified_limits = false; + Matrix kids; + + if (xlimmode_is ("auto") && ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + kids = get_children (); + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', true); + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', true); + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', true); + } + else if (xlimmode_is ("auto") && ylimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, zlimits, kids, pba(2), da(2), 'z', false); + } + else if (ylimmode_is ("auto") && zlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, xlimits, kids, pba(0), da(0), 'x', false); + } + else if (zlimmode_is ("auto") && xlimmode_is ("auto")) + { + modified_limits = true; + max_axes_scale (s, ylimits, kids, pba(1), da(1), 'y', false); + } + + if (modified_limits) + { + + unwind_protect frame; + frame.protect_var (updating_aspectratios); + + updating_aspectratios = true; + + dx = pba(0) *da(0); + dy = pba(1) *da(1); + dz = pba(2) *da(2); + if (xisinf (s)) + s = 1 / xmin (xmin (dx, dy), dz); + + if (xlimmode_is ("auto")) + { + dx = s * dx; + xlimits(0) = 0.5 * (xlimits(0) + xlimits(1) - dx); + xlimits(1) = xlimits(0) + dx; + set_xlim (xlimits); + set_xlimmode ("auto"); + } + + if (ylimmode_is ("auto")) + { + dy = s * dy; + ylimits(0) = 0.5 * (ylimits(0) + ylimits(1) - dy); + ylimits(1) = ylimits(0) + dy; + set_ylim (ylimits); + set_ylimmode ("auto"); + } + + if (zlimmode_is ("auto")) + { + dz = s * dz; + zlimits(0) = 0.5 * (zlimits(0) + zlimits(1) - dz); + zlimits(1) = zlimits(0) + dz; + set_zlim (zlimits); + set_zlimmode ("auto"); + } + } + else + { + normalized_aspectratios (pba, da, dx, dy, dz); + plotboxaspectratio.set (pba, false); + } + } +} + +void +axes::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif +#endif +} + +// The INTERNAL flag defines whether position or outerposition is used. + +Matrix +axes::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = (internal ? + get_position ().matrix_value () + : get_outerposition ().matrix_value ()); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +Matrix +axes::properties::get_extent (bool with_text, bool only_text_height) const +{ + graphics_xform xform = get_transform (); + + Matrix ext (1, 4, 0.0); + ext(0) = octave_Inf; + ext(1) = octave_Inf; + ext(2) = -octave_Inf; + ext(3) = -octave_Inf; + for (int i = 0; i <= 1; i++) + for (int j = 0; j <= 1; j++) + for (int k = 0; k <= 1; k++) + { + ColumnVector p = xform.transform (i ? xPlaneN : xPlane, + j ? yPlaneN : yPlane, + k ? zPlaneN : zPlane, false); + ext(0) = std::min (ext(0), p(0)); + ext(1) = std::min (ext(1), p(1)); + ext(2) = std::max (ext(2), p(0)); + ext(3) = std::max (ext(3), p(1)); + } + + if (with_text) + { + for (int i = 0; i < 4; i++) + { + graphics_handle text_handle; + if (i == 0) + text_handle = get_title (); + else if (i == 1) + text_handle = get_xlabel (); + else if (i == 2) + text_handle = get_ylabel (); + else if (i == 3) + text_handle = get_zlabel (); + + text::properties& text_props = reinterpret_cast + (gh_manager::get_object (text_handle).get_properties ()); + + Matrix text_pos = text_props.get_data_position (); + text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); + if (text_props.get_string ().is_empty ()) + { + ext(0) = std::min (ext(0), text_pos(0)); + ext(1) = std::min (ext(1), text_pos(1)); + ext(2) = std::max (ext(2), text_pos(0)); + ext(3) = std::max (ext(3), text_pos(1)); + } + else + { + Matrix text_ext = text_props.get_extent_matrix (); + + bool ignore_horizontal = false; + bool ignore_vertical = false; + if (only_text_height) + { + double text_rotation = text_props.get_rotation (); + if (text_rotation == 0. || text_rotation == 180.) + ignore_horizontal = true; + else if (text_rotation == 90. || text_rotation == 270.) + ignore_vertical = true; + } + + if (! ignore_horizontal) + { + ext(0) = std::min (ext(0), text_pos(0)+text_ext(0)); + ext(2) = std::max (ext(2), text_pos(0)+text_ext(0)+text_ext(2)); + } + + if (! ignore_vertical) + { + ext(1) = std::min (ext(1), text_pos(1)-text_ext(1)-text_ext(3)); + ext(3) = std::max (ext(3), text_pos(1)-text_ext(1)); + } + } + } + } + + ext(2) = ext(2)-ext(0); + ext(3) = ext(3)-ext(1); + + return ext; +} + +void +axes::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +axes::properties::update_units (const caseless_str& old_units) +{ + graphics_object obj = gh_manager::get_object (get_parent ()); + Matrix parent_bb = obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + caseless_str new_units = get_units (); + position.set (octave_value (convert_position (get_position ().matrix_value (), old_units, new_units, parent_bb)), false); + outerposition.set (octave_value (convert_position (get_outerposition ().matrix_value (), old_units, new_units, parent_bb)), false); + tightinset.set (octave_value (convert_position (get_tightinset ().matrix_value (), old_units, new_units, parent_bb)), false); +} + +void +axes::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +axes::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (true).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +axes::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (true).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +ColumnVector +graphics_xform::xform_vector (double x, double y, double z) +{ + return ::xform_vector (x, y, z); +} + +Matrix +graphics_xform::xform_eye (void) +{ + return ::xform_matrix (); +} + +ColumnVector +graphics_xform::transform (double x, double y, double z, + bool use_scale) const +{ + if (use_scale) + { + x = sx.scale (x); + y = sy.scale (y); + z = sz.scale (z); + } + + return ::transform (xform, x, y, z); +} + +ColumnVector +graphics_xform::untransform (double x, double y, double z, + bool use_scale) const +{ + ColumnVector v = ::transform (xform_inv, x, y, z); + + if (use_scale) + { + v(0) = sx.unscale (v(0)); + v(1) = sy.unscale (v(1)); + v(2) = sz.unscale (v(2)); + } + + return v; +} + +octave_value +axes::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +// FIXME -- remove. +// FIXME -- maybe this should go into array_property class? +/* +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const array_property& data) +{ + double val = data.min_val (); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + val = data.max_val (); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + val = data.min_pos (); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + val = data.max_neg (); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; +} +*/ + +static void +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const octave_value& data) +{ + if (data.is_matrix_type ()) + { + Matrix m = data.matrix_value (); + + if (! error_state && m.numel () == 4) + { + double val; + + val = m(0); + if (! (xisinf (val) || xisnan (val)) && val < min_val) + min_val = val; + + val = m(1); + if (! (xisinf (val) || xisnan (val)) && val > max_val) + max_val = val; + + val = m(2); + if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) + min_pos = val; + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; + } + } +} + +// magform(x) Returns (a, b), where x = a * 10^b, abs (a) >= 1., and b is +// integer. + +static void +magform (double x, double& a, int& b) +{ + if (x == 0) + { + a = 0; + b = 0; + } + else + { + b = static_cast (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); + } +} + +// A translation from Tom Holoryd's python code at +// http://kurage.nimh.nih.gov/tomh/tics.py +// FIXME -- add log ticks + +double +axes::properties::calc_tick_sep (double lo, double hi) +{ + int ticint = 5; + + // Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and + // SCALE3 for Determination of Scales on Computer Generated + // Plots", Communications of the ACM, 10 (1973), 639-640. + // Also cited as ACM Algorithm 463. + + double a; + int b, x; + + magform ((hi-lo)/ticint, a, b); + + static const double sqrt_2 = sqrt (2.0); + static const double sqrt_10 = sqrt (10.0); + static const double sqrt_50 = sqrt (50.0); + + if (a < sqrt_2) + x = 1; + else if (a < sqrt_10) + x = 2; + else if (a < sqrt_50) + x = 5; + else + x = 10; + + return x * std::pow (10., b); + +} + +// Attempt to make "nice" limits from the actual max and min of the +// data. For log plots, we will also use the smallest strictly positive +// value. + +Matrix +axes::properties::get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale) +{ + Matrix retval; + + double min_val = xmin; + double max_val = xmax; + + if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) + { + retval = default_lim (logscale); + return retval; + } + else if (! (xisinf (min_val) || xisinf (max_val))) + { + if (logscale) + { + if (xisinf (min_pos) && xisinf (max_neg)) + { + // TODO -- max_neg is needed for "loglog ([0 -Inf])" + // This is the only place where max_neg is needed. + // Is there another way? + retval = default_lim (); + retval(0) = pow (10., retval(0)); + retval(1) = pow (10., retval(1)); + return retval; + } + if ((min_val <= 0 && max_val > 0)) + { + warning ("axis: omitting non-positive data in log plot"); + min_val = min_pos; + } + // FIXME -- maybe this test should also be relative? + if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) + { + // Widen range when too small + if (min_val >= 0) + { + min_val *= 0.9; + max_val *= 1.1; + } + else + { + min_val *= 1.1; + max_val *= 0.9; + } + } + if (min_val > 0) + { + // Log plots with all positive data + min_val = pow (10, gnulib::floor (log10 (min_val))); + max_val = pow (10, std::ceil (log10 (max_val))); + } + else + { + // Log plots with all negative data + min_val = -pow (10, std::ceil (log10 (-min_val))); + max_val = -pow (10, gnulib::floor (log10 (-max_val))); + } + } + else + { + if (min_val == 0 && max_val == 0) + { + min_val = -1; + max_val = 1; + } + // FIXME -- maybe this test should also be relative? + else if (std::abs (min_val - max_val) < sqrt (DBL_EPSILON)) + { + min_val -= 0.1 * std::abs (min_val); + max_val += 0.1 * std::abs (max_val); + } + + double tick_sep = calc_tick_sep (min_val , max_val); + double min_tick = gnulib::floor (min_val / tick_sep); + double max_tick = std::ceil (max_val / tick_sep); + // Prevent round-off from cropping ticks + min_val = std::min (min_val, tick_sep * min_tick); + max_val = std::max (max_val, tick_sep * max_tick); + } + } + + retval.resize (1, 2); + + retval(1) = max_val; + retval(0) = min_val; + + return retval; +} + +void +axes::properties::calc_ticks_and_lims (array_property& lims, + array_property& ticks, + array_property& mticks, + bool limmode_is_auto, bool is_logscale) +{ + // FIXME -- add log ticks and lims + + if (lims.get ().is_empty ()) + return; + + double lo = (lims.get ().matrix_value ()) (0); + double hi = (lims.get ().matrix_value ()) (1); + bool is_negative = lo < 0 && hi < 0; + double tmp; + // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) + if (hi < lo) + { + tmp = hi; + hi = lo; + lo = tmp; + } + + if (is_logscale) + { + if (is_negative) + { + tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + } + + double tick_sep = calc_tick_sep (lo , hi); + + if (is_logscale && ! (xisinf (hi) || xisinf (lo))) + { + // FIXME - what if (hi-lo) < tick_sep? + // ex: loglog ([1 1.1]) + tick_sep = std::max (tick_sep, 1.); + tick_sep = std::ceil (tick_sep); + } + + int i1 = static_cast (gnulib::floor (lo / tick_sep)); + int i2 = static_cast (std::ceil (hi / tick_sep)); + + if (limmode_is_auto) + { + // adjust limits to include min and max tics + Matrix tmp_lims (1,2); + tmp_lims(0) = std::min (tick_sep * i1, lo); + tmp_lims(1) = std::max (tick_sep * i2, hi); + + if (is_logscale) + { + tmp_lims(0) = std::pow (10.,tmp_lims(0)); + tmp_lims(1) = std::pow (10.,tmp_lims(1)); + if (tmp_lims(0) <= 0) + tmp_lims(0) = std::pow (10., lo); + if (is_negative) + { + tmp = tmp_lims(0); + tmp_lims(0) = -tmp_lims(1); + tmp_lims(1) = -tmp; + } + } + lims = tmp_lims; + } + + Matrix tmp_ticks (1, i2-i1+1); + for (int i = 0; i <= i2-i1; i++) + { + tmp_ticks (i) = tick_sep * (i+i1); + if (is_logscale) + tmp_ticks (i) = std::pow (10., tmp_ticks (i)); + } + if (is_logscale && is_negative) + { + Matrix rev_ticks (1, i2-i1+1); + rev_ticks = -tmp_ticks; + for (int i = 0; i <= i2-i1; i++) + tmp_ticks (i) = rev_ticks (i2-i1-i); + } + + ticks = tmp_ticks; + + int n = is_logscale ? 8 : 4; + Matrix tmp_mticks (1, n * (tmp_ticks.numel () - 1)); + + for (int i = 0; i < tmp_ticks.numel ()-1; i++) + { + double d = (tmp_ticks (i+1) - tmp_ticks (i)) / (n+1); + for (int j = 0; j < n; j++) + { + tmp_mticks (n*i+j) = tmp_ticks (i) + d * (j+1); + } + } + mticks = tmp_mticks; +} + +void +axes::properties::calc_ticklabels (const array_property& ticks, + any_property& labels, bool logscale) +{ + Matrix values = ticks.get ().matrix_value (); + Cell c (values.dims ()); + std::ostringstream os; + + if (logscale) + { + double significand; + double exponent; + double exp_max = 0.; + double exp_min = 0.; + + for (int i = 0; i < values.numel (); i++) + { + exp_max = std::max (exp_max, std::log10 (values(i))); + exp_min = std::max (exp_min, std::log10 (values(i))); + } + + for (int i = 0; i < values.numel (); i++) + { + if (values(i) < 0.) + exponent = gnulib::floor (std::log10 (-values(i))); + else + exponent = gnulib::floor (std::log10 (values(i))); + significand = values(i) * std::pow (10., -exponent); + os.str (std::string ()); + os << significand; + if (exponent < 0.) + { + os << "e-"; + exponent = -exponent; + } + else + os << "e+"; + if (exponent < 10. && (exp_max > 9 || exp_min < -9)) + os << "0"; + os << exponent; + c(i) = os.str (); + } + } + else + { + for (int i = 0; i < values.numel (); i++) + { + os.str (std::string ()); + os << values(i); + c(i) = os.str (); + } + } + + labels = c; +} + +Matrix +axes::properties::get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits) +{ +#ifndef HAVE_FREETYPE + double fontsize = get ("fontsize").double_value (); +#endif + + Matrix ext (1, 2, 0.0); + double wmax = 0., hmax = 0.; + int n = std::min (ticklabels.numel (), ticks.numel ()); + for (int i = 0; i < n; i++) + { + double val = ticks(i); + if (limits(0) <= val && val <= limits(1)) + { +#ifdef HAVE_FREETYPE + ext = text_renderer.get_extent (ticklabels(i)); + wmax = std::max (wmax, ext(0)); + hmax = std::max (hmax, ext(1)); +#else + //FIXME: find a better approximation + int len = ticklabels(i).length (); + wmax = std::max (wmax, 0.5*fontsize*len); + hmax = fontsize; +#endif + } + } + + ext(0) = wmax; + ext(1) = hmax; + return ext; +} + +void +get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type) +{ + octave_idx_type n = kids.numel (); + + switch (limit_type) + { + case 'x': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_xliminclude ()) + { + octave_value lim = obj.get_xlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'y': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_yliminclude ()) + { + octave_value lim = obj.get_ylim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'z': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_zliminclude ()) + { + octave_value lim = obj.get_zlim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'c': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_climinclude ()) + { + octave_value lim = obj.get_clim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + case 'a': + for (octave_idx_type i = 0; i < n; i++) + { + graphics_object obj = gh_manager::get_object (kids(i)); + + if (obj.is_aliminclude ()) + { + octave_value lim = obj.get_alim (); + + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); + } + } + break; + + default: + break; + } +} + +static bool updating_axis_limits = false; + +void +axes::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_axis_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + double val; + +#define FIX_LIMITS \ + if (limits.numel () == 4) \ + { \ + val = limits(0); \ + if (! (xisinf (val) || xisnan (val))) \ + min_val = val; \ + val = limits(1); \ + if (! (xisinf (val) || xisnan (val))) \ + max_val = val; \ + val = limits(2); \ + if (! (xisinf (val) || xisnan (val))) \ + min_pos = val; \ + val = limits(3); \ + if (! (xisinf (val) || xisnan (val))) \ + max_neg = val; \ + } \ + else \ + { \ + limits.resize (4, 1); \ + limits(0) = min_val; \ + limits(1) = max_val; \ + limits(2) = min_pos; \ + limits(3) = max_neg; \ + } + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + limits = xproperties.get_xlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + limits = xproperties.get_ylim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + limits = xproperties.get_zlim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + limits = xproperties.get_clim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + limits = xproperties.get_alim ().matrix_value (); + FIX_LIMITS ; + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + +#undef FIX_LIMITS + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); + +} + +void +axes::update_axis_limits (const std::string& axis_type) +{ + if (updating_axis_limits || updating_aspectratios) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + Matrix limits; + + if (axis_type == "xdata" || axis_type == "xscale" + || axis_type == "xlimmode" || axis_type == "xliminclude" + || axis_type == "xlim") + { + if (xproperties.xlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.xscale_is ("log")); + + update_type = 'x'; + } + } + else if (axis_type == "ydata" || axis_type == "yscale" + || axis_type == "ylimmode" || axis_type == "yliminclude" + || axis_type == "ylim") + { + if (xproperties.ylimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.yscale_is ("log")); + + update_type = 'y'; + } + } + else if (axis_type == "zdata" || axis_type == "zscale" + || axis_type == "zlimmode" || axis_type == "zliminclude" + || axis_type == "zlim") + { + if (xproperties.zlimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, + xproperties.zscale_is ("log")); + + update_type = 'z'; + } + } + else if (axis_type == "cdata" || axis_type == "climmode" + || axis_type == "cdatamapping" || axis_type == "climinclude" + || axis_type == "clim") + { + if (xproperties.climmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + { + max_val = min_val + 1; + min_val -= 1; + } + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'c'; + } + + } + else if (axis_type == "alphadata" || axis_type == "alimmode" + || axis_type == "alphadatamapping" || axis_type == "aliminclude" + || axis_type == "alim") + { + if (xproperties.alimmode_is ("auto")) + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + if (min_val > max_val) + { + min_val = min_pos = 0; + max_val = 1; + } + else if (min_val == max_val) + max_val = min_val + 1; + + limits.resize (1, 2); + + limits(0) = min_val; + limits(1) = max_val; + + update_type = 'a'; + } + + } + + unwind_protect frame; + frame.protect_var (updating_axis_limits); + + updating_axis_limits = true; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + xproperties.set_xlimmode ("auto"); + xproperties.update_xlim (); + break; + + case 'y': + xproperties.set_ylim (limits); + xproperties.set_ylimmode ("auto"); + xproperties.update_ylim (); + break; + + case 'z': + xproperties.set_zlim (limits); + xproperties.set_zlimmode ("auto"); + xproperties.update_zlim (); + break; + + case 'c': + xproperties.set_clim (limits); + xproperties.set_climmode ("auto"); + break; + + case 'a': + xproperties.set_alim (limits); + xproperties.set_alimmode ("auto"); + break; + + default: + break; + } + + xproperties.update_transform (); +} + +inline +double force_in_range (const double x, const double lower, const double upper) +{ + if (x < lower) + { return lower; } + else if (x > upper) + { return upper; } + else + { return x; } +} + +static Matrix +do_zoom (double val, double factor, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + val = std::log10 (-val); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + val = std::log10 (val); + } + } + + // Perform the zooming + lo = val + factor * (lo - val); + hi = val + factor * (hi - val); + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_zoom (x, factor, xlims, xscale_is ("log")); + ylims = do_zoom (y, factor, ylims, yscale_is ("log")); + + zoom (xlims, ylims, push_to_zoom_stack); +} + +void +axes::properties::zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack) +{ + if (push_to_zoom_stack) + { + zoom_stack.push_front (xlimmode.get ()); + zoom_stack.push_front (xlim.get ()); + zoom_stack.push_front (ylimmode.get ()); + zoom_stack.push_front (ylim.get ()); + } + + xlim = xl; + xlimmode = "manual"; + ylim = yl; + ylimmode = "manual"; + + update_transform (); + update_xlim (false); + update_ylim (false); +} + +static Matrix +do_translate (double x0, double x1, const Matrix& lims, bool is_logscale) +{ + Matrix new_lims = lims; + + double lo = lims(0); + double hi = lims(1); + + bool is_negative = lo < 0 && hi < 0; + + double delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + x0 = -x0; + x1 = -x1; + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } + + delta = std::log10 (x0) - std::log10 (x1); + } + else + { + delta = x0 - x1; + } + + // Perform the translation + lo += delta; + hi += delta; + + if (is_logscale) + { + if (is_negative) + { + double tmp = -std::pow (10.0, hi); + hi = -std::pow (10.0, lo); + lo = tmp; + } + else + { + lo = std::pow (10.0, lo); + hi = std::pow (10.0, hi); + } + } + + new_lims(0) = lo; + new_lims(1) = hi; + + return new_lims; +} + +void +axes::properties::translate_view (double x0, double x1, double y0, double y1) +{ + // FIXME: Do we need error checking here? + Matrix xlims = get_xlim ().matrix_value (); + Matrix ylims = get_ylim ().matrix_value (); + + // Get children axes limits + Matrix kids = get_children (); + double minx = octave_Inf; + double maxx = -octave_Inf; + double min_pos_x = octave_Inf; + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); + + double miny = octave_Inf; + double maxy = -octave_Inf; + double min_pos_y = octave_Inf; + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); + + xlims = do_translate (x0, x1, xlims, xscale_is ("log")); + ylims = do_translate (y0, y1, ylims, yscale_is ("log")); + + zoom (xlims, ylims, false); +} + +void +axes::properties::rotate_view (double delta_el, double delta_az) +{ + Matrix v = get_view ().matrix_value (); + + v(1) += delta_el; + + if (v(1) > 90) + v(1) = 90; + if (v(1) < -90) + v(1) = -90; + + v(0) = fmod (v(0) - delta_az + 720,360); + + set_view (v); + update_transform (); +} + +void +axes::properties::unzoom (void) +{ + if (zoom_stack.size () >= 4) + { + ylim = zoom_stack.front (); + zoom_stack.pop_front (); + ylimmode = zoom_stack.front (); + zoom_stack.pop_front (); + xlim = zoom_stack.front (); + zoom_stack.pop_front (); + xlimmode = zoom_stack.front (); + zoom_stack.pop_front (); + + update_transform (); + update_xlim (false); + update_ylim (false); + } +} + +void +axes::properties::clear_zoom_stack (void) +{ + while (zoom_stack.size () > 4) + zoom_stack.pop_front (); + + unzoom (); +} + +void +axes::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +void +axes::initialize (const graphics_object& go) +{ + base_graphics_object::initialize (go); + + xinitialize (xproperties.get_title ()); + xinitialize (xproperties.get_xlabel ()); + xinitialize (xproperties.get_ylabel ()); + xinitialize (xproperties.get_zlabel ()); +} + +// --------------------------------------------------------------------- + +Matrix +line::properties::compute_xlim (void) const +{ + Matrix m (1, 4); + + m(0) = xdata.min_val (); + m(1) = xdata.max_val (); + m(2) = xdata.min_pos (); + m(3) = xdata.max_neg (); + + return m; +} + +Matrix +line::properties::compute_ylim (void) const +{ + Matrix m (1, 4); + + m(0) = ydata.min_val (); + m(1) = ydata.max_val (); + m(2) = ydata.min_pos (); + m(3) = ydata.max_neg (); + + return m; +} + +// --------------------------------------------------------------------- + +Matrix +text::properties::get_data_position (void) const +{ + Matrix pos = get_position ().matrix_value (); + + if (! units_is ("data")) + pos = convert_text_position (pos, *this, get_units (), "data"); + + return pos; +} + +Matrix +text::properties::get_extent_matrix (void) const +{ + // FIXME: Should this function also add the (x,y) base position? + return extent.get ().matrix_value (); +} + +octave_value +text::properties::get_extent (void) const +{ + // FIXME: This doesn't work right for 3D plots. + // (It doesn't in Matlab either, at least not in version 6.5.) + Matrix m = extent.get ().matrix_value (); + Matrix pos = get_position ().matrix_value (); + Matrix p = convert_text_position (pos, *this, get_units (), "pixels"); + + m(0) += p(0); + m(1) += p(1); + + return convert_text_position (m, *this, "pixels", get_units ()); +} + +void +text::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif + renderer.set_color (get_color_rgb ()); +#endif +} + +void +text::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + int halign = 0, valign = 0; + + if (horizontalalignment_is ("center")) + halign = 1; + else if (horizontalalignment_is ("right")) + halign = 2; + + if (verticalalignment_is ("top")) + valign = 2; + else if (verticalalignment_is ("baseline")) + valign = 3; + else if (verticalalignment_is ("middle")) + valign = 1; + + Matrix bbox; + + // FIXME: string should be parsed only when modified, for efficiency + + octave_value string_prop = get_string (); + + string_vector sv = string_prop.all_strings (); + + renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, + halign, valign, get_rotation ()); + /* The bbox is relative to the text's position. + We'll leave it that way, because get_position () does not return + valid results when the text is first constructed. + Conversion to proper coordinates is performed in get_extent. */ + set_extent (bbox); + +#endif + + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos ("sync"); +} + +void +text::properties::request_autopos (void) +{ + if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || + autopos_tag_is ("zlabel") || autopos_tag_is ("title")) + update_autopos (get_autopos_tag ()); +} + +void +text::properties::update_units (void) +{ + if (! units_is ("data")) + { + set_xliminclude ("off"); + set_yliminclude ("off"); + set_zliminclude ("off"); + } + + Matrix pos = get_position ().matrix_value (); + + pos = convert_text_position (pos, *this, cached_units, get_units ()); + // FIXME: if the current axes view is 2D, then one should + // probably drop the z-component of "pos" and leave "zliminclude" + // to "off". + set_position (pos); + + if (units_is ("data")) + { + set_xliminclude ("on"); + set_yliminclude ("on"); + // FIXME: see above + set_zliminclude ("off"); + } + + cached_units = get_units (); +} + +double +text::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + { + graphics_object go (gh_manager::get_object (get___myhandle__ ())); + graphics_object ax (go.get_ancestor ("axes")); + + parent_height = ax.get_properties ().get_boundingbox (true).elem (3); + } + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +image::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), + cdatamapping_is ("scaled"), 3); +} + +// --------------------------------------------------------------------- + +octave_value +patch::properties::get_color_data (void) const +{ + octave_value fvc = get_facevertexcdata (); + if (fvc.is_undefined () || fvc.is_empty ()) + return Matrix (); + else + return convert_cdata (*this, fvc,cdatamapping_is ("scaled"), 2); +} + +// --------------------------------------------------------------------- + +octave_value +surface::properties::get_color_data (void) const +{ + return convert_cdata (*this, get_cdata (), cdatamapping_is ("scaled"), 3); +} + +inline void +cross_product (double x1, double y1, double z1, + double x2, double y2, double z2, + double& x, double& y, double& z) +{ + x += (y1 * z2 - z1 * y2); + y += (z1 * x2 - x1 * z2); + z += (x1 * y2 - y1 * x2); +} + +void +surface::properties::update_normals (void) +{ + if (normalmode_is ("auto")) + { + Matrix x = get_xdata ().matrix_value (); + Matrix y = get_ydata ().matrix_value (); + Matrix z = get_zdata ().matrix_value (); + + + int p = z.columns (), q = z.rows (); + int i1 = 0, i2 = 0, i3 = 0; + int j1 = 0, j2 = 0, j3 = 0; + + bool x_mat = (x.rows () == q); + bool y_mat = (y.columns () == p); + + NDArray n (dim_vector (q, p, 3), 0.0); + + for (int i = 0; i < p; i++) + { + if (y_mat) + { + i1 = i - 1; + i2 = i; + i3 = i + 1; + } + + for (int j = 0; j < q; j++) + { + if (x_mat) + { + j1 = j - 1; + j2 = j; + j3 = j + 1; + } + + double& nx = n(j, i, 0); + double& ny = n(j, i, 1); + double& nz = n(j, i, 2); + + if ((j > 0) && (i > 0)) + // upper left quadrangle + cross_product (x(j1,i-1)-x(j2,i), y(j-1,i1)-y(j,i2), z(j-1,i-1)-z(j,i), + x(j2,i-1)-x(j1,i), y(j,i1)-y(j-1,i2), z(j,i-1)-z(j-1,i), + nx, ny, nz); + + if ((j > 0) && (i < (p -1))) + // upper right quadrangle + cross_product (x(j1,i+1)-x(j2,i), y(j-1,i3)-y(j,i2), z(j-1,i+1)-z(j,i), + x(j1,i)-x(j2,i+1), y(j-1,i2)-y(j,i3), z(j-1,i)-z(j,i+1), + nx, ny, nz); + + if ((j < (q - 1)) && (i > 0)) + // lower left quadrangle + cross_product (x(j2,i-1)-x(j3,i), y(j,i1)-y(j+1,i2), z(j,i-1)-z(j+1,i), + x(j3,i-1)-x(j2,i), y(j+1,i1)-y(j,i2), z(j+1,i-1)-z(j,i), + nx, ny, nz); + + if ((j < (q - 1)) && (i < (p -1))) + // lower right quadrangle + cross_product (x(j3,i)-x(j2,i+1), y(j+1,i2)-y(j,i3), z(j+1,i)-z(j,i+1), + x(j3,i+1)-x(j2,i), y(j+1,i3)-y(j,i2), z(j+1,i+1)-z(j,i), + nx, ny, nz); + + double d = -std::max (std::max (fabs (nx), fabs (ny)), fabs (nz)); + + nx /= d; + ny /= d; + nz /= d; + } + } + vertexnormals = n; + } +} + +// --------------------------------------------------------------------- + +void +hggroup::properties::update_limits (void) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim"); + obj.update_axis_limits ("ylim"); + obj.update_axis_limits ("zlim"); + obj.update_axis_limits ("clim"); + obj.update_axis_limits ("alim"); + } +} + +void +hggroup::properties::update_limits (const graphics_handle& h) const +{ + graphics_object obj = gh_manager::get_object (__myhandle__); + + if (obj) + { + obj.update_axis_limits ("xlim", h); + obj.update_axis_limits ("ylim", h); + obj.update_axis_limits ("zlim", h); + obj.update_axis_limits ("clim", h); + obj.update_axis_limits ("alim", h); + } +} + +static bool updating_hggroup_limits = false; + +void +hggroup::update_axis_limits (const std::string& axis_type, + const graphics_handle& h) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = Matrix (1, 1, h.value ()); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + Matrix limits; + double val; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + limits = xproperties.get_xlim ().matrix_value (); + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + limits = xproperties.get_ylim ().matrix_value (); + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + limits = xproperties.get_zlim ().matrix_value (); + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + limits = xproperties.get_clim ().matrix_value (); + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + limits = xproperties.get_alim ().matrix_value (); + update_type = 'a'; + } + + if (limits.numel () == 4) + { + val = limits(0); + if (! (xisinf (val) || xisnan (val))) + min_val = val; + val = limits(1); + if (! (xisinf (val) || xisnan (val))) + max_val = val; + val = limits(2); + if (! (xisinf (val) || xisnan (val))) + min_pos = val; + val = limits(3); + if (! (xisinf (val) || xisnan (val))) + max_neg = val; + } + else + { + limits.resize (4,1); + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + } + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + if (limits(0) != min_val || limits(1) != max_val + || limits(2) != min_pos || limits(3) != max_neg) + { + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type, h); + } +} + +void +hggroup::update_axis_limits (const std::string& axis_type) +{ + if (updating_hggroup_limits) + return; + + Matrix kids = xproperties.get_children (); + + double min_val = octave_Inf; + double max_val = -octave_Inf; + double min_pos = octave_Inf; + double max_neg = -octave_Inf; + + char update_type = 0; + + if (axis_type == "xlim" || axis_type == "xliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + update_type = 'x'; + } + else if (axis_type == "ylim" || axis_type == "yliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + update_type = 'y'; + } + else if (axis_type == "zlim" || axis_type == "zliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + update_type = 'z'; + } + else if (axis_type == "clim" || axis_type == "climinclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); + + update_type = 'c'; + } + else if (axis_type == "alim" || axis_type == "aliminclude") + { + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); + + update_type = 'a'; + } + + unwind_protect frame; + frame.protect_var (updating_hggroup_limits); + + updating_hggroup_limits = true; + + Matrix limits (1, 4, 0.0); + + limits(0) = min_val; + limits(1) = max_val; + limits(2) = min_pos; + limits(3) = max_neg; + + switch (update_type) + { + case 'x': + xproperties.set_xlim (limits); + break; + + case 'y': + xproperties.set_ylim (limits); + break; + + case 'z': + xproperties.set_zlim (limits); + break; + + case 'c': + xproperties.set_clim (limits); + break; + + case 'a': + xproperties.set_alim (limits); + break; + + default: + break; + } + + base_graphics_object::update_axis_limits (axis_type); +} + +// --------------------------------------------------------------------- + +octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_object parent_obj = + gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + return convert_position (m, "pixels", get_units (), parent_size); +} + +void +uicontrol::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + text_element *elt; + ft_render text_renderer; + Matrix box; + + // FIXME: parsed content should be cached for efficiency + // FIXME: support multiline text + + elt = text_parser_none ().parse (get_string_string ()); +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get_fontname (), + get_fontweight (), + get_fontangle (), + get_fontsize ()); +#endif + box = text_renderer.get_extent (elt, 0); + + Matrix ext (1, 4, 0.0); + + // FIXME: also handle left and bottom components + + ext(0) = ext(1) = 1; + ext(2) = box(0); + ext(3) = box(1); + + set_extent (ext); + +#endif +} + +void +uicontrol::properties::update_units (void) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, cached_units, get_units (), parent_size); + set_position (pos); + + cached_units = get_units (); +} + +void +uicontrol::properties::set_style (const octave_value& st) +{ + if (get___object__ ().is_empty ()) + style = st; + else + error ("set: cannot change the style of a uicontrol object after creation."); +} + +Matrix +uicontrol::properties::get_boundingbox (bool, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +void +uicontrol::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uicontrol::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + fontsize.set (octave_value (fsz), true); +} + +double +uicontrol::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +Matrix +uipanel::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + if (internal) + { + double outer_height = pos(3); + + pos(0) = pos(1) = 0; + + if (! bordertype_is ("none")) + { + double bw = get_borderwidth (); + double mul = 1.0; + + if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) + mul = 2.0; + + pos(0) += mul * bw; + pos(1) += mul * bw; + pos(2) -= 2 * mul * bw; + pos(3) -= 2 * mul * bw; + } + + if (! get_title ().empty ()) + { + double fs = get_fontsize (); + + if (! fontunits_is ("pixels")) + { + double res = xget (0, "screenpixelsperinch").double_value (); + + if (fontunits_is ("points")) + fs *= (res / 72.0); + else if (fontunits_is ("inches")) + fs *= res; + else if (fontunits_is ("centimeters")) + fs *= (res / 2.54); + else if (fontunits_is ("normalized")) + fs *= outer_height; + } + + if (titleposition_is ("lefttop") || titleposition_is ("centertop") + || titleposition_is ("righttop")) + pos(1) += (fs / 2); + pos(3) -= (fs / 2); + } + } + + return pos; +} + +void +uipanel::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +uipanel::properties::update_units (const caseless_str& old_units) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, old_units, get_units (), parent_size); + set_position (pos); +} + +void +uipanel::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uipanel::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +uipanel::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem (3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +uitoolbar::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +uitoolbar::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +octave_value +base_graphics_object::get_default (const caseless_str& name) const +{ + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + return parent_obj.get_default (type () + name); +} + +octave_value +base_graphics_object::get_factory_default (const caseless_str& name) const +{ + graphics_object parent_obj = gh_manager::get_object (0); + + return parent_obj.get_factory_default (type () + name); +} + +// We use a random value for the handle to avoid issues with plots and +// scalar values for the first argument. +gh_manager::gh_manager (void) + : handle_map (), handle_free_list (), + next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), + figure_list (), graphics_lock (), event_queue (), + callback_objects (), event_processing (0) +{ + handle_map[0] = graphics_object (new root_figure ()); + + // Make sure the default graphics toolkit is registered. + gtk_manager::default_toolkit (); +} + +void +gh_manager::create_instance (void) +{ + instance = new gh_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_handle +gh_manager::do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit) +{ + graphics_handle h = get_handle (integer_figure_handle); + + base_graphics_object *go = 0; + + go = make_graphics_object_from_type (go_name, h, p); + + if (go) + { + graphics_object obj (go); + + handle_map[h] = obj; + if (do_createfcn) + go->get_properties ().execute_createfcn (); + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + } + else + error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", + go_name.c_str ()); + + return h; +} + +graphics_handle +gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) +{ + graphics_handle h = val; + + base_graphics_object* go = new figure (h, 0); + graphics_object obj (go); + + handle_map[h] = obj; + + // Notify graphics toolkit. + if (do_notify_toolkit) + obj.initialize (); + + return h; +} + +void +gh_manager::do_push_figure (const graphics_handle& h) +{ + do_pop_figure (h); + + figure_list.push_front (h); +} + +void +gh_manager::do_pop_figure (const graphics_handle& h) +{ + for (figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + if (*p == h) + { + figure_list.erase (p); + break; + } + } +} + +class +callback_event : public base_graphics_event +{ +public: + callback_event (const graphics_handle& h, const std::string& name, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (name), + callback (), callback_data (data) { } + + callback_event (const graphics_handle& h, const octave_value& cb, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (), + callback (cb), callback_data (data) { } + + void execute (void) + { + if (callback.is_defined ()) + gh_manager::execute_callback (handle, callback, callback_data); + else + gh_manager::execute_callback (handle, callback_name, callback_data); + } + +private: + callback_event (void) + : base_graphics_event (), handle (), + callback_name (), callback_data () + { } + +private: + graphics_handle handle; + std::string callback_name; + octave_value callback; + octave_value callback_data; +}; + +class +function_event : public base_graphics_event +{ +public: + function_event (graphics_event::event_fcn fcn, void* data = 0) + : base_graphics_event (), function (fcn), + function_data (data) { } + + void execute (void) + { + function (function_data); + } + +private: + + graphics_event::event_fcn function; + + void* function_data; + + // function_event objects must be created with at least a function. + function_event (void); + + // No copying! + + function_event (const function_event &); + + function_event & operator = (const function_event &); +}; + +class +set_event : public base_graphics_event +{ +public: + set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, bool do_notify_toolkit = true) + : base_graphics_event (), handle (h), property_name (name), + property_value (value), notify_toolkit (do_notify_toolkit) { } + + void execute (void) + { + gh_manager::auto_lock guard; + + graphics_object go = gh_manager::get_object (handle); + + if (go) + { + property p = go.get_properties ().get_property (property_name); + + if (p.ok ()) + p.set (property_value, true, notify_toolkit); + } + } + +private: + set_event (void) + : base_graphics_event (), handle (), property_name (), property_value () + { } + +private: + graphics_handle handle; + std::string property_name; + octave_value property_value; + bool notify_toolkit; +}; + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, name, data); + + return e; +} + +graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, cb, data); + + return e; +} + +graphics_event +graphics_event::create_function_event (graphics_event::event_fcn fcn, + void *data) +{ + graphics_event e; + + e.rep = new function_event (fcn, data); + + return e; +} + +graphics_event +graphics_event::create_set_event (const graphics_handle& h, + const std::string& name, + const octave_value& data, + bool notify_toolkit) +{ + graphics_event e; + + e.rep = new set_event (h, name, data, notify_toolkit); + + return e; +} + +static void +xset_gcbo (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (0); + root_figure::properties& props = + dynamic_cast (go.get_properties ()); + + props.set_callbackobject (h.as_octave_value ()); +} + +void +gh_manager::do_restore_gcbo (void) +{ + gh_manager::auto_lock guard; + + callback_objects.pop_front (); + + xset_gcbo (callback_objects.empty () + ? graphics_handle () + : callback_objects.front ().get_handle ()); +} + +void +gh_manager::do_execute_listener (const graphics_handle& h, + const octave_value& l) +{ + if (octave_thread::is_octave_thread ()) + gh_manager::execute_callback (h, l, octave_value ()); + else + { + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_callback_event (h, l)); + } +} + +void +gh_manager::do_execute_callback (const graphics_handle& h, + const octave_value& cb_arg, + const octave_value& data) +{ + if (cb_arg.is_defined () && ! cb_arg.is_empty ()) + { + octave_value_list args; + octave_function *fcn = 0; + + args(0) = h.as_octave_value (); + if (data.is_defined ()) + args(1) = data; + else + args(1) = Matrix (); + + unwind_protect_safe frame; + frame.add_fcn (gh_manager::restore_gcbo); + + if (true) + { + gh_manager::auto_lock guard; + + callback_objects.push_front (get_object (h)); + xset_gcbo (h); + } + + BEGIN_INTERRUPT_WITH_EXCEPTIONS; + + // Copy CB because "function_value" method is non-const. + + octave_value cb = cb_arg; + + if (cb.is_function () || cb.is_function_handle ()) + fcn = cb.function_value (); + else if (cb.is_string ()) + { + int status; + std::string s = cb.string_value (); + + eval_string (s, false, status, 0); + } + else if (cb.is_cell () && cb.length () > 0 + && (cb.rows () == 1 || cb.columns () == 1) + && (cb.cell_value ()(0).is_function () + || cb.cell_value ()(0).is_function_handle ())) + { + Cell c = cb.cell_value (); + + fcn = c(0).function_value (); + if (! error_state) + { + for (int i = 1; i < c.length () ; i++) + args(1+i) = c(i); + } + } + else + { + std::string nm = cb.class_name (); + error ("trying to execute non-executable object (class = %s)", + nm.c_str ()); + } + + if (fcn && ! error_state) + feval (fcn, args); + + END_INTERRUPT_WITH_EXCEPTIONS; + } +} + +void +gh_manager::do_post_event (const graphics_event& e) +{ + event_queue.push_back (e); + + command_editor::add_event_hook (gh_manager::process_events); +} + +void +gh_manager::do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data) +{ + gh_manager::auto_lock guard; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + { + if (callback_objects.empty ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + const graphics_object& current = callback_objects.front (); + + if (current.get_properties ().is_interruptible ()) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str busy_action (go.get_properties ().get_busyaction ()); + + if (busy_action.compare ("queue")) + do_post_event (graphics_event::create_callback_event (h, name, data)); + else + { + caseless_str cname (name); + + if (cname.compare ("deletefcn") + || cname.compare ("createfcn") + || (go.isa ("figure") + && (cname.compare ("closerequestfcn") + || cname.compare ("resizefcn")))) + do_post_event (graphics_event::create_callback_event (h, name, data)); + } + } + } + } +} + +void +gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_function_event (fcn, fcn_data)); +} + +void +gh_manager::do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_set_event (h, name, value, + notify_toolkit)); +} + +int +gh_manager::do_process_events (bool force) +{ + graphics_event e; + bool old_Vdrawnow_requested = Vdrawnow_requested; + bool events_executed = false; + + do + { + e = graphics_event (); + + gh_manager::lock (); + + if (! event_queue.empty ()) + { + if (callback_objects.empty () || force) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + else + { + const graphics_object& go = callback_objects.front (); + + if (go.get_properties ().is_interruptible ()) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + } + } + + gh_manager::unlock (); + + if (e.ok ()) + { + e.execute (); + events_executed = true; + } + } + while (e.ok ()); + + gh_manager::lock (); + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + + gh_manager::unlock (); + + if (events_executed) + flush_octave_stdout (); + + if (Vdrawnow_requested && ! old_Vdrawnow_requested) + { + feval ("drawnow"); + + Vdrawnow_requested = false; + } + + return 0; +} + +void +gh_manager::do_enable_event_processing (bool enable) +{ + gh_manager::auto_lock guard; + + if (enable) + { + event_processing++; + + command_editor::add_event_hook (gh_manager::process_events); + } + else + { + event_processing--; + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + } +} + +property_list::plist_map_type +root_figure::init_factory_properties (void) +{ + property_list::plist_map_type plist_map; + + plist_map["figure"] = figure::properties::factory_defaults (); + plist_map["axes"] = axes::properties::factory_defaults (); + plist_map["line"] = line::properties::factory_defaults (); + plist_map["text"] = text::properties::factory_defaults (); + plist_map["image"] = image::properties::factory_defaults (); + plist_map["patch"] = patch::properties::factory_defaults (); + plist_map["surface"] = surface::properties::factory_defaults (); + plist_map["hggroup"] = hggroup::properties::factory_defaults (); + plist_map["uimenu"] = uimenu::properties::factory_defaults (); + plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); + plist_map["uipanel"] = uipanel::properties::factory_defaults (); + plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); + plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); + plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); + plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); + + return plist_map; +} + +// --------------------------------------------------------------------- + +DEFUN (ishandle, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} ishandle (@var{h})\n\ +Return true if @var{h} is a graphics handle and false otherwise.\n\ +@var{h} may also be a matrix of handles in which case a logical\n\ +array is returned that is true where the elements of @var{h} are\n\ +graphics handles and false where they are not.\n\ +@seealso{isfigure}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 1) + retval = is_handle (args(0)); + else + print_usage (); + + return retval; +} + +static bool +is_handle_visible (const graphics_handle& h) +{ + return h.ok () && gh_manager::is_handle_visible (h); +} + +static bool +is_handle_visible (double val) +{ + return is_handle_visible (gh_manager::lookup (val)); +} + +static octave_value +is_handle_visible (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle_visible (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle_visible (handles (i)); + + retval = result; + } + } + + return retval; +} + +DEFUN (__is_handle_visible__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = is_handle_visible (args(0)); + else + print_usage (); + + return retval; +} + +DEFUN (reset, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ +Remove any defaults set for the handle @var{h}. The default figure\n\ +properties of \"position\", \"units\", \"windowstyle\" and\n\ +\"paperunits\" and the default axes properties of \"position\" and \"units\"\n\ +are not reset.\n\ +@end deftypefn") +{ + int nargin = args.length (); + + if (nargin != 1) + print_usage (); + else + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + gh_manager::get_object (hcv(n)).reset_default_properties (); + } + } + + return octave_value (); +} + +DEFUN (set, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} set (@var{h}, @var{property}, @var{value}, @dots{})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{properties}, @var{values})\n\ +@deftypefnx {Built-in Function} {} set (@var{h}, @var{pv})\n\ +Set named property values for the graphics handle (or vector of graphics\n\ +handles) @var{h}.\n\ +There are three ways how to give the property names and values:\n\ +\n\ +@itemize\n\ +@item as a comma separated list of @var{property}, @var{value} pairs\n\ +\n\ +Here, each @var{property} is a string containing the property name, each\n\ +@var{value} is a value of the appropriate type for the property.\n\ +\n\ +@item as a cell array of strings @var{properties} containing property names\n\ +and a cell array @var{values} containing property values.\n\ +\n\ +In this case, the number of columns of @var{values} must match the number of\n\ +elements in @var{properties}. The first column of @var{values} contains\n\ +values for the first entry in @var{properties}, etc. The number of rows of\n\ +@var{values} must be 1 or match the number of elements of @var{h}. In the\n\ +first case, each handle in @var{h} will be assigned the same values. In the\n\ +latter case, the first handle in @var{h} will be assigned the values from\n\ +the first row of @var{values} and so on.\n\ +\n\ +@item as a structure array @var{pv}\n\ +\n\ +Here, the field names of @var{pv} represent the property names, and the field\n\ +values give the property values. In contrast to the previous case, all\n\ +elements of @var{pv} will be set in all handles in @var{h} independent of\n\ +the dimensions of @var{pv}.\n\ +@end itemize\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin > 0) + { + // get vector of graphics handles + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + bool request_drawnow = false; + + // loop over graphics objects + for (octave_idx_type n = 0; n < hcv.length (); n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 3 && args(1).is_cellstr () + && args(2).is_cell ()) + { + if (args(2).cell_value ().rows () == 1) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), 0); + } + else if (hcv.length () == args(2).cell_value ().rows ()) + { + obj.set (args(1).cellstr_value (), + args(2).cell_value (), n); + } + else + { + error ("set: number of graphics handles must match number of value rows (%d != %d)", + hcv.length (), args(2).cell_value ().rows ()); + break; + + } + } + else if (nargin == 2 && args(1).is_map ()) + { + obj.set (args(1).map_value ()); + } + else if (nargin == 1) + { + if (nargout != 0) + retval = obj.values_as_struct (); + else + { + std::string s = obj.values_as_string (); + if (! error_state) + octave_stdout << s; + } + } + else + { + obj.set (args.splice (0, 1)); + request_drawnow = true; + } + } + else + { + error ("set: invalid handle (= %g)", hcv(n)); + break; + } + + if (error_state) + break; + + request_drawnow = true; + } + + if (! error_state && request_drawnow) + Vdrawnow_requested = true; + } + else + error ("set: expecting graphics handle as first argument"); + } + else + print_usage (); + + return retval; +} + +static std::string +get_graphics_object_type (const double val) +{ + std::string retval; + + graphics_object obj = gh_manager::get_object (val); + + if (obj) + retval = obj.type (); + else + error ("get: invalid handle (= %g)", val); + + return retval; +} + +DEFUN (get, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ +Return the named property @var{p} from the graphics handle @var{h}.\n\ +If @var{p} is omitted, return the complete property list for @var{h}.\n\ +If @var{h} is a vector, return a cell array including the property\n\ +values or lists respectively.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + bool use_cell_format = false; + + if (nargin == 1 || nargin == 2) + { + if (args(0).is_empty ()) + { + retval = Matrix (); + return retval; + } + + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + if (nargin == 1 && len > 1) + { + std::string t0 = get_graphics_object_type (hcv(0)); + + if (! error_state) + { + for (octave_idx_type n = 1; n < len; n++) + { + std::string t = get_graphics_object_type (hcv(n)); + + if (error_state) + break; + + if (t != t0) + { + error ("get: vector of handles must all have same type"); + break; + } + } + + } + } + + if (! error_state) + { + if (nargin > 1 && args(1).is_cellstr ()) + { + Array plist = args(1).cellstr_value (); + + if (! error_state) + { + octave_idx_type plen = plist.numel (); + + use_cell_format = true; + + vals.resize (dim_vector (len, plen)); + + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + for (octave_idx_type m = 0; ! error_state && m < plen; m++) + { + caseless_str property = plist(m); + + vals(n, m) = obj.get (property); + } + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting property name or cell array of property names as second argument"); + } + else + { + caseless_str property; + + if (nargin > 1) + { + property = args(1).string_value (); + + if (error_state) + error ("get: expecting property name or cell array of property names as second argument"); + } + + vals.resize (dim_vector (len, 1)); + + if (! error_state) + { + for (octave_idx_type n = 0; ! error_state && n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 1) + vals(n) = obj.get (); + else + vals(n) = obj.get (property); + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + if (use_cell_format) + retval = vals; + else + { + octave_idx_type len = vals.numel (); + + if (len == 0) + retval = Matrix (); + else if (len == 1) + retval = vals(0); + else if (len > 1 && nargin == 1) + { + OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); + + for (octave_idx_type n = 0; n < len; n++) + tmp[n] = vals(n).scalar_map_value (); + + retval = octave_map::cat (0, len, tmp); + } + else + retval = vals; + } + } + + return retval; +} + +/* +%!assert (get (findobj (0, "Tag", "nonexistenttag"), "nonexistentproperty"), []) +*/ + +// Return all properties from the graphics handle @var{h}. +// If @var{h} is a vector, return a cell array including the +// property values or lists respectively. + +DEFUN (__get__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __get__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + Cell vals; + + int nargin = args.length (); + + if (nargin == 1) + { + ColumnVector hcv (args(0).vector_value ()); + + if (! error_state) + { + octave_idx_type len = hcv.length (); + + vals.resize (dim_vector (len, 1)); + + for (octave_idx_type n = 0; n < len; n++) + { + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + vals(n) = obj.get (true); + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } + } + } + else + error ("get: expecting graphics handle as first argument"); + } + else + print_usage (); + + if (! error_state) + { + octave_idx_type len = vals.numel (); + + if (len > 1) + retval = vals; + else if (len == 1) + retval = vals(0); + } + + return retval; +} + +static octave_value +make_graphics_object (const std::string& go_name, + bool integer_figure_handle, + const octave_value_list& args) +{ + octave_value retval; + + double val = octave_NaN; + + octave_value_list xargs = args.splice (0, 1); + + caseless_str p ("parent"); + + for (int i = 0; i < xargs.length (); i++) + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + val = xargs(i+1).double_value (); + + if (! error_state) + { + xargs = xargs.splice (i, 2); + break; + } + } + else + error ("__go_%s__: missing value for parent property", + go_name.c_str ()); + } + + if (! error_state && xisnan (val)) + val = args(0).double_value (); + + if (! error_state) + { + graphics_handle parent = gh_manager::lookup (val); + + if (parent.ok ()) + { + graphics_handle h + = gh_manager::make_graphics_handle (go_name, parent, + integer_figure_handle, + false, false); + + if (! error_state) + { + adopt (parent, h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + + if (! error_state) + Vdrawnow_requested = true; + } + else + error ("__go%s__: unable to create graphics handle", + go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + } + else + error ("__go_%s__: invalid parent", go_name.c_str ()); + + return retval; +} + +DEFUN (__go_figure__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure__ (@var{fignum})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () > 0) + { + double val = args(0).double_value (); + + if (! error_state) + { + if (is_figure (val)) + { + graphics_handle h = gh_manager::lookup (val); + + xset (h, args.splice (0, 1)); + + retval = h.value (); + } + else + { + bool int_fig_handle = true; + + octave_value_list xargs = args.splice (0, 1); + + graphics_handle h = octave_NaN; + + if (xisnan (val)) + { + caseless_str p ("integerhandle"); + + for (int i = 0; i < xargs.length (); i++) + { + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + std::string pval = xargs(i+1).string_value (); + + if (! error_state) + { + caseless_str on ("on"); + int_fig_handle = on.compare (pval); + xargs = xargs.splice (i, 2); + break; + } + } + } + } + + h = gh_manager::make_graphics_handle ("figure", 0, + int_fig_handle, + false, false); + + if (! int_fig_handle) + { + // We need to intiailize the integerhandle + // property without calling the set_integerhandle + // method, because doing that will generate a new + // handle value... + + graphics_object go = gh_manager::get_object (h); + go.get_properties ().init_integerhandle ("off"); + } + } + else if (val > 0 && D_NINT (val) == val) + h = gh_manager::make_figure_handle (val, false); + + if (! error_state && h.ok ()) + { + adopt (0, h); + + gh_manager::push_figure (h); + + xset (h, xargs); + xcreatefcn (h); + xinitialize (h); + + retval = h.value (); + } + else + error ("__go_figure__: failed to create figure handle"); + } + } + else + error ("__go_figure__: expecting figure number to be double value"); + } + else + print_usage (); + + return retval; +} + +#define GO_BODY(TYPE) \ + gh_manager::auto_lock guard; \ + \ + octave_value retval; \ + \ + if (args.length () > 0) \ + retval = make_graphics_object (#TYPE, false, args); \ + else \ + print_usage (); \ + \ + return retval + +int +calc_dimensions (const graphics_object& go) +{ + + int nd = 2; + + if (go.isa ("surface")) + nd = 3; + + if ((go.isa ("line") || go.isa ("patch")) && ! go.get("zdata").is_empty ()) + nd = 3; + + Matrix kids = go.get_properties ().get_children (); + + for (octave_idx_type i = 0; i < kids.length (); i++) + { + graphics_handle hnd = gh_manager::lookup (kids(i)); + + if (hnd.ok ()) + { + const graphics_object& kid = gh_manager::get_object (hnd); + + if (kid.valid_object ()) + nd = calc_dimensions (kid); + + if (nd == 3) + break; + } + } + + return nd; +} + +DEFUN (__calc_dimensions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __calc_dimensions__ (@var{axes})\n\ +Internal function. Determine the number of dimensions in a graphics\n\ +object, whether 2 or 3.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + retval = calc_dimensions (gh_manager::get_object (h)); + else + error ("__calc_dimensions__: expecting graphics handle as only argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (axes); +} + +DEFUN (__go_line__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_line__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (line); +} + +DEFUN (__go_text__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_text__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (text); +} + +DEFUN (__go_image__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_image__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (image); +} + +DEFUN (__go_surface__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_surface__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (surface); +} + +DEFUN (__go_patch__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_patch__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (patch); +} + +DEFUN (__go_hggroup__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_hggroup__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (hggroup); +} + +DEFUN (__go_uimenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uimenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uimenu); +} + +DEFUN (__go_uicontrol__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontrol); +} + +DEFUN (__go_uipanel__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipanel); +} + +DEFUN (__go_uicontextmenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontextmenu); +} + +DEFUN (__go_uitoolbar__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoolbar); +} + +DEFUN (__go_uipushtool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipushtool); +} + +DEFUN (__go_uitoggletool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoggletool); +} + +DEFUN (__go_delete__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value_list retval; + + if (args.length () == 1) + { + graphics_handle h = octave_NaN; + + const NDArray vals = args (0).array_value (); + + if (! error_state) + { + // Check is all the handles to delete are valid first + // as callbacks might delete one of the handles we + // later want to delete + for (octave_idx_type i = 0; i < vals.numel (); i++) + { + h = gh_manager::lookup (vals.elem (i)); + + if (! h.ok ()) + { + error ("delete: invalid graphics object (= %g)", + vals.elem (i)); + break; + } + } + + if (! error_state) + delete_graphics_objects (vals); + } + else + error ("delete: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_axes_init__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_axes_init__ (@var{h}, @var{mode})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + int nargin = args.length (); + + std::string mode = ""; + + if (nargin == 2) + { + mode = args(1).string_value (); + + if (error_state) + return retval; + } + + if (nargin == 1 || nargin == 2) + { + graphics_handle h = octave_NaN; + + double val = args(0).double_value (); + + if (! error_state) + { + h = gh_manager::lookup (val); + + if (h.ok ()) + { + graphics_object obj = gh_manager::get_object (h); + + obj.set_defaults (mode); + + h = gh_manager::lookup (val); + if (! h.ok ()) + error ("__go_axes_init__: axis deleted during initialization (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object (= %g)", val); + } + else + error ("__go_axes_init__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__go_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::handle_list (show_hidden)); +} + +DEFUN (__go_figure_handles__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::figure_handle_list (show_hidden)); +} + +DEFUN (__go_execute_callback__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name})\n\ +@deftypefnx {Built-in Function} {} __go_execute_callback__ (@var{h}, @var{name}, @var{param})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + double val = args(0).double_value (); + + if (! error_state) + { + graphics_handle h = gh_manager::lookup (val); + + if (h.ok ()) + { + std::string name = args(1).string_value (); + + if (! error_state) + { + if (nargin == 2) + gh_manager::execute_callback (h, name); + else + gh_manager::execute_callback (h, name, args(2)); + } + else + error ("__go_execute_callback__: invalid callback name"); + } + else + error ("__go_execute_callback__: invalid graphics object (= %g)", + val); + } + else + error ("__go_execute_callback__: invalid graphics object"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__image_pixel_size__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{px}, @var{py}} __image_pixel_size__ (@var{h})\n\ +Internal function: returns the pixel size of the image in normalized units.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + double h = args(0).double_value (); + + if (! error_state) + { + graphics_object fobj = gh_manager::get_object (h); + if (fobj && fobj.isa ("image")) + { + image::properties& ip = + dynamic_cast (fobj.get_properties ()); + + Matrix dp = Matrix (1, 2, 0); + dp(0, 0) = ip.pixel_xsize (); + dp(0, 1) = ip.pixel_ysize (); + retval = dp; + } + else + error ("__image_pixel_size__: object is not an image"); + } + else + error ("__image_pixel_size__: argument is not a handle"); + } + else + print_usage (); + + return retval; +} + +gtk_manager *gtk_manager::instance = 0; + +void +gtk_manager::create_instance (void) +{ + instance = new gtk_manager (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); +} + +graphics_toolkit +gtk_manager::do_get_toolkit (void) const +{ + graphics_toolkit retval; + + const_loaded_toolkits_iterator pl = loaded_toolkits.find (dtk); + + if (pl == loaded_toolkits.end ()) + { + const_available_toolkits_iterator pa = available_toolkits.find (dtk); + + if (pa != available_toolkits.end ()) + { + octave_value_list args; + args(0) = dtk; + feval ("graphics_toolkit", args); + + if (! error_state) + pl = loaded_toolkits.find (dtk); + + if (error_state || pl == loaded_toolkits.end ()) + error ("failed to load %s graphics toolkit", dtk.c_str ()); + else + retval = pl->second; + } + else + error ("default graphics toolkit `%s' is not available!", + dtk.c_str ()); + } + else + retval = pl->second; + + return retval; +} + +DEFUN (available_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} available_graphics_toolkits ()\n\ +Return a cell array of registered graphics toolkits.\n\ +@seealso{graphics_toolkit, register_graphics_toolkit}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::available_toolkits_list ()); +} + +DEFUN (register_graphics_toolkit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} register_graphics_toolkit (@var{toolkit})\n\ +List @var{toolkit} as an available graphics toolkit.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + octave_value retval; + + gh_manager::auto_lock guard; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + gtk_manager::register_toolkit (name); + else + error ("register_graphics_toolkit: expecting character string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (loaded_graphics_toolkits, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} loaded_graphics_toolkits ()\n\ +Return a cell array of the currently loaded graphics toolkits.\n\ +@seealso{available_graphics_toolkits}\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + return octave_value (gtk_manager::loaded_toolkits_list ()); +} + +DEFUN (drawnow, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} drawnow ()\n\ +@deftypefnx {Built-in Function} {} drawnow (\"expose\")\n\ +@deftypefnx {Built-in Function} {} drawnow (@var{term}, @var{file}, @var{mono}, @var{debug_file})\n\ +Update figure windows and their children. The event queue is flushed and\n\ +any callbacks generated are executed. With the optional argument\n\ +@code{\"expose\"}, only graphic objects are updated and no other events or\n\ +callbacks are processed.\n\ +The third calling form of @code{drawnow} is for debugging and is\n\ +undocumented.\n\ +@end deftypefn") +{ + static int drawnow_executing = 0; + + octave_value retval; + + gh_manager::lock (); + + unwind_protect frame; + frame.protect_var (Vdrawnow_requested, false); + + frame.protect_var (drawnow_executing); + + if (++drawnow_executing <= 1) + { + if (args.length () == 0 || args.length () == 1) + { + Matrix hlist = gh_manager::figure_handle_list (true); + + for (int i = 0; ! error_state && i < hlist.length (); i++) + { + graphics_handle h = gh_manager::lookup (hlist(i)); + + if (h.ok () && h != 0) + { + graphics_object go = gh_manager::get_object (h); + figure::properties& fprops = dynamic_cast (go.get_properties ()); + + if (fprops.is_modified ()) + { + if (fprops.is_visible ()) + { + gh_manager::unlock (); + + fprops.get_toolkit ().redraw_figure (go); + + gh_manager::lock (); + } + + fprops.set_modified (false); + } + } + } + + bool do_events = true; + + if (args.length () == 1) + { + caseless_str val (args(0).string_value ()); + + if (! error_state && val.compare ("expose")) + do_events = false; + else + { + error ("drawnow: invalid argument, expected `expose' as argument"); + return retval; + } + } + + if (do_events) + { + gh_manager::unlock (); + + gh_manager::process_events (); + + gh_manager::lock (); + } + } + else if (args.length () >= 2 && args.length () <= 4) + { + std::string term, file, debug_file; + bool mono; + + term = args(0).string_value (); + + if (! error_state) + { + file = args(1).string_value (); + + if (! error_state) + { + size_t pos = file.find_first_not_of ("|"); + if (pos > 0) + file = file.substr (pos); + else + { + pos = file.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string dirname = file.substr (0, pos+1); + + file_stat fs (dirname); + + if (! (fs && fs.is_dir ())) + { + error ("drawnow: nonexistent directory `%s'", + dirname.c_str ()); + + return retval; + } + } + } + + mono = (args.length () >= 3 ? args(2).bool_value () : false); + + if (! error_state) + { + debug_file = (args.length () > 3 ? args(3).string_value () + : ""); + + if (! error_state) + { + graphics_handle h = gcf (); + + if (h.ok ()) + { + graphics_object go = gh_manager::get_object (h); + + gh_manager::unlock (); + + go.get_toolkit () + .print_figure (go, term, file, mono, debug_file); + + gh_manager::lock (); + } + else + error ("drawnow: nothing to draw"); + } + else + error ("drawnow: invalid DEBUG_FILE, expected a string value"); + } + else + error ("drawnow: invalid colormode MONO, expected a boolean value"); + } + else + error ("drawnow: invalid FILE, expected a string value"); + } + else + error ("drawnow: invalid terminal TERM, expected a string value"); + } + else + print_usage (); + } + + gh_manager::unlock (); + + return retval; +} + +DEFUN (addlistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addlistener (@var{h}, @var{prop}, @var{fcn})\n\ +Register @var{fcn} as listener for the property @var{prop} of the graphics\n\ +object @var{h}. Property listeners are executed (in order of registration)\n\ +when the property is set. The new value is already available when the\n\ +listeners are executed.\n\ +\n\ +@var{prop} must be a string naming a valid property in @var{h}.\n\ +\n\ +@var{fcn} can be a function handle, a string or a cell array whose first\n\ +element is a function handle. If @var{fcn} is a function handle, the\n\ +corresponding function should accept at least 2 arguments, that will be\n\ +set to the object handle and the empty matrix respectively. If @var{fcn}\n\ +is a string, it must be any valid octave expression. If @var{fcn} is a cell\n\ +array, the first element must be a function handle with the same signature\n\ +as described above. The next elements of the cell array are passed\n\ +as additional arguments to the function.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +addlistener (gcf, \"position\", @{@@my_listener, \"my string\"@})\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3 && args.length () <= 4) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + go.add_property_listener (pname, args(2), POSTSET); + + if (args.length () == 4) + { + caseless_str persistent = args(3).string_value (); + if (persistent.compare ("persistent")) + go.add_property_listener (pname, args(2), PERSISTENT); + } + } + else + error ("addlistener: invalid graphics object (= %g)", + h); + } + else + error ("addlistener: invalid property name, expected a string value"); + } + else + error ("addlistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (dellistener, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} dellistener (@var{h}, @var{prop}, @var{fcn})\n\ +Remove the registration of @var{fcn} as a listener for the property\n\ +@var{prop} of the graphics object @var{h}. The function @var{fcn} must\n\ +be the same variable (not just the same value), as was passed to the\n\ +original call to @code{addlistener}.\n\ +\n\ +If @var{fcn} is not defined then all listener functions of @var{prop}\n\ +are removed.\n\ +\n\ +Example:\n\ +\n\ +@example\n\ +@group\n\ +function my_listener (h, dummy, p1)\n\ + fprintf (\"my_listener called with p1=%s\\n\", p1);\n\ +endfunction\n\ +\n\ +c = @{@@my_listener, \"my string\"@};\n\ +addlistener (gcf, \"position\", c);\n\ +dellistener (gcf, \"position\", c);\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () == 3 || args.length () == 2) + { + double h = args(0).double_value (); + + if (! error_state) + { + std::string pname = args(1).string_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + if (args.length () == 2) + go.delete_property_listener (pname, octave_value (), POSTSET); + else + { + caseless_str persistent = args(2).string_value (); + if (persistent.compare ("persistent")) + { + go.delete_property_listener (pname, octave_value (), PERSISTENT); + go.delete_property_listener (pname, octave_value (), POSTSET); + } + else + go.delete_property_listener (pname, args(2), POSTSET); + } + } + else + error ("dellistener: invalid graphics object (= %g)", + h); + } + else + error ("dellistener: invalid property name, expected a string value"); + } + else + error ("dellistener: invalid handle"); + } + else + print_usage (); + + return retval; +} + +DEFUN (addproperty, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type})\n\ +@deftypefnx {Built-in Function} {} addproperty (@var{name}, @var{h}, @var{type}, @var{arg}, @dots{})\n\ +Create a new property named @var{name} in graphics object @var{h}.\n\ +@var{type} determines the type of the property to create. @var{args}\n\ +usually contains the default value of the property, but additional\n\ +arguments might be given, depending on the type of the property.\n\ +\n\ +The supported property types are:\n\ +\n\ +@table @code\n\ +@item string\n\ +A string property. @var{arg} contains the default string value.\n\ +\n\ +@item any\n\ +An un-typed property. This kind of property can hold any octave\n\ +value. @var{args} contains the default value.\n\ +\n\ +@item radio\n\ +A string property with a limited set of accepted values. The first\n\ +argument must be a string with all accepted values separated by\n\ +a vertical bar ('|'). The default value can be marked by enclosing\n\ +it with a '@{' '@}' pair. The default value may also be given as\n\ +an optional second string argument.\n\ +\n\ +@item boolean\n\ +A boolean property. This property type is equivalent to a radio\n\ +property with \"on|off\" as accepted values. @var{arg} contains\n\ +the default property value.\n\ +\n\ +@item double\n\ +A scalar double property. @var{arg} contains the default value.\n\ +\n\ +@item handle\n\ +A handle property. This kind of property holds the handle of a\n\ +graphics object. @var{arg} contains the default handle value.\n\ +When no default value is given, the property is initialized to\n\ +the empty matrix.\n\ +\n\ +@item data\n\ +A data (matrix) property. @var{arg} contains the default data\n\ +value. When no default value is given, the data is initialized to\n\ +the empty matrix.\n\ +\n\ +@item color\n\ +A color property. @var{arg} contains the default color value.\n\ +When no default color is given, the property is set to black.\n\ +An optional second string argument may be given to specify an\n\ +additional set of accepted string values (like a radio property).\n\ +@end table\n\ +\n\ +@var{type} may also be the concatenation of a core object type and\n\ +a valid property name for that object type. The property created\n\ +then has the same characteristics as the referenced property (type,\n\ +possible values, hidden state@dots{}). This allows to clone an existing\n\ +property into the graphics object @var{h}.\n\ +\n\ +Examples:\n\ +\n\ +@example\n\ +@group\n\ +addproperty (\"my_property\", gcf, \"string\", \"a string value\");\n\ +addproperty (\"my_radio\", gcf, \"radio\", \"val_1|val_2|@{val_3@}\");\n\ +addproperty (\"my_style\", gcf, \"linelinestyle\", \"--\");\n\ +@end group\n\ +@end example\n\ +\n\ +@end deftypefn") +{ + gh_manager::auto_lock guard; + + octave_value retval; + + if (args.length () >= 3) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + double h = args(1).double_value (); + + if (! error_state) + { + graphics_handle gh = gh_manager::lookup (h); + + if (gh.ok ()) + { + graphics_object go = gh_manager::get_object (gh); + + std::string type = args(2).string_value (); + + if (! error_state) + { + if (! go.get_properties ().has_property (name)) + { + property p = property::create (name, gh, type, + args.splice (0, 3)); + + if (! error_state) + go.get_properties ().insert_property (name, p); + } + else + error ("addproperty: a `%s' property already exists in the graphics object", + name.c_str ()); + } + else + error ("addproperty: invalid property TYPE, expected a string value"); + } + else + error ("addproperty: invalid graphics object (= %g)", h); + } + else + error ("addproperty: invalid handle value"); + } + else + error ("addproperty: invalid property NAME, expected a string value"); + } + else + print_usage (); + + return retval; +} + +octave_value +get_property_from_handle (double handle, const std::string& property, + const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + octave_value retval; + + if (obj) + retval = obj.get (caseless_str (property)); + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return retval; +} + +bool +set_property_in_handle (double handle, const std::string& property, + const octave_value& arg, const std::string& func) +{ + gh_manager::auto_lock guard; + + graphics_object obj = gh_manager::get_object (handle); + int ret = false; + + if (obj) + { + obj.set (caseless_str (property), arg); + + if (! error_state) + ret = true; + } + else + error ("%s: invalid handle (= %g)", func.c_str (), handle); + + return ret; +} + +static bool +compare_property_values (const octave_value& o1, const octave_value& o2) +{ + octave_value_list args (2); + + args(0) = o1; + args(1) = o2; + + octave_value_list result = feval ("isequal", args, 1); + + if (! error_state && result.length () > 0) + return result(0).bool_value (); + + return false; +} + +static std::map waitfor_results; + +static void +cleanup_waitfor_id (uint32_t id) +{ + waitfor_results.erase (id); +} + +static void +do_cleanup_waitfor_listener (const octave_value& listener, + listener_mode mode = POSTSET) +{ + Cell c = listener.cell_value (); + + if (c.numel () >= 4) + { + double h = c(2).double_value (); + + if (! error_state) + { + caseless_str pname = c(3).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (go.get_properties ().has_property (pname)) + { + go.get_properties () + .delete_listener (pname, listener, mode); + if (mode == POSTSET) + go.get_properties () + .delete_listener (pname, listener, PERSISTENT); + } + } + } + } + } +} + +static void +cleanup_waitfor_postset_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, POSTSET); } + +static void +cleanup_waitfor_predelete_listener (const octave_value& listener) +{ do_cleanup_waitfor_listener (listener, PREDELETE); } + +static octave_value_list +waitfor_listener (const octave_value_list& args, int) +{ + if (args.length () > 3) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + { + if (args.length () > 5) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname = args(4).string_value (); + + if (! error_state) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + octave_value pvalue = go.get (pname); + + if (compare_property_values (pvalue, args(5))) + waitfor_results[id] = true; + } + } + } + } + else + waitfor_results[id] = true; + } + } + + return octave_value_list (); +} + +static octave_value_list +waitfor_del_listener (const octave_value_list& args, int) +{ + if (args.length () > 2) + { + uint32_t id = args(2).uint32_scalar_value ().value (); + + if (! error_state) + waitfor_results[id] = true; + } + + return octave_value_list (); +} + +DEFUN (waitfor, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} waitfor (@var{h})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop})\n\ +@deftypefnx {Built-in Function} {} waitfor (@var{h}, @var{prop}, @var{value})\n\ +@deftypefnx {Built-in Function} {} waitfor (@dots{}, \"timeout\", @var{timeout})\n\ +Suspend the execution of the current program until a condition is\n\ +satisfied on the graphics handle @var{h}. While the program is suspended\n\ +graphics events are still being processed normally, allowing callbacks to\n\ +modify the state of graphics objects. This function is reentrant and can be\n\ +called from a callback, while another @code{waitfor} call is pending at\n\ +top-level.\n\ +\n\ +In the first form, program execution is suspended until the graphics object\n\ +@var{h} is destroyed. If the graphics handle is invalid, the function\n\ +returns immediately.\n\ +\n\ +In the second form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is modified. If the graphics\n\ +handle is invalid or the property does not exist, the function returns\n\ +immediately.\n\ +\n\ +In the third form, execution is suspended until the graphics object is\n\ +destroyed or the property named @var{prop} is set to @var{value}. The\n\ +function @code{isequal} is used to compare property values. If the graphics\n\ +handle is invalid, the property does not exist or the property is already\n\ +set to @var{value}, the function returns immediately.\n\ +\n\ +An optional timeout can be specified using the property @code{timeout}.\n\ +This timeout value is the number of seconds to wait for the condition to be\n\ +true. @var{timeout} must be at least 1. If a smaller value is specified, a\n\ +warning is issued and a value of 1 is used instead. If the timeout value is\n\ +not an integer, it is truncated towards 0.\n\ +\n\ +To define a condition on a property named @code{timeout}, use the string\n\ +@code{\\timeout} instead.\n\ +\n\ +In all cases, typing CTRL-C stops program execution immediately.\n\ +@seealso{isequal}\n\ +@end deftypefn") +{ + if (args.length () > 0) + { + double h = args(0).double_value (); + + if (! error_state) + { + caseless_str pname; + + unwind_protect frame; + + static uint32_t id_counter = 0; + uint32_t id = 0; + + int max_arg_index = 0; + int timeout_index = -1; + + int timeout = 0; + + if (args.length () > 1) + { + pname = args(1).string_value (); + if (! error_state + && ! pname.empty () + && ! pname.compare ("timeout")) + { + if (pname.compare ("\\timeout")) + pname = "timeout"; + + static octave_value wf_listener; + + if (! wf_listener.is_defined ()) + wf_listener = + octave_value (new octave_builtin (waitfor_listener, + "waitfor_listener")); + + max_arg_index++; + if (args.length () > 2) + { + if (args(2).is_string ()) + { + caseless_str s = args(2).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = 2; + else + max_arg_index++; + } + } + else + max_arg_index++; + } + + Cell listener (1, max_arg_index >= 2 ? 5 : 4); + + id = id_counter++; + frame.add_fcn (cleanup_waitfor_id, id); + waitfor_results[id] = false; + + listener(0) = wf_listener; + listener(1) = octave_uint32 (id); + listener(2) = h; + listener(3) = pname; + + if (max_arg_index >= 2) + listener(4) = args(2); + + octave_value ov_listener (listener); + + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + graphics_object go = gh_manager::get_object (handle); + + if (max_arg_index >= 2 + && compare_property_values (go.get (pname), + args(2))) + waitfor_results[id] = true; + else + { + + frame.add_fcn (cleanup_waitfor_postset_listener, + ov_listener); + go.add_property_listener (pname, ov_listener, + POSTSET); + go.add_property_listener (pname, ov_listener, + PERSISTENT); + + if (go.get_properties () + .has_dynamic_property (pname)) + { + static octave_value wf_del_listener; + + if (! wf_del_listener.is_defined ()) + wf_del_listener = + octave_value (new octave_builtin + (waitfor_del_listener, + "waitfor_del_listener")); + + Cell del_listener (1, 4); + + del_listener(0) = wf_del_listener; + del_listener(1) = octave_uint32 (id); + del_listener(2) = h; + del_listener(3) = pname; + + octave_value ov_del_listener (del_listener); + + frame.add_fcn (cleanup_waitfor_predelete_listener, + ov_del_listener); + go.add_property_listener (pname, ov_del_listener, + PREDELETE); + } + } + } + } + else if (error_state || pname.empty ()) + error ("waitfor: invalid property name, expected a non-empty string value"); + } + + if (! error_state + && timeout_index < 0 + && args.length () > (max_arg_index + 1)) + { + caseless_str s = args(max_arg_index + 1).string_value (); + + if (! error_state) + { + if (s.compare ("timeout")) + timeout_index = max_arg_index + 1; + else + error ("waitfor: invalid parameter `%s'", s.c_str ()); + } + else + error ("waitfor: invalid parameter, expected `timeout'"); + } + + if (! error_state && timeout_index >= 0) + { + if (args.length () > (timeout_index + 1)) + { + timeout = static_cast + (args(timeout_index + 1).scalar_value ()); + + if (! error_state) + { + if (timeout < 1) + { + warning ("waitfor: the timeout value must be >= 1, using 1 instead"); + timeout = 1; + } + } + else + error ("waitfor: invalid timeout value, expected a value >= 1"); + } + else + error ("waitfor: missing timeout value"); + } + + // FIXME: There is still a "hole" in the following loop. The code + // assumes that an object handle is unique, which is a fair + // assumptions, except for figures. If a figure is destroyed + // then recreated with the same figure ID, within the same + // run of event hooks, then the figure destruction won't be + // caught and the loop will not stop. This is an unlikely + // possibility in practice, though. + // + // Using deletefcn callback is also unreliable as it could be + // modified during a callback execution and the waitfor loop + // would not stop. + // + // The only "good" implementation would require object + // listeners, similar to property listeners. + + time_t start = 0; + + if (timeout > 0) + start = time (0); + + while (! error_state) + { + if (true) + { + gh_manager::auto_lock guard; + + graphics_handle handle = gh_manager::lookup (h); + + if (handle.ok ()) + { + if (! pname.empty () && waitfor_results[id]) + break; + } + else + break; + } + + octave_usleep (100000); + + OCTAVE_QUIT; + + command_editor::run_event_hooks (); + + if (timeout > 0) + { + if (start + timeout < time (0)) + break; + } + } + } + else + error ("waitfor: invalid handle value."); + } + else + print_usage (); + + return octave_value (); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/graphics.in.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/graphics.in.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,5831 @@ +/* + +Copyright (C) 2007-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (graphics_h) +#define graphics_h 1 + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include +#include +#include +#include +#include + +#include "caseless-str.h" +#include "lo-ieee.h" + +#include "gripes.h" +#include "oct-map.h" +#include "oct-mutex.h" +#include "oct-refcount.h" +#include "ov.h" +#include "txt-eng-ft.h" + +// FIXME -- maybe this should be a configure option? +// Matlab defaults to "Helvetica", but that causes problems for many +// gnuplot users. +#if !defined (OCTAVE_DEFAULT_FONTNAME) +#define OCTAVE_DEFAULT_FONTNAME "*" +#endif + +// --------------------------------------------------------------------- + +class graphics_handle +{ +public: + graphics_handle (void) : val (octave_NaN) { } + + graphics_handle (const octave_value& a); + + graphics_handle (int a) : val (a) { } + + graphics_handle (double a) : val (a) { } + + graphics_handle (const graphics_handle& a) : val (a.val) { } + + graphics_handle& operator = (const graphics_handle& a) + { + if (&a != this) + val = a.val; + + return *this; + } + + ~graphics_handle (void) { } + + double value (void) const { return val; } + + octave_value as_octave_value (void) const + { + return ok () ? octave_value (val) : octave_value (Matrix ()); + } + + // Prefix increment/decrement operators. + graphics_handle& operator ++ (void) + { + ++val; + return *this; + } + + graphics_handle& operator -- (void) + { + --val; + return *this; + } + + // Postfix increment/decrement operators. + const graphics_handle operator ++ (int) + { + graphics_handle old_value = *this; + ++(*this); + return old_value; + } + + const graphics_handle operator -- (int) + { + graphics_handle old_value = *this; + --(*this); + return old_value; + } + + bool ok (void) const { return ! xisnan (val); } + +private: + double val; +}; + +inline bool +operator == (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () == b.value (); +} + +inline bool +operator != (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () != b.value (); +} + +inline bool +operator < (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () < b.value (); +} + +inline bool +operator <= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () <= b.value (); +} + +inline bool +operator >= (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () >= b.value (); +} + +inline bool +operator > (const graphics_handle& a, const graphics_handle& b) +{ + return a.value () > b.value (); +} + +// --------------------------------------------------------------------- + +class base_scaler +{ +public: + base_scaler (void) { } + + virtual ~base_scaler (void) { } + + virtual Matrix scale (const Matrix& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual NDArray scale (const NDArray& m) const + { + error ("invalid axis scale"); + return m; + } + + virtual double scale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual double unscale (double d) const + { + error ("invalid axis scale"); + return d; + } + + virtual base_scaler* clone () const + { return new base_scaler (); } + + virtual bool is_linear (void) const + { return false; } +}; + +class lin_scaler : public base_scaler +{ +public: + lin_scaler (void) { } + + Matrix scale (const Matrix& m) const { return m; } + + NDArray scale (const NDArray& m) const { return m; } + + double scale (double d) const { return d; } + + double unscale (double d) const { return d; } + + base_scaler* clone (void) const { return new lin_scaler (); } + + bool is_linear (void) const { return true; } +}; + +class log_scaler : public base_scaler +{ +public: + log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return log10 (d); } + + double unscale (double d) const + { return pow (10.0, d); } + + base_scaler* clone (void) const + { return new log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = log10 (src[i]); + } +}; + +class neg_log_scaler : public base_scaler +{ +public: + neg_log_scaler (void) { } + + Matrix scale (const Matrix& m) const + { + Matrix retval (m.rows (), m.cols ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + NDArray scale (const NDArray& m) const + { + NDArray retval (m.dims ()); + + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + + return retval; + } + + double scale (double d) const + { return -log10 (-d); } + + double unscale (double d) const + { return -pow (10.0, -d); } + + base_scaler* clone (void) const + { return new neg_log_scaler (); } + +private: + void do_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = -log10 (-src[i]); + } +}; + +class scaler +{ +public: + scaler (void) : rep (new base_scaler ()) { } + + scaler (const scaler& s) : rep (s.rep->clone ()) { } + + scaler (const std::string& s) + : rep (s == "log" + ? new log_scaler () + : (s == "neglog" ? new neg_log_scaler () + : (s == "linear" ? new lin_scaler () : new base_scaler ()))) + { } + + ~scaler (void) { delete rep; } + + Matrix scale (const Matrix& m) const + { return rep->scale (m); } + + NDArray scale (const NDArray& m) const + { return rep->scale (m); } + + double scale (double d) const + { return rep->scale (d); } + + double unscale (double d) const + { return rep->unscale (d); } + + bool is_linear (void) const + { return rep->is_linear (); } + + scaler& operator = (const scaler& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + rep = s.rep->clone (); + + return *this; + } + + scaler& operator = (const std::string& s) + { + if (rep) + { + delete rep; + rep = 0; + } + + if (s == "log") + rep = new log_scaler (); + else if (s == "neglog") + rep = new neg_log_scaler (); + else if (s == "linear") + rep = new lin_scaler (); + else + rep = new base_scaler (); + + return *this; + } + +private: + base_scaler *rep; +}; + +// --------------------------------------------------------------------- + +class property; + +enum listener_mode { POSTSET, PERSISTENT, PREDELETE }; + +class base_property +{ +public: + friend class property; + +public: + base_property (void) + : id (-1), count (1), name (), parent (), hidden (), listeners () + { } + + base_property (const std::string& s, const graphics_handle& h) + : id (-1), count (1), name (s), parent (h), hidden (false), listeners () + { } + + base_property (const base_property& p) + : id (-1), count (1), name (p.name), parent (p.parent), + hidden (p.hidden), listeners () + { } + + virtual ~base_property (void) { } + + bool ok (void) const { return parent.ok (); } + + std::string get_name (void) const { return name; } + + void set_name (const std::string& s) { name = s; } + + graphics_handle get_parent (void) const { return parent; } + + void set_parent (const graphics_handle &h) { parent = h; } + + bool is_hidden (void) const { return hidden; } + + void set_hidden (bool flag) { hidden = flag; } + + virtual bool is_radio (void) const { return false; } + + int get_id (void) const { return id; } + + void set_id (int d) { id = d; } + + // Sets property value, notifies graphics toolkit. + // If do_run is true, runs associated listeners. + OCTINTERP_API bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); + + virtual octave_value get (void) const + { + error ("get: invalid property \"%s\"", name.c_str ()); + return octave_value (); + } + + + virtual std::string values_as_string (void) const + { + error ("values_as_string: invalid property \"%s\"", name.c_str ()); + return std::string (); + } + + virtual Cell values_as_cell (void) const + { + error ("values_as_cell: invalid property \"%s\"", name.c_str ()); + return Cell (); + } + + base_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + l.resize (l.length () + 1, v); + } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { + octave_value_list& l = listeners[mode]; + + if (v.is_defined ()) + { + bool found = false; + int i; + + for (i = 0; i < l.length (); i++) + { + if (v.internal_rep () == l(i).internal_rep ()) + { + found = true; + break; + } + } + if (found) + { + for (int j = i; j < l.length () - 1; j++) + l(j) = l(j + 1); + + l.resize (l.length () - 1); + } + } + else + { + if (mode == PERSISTENT) + l.resize (0); + else + { + octave_value_list lnew (0); + octave_value_list& lp = listeners[PERSISTENT]; + for (int i = l.length () - 1; i >= 0 ; i--) + { + for (int j = 0; j < lp.length (); j++) + { + if (l(i).internal_rep () == lp(j).internal_rep ()) + { + lnew.resize (lnew.length () + 1, l(i)); + break; + } + } + } + l = lnew; + } + } + + } + + OCTINTERP_API void run_listeners (listener_mode mode = POSTSET); + + virtual base_property* clone (void) const + { return new base_property (*this); } + +protected: + virtual bool do_set (const octave_value&) + { + error ("set: invalid property \"%s\"", name.c_str ()); + return false; + } + +private: + typedef std::map listener_map; + typedef std::map::iterator listener_map_iterator; + typedef std::map::const_iterator listener_map_const_iterator; + +private: + int id; + octave_refcount count; + std::string name; + graphics_handle parent; + bool hidden; + listener_map listeners; +}; + +// --------------------------------------------------------------------- + +class string_property : public base_property +{ +public: + string_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), str (val) { } + + string_property (const string_property& p) + : base_property (p), str (p.str) { } + + octave_value get (void) const + { return octave_value (str); } + + std::string string_value (void) const { return str; } + + string_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + std::string new_str = val.string_value (); + + if (new_str != str) + { + str = new_str; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + std::string str; +}; + +// --------------------------------------------------------------------- + +class string_array_property : public base_property +{ +public: + enum desired_enum { string_t, cell_t }; + + string_array_property (const std::string& s, const graphics_handle& h, + const std::string& val = "", const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + size_t pos = 0; + + while (true) + { + size_t new_pos = val.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + str.append (val.substr (pos)); + break; + } + else + str.append (val.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + } + + string_array_property (const std::string& s, const graphics_handle& h, + const Cell& c, const char& sep = '|', + const desired_enum& typ = string_t) + : base_property (s, h), desired_type (typ), separator (sep), str () + { + if (c.is_cellstr ()) + { + string_vector strings (c.numel ()); + + for (octave_idx_type i = 0; i < c.numel (); i++) + strings[i] = c(i).string_value (); + + str = strings; + } + else + error ("set: invalid order property value for \"%s\"", + get_name ().c_str ()); + } + + string_array_property (const string_array_property& p) + : base_property (p), desired_type (p.desired_type), + separator (p.separator), str (p.str) { } + + octave_value get (void) const + { + if (desired_type == string_t) + return octave_value (string_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + std::string s; + + for (octave_idx_type i = 0; i < str.length (); i++) + { + s += str[i]; + if (i != str.length () - 1) + s += separator; + } + + return s; + } + + Cell cell_value (void) const {return Cell (str);} + + string_vector string_vector_value (void) const { return str; } + + string_array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new string_array_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + bool replace = false; + std::string new_str = val.string_value (); + string_vector strings; + size_t pos = 0; + + while (pos != std::string::npos) + { + size_t new_pos = new_str.find_first_of (separator, pos); + + if (new_pos == std::string::npos) + { + strings.append (new_str.substr (pos)); + break; + } + else + strings.append (new_str.substr (pos, new_pos - pos)); + + pos = new_pos + 1; + } + + if (str.numel () == strings.numel ()) + { + for (octave_idx_type i = 0; i < str.numel (); i++) + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + else + replace = true; + + desired_type = string_t; + + if (replace) + { + str = strings; + return true; + } + } + else if (val.is_cellstr ()) + { + bool replace = false; + Cell new_cell = val.cell_value (); + + string_vector strings = new_cell.cellstr_value (); + + octave_idx_type nel = strings.length (); + + if (nel != str.length ()) + replace = true; + else + { + for (octave_idx_type i = 0; i < nel; i++) + { + if (strings[i] != str[i]) + { + replace = true; + break; + } + } + } + + desired_type = cell_t; + + if (replace) + { + str = strings; + return true; + } + } + else + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + desired_enum desired_type; + char separator; + string_vector str; +}; + +// --------------------------------------------------------------------- + +class text_label_property : public base_property +{ +public: + enum type { char_t, cellstr_t }; + + text_label_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), value (val), stored_type (char_t) + { } + + text_label_property (const std::string& s, const graphics_handle& h, + const NDArray& nda) + : base_property (s, h), stored_type (char_t) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + } + + text_label_property (const std::string& s, const graphics_handle& h, + const Cell& c) + : base_property (s, h), stored_type (cellstr_t) + { + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + break; + } + } + } + + text_label_property (const text_label_property& p) + : base_property (p), value (p.value), stored_type (p.stored_type) + { } + + bool empty (void) const + { + octave_value tmp = get (); + return tmp.is_empty (); + } + + octave_value get (void) const + { + if (stored_type == char_t) + return octave_value (char_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + return value.empty () ? std::string () : value[0]; + } + + string_vector string_vector_value (void) const { return value; } + + charMatrix char_value (void) const { return charMatrix (value, ' '); } + + Cell cell_value (void) const {return Cell (value); } + + text_label_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new text_label_property (*this); } + +protected: + + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + value = val.all_strings (); + + stored_type = char_t; + } + else if (val.is_cell ()) + { + Cell c = val.cell_value (); + + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + return false; + } + } + + stored_type = cellstr_t; + } + else + { + NDArray nda = val.array_value (); + + if (! error_state) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + + stored_type = char_t; + } + else + { + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + + return false; + } + } + + return true; + } + +private: + string_vector value; + type stored_type; +}; + +// --------------------------------------------------------------------- + +class radio_values +{ +public: + OCTINTERP_API radio_values (const std::string& opt_string = std::string ()); + + radio_values (const radio_values& a) + : default_val (a.default_val), possible_vals (a.possible_vals) { } + + radio_values& operator = (const radio_values& a) + { + if (&a != this) + { + default_val = a.default_val; + possible_vals = a.possible_vals; + } + + return *this; + } + + std::string default_value (void) const { return default_val; } + + bool validate (const std::string& val, std::string& match) + { + bool retval = true; + + if (! contains (val, match)) + { + error ("invalid value = %s", val.c_str ()); + retval = false; + } + + return retval; + } + + bool contains (const std::string& val, std::string& match) + { + size_t k = 0; + + size_t len = val.length (); + + std::string first_match; + + for (std::set::const_iterator p = possible_vals.begin (); + p != possible_vals.end (); p++) + { + if (p->compare (val, len)) + { + if (len == p->length ()) + { + // We found a full match (consider the case of val == + // "replace" with possible values "replace" and + // "replacechildren"). Any other matches are + // irrelevant, so set match and return now. + + match = *p; + return true; + } + else + { + if (k == 0) + first_match = *p; + + k++; + } + } + } + + if (k == 1) + { + match = first_match; + return true; + } + else + return false; + } + + std::string values_as_string (void) const; + + Cell values_as_cell (void) const; + + octave_idx_type nelem (void) const { return possible_vals.size (); } + +private: + // Might also want to cache + std::string default_val; + std::set possible_vals; +}; + +class radio_property : public base_property +{ +public: + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v = radio_values ()) + : base_property (nm, h), + vals (v), current_val (v.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + vals (v), current_val (vals.default_value ()) { } + + radio_property (const std::string& nm, const graphics_handle& h, + const radio_values& v, const std::string& def) + : base_property (nm, h), + vals (v), current_val (def) { } + + radio_property (const radio_property& p) + : base_property (p), vals (p.vals), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + const std::string& current_value (void) const { return current_val; } + + std::string values_as_string (void) const { return vals.values_as_string (); } + + Cell values_as_cell (void) const { return vals.values_as_cell (); } + + bool is (const caseless_str& v) const + { return v.compare (current_val); } + + bool is_radio (void) const { return true; } + + radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new radio_property (*this); } + +protected: + bool do_set (const octave_value& newval) + { + if (newval.is_string ()) + { + std::string s = newval.string_value (); + + std::string match; + + if (vals.validate (s, match)) + { + if (match != current_val) + { + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; + return true; + } + } + else + error ("set: invalid value for radio property \"%s\" (value = %s)", + get_name ().c_str (), s.c_str ()); + } + else + error ("set: invalid value for radio property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + radio_values vals; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class color_values +{ +public: + color_values (double r = 0, double g = 0, double b = 1) + : xrgb (1, 3) + { + xrgb(0) = r; + xrgb(1) = g; + xrgb(2) = b; + + validate (); + } + + color_values (std::string str) + : xrgb (1, 3) + { + if (! str2rgb (str)) + error ("invalid color specification: %s", str.c_str ()); + } + + color_values (const color_values& c) + : xrgb (c.xrgb) + { } + + color_values& operator = (const color_values& c) + { + if (&c != this) + xrgb = c.xrgb; + + return *this; + } + + bool operator == (const color_values& c) const + { + return (xrgb(0) == c.xrgb(0) + && xrgb(1) == c.xrgb(1) + && xrgb(2) == c.xrgb(2)); + } + + bool operator != (const color_values& c) const + { return ! (*this == c); } + + Matrix rgb (void) const { return xrgb; } + + operator octave_value (void) const { return xrgb; } + + void validate (void) const + { + for (int i = 0; i < 3; i++) + { + if (xrgb(i) < 0 || xrgb(i) > 1) + { + error ("invalid RGB color specification"); + break; + } + } + } + +private: + Matrix xrgb; + + OCTINTERP_API bool str2rgb (std::string str); +}; + +class color_property : public base_property +{ +public: + color_property (const color_values& c, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_values& c = color_values (), + const radio_values& v = radio_values ()) + : base_property (nm, h), + current_type (color_t), color_val (c), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const radio_values& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (v.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), color_val (color_values ()), radio_val (v), + current_val (radio_val.default_value ()) + { } + + color_property (const std::string& nm, const graphics_handle& h, + const color_property& v) + : base_property (nm, h), + current_type (v.current_type), color_val (v.color_val), + radio_val (v.radio_val), current_val (v.current_val) + { } + + color_property (const color_property& p) + : base_property (p), current_type (p.current_type), + color_val (p.color_val), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == color_t) + return color_val.rgb (); + + return current_val; + } + + bool is_rgb (void) const { return (current_type == color_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + Matrix rgb (void) const + { + if (current_type != color_t) + error ("color has no rgb value"); + + return color_val.rgb (); + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("color has no radio value"); + + return current_val; + } + + color_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const { return new color_property (*this); } + + std::string values_as_string (void) const { return radio_val.values_as_string (); } + + Cell values_as_cell (void) const { return radio_val.values_as_cell (); } + +protected: + OCTINTERP_API bool do_set (const octave_value& newval); + +private: + enum current_enum { color_t, radio_t } current_type; + color_values color_val; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class double_property : public base_property +{ +public: + double_property (const std::string& nm, const graphics_handle& h, + double d = 0) + : base_property (nm, h), + current_val (d) { } + + double_property (const double_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return octave_value (current_val); } + + double double_value (void) const { return current_val; } + + double_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new double_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (v.is_scalar_type () && v.is_real_type ()) + { + double new_val = v.double_value (); + + if (new_val != current_val) + { + current_val = new_val; + return true; + } + } + else + error ("set: invalid value for double property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + double current_val; +}; + +// --------------------------------------------------------------------- + +class double_radio_property : public base_property +{ +public: + double_radio_property (double d, const radio_values& v) + : base_property ("", graphics_handle ()), + current_type (double_t), dval (d), radio_val (v), + current_val (v.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const std::string& v) + : base_property (nm, h), + current_type (radio_t), dval (0), radio_val (v), + current_val (radio_val.default_value ()) + { } + + double_radio_property (const std::string& nm, const graphics_handle& h, + const double_radio_property& v) + : base_property (nm, h), + current_type (v.current_type), dval (v.dval), + radio_val (v.radio_val), current_val (v.current_val) + { } + + double_radio_property (const double_radio_property& p) + : base_property (p), current_type (p.current_type), + dval (p.dval), radio_val (p.radio_val), + current_val (p.current_val) { } + + octave_value get (void) const + { + if (current_type == double_t) + return dval; + + return current_val; + } + + bool is_double (void) const { return (current_type == double_t); } + + bool is_radio (void) const { return (current_type == radio_t); } + + bool is (const std::string& v) const + { return (is_radio () && current_val == v); } + + double double_value (void) const + { + if (current_type != double_t) + error ("%s: property has no double", get_name ().c_str ()); + + return dval; + } + + const std::string& current_value (void) const + { + if (current_type != radio_t) + error ("%s: property has no radio value"); + + return current_val; + } + + double_radio_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + operator octave_value (void) const { return get (); } + + base_property* clone (void) const + { return new double_radio_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + enum current_enum { double_t, radio_t } current_type; + double dval; + radio_values radio_val; + std::string current_val; +}; + +// --------------------------------------------------------------------- + +class array_property : public base_property +{ +public: + array_property (void) + : base_property ("", graphics_handle ()), data (Matrix ()), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + array_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), data (m), + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () + { + get_data_limits (); + } + + // This copy constructor is only intended to be used + // internally to access min/max values; no need to + // copy constraints. + array_property (const array_property& p) + : base_property (p), data (p.data), + xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), + type_constraints (), size_constraints () + { } + + octave_value get (void) const { return data; } + + void add_constraint (const std::string& type) + { type_constraints.insert (type); } + + void add_constraint (const dim_vector& dims) + { size_constraints.push_back (dims); } + + double min_val (void) const { return xmin; } + double max_val (void) const { return xmax; } + double min_pos (void) const { return xminp; } + double max_neg (void) const { return xmaxp; } + + Matrix get_limits (void) const + { + Matrix m (1, 4); + + m(0) = min_val (); + m(1) = max_val (); + m(2) = min_pos (); + m(3) = max_neg (); + + return m; + } + + array_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + array_property *p = new array_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + if (validate (v)) + { + // FIXME -- should we check for actual data change? + if (! is_equal (v)) + { + data = v; + + get_data_limits (); + + return true; + } + } + else + error ("invalid value for array property \"%s\"", + get_name ().c_str ()); + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); + + OCTINTERP_API bool is_equal (const octave_value& v) const; + + OCTINTERP_API void get_data_limits (void); + +protected: + octave_value data; + double xmin; + double xmax; + double xminp; + double xmaxp; + std::set type_constraints; + std::list size_constraints; +}; + +class row_vector_property : public array_property +{ +public: + row_vector_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : array_property (nm, h, m) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + row_vector_property (const row_vector_property& p) + : array_property (p) + { + add_constraint (dim_vector (-1, 1)); + add_constraint (dim_vector (1, -1)); + } + + void add_constraint (const std::string& type) + { + array_property::add_constraint (type); + } + + void add_constraint (const dim_vector& dims) + { + array_property::add_constraint (dims); + } + + void add_constraint (octave_idx_type len) + { + size_constraints.remove (dim_vector (1, -1)); + size_constraints.remove (dim_vector (-1, 1)); + + add_constraint (dim_vector (1, len)); + add_constraint (dim_vector (len, 1)); + } + + row_vector_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const + { + row_vector_property *p = new row_vector_property (*this); + + p->type_constraints = type_constraints; + p->size_constraints = size_constraints; + + return p; + } + +protected: + bool do_set (const octave_value& v) + { + bool retval = array_property::do_set (v); + + if (! error_state) + { + dim_vector dv = data.dims (); + + if (dv(0) > 1 && dv(1) == 1) + { + int tmp = dv(0); + dv(0) = dv(1); + dv(1) = tmp; + + data = data.reshape (dv); + } + + return retval; + } + + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v); +}; + +// --------------------------------------------------------------------- + +class bool_property : public radio_property +{ +public: + bool_property (const std::string& nm, const graphics_handle& h, + bool val) + : radio_property (nm, h, radio_values (val ? "{on}|off" : "on|{off}")) + { } + + bool_property (const std::string& nm, const graphics_handle& h, + const char* val) + : radio_property (nm, h, radio_values ("on|off"), val) + { } + + bool_property (const bool_property& p) + : radio_property (p) { } + + bool is_on (void) const { return is ("on"); } + + bool_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new bool_property (*this); } + +protected: + bool do_set (const octave_value& val) + { + if (val.is_bool_scalar ()) + return radio_property::do_set (val.bool_value () ? "on" : "off"); + else + return radio_property::do_set (val); + } +}; + +// --------------------------------------------------------------------- + +class handle_property : public base_property +{ +public: + handle_property (const std::string& nm, const graphics_handle& h, + const graphics_handle& val = graphics_handle ()) + : base_property (nm, h), + current_val (val) { } + + handle_property (const handle_property& p) + : base_property (p), current_val (p.current_val) { } + + octave_value get (void) const { return current_val.as_octave_value (); } + + graphics_handle handle_value (void) const { return current_val; } + + handle_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + handle_property& operator = (const graphics_handle& h) + { + set (octave_value (h.value ())); + return *this; + } + + base_property* clone (void) const { return new handle_property (*this); } + +protected: + OCTINTERP_API bool do_set (const octave_value& v); + +private: + graphics_handle current_val; +}; + +// --------------------------------------------------------------------- + +class any_property : public base_property +{ +public: + any_property (const std::string& nm, const graphics_handle& h, + const octave_value& m = Matrix ()) + : base_property (nm, h), data (m) { } + + any_property (const any_property& p) + : base_property (p), data (p.data) { } + + octave_value get (void) const { return data; } + + any_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new any_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + data = v; + return true; + } + +private: + octave_value data; +}; + +// --------------------------------------------------------------------- + +class children_property : public base_property +{ +public: + children_property (void) + : base_property ("", graphics_handle ()), children_list () + { + do_init_children (Matrix ()); + } + + children_property (const std::string& nm, const graphics_handle& h, + const Matrix &val) + : base_property (nm, h), children_list () + { + do_init_children (val); + } + + children_property (const children_property& p) + : base_property (p), children_list () + { + do_init_children (p.children_list); + } + + children_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new children_property (*this); } + + bool remove_child (const double &val) + { + return do_remove_child (val); + } + + void adopt (const double &val) + { + do_adopt_child (val); + } + + Matrix get_children (void) const + { + return do_get_children (false); + } + + Matrix get_hidden (void) const + { + return do_get_children (true); + } + + Matrix get_all (void) const + { + return do_get_all_children (); + } + + octave_value get (void) const + { + return octave_value (get_children ()); + } + + void delete_children (bool clear = false) + { + do_delete_children (clear); + } + + void renumber (graphics_handle old_gh, graphics_handle new_gh) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == old_gh) + { + *p = new_gh.value (); + return; + } + } + + error ("children_list::renumber: child not found!"); + } + +private: + typedef std::list::iterator children_list_iterator; + typedef std::list::const_iterator const_children_list_iterator; + std::list children_list; + +protected: + bool do_set (const octave_value& val) + { + const Matrix new_kids = val.matrix_value (); + + octave_idx_type nel = new_kids.numel (); + + const Matrix new_kids_column = new_kids.reshape (dim_vector (nel, 1)); + + bool is_ok = true; + + if (! error_state) + { + const Matrix visible_kids = do_get_children (false); + + if (visible_kids.numel () == new_kids.numel ()) + { + Matrix t1 = visible_kids.sort (); + Matrix t2 = new_kids_column.sort (); + + if (t1 != t2) + is_ok = false; + } + else + is_ok = false; + + if (! is_ok) + error ("set: new children must be a permutation of existing children"); + } + else + { + is_ok = false; + error ("set: expecting children to be array of graphics handles"); + } + + if (is_ok) + { + Matrix tmp = new_kids_column.stack (get_hidden ()); + + children_list.clear (); + + // Don't use do_init_children here, as that reverses the + // order of the list, and we don't want to do that if setting + // the child list directly. + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + children_list.push_back (tmp.xelem (i)); + } + + return is_ok; + } + +private: + void do_init_children (const Matrix &val) + { + children_list.clear (); + for (octave_idx_type i = 0; i < val.numel (); i++) + children_list.push_front (val.xelem (i)); + } + + void do_init_children (const std::list &val) + { + children_list.clear (); + for (const_children_list_iterator p = val.begin (); p != val.end (); p++) + children_list.push_front (*p); + } + + Matrix do_get_children (bool return_hidden) const; + + Matrix do_get_all_children (void) const + { + Matrix retval (children_list.size (), 1); + octave_idx_type i = 0; + + for (const_children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + retval(i++) = *p; + return retval; + } + + bool do_remove_child (double child) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == child) + { + children_list.erase (p); + return true; + } + } + return false; + } + + void do_adopt_child (const double &val) + { + children_list.push_front (val); + } + + void do_delete_children (bool clear); +}; + + + +// --------------------------------------------------------------------- + +class callback_property : public base_property +{ +public: + callback_property (const std::string& nm, const graphics_handle& h, + const octave_value& m) + : base_property (nm, h), callback (m), executing (false) { } + + callback_property (const callback_property& p) + : base_property (p), callback (p.callback), executing (false) { } + + octave_value get (void) const { return callback; } + + OCTINTERP_API void execute (const octave_value& data = octave_value ()) const; + + bool is_defined (void) const + { + return (callback.is_defined () && ! callback.is_empty ()); + } + + callback_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new callback_property (*this); } + +protected: + bool do_set (const octave_value& v) + { + if (validate (v)) + { + callback = v; + return true; + } + else + error ("invalid value for callback property \"%s\"", + get_name ().c_str ()); + return false; + } + +private: + OCTINTERP_API bool validate (const octave_value& v) const; + +private: + octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; +}; + +// --------------------------------------------------------------------- + +class property +{ +public: + property (void) : rep (new base_property ("", graphics_handle ())) + { } + + property (base_property *bp, bool persist = false) : rep (bp) + { if (persist) rep->count++; } + + property (const property& p) : rep (p.rep) + { + rep->count++; + } + + ~property (void) + { + if (--rep->count == 0) + delete rep; + } + + bool ok (void) const + { return rep->ok (); } + + std::string get_name (void) const + { return rep->get_name (); } + + void set_name (const std::string& name) + { rep->set_name (name); } + + graphics_handle get_parent (void) const + { return rep->get_parent (); } + + void set_parent (const graphics_handle& h) + { rep->set_parent (h); } + + bool is_hidden (void) const + { return rep->is_hidden (); } + + void set_hidden (bool flag) + { rep->set_hidden (flag); } + + bool is_radio (void) const + { return rep->is_radio (); } + + int get_id (void) const + { return rep->get_id (); } + + void set_id (int d) + { rep->set_id (d); } + + octave_value get (void) const + { return rep->get (); } + + bool set (const octave_value& val, bool do_run = true, + bool do_notify_toolkit = true) + { return rep->set (val, do_run, do_notify_toolkit); } + + std::string values_as_string (void) const + { return rep->values_as_string (); } + + Cell values_as_cell (void) const + { return rep->values_as_cell (); } + + property& operator = (const octave_value& val) + { + *rep = val; + return *this; + } + + property& operator = (const property& p) + { + if (rep && --rep->count == 0) + delete rep; + + rep = p.rep; + rep->count++; + + return *this; + } + + void add_listener (const octave_value& v, listener_mode mode = POSTSET) + { rep->add_listener (v, mode); } + + void delete_listener (const octave_value& v = octave_value (), + listener_mode mode = POSTSET) + { rep->delete_listener (v, mode); } + + void run_listeners (listener_mode mode = POSTSET) + { rep->run_listeners (mode); } + + OCTINTERP_API static + property create (const std::string& name, const graphics_handle& parent, + const caseless_str& type, + const octave_value_list& args); + + property clone (void) const + { return property (rep->clone ()); } + + /* + const string_property& as_string_property (void) const + { return *(dynamic_cast (rep)); } + + const radio_property& as_radio_property (void) const + { return *(dynamic_cast (rep)); } + + const color_property& as_color_property (void) const + { return *(dynamic_cast (rep)); } + + const double_property& as_double_property (void) const + { return *(dynamic_cast (rep)); } + + const bool_property& as_bool_property (void) const + { return *(dynamic_cast (rep)); } + + const handle_property& as_handle_property (void) const + { return *(dynamic_cast (rep)); } + */ + +private: + base_property *rep; +}; + +// --------------------------------------------------------------------- + +class property_list +{ +public: + typedef std::map pval_map_type; + typedef std::map plist_map_type; + + typedef pval_map_type::iterator pval_map_iterator; + typedef pval_map_type::const_iterator pval_map_const_iterator; + + typedef plist_map_type::iterator plist_map_iterator; + typedef plist_map_type::const_iterator plist_map_const_iterator; + + property_list (const plist_map_type& m = plist_map_type ()) + : plist_map (m) { } + + ~property_list (void) { } + + void set (const caseless_str& name, const octave_value& val); + + octave_value lookup (const caseless_str& name) const; + + plist_map_iterator begin (void) { return plist_map.begin (); } + plist_map_const_iterator begin (void) const { return plist_map.begin (); } + + plist_map_iterator end (void) { return plist_map.end (); } + plist_map_const_iterator end (void) const { return plist_map.end (); } + + plist_map_iterator find (const std::string& go_name) + { + return plist_map.find (go_name); + } + + plist_map_const_iterator find (const std::string& go_name) const + { + return plist_map.find (go_name); + } + + octave_scalar_map as_struct (const std::string& prefix_arg) const; + +private: + plist_map_type plist_map; +}; + +// --------------------------------------------------------------------- + +class graphics_toolkit; +class graphics_object; + +class base_graphics_toolkit +{ +public: + friend class graphics_toolkit; + +public: + base_graphics_toolkit (const std::string& nm) + : name (nm), count (0) { } + + virtual ~base_graphics_toolkit (void) { } + + std::string get_name (void) const { return name; } + + virtual bool is_valid (void) const { return false; } + + virtual void redraw_figure (const graphics_object&) const + { gripe_invalid ("redraw_figure"); } + + virtual void print_figure (const graphics_object&, const std::string&, + const std::string&, bool, + const std::string& = "") const + { gripe_invalid ("print_figure"); } + + virtual Matrix get_canvas_size (const graphics_handle&) const + { + gripe_invalid ("get_canvas_size"); + return Matrix (1, 2, 0.0); + } + + virtual double get_screen_resolution (void) const + { + gripe_invalid ("get_screen_resolution"); + return 72.0; + } + + virtual Matrix get_screen_size (void) const + { + gripe_invalid ("get_screen_size"); + return Matrix (1, 2, 0.0); + } + + // Callback function executed when the given graphics object + // changes. This allows the graphics toolkit to act on property + // changes if needed. + virtual void update (const graphics_object&, int) + { gripe_invalid ("base_graphics_toolkit::update"); } + + void update (const graphics_handle&, int); + + // Callback function executed when the given graphics object is + // created. This allows the graphics toolkit to do toolkit-specific + // initializations for a newly created object. + virtual bool initialize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } + + bool initialize (const graphics_handle&); + + // Callback function executed just prior to deleting the given + // graphics object. This allows the graphics toolkit to perform + // toolkit-specific cleanup operations before an object is deleted. + virtual void finalize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::finalize"); } + + void finalize (const graphics_handle&); + + // Close the graphics toolkit. + virtual void close (void) + { gripe_invalid ("base_graphics_toolkit::close"); } + +private: + std::string name; + octave_refcount count; + +private: + void gripe_invalid (const std::string& fname) const + { + if (! is_valid ()) + error ("%s: invalid graphics toolkit", fname.c_str ()); + } +}; + +class graphics_toolkit +{ +public: + graphics_toolkit (void) + : rep (new base_graphics_toolkit ("unknown")) + { + rep->count++; + } + + graphics_toolkit (base_graphics_toolkit* b) + : rep (b) + { + rep->count++; + } + + graphics_toolkit (const graphics_toolkit& b) + : rep (b.rep) + { + rep->count++; + } + + ~graphics_toolkit (void) + { + if (--rep->count == 0) + delete rep; + } + + graphics_toolkit& operator = (const graphics_toolkit& b) + { + if (rep != b.rep) + { + if (--rep->count == 0) + delete rep; + + rep = b.rep; + rep->count++; + } + + return *this; + } + + operator bool (void) const { return rep->is_valid (); } + + std::string get_name (void) const { return rep->get_name (); } + + void redraw_figure (const graphics_object& go) const + { rep->redraw_figure (go); } + + void print_figure (const graphics_object& go, const std::string& term, + const std::string& file, bool mono, + const std::string& debug_file = "") const + { rep->print_figure (go, term, file, mono, debug_file); } + + Matrix get_canvas_size (const graphics_handle& fh) const + { return rep->get_canvas_size (fh); } + + double get_screen_resolution (void) const + { return rep->get_screen_resolution (); } + + Matrix get_screen_size (void) const + { return rep->get_screen_size (); } + + // Notifies graphics toolkit that object't property has changed. + void update (const graphics_object& go, int id) + { rep->update (go, id); } + + void update (const graphics_handle& h, int id) + { rep->update (h, id); } + + // Notifies graphics toolkit that new object was created. + bool initialize (const graphics_object& go) + { return rep->initialize (go); } + + bool initialize (const graphics_handle& h) + { return rep->initialize (h); } + + // Notifies graphics toolkit that object was destroyed. + // This is called only for explicitly deleted object. Children are + // deleted implicitly and graphics toolkit isn't notified. + void finalize (const graphics_object& go) + { rep->finalize (go); } + + void finalize (const graphics_handle& h) + { rep->finalize (h); } + + // Close the graphics toolkit. + void close (void) { rep->close (); } + +private: + + base_graphics_toolkit *rep; +}; + +class gtk_manager +{ +public: + + static graphics_toolkit get_toolkit (void) + { + return instance_ok () ? instance->do_get_toolkit () : graphics_toolkit (); + } + + static void register_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_register_toolkit (name); + } + + static void unregister_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unregister_toolkit (name); + } + + static void load_toolkit (const graphics_toolkit& tk) + { + if (instance_ok ()) + instance->do_load_toolkit (tk); + } + + static void unload_toolkit (const std::string& name) + { + if (instance_ok ()) + instance->do_unload_toolkit (name); + } + + static graphics_toolkit find_toolkit (const std::string& name) + { + return instance_ok () + ? instance->do_find_toolkit (name) : graphics_toolkit (); + } + + static Cell available_toolkits_list (void) + { + return instance_ok () ? instance->do_available_toolkits_list () : Cell (); + } + + static Cell loaded_toolkits_list (void) + { + return instance_ok () ? instance->do_loaded_toolkits_list () : Cell (); + } + + static void unload_all_toolkits (void) + { + if (instance_ok ()) + instance->do_unload_all_toolkits (); + } + + static std::string default_toolkit (void) + { + return instance_ok () ? instance->do_default_toolkit () : std::string (); + } + +private: + + // FIXME -- default toolkit should be configurable. + + gtk_manager (void) + : dtk ("gnuplot"), available_toolkits (), loaded_toolkits () { } + + ~gtk_manager (void) { } + + OCTINTERP_API static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + OCTINTERP_API static gtk_manager *instance; + + // The name of the default toolkit. + std::string dtk; + + // The list of toolkits that we know about. + std::set available_toolkits; + + // The list of toolkits we have actually loaded. + std::map loaded_toolkits; + + typedef std::set::iterator available_toolkits_iterator; + + typedef std::set::const_iterator + const_available_toolkits_iterator; + + typedef std::map::iterator + loaded_toolkits_iterator; + + typedef std::map::const_iterator + const_loaded_toolkits_iterator; + + graphics_toolkit do_get_toolkit (void) const; + + void do_register_toolkit (const std::string& name) + { + available_toolkits.insert (name); + } + + void do_unregister_toolkit (const std::string& name) + { + available_toolkits.erase (name); + } + + void do_load_toolkit (const graphics_toolkit& tk) + { + loaded_toolkits[tk.get_name ()] = tk; + } + + void do_unload_toolkit (const std::string& name) + { + loaded_toolkits.erase (name); + } + + graphics_toolkit do_find_toolkit (const std::string& name) const + { + const_loaded_toolkits_iterator p = loaded_toolkits.find (name); + + if (p != loaded_toolkits.end ()) + return p->second; + else + return graphics_toolkit (); + } + + Cell do_available_toolkits_list (void) const + { + Cell m (1 , available_toolkits.size ()); + + octave_idx_type i = 0; + for (const_available_toolkits_iterator p = available_toolkits.begin (); + p != available_toolkits.end (); p++) + m(i++) = *p; + + return m; + } + + Cell do_loaded_toolkits_list (void) const + { + Cell m (1 , loaded_toolkits.size ()); + + octave_idx_type i = 0; + for (const_loaded_toolkits_iterator p = loaded_toolkits.begin (); + p != loaded_toolkits.end (); p++) + m(i++) = p->first; + + return m; + } + + void do_unload_all_toolkits (void) + { + while (! loaded_toolkits.empty ()) + { + loaded_toolkits_iterator p = loaded_toolkits.begin (); + + std::string name = p->first; + + p->second.close (); + + // The toolkit may have unloaded itself. If not, we'll do + // it here. + if (loaded_toolkits.find (name) != loaded_toolkits.end ()) + unload_toolkit (name); + } + } + + std::string do_default_toolkit (void) { return dtk; } +}; + +// --------------------------------------------------------------------- + +class base_graphics_object; +class graphics_object; + +class OCTINTERP_API base_properties +{ +public: + base_properties (const std::string& ty = "unknown", + const graphics_handle& mh = graphics_handle (), + const graphics_handle& p = graphics_handle ()); + + virtual ~base_properties (void) { } + + virtual std::string graphics_object_name (void) const { return "unknonwn"; } + + void mark_modified (void); + + void override_defaults (base_graphics_object& obj); + + virtual void init_integerhandle (const octave_value&) + { + panic_impossible (); + } + + // Look through DEFAULTS for properties with given CLASS_NAME, and + // apply them to the current object with set (virtual method). + + void set_from_list (base_graphics_object& obj, property_list& defaults); + + void insert_property (const std::string& name, property p) + { + p.set_name (name); + p.set_parent (__myhandle__); + all_props[name] = p; + } + + virtual void set (const caseless_str&, const octave_value&); + + virtual octave_value get (const caseless_str& pname) const; + + virtual octave_value get (const std::string& pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (const char *pname) const + { + return get (caseless_str (pname)); + } + + virtual octave_value get (bool all = false) const; + + virtual property get_property (const caseless_str& pname); + + virtual bool has_property (const caseless_str&) const + { + panic_impossible (); + return false; + } + + bool is_modified (void) const { return is___modified__ (); } + + virtual void remove_child (const graphics_handle& h) + { + if (children.remove_child (h.value ())) + mark_modified (); + } + + virtual void adopt (const graphics_handle& h) + { + children.adopt (h.value ()); + mark_modified (); + } + + virtual graphics_toolkit get_toolkit (void) const; + + virtual Matrix get_boundingbox (bool /*internal*/ = false, + const Matrix& /*parent_pix_size*/ = Matrix ()) const + { return Matrix (1, 4, 0.0); } + + virtual void update_boundingbox (void); + + virtual void update_autopos (const std::string& elem_type); + + virtual void add_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + virtual void delete_listener (const caseless_str&, const octave_value&, + listener_mode = POSTSET); + + void set_tag (const octave_value& val) { tag = val; } + + void set_parent (const octave_value& val); + + Matrix get_children (void) const + { + return children.get_children (); + } + + Matrix get_all_children (void) const + { + return children.get_all (); + } + + Matrix get_hidden_children (void) const + { + return children.get_hidden (); + } + + void set_modified (const octave_value& val) { set___modified__ (val); } + + void set___modified__ (const octave_value& val) { __modified__ = val; } + + void reparent (const graphics_handle& new_parent) { parent = new_parent; } + + // Update data limits for AXIS_TYPE (xdata, ydata, etc.) in the parent + // axes object. + + virtual void update_axis_limits (const std::string& axis_type) const; + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) const; + + virtual void delete_children (bool clear = false) + { + children.delete_children (clear); + } + + void renumber_child (graphics_handle old_gh, graphics_handle new_gh) + { + children.renumber (old_gh, new_gh); + } + + void renumber_parent (graphics_handle new_gh) + { + parent = new_gh; + } + + static property_list::pval_map_type factory_defaults (void); + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_BASE_PROPERTIES_GET_FUNCTIONS + + virtual octave_value get_xlim (void) const { return octave_value (); } + virtual octave_value get_ylim (void) const { return octave_value (); } + virtual octave_value get_zlim (void) const { return octave_value (); } + virtual octave_value get_clim (void) const { return octave_value (); } + virtual octave_value get_alim (void) const { return octave_value (); } + + virtual bool is_xliminclude (void) const { return false; } + virtual bool is_yliminclude (void) const { return false; } + virtual bool is_zliminclude (void) const { return false; } + virtual bool is_climinclude (void) const { return false; } + virtual bool is_aliminclude (void) const { return false; } + + bool is_handle_visible (void) const; + + std::set dynamic_property_names (void) const; + + bool has_dynamic_property (const std::string& pname); + +protected: + std::set dynamic_properties; + + void set_dynamic (const caseless_str& pname, const octave_value& val); + + octave_value get_dynamic (const caseless_str& pname) const; + + octave_value get_dynamic (bool all = false) const; + + property get_property_dynamic (const caseless_str& pname); + + BEGIN_BASE_PROPERTIES + // properties common to all objects + bool_property beingdeleted , "off" + radio_property busyaction , "{queue}|cancel" + callback_property buttondownfcn , Matrix () + children_property children gf , Matrix () + bool_property clipping , "on" + callback_property createfcn , Matrix () + callback_property deletefcn , Matrix () + radio_property handlevisibility , "{on}|callback|off" + bool_property hittest , "on" + bool_property interruptible , "on" + handle_property parent fs , p + bool_property selected , "off" + bool_property selectionhighlight , "on" + string_property tag s , "" + string_property type frs , ty + any_property userdata , Matrix () + bool_property visible , "on" + // additional (octave-specific) properties + bool_property __modified__ s , "on" + graphics_handle __myhandle__ fhrs , mh + // FIXME -- should this really be here? + handle_property uicontextmenu , graphics_handle () + END_PROPERTIES + +protected: + struct cmp_caseless_str + { + bool operator () (const caseless_str &a, const caseless_str &b) const + { + std::string a1 = a; + std::transform (a1.begin (), a1.end (), a1.begin (), tolower); + std::string b1 = b; + std::transform (b1.begin (), b1.end (), b1.begin (), tolower); + + return a1 < b1; + } + }; + + std::map all_props; + +protected: + void insert_static_property (const std::string& name, base_property& p) + { insert_property (name, property (&p, true)); } + + virtual void init (void) { } +}; + +class OCTINTERP_API base_graphics_object +{ +public: + friend class graphics_object; + + base_graphics_object (void) : count (1), toolkit_flag (false) { } + + virtual ~base_graphics_object (void) { } + + virtual void mark_modified (void) + { + if (valid_object ()) + get_properties ().mark_modified (); + else + error ("base_graphics_object::mark_modified: invalid graphics object"); + } + + virtual void override_defaults (base_graphics_object& obj) + { + if (valid_object ()) + get_properties ().override_defaults (obj); + else + error ("base_graphics_object::override_defaults: invalid graphics object"); + } + + virtual void set_from_list (property_list& plist) + { + if (valid_object ()) + get_properties ().set_from_list (*this, plist); + else + error ("base_graphics_object::set_from_list: invalid graphics object"); + } + + virtual void set (const caseless_str& pname, const octave_value& pval) + { + if (valid_object ()) + get_properties ().set (pname, pval); + else + error ("base_graphics_object::set: invalid graphics object"); + } + + virtual void set_defaults (const std::string&) + { + error ("base_graphics_object::set_defaults: invalid graphics object"); + } + + virtual octave_value get (bool all = false) const + { + if (valid_object ()) + return get_properties ().get (all); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get (const caseless_str& pname) const + { + if (valid_object ()) + return get_properties ().get (pname); + else + { + error ("base_graphics_object::get: invalid graphics object"); + return octave_value (); + } + } + + virtual octave_value get_default (const caseless_str&) const; + + virtual octave_value get_factory_default (const caseless_str&) const; + + virtual octave_value get_defaults (void) const + { + error ("base_graphics_object::get_defaults: invalid graphics object"); + return octave_value (); + } + + virtual octave_value get_factory_defaults (void) const + { + error ("base_graphics_object::get_factory_defaults: invalid graphics object"); + return octave_value (); + } + + virtual std::string values_as_string (void); + + virtual octave_scalar_map values_as_struct (void); + + virtual graphics_handle get_parent (void) const + { + if (valid_object ()) + return get_properties ().get_parent (); + else + { + error ("base_graphics_object::get_parent: invalid graphics object"); + return graphics_handle (); + } + } + + graphics_handle get_handle (void) const + { + if (valid_object ()) + return get_properties ().get___myhandle__ (); + else + { + error ("base_graphics_object::get_handle: invalid graphics object"); + return graphics_handle (); + } + } + + virtual void remove_child (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().remove_child (h); + else + error ("base_graphics_object::remove_child: invalid graphics object"); + } + + virtual void adopt (const graphics_handle& h) + { + if (valid_object ()) + get_properties ().adopt (h); + else + error ("base_graphics_object::adopt: invalid graphics object"); + } + + virtual void reparent (const graphics_handle& np) + { + if (valid_object ()) + get_properties ().reparent (np); + else + error ("base_graphics_object::reparent: invalid graphics object"); + } + + virtual void defaults (void) const + { + if (valid_object ()) + { + std::string msg = (type () + "::defaults"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + + virtual base_properties& get_properties (void) + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual const base_properties& get_properties (void) const + { + static base_properties properties; + error ("base_graphics_object::get_properties: invalid graphics object"); + return properties; + } + + virtual void update_axis_limits (const std::string& axis_type); + + virtual void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + virtual bool valid_object (void) const { return false; } + + bool valid_toolkit_object (void) const { return toolkit_flag; } + + virtual std::string type (void) const + { + return (valid_object () ? get_properties ().graphics_object_name () + : "unknown"); + } + + bool isa (const std::string& go_name) const + { + return type () == go_name; + } + + virtual graphics_toolkit get_toolkit (void) const + { + if (valid_object ()) + return get_properties ().get_toolkit (); + else + { + error ("base_graphics_object::get_toolkit: invalid graphics object"); + return graphics_toolkit (); + } + } + + virtual void add_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().add_listener (nm, v, mode); + } + + virtual void delete_property_listener (const std::string& nm, + const octave_value& v, + listener_mode mode = POSTSET) + { + if (valid_object ()) + get_properties ().delete_listener (nm, v, mode); + } + + virtual void remove_all_listeners (void); + + virtual void reset_default_properties (void) + { + if (valid_object ()) + { + std::string msg = (type () + "::reset_default_properties"); + gripe_not_implemented (msg.c_str ()); + } + else + error ("base_graphics_object::default: invalid graphics object"); + } + +protected: + virtual void initialize (const graphics_object& go) + { + if (! toolkit_flag) + toolkit_flag = get_toolkit ().initialize (go); + } + + virtual void finalize (const graphics_object& go) + { + if (toolkit_flag) + { + get_toolkit ().finalize (go); + toolkit_flag = false; + } + } + + virtual void update (const graphics_object& go, int id) + { + if (toolkit_flag) + get_toolkit ().update (go, id); + } + +protected: + // A reference count. + octave_refcount count; + + // A flag telling whether this object is a valid object + // in the backend context. + bool toolkit_flag; + + // No copying! + + base_graphics_object (const base_graphics_object&) : count (0) { } + + base_graphics_object& operator = (const base_graphics_object&) + { + return *this; + } +}; + +class OCTINTERP_API graphics_object +{ +public: + graphics_object (void) : rep (new base_graphics_object ()) { } + + graphics_object (base_graphics_object *new_rep) + : rep (new_rep) { } + + graphics_object (const graphics_object& obj) : rep (obj.rep) + { + rep->count++; + } + + graphics_object& operator = (const graphics_object& obj) + { + if (rep != obj.rep) + { + if (--rep->count == 0) + delete rep; + + rep = obj.rep; + rep->count++; + } + + return *this; + } + + ~graphics_object (void) + { + if (--rep->count == 0) + delete rep; + } + + void mark_modified (void) { rep->mark_modified (); } + + void override_defaults (base_graphics_object& obj) + { + rep->override_defaults (obj); + } + + void set_from_list (property_list& plist) { rep->set_from_list (plist); } + + void set (const caseless_str& name, const octave_value& val) + { + rep->set (name, val); + } + + void set (const octave_value_list& args); + + void set (const Array& names, const Cell& values, + octave_idx_type row); + + void set (const octave_map& m); + + void set_value_or_default (const caseless_str& name, + const octave_value& val); + + void set_defaults (const std::string& mode) { rep->set_defaults (mode); } + + octave_value get (bool all = false) const { return rep->get (all); } + + octave_value get (const caseless_str& name) const + { + return name.compare ("default") + ? get_defaults () + : (name.compare ("factory") + ? get_factory_defaults () : rep->get (name)); + } + + octave_value get (const std::string& name) const + { + return get (caseless_str (name)); + } + + octave_value get (const char *name) const + { + return get (caseless_str (name)); + } + + octave_value get_default (const caseless_str& name) const + { + return rep->get_default (name); + } + + octave_value get_factory_default (const caseless_str& name) const + { + return rep->get_factory_default (name); + } + + octave_value get_defaults (void) const { return rep->get_defaults (); } + + octave_value get_factory_defaults (void) const + { + return rep->get_factory_defaults (); + } + + std::string values_as_string (void) { return rep->values_as_string (); } + + octave_map values_as_struct (void) { return rep->values_as_struct (); } + + graphics_handle get_parent (void) const { return rep->get_parent (); } + + graphics_handle get_handle (void) const { return rep->get_handle (); } + + graphics_object get_ancestor (const std::string& type) const; + + void remove_child (const graphics_handle& h) { rep->remove_child (h); } + + void adopt (const graphics_handle& h) { rep->adopt (h); } + + void reparent (const graphics_handle& h) { rep->reparent (h); } + + void defaults (void) const { rep->defaults (); } + + bool isa (const std::string& go_name) const { return rep->isa (go_name); } + + base_properties& get_properties (void) { return rep->get_properties (); } + + const base_properties& get_properties (void) const + { + return rep->get_properties (); + } + + void update_axis_limits (const std::string& axis_type) + { + rep->update_axis_limits (axis_type); + } + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h) + { + rep->update_axis_limits (axis_type, h); + } + + bool valid_object (void) const { return rep->valid_object (); } + + std::string type (void) const { return rep->type (); } + + operator bool (void) const { return rep->valid_object (); } + + // FIXME -- these functions should be generated automatically by the + // genprops.awk script. + // + // EMIT_GRAPHICS_OBJECT_GET_FUNCTIONS + + octave_value get_xlim (void) const + { return get_properties ().get_xlim (); } + + octave_value get_ylim (void) const + { return get_properties ().get_ylim (); } + + octave_value get_zlim (void) const + { return get_properties ().get_zlim (); } + + octave_value get_clim (void) const + { return get_properties ().get_clim (); } + + octave_value get_alim (void) const + { return get_properties ().get_alim (); } + + bool is_xliminclude (void) const + { return get_properties ().is_xliminclude (); } + + bool is_yliminclude (void) const + { return get_properties ().is_yliminclude (); } + + bool is_zliminclude (void) const + { return get_properties ().is_zliminclude (); } + + bool is_climinclude (void) const + { return get_properties ().is_climinclude (); } + + bool is_aliminclude (void) const + { return get_properties ().is_aliminclude (); } + + bool is_handle_visible (void) const + { return get_properties ().is_handle_visible (); } + + graphics_toolkit get_toolkit (void) const { return rep->get_toolkit (); } + + void add_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->add_property_listener (nm, v, mode); } + + void delete_property_listener (const std::string& nm, const octave_value& v, + listener_mode mode = POSTSET) + { rep->delete_property_listener (nm, v, mode); } + + void initialize (void) { rep->initialize (*this); } + + void finalize (void) { rep->finalize (*this); } + + void update (int id) { rep->update (*this, id); } + + void reset_default_properties (void) + { rep->reset_default_properties (); } + +private: + base_graphics_object *rep; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API root_figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // FIXME -- it seems strange to me that the diary, diaryfile, + // echo, format, formatspacing, language, and recursionlimit + // properties are here. WTF do they have to do with graphics? + // Also note that these properties (and the monitorpositions, + // pointerlocation, and pointerwindow properties) are not yet used + // by Octave, so setting them will have no effect, and changes + // made elswhere (say, the diary or format functions) will not + // cause these properties to be updated. + + BEGIN_PROPERTIES (root_figure, root) + handle_property callbackobject Sr , graphics_handle () + array_property commandwindowsize r , Matrix (1, 2, 0) + handle_property currentfigure S , graphics_handle () + bool_property diary , "off" + string_property diaryfile , "diary" + bool_property echo , "off" + radio_property format , "+|bank|bit|debug|hex|long|longe|longeng|longg|native-bit|native-hex|rational|{short}|shorte|shorteng|shortg" + radio_property formatspacing , "{loose}|compact" + string_property language , "ascii" + array_property monitorpositions , Matrix (1, 4, 0) + array_property pointerlocation , Matrix (1, 2, 0) + double_property pointerwindow , 0.0 + double_property recursionlimit , 256.0 + double_property screendepth r , default_screendepth () + double_property screenpixelsperinch r , default_screenpixelsperinch () + array_property screensize r , default_screensize () + bool_property showhiddenhandles , "off" + radio_property units U , "inches|centimeters|normalized|points|{pixels}" + END_PROPERTIES + + private: + std::list cbo_stack; + }; + +private: + properties xproperties; + +public: + + root_figure (void) : xproperties (0, graphics_handle ()), default_properties () { } + + ~root_figure (void) { } + + void mark_modified (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + return get_default (name.substr (7)); + else if (name.compare ("factory", 7)) + return get_factory_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const + { + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + // no default property found, use factory default + retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid default property `%s'", name.c_str ()); + } + + return retval; + } + + octave_value get_factory_default (const caseless_str& name) const + { + octave_value retval = factory_properties.lookup (name); + + if (retval.is_undefined ()) + error ("get: invalid factory default property `%s'", name.c_str ()); + + return retval; + } + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + octave_value get_factory_defaults (void) const + { + return factory_properties.as_struct ("factory"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; + + static property_list factory_properties; + + static property_list::plist_map_type init_factory_properties (void); +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API figure : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void init_integerhandle (const octave_value& val) + { + integerhandle = val; + } + + void remove_child (const graphics_handle& h); + + void set_visible (const octave_value& val); + + graphics_toolkit get_toolkit (void) const + { + if (! toolkit) + toolkit = gtk_manager::get_toolkit (); + + return toolkit; + } + + void set_toolkit (const graphics_toolkit& b); + + void set___graphics_toolkit__ (const octave_value& val) + { + if (! error_state) + { + if (val.is_string ()) + { + std::string nm = val.string_value (); + graphics_toolkit b = gtk_manager::find_toolkit (nm); + if (b.get_name () != nm) + { + error ("set___graphics_toolkit__: invalid graphics toolkit"); + } + else + { + set_toolkit (b); + mark_modified (); + } + } + else + error ("set___graphics_toolkit__ must be a string"); + } + } + + void set_position (const octave_value& val, + bool do_notify_toolkit = true); + + void set_outerposition (const octave_value& val, + bool do_notify_toolkit = true); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + void set_boundingbox (const Matrix& bb, bool internal = false, + bool do_notify_toolkit = true); + + Matrix map_from_boundingbox (double x, double y) const; + + Matrix map_to_boundingbox (double x, double y) const; + + void update_units (const caseless_str& old_units); + + void update_paperunits (const caseless_str& old_paperunits); + + std::string get_title (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (figure) + any_property __plot_stream__ h , Matrix () + bool_property __enhanced__ h , "on" + radio_property nextplot , "new|{add}|replacechildren|replace" + callback_property closerequestfcn , "closereq" + handle_property currentaxes S , graphics_handle () + array_property colormap , jet_colormap () + radio_property paperorientation U , "{portrait}|landscape|rotated" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + array_property alphamap , Matrix (64, 1, 1) + string_property currentcharacter r , "" + handle_property currentobject r , graphics_handle () + array_property currentpoint r , Matrix (2, 1, 0) + bool_property dockcontrols , "off" + bool_property doublebuffer , "on" + string_property filename , "" + bool_property integerhandle S , "on" + bool_property inverthardcopy , "off" + callback_property keypressfcn , Matrix () + callback_property keyreleasefcn , Matrix () + radio_property menubar , "none|{figure}" + double_property mincolormap , 64 + string_property name , "" + bool_property numbertitle , "on" + array_property outerposition s , Matrix (1, 4, -1.0) + radio_property paperunits Su , "{inches}|centimeters|normalized|points" + array_property paperposition , default_figure_paperposition () + radio_property paperpositionmode , "auto|{manual}" + array_property papersize U , default_figure_papersize () + radio_property papertype SU , "{usletter}|uslegal|a0|a1|a2|a3|a4|a5|b0|b1|b2|b3|b4|b5|arch-a|arch-b|arch-c|arch-d|arch-e|a|b|c|d|e|tabloid|" + radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" + array_property pointershapecdata , Matrix (16, 16, 0) + array_property pointershapehotspot , Matrix (1, 2, 0) + array_property position s , default_figure_position () + radio_property renderer , "{painters}|zbuffer|opengl|none" + radio_property renderermode , "{auto}|manual" + bool_property resize , "on" + callback_property resizefcn , Matrix () + radio_property selectiontype , "{normal}|open|alt|extend" + radio_property toolbar , "none|{auto}|figure" + radio_property units Su , "inches|centimeters|normalized|points|{pixels}|characters" + callback_property windowbuttondownfcn , Matrix () + callback_property windowbuttonmotionfcn , Matrix () + callback_property windowbuttonupfcn , Matrix () + callback_property windowbuttonwheelfcn , Matrix () + radio_property windowstyle , "{normal}|modal|docked" + string_property wvisual , "" + radio_property wvisualmode , "{auto}|manual" + string_property xdisplay , "" + string_property xvisual , "" + radio_property xvisualmode , "{auto}|manual" + callback_property buttondownfcn , Matrix () + string_property __graphics_toolkit__ s , "gnuplot" + any_property __guidata__ h , Matrix () + END_PROPERTIES + + protected: + void init (void) + { + colormap.add_constraint (dim_vector (-1, 3)); + alphamap.add_constraint (dim_vector (-1, 1)); + paperposition.add_constraint (dim_vector (1, 4)); + pointershapecdata.add_constraint (dim_vector (16, 16)); + pointershapehotspot.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (1, 4)); + outerposition.add_constraint (dim_vector (1, 4)); + } + + private: + mutable graphics_toolkit toolkit; + }; + +private: + properties xproperties; + +public: + figure (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~figure (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (root figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API graphics_xform +{ +public: + graphics_xform (void) + : xform (xform_eye ()), xform_inv (xform_eye ()), + sx ("linear"), sy ("linear"), sz ("linear"), zlim (1, 2, 0.0) + { + zlim(1) = 1.0; + } + + graphics_xform (const Matrix& xm, const Matrix& xim, + const scaler& x, const scaler& y, const scaler& z, + const Matrix& zl) + : xform (xm), xform_inv (xim), sx (x), sy (y), sz (z), zlim (zl) { } + + graphics_xform (const graphics_xform& g) + : xform (g.xform), xform_inv (g.xform_inv), sx (g.sx), + sy (g.sy), sz (g.sz), zlim (g.zlim) { } + + ~graphics_xform (void) { } + + graphics_xform& operator = (const graphics_xform& g) + { + xform = g.xform; + xform_inv = g.xform_inv; + sx = g.sx; + sy = g.sy; + sz = g.sz; + zlim = g.zlim; + + return *this; + } + + static ColumnVector xform_vector (double x, double y, double z); + + static Matrix xform_eye (void); + + ColumnVector transform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, double z, + bool use_scale = true) const; + + ColumnVector untransform (double x, double y, bool use_scale = true) const + { return untransform (x, y, (zlim(0)+zlim(1))/2, use_scale); } + + Matrix xscale (const Matrix& m) const { return sx.scale (m); } + Matrix yscale (const Matrix& m) const { return sy.scale (m); } + Matrix zscale (const Matrix& m) const { return sz.scale (m); } + + Matrix scale (const Matrix& m) const + { + bool has_z = (m.columns () > 2); + + if (sx.is_linear () && sy.is_linear () + && (! has_z || sz.is_linear ())) + return m; + + Matrix retval (m.dims ()); + + int r = m.rows (); + + for (int i = 0; i < r; i++) + { + retval(i,0) = sx.scale (m(i,0)); + retval(i,1) = sy.scale (m(i,1)); + if (has_z) + retval(i,2) = sz.scale (m(i,2)); + } + + return retval; + } + +private: + Matrix xform; + Matrix xform_inv; + scaler sx, sy, sz; + Matrix zlim; +}; + +enum { + AXE_ANY_DIR = 0, + AXE_DEPTH_DIR = 1, + AXE_HORZ_DIR = 2, + AXE_VERT_DIR = 3 +}; + +class OCTINTERP_API axes : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void set_defaults (base_graphics_object& obj, const std::string& mode); + + void remove_child (const graphics_handle& h); + + const scaler& get_x_scaler (void) const { return sx; } + const scaler& get_y_scaler (void) const { return sy; } + const scaler& get_z_scaler (void) const { return sz; } + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + Matrix get_extent (bool with_text = false, bool only_text_height=false) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + void update_boundingbox (void) + { + if (units_is ("normalized")) + { + sync_positions (); + base_properties::update_boundingbox (); + } + } + + void update_camera (void); + void update_axes_layout (void); + void update_aspectratios (void); + void update_transform (void) + { + update_aspectratios (); + update_camera (); + update_axes_layout (); + } + + void update_autopos (const std::string& elem_type); + void update_xlabel_position (void); + void update_ylabel_position (void); + void update_zlabel_position (void); + void update_title_position (void); + + graphics_xform get_transform (void) const + { return graphics_xform (x_render, x_render_inv, sx, sy, sz, x_zlim); } + + Matrix get_transform_matrix (void) const { return x_render; } + Matrix get_inverse_transform_matrix (void) const { return x_render_inv; } + Matrix get_opengl_matrix_1 (void) const { return x_gl_mat1; } + Matrix get_opengl_matrix_2 (void) const { return x_gl_mat2; } + Matrix get_transform_zlim (void) const { return x_zlim; } + + int get_xstate (void) const { return xstate; } + int get_ystate (void) const { return ystate; } + int get_zstate (void) const { return zstate; } + double get_xPlane (void) const { return xPlane; } + double get_xPlaneN (void) const { return xPlaneN; } + double get_yPlane (void) const { return yPlane; } + double get_yPlaneN (void) const { return yPlaneN; } + double get_zPlane (void) const { return zPlane; } + double get_zPlaneN (void) const { return zPlaneN; } + double get_xpTick (void) const { return xpTick; } + double get_xpTickN (void) const { return xpTickN; } + double get_ypTick (void) const { return ypTick; } + double get_ypTickN (void) const { return ypTickN; } + double get_zpTick (void) const { return zpTick; } + double get_zpTickN (void) const { return zpTickN; } + double get_x_min (void) const { return std::min (xPlane, xPlaneN); } + double get_x_max (void) const { return std::max (xPlane, xPlaneN); } + double get_y_min (void) const { return std::min (yPlane, yPlaneN); } + double get_y_max (void) const { return std::max (yPlane, yPlaneN); } + double get_z_min (void) const { return std::min (zPlane, zPlaneN); } + double get_z_max (void) const { return std::max (zPlane, zPlaneN); } + double get_fx (void) const { return fx; } + double get_fy (void) const { return fy; } + double get_fz (void) const { return fz; } + double get_xticklen (void) const { return xticklen; } + double get_yticklen (void) const { return yticklen; } + double get_zticklen (void) const { return zticklen; } + double get_xtickoffset (void) const { return xtickoffset; } + double get_ytickoffset (void) const { return ytickoffset; } + double get_ztickoffset (void) const { return ztickoffset; } + bool get_x2Dtop (void) const { return x2Dtop; } + bool get_y2Dright (void) const { return y2Dright; } + bool get_layer2Dtop (void) const { return layer2Dtop; } + bool get_xySym (void) const { return xySym; } + bool get_xyzSym (void) const { return xyzSym; } + bool get_zSign (void) const { return zSign; } + bool get_nearhoriz (void) const { return nearhoriz; } + + ColumnVector pixel2coord (double px, double py) const + { return get_transform ().untransform (px, py, (x_zlim(0)+x_zlim(1))/2); } + + ColumnVector coord2pixel (double x, double y, double z) const + { return get_transform ().transform (x, y, z); } + + void zoom_about_point (double x, double y, double factor, + bool push_to_zoom_stack = true); + void zoom (const Matrix& xl, const Matrix& yl, bool push_to_zoom_stack = true); + void translate_view (double x0, double x1, double y0, double y1); + void rotate_view (double delta_az, double delta_el); + void unzoom (void); + void clear_zoom_stack (void); + + void update_units (const caseless_str& old_units); + + void update_fontunits (const caseless_str& old_fontunits); + + private: + scaler sx, sy, sz; + Matrix x_render, x_render_inv; + Matrix x_gl_mat1, x_gl_mat2; + Matrix x_zlim; + std::list zoom_stack; + + // Axes layout data + int xstate, ystate, zstate; + double xPlane, xPlaneN, yPlane, yPlaneN, zPlane, zPlaneN; + double xpTick, xpTickN, ypTick, ypTickN, zpTick, zpTickN; + double fx, fy, fz; + double xticklen, yticklen, zticklen; + double xtickoffset, ytickoffset, ztickoffset; + bool x2Dtop, y2Dright, layer2Dtop; + bool xySym, xyzSym, zSign, nearhoriz; + +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text (tick labels) size + ft_render text_renderer; +#endif + + void set_text_child (handle_property& h, const std::string& who, + const octave_value& v); + + void delete_text_child (handle_property& h); + + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (axes) + array_property position u , default_axes_position () + bool_property box , "on" + array_property colororder , default_colororder () + array_property dataaspectratio mu , Matrix (1, 3, 1.0) + radio_property dataaspectratiomode u , "{auto}|manual" + radio_property layer u , "{bottom}|top" + row_vector_property xlim mu , default_lim () + row_vector_property ylim mu , default_lim () + row_vector_property zlim mu , default_lim () + row_vector_property clim m , default_lim () + row_vector_property alim m , default_lim () + radio_property xlimmode al , "{auto}|manual" + radio_property ylimmode al , "{auto}|manual" + radio_property zlimmode al , "{auto}|manual" + radio_property climmode al , "{auto}|manual" + radio_property alimmode , "{auto}|manual" + handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + bool_property xgrid , "off" + bool_property ygrid , "off" + bool_property zgrid , "off" + bool_property xminorgrid , "off" + bool_property yminorgrid , "off" + bool_property zminorgrid , "off" + row_vector_property xtick mu , default_axes_tick () + row_vector_property ytick mu , default_axes_tick () + row_vector_property ztick mu , default_axes_tick () + radio_property xtickmode u , "{auto}|manual" + radio_property ytickmode u , "{auto}|manual" + radio_property ztickmode u , "{auto}|manual" + bool_property xminortick , "off" + bool_property yminortick , "off" + bool_property zminortick , "off" + // FIXME -- should be kind of string array. + any_property xticklabel m , "" + any_property yticklabel m , "" + any_property zticklabel m , "" + radio_property xticklabelmode u , "{auto}|manual" + radio_property yticklabelmode u , "{auto}|manual" + radio_property zticklabelmode u , "{auto}|manual" + radio_property interpreter , "tex|{none}|latex" + color_property color , color_property (color_values (1, 1, 1), radio_values ("none")) + color_property xcolor , color_values (0, 0, 0) + color_property ycolor , color_values (0, 0, 0) + color_property zcolor , color_values (0, 0, 0) + radio_property xscale alu , "{linear}|log" + radio_property yscale alu , "{linear}|log" + radio_property zscale alu , "{linear}|log" + radio_property xdir u , "{normal}|reverse" + radio_property ydir u , "{normal}|reverse" + radio_property zdir u , "{normal}|reverse" + radio_property yaxislocation u , "{left}|right|zero" + radio_property xaxislocation u , "{bottom}|top|zero" + array_property view u , Matrix () + bool_property __hold_all__ h , "off" + radio_property nextplot , "new|add|replacechildren|{replace}" + array_property outerposition u , default_axes_outerposition () + radio_property activepositionproperty , "{outerposition}|position" + color_property ambientlightcolor , color_values (1, 1, 1) + array_property cameraposition m , Matrix (1, 3, 0.0) + array_property cameratarget m , Matrix (1, 3, 0.0) + array_property cameraupvector m , Matrix () + double_property cameraviewangle m , 10.0 + radio_property camerapositionmode , "{auto}|manual" + radio_property cameratargetmode , "{auto}|manual" + radio_property cameraupvectormode , "{auto}|manual" + radio_property cameraviewanglemode , "{auto}|manual" + array_property currentpoint , Matrix (2, 3, 0.0) + radio_property drawmode , "{normal}|fast" + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" + radio_property fontweight u , "{normal}|light|demi|bold" + radio_property gridlinestyle , "-|--|{:}|-.|none" + string_array_property linestyleorder , "-" + double_property linewidth , 0.5 + radio_property minorgridlinestyle , "-|--|{:}|-.|none" + array_property plotboxaspectratio mu , Matrix (1, 3, 1.0) + radio_property plotboxaspectratiomode u , "{auto}|manual" + radio_property projection , "{orthographic}|perpective" + radio_property tickdir mu , "{in}|out" + radio_property tickdirmode u , "{auto}|manual" + array_property ticklength u , default_axes_ticklength () + array_property tightinset r , Matrix (1, 4, 0.0) + // FIXME -- uicontextmenu should be moved here. + radio_property units SU , "{normalized}|inches|centimeters|points|pixels|characters" + // hidden properties for transformation computation + array_property x_viewtransform h , Matrix (4, 4, 0.0) + array_property x_projectiontransform h , Matrix (4, 4, 0.0) + array_property x_viewporttransform h , Matrix (4, 4, 0.0) + array_property x_normrendertransform h , Matrix (4, 4, 0.0) + array_property x_rendertransform h , Matrix (4, 4, 0.0) + // hidden properties for minor ticks + row_vector_property xmtick h , Matrix () + row_vector_property ymtick h , Matrix () + row_vector_property zmtick h , Matrix () + // hidden properties for inset + array_property looseinset hu , Matrix (1, 4, 0.0) + // hidden properties for alignment of subplots + radio_property autopos_tag h , "{none}|subplot" + END_PROPERTIES + + protected: + void init (void); + + private: + + std::string + get_scale (const std::string& scale, const Matrix& lims) + { + std::string retval = scale; + + if (scale == "log" && lims.numel () > 1 && lims(0) < 0 && lims(1) < 0) + retval = "neglog"; + + return retval; + } + + void update_xscale (void) + { + sx = get_scale (get_xscale (), xlim.get ().matrix_value ()); + } + + void update_yscale (void) + { + sy = get_scale (get_yscale (), ylim.get ().matrix_value ()); + } + + void update_zscale (void) + { + sz = get_scale (get_zscale (), zlim.get ().matrix_value ()); + } + + void update_view (void) { sync_positions (); } + void update_dataaspectratio (void) { sync_positions (); } + void update_dataaspectratiomode (void) { sync_positions (); } + void update_plotboxaspectratio (void) { sync_positions (); } + void update_plotboxaspectratiomode (void) { sync_positions (); } + + void update_layer (void) { update_axes_layout (); } + void update_yaxislocation (void) + { + update_axes_layout (); + update_ylabel_position (); + } + void update_xaxislocation (void) + { + update_axes_layout (); + update_xlabel_position (); + } + + void update_xdir (void) { update_camera (); update_axes_layout (); } + void update_ydir (void) { update_camera (); update_axes_layout (); } + void update_zdir (void) { update_camera (); update_axes_layout (); } + + void update_ticklength (void); + void update_tickdir (void) { update_ticklength (); } + void update_tickdirmode (void) { update_ticklength (); } + + void update_xtick (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_ytick (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_ztick (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_xtickmode (void) + { + if (xtickmode.is ("auto")) + { + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + update_xtick (); + } + } + void update_ytickmode (void) + { + if (ytickmode.is ("auto")) + { + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + update_ytick (); + } + } + void update_ztickmode (void) + { + if (ztickmode.is ("auto")) + { + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + update_ztick (); + } + } + + void update_xticklabelmode (void) + { + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + } + void update_yticklabelmode (void) + { + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + } + void update_zticklabelmode (void) + { + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + } + + void update_font (void); + void update_fontname (void) { update_font (); } + void update_fontsize (void) { update_font (); } + void update_fontangle (void) { update_font (); } + void update_fontweight (void) { update_font (); } + + void sync_positions (const Matrix& linset); + void sync_positions (void); + + void update_outerposition (void) + { + set_activepositionproperty ("outerposition"); + sync_positions (); + } + + void update_position (void) + { + set_activepositionproperty ("position"); + sync_positions (); + } + + void update_looseinset (void) { sync_positions (); } + + double calc_tick_sep (double minval, double maxval); + void calc_ticks_and_lims (array_property& lims, array_property& ticks, array_property& mticks, + bool limmode_is_auto, bool is_logscale); + void calc_ticklabels (const array_property& ticks, any_property& labels, bool is_logscale); + Matrix get_ticklabel_extents (const Matrix& ticks, + const string_vector& ticklabels, + const Matrix& limits); + + void fix_limits (array_property& lims) + { + if (lims.get ().is_empty ()) + return; + + Matrix l = lims.get ().matrix_value (); + if (l(0) > l(1)) + { + l(0) = 0; + l(1) = 1; + lims = l; + } + else if (l(0) == l(1)) + { + l(0) -= 0.5; + l(1) += 0.5; + lims = l; + } + } + + Matrix calc_tightbox (const Matrix& init_pos); + + public: + Matrix get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale); + + void update_xlim (bool do_clr_zoom = true) + { + if (xtickmode.is ("auto")) + calc_ticks_and_lims (xlim, xtick, xmtick, xlimmode.is ("auto"), xscale.is ("log")); + if (xticklabelmode.is ("auto")) + calc_ticklabels (xtick, xticklabel, xscale.is ("log")); + + fix_limits (xlim); + + update_xscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_ylim (bool do_clr_zoom = true) + { + if (ytickmode.is ("auto")) + calc_ticks_and_lims (ylim, ytick, ymtick, ylimmode.is ("auto"), yscale.is ("log")); + if (yticklabelmode.is ("auto")) + calc_ticklabels (ytick, yticklabel, yscale.is ("log")); + + fix_limits (ylim); + + update_yscale (); + + if (do_clr_zoom) + zoom_stack.clear (); + + update_axes_layout (); + } + + void update_zlim (void) + { + if (ztickmode.is ("auto")) + calc_ticks_and_lims (zlim, ztick, zmtick, zlimmode.is ("auto"), zscale.is ("log")); + if (zticklabelmode.is ("auto")) + calc_ticklabels (ztick, zticklabel, zscale.is ("log")); + + fix_limits (zlim); + + update_zscale (); + + zoom_stack.clear (); + + update_axes_layout (); + } + + }; + +private: + properties xproperties; + +public: + axes (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + xproperties.update_transform (); + } + + ~axes (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + void set_defaults (const std::string& mode) + { + remove_all_listeners (); + xproperties.set_defaults (*this, mode); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + // FIXME -- finish this. + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +protected: + void initialize (const graphics_object& go); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API line : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + // properties which are not in matlab: interpreter + + BEGIN_PROPERTIES (line) + row_vector_property xdata u , default_data () + row_vector_property ydata u , default_data () + row_vector_property zdata u , Matrix () + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + color_property color , color_values (0, 0, 0) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property erasemode , "{normal}|none|xor|background" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "off" + END_PROPERTIES + + private: + Matrix compute_xlim (void) const; + Matrix compute_ylim (void) const; + + void update_xdata (void) { set_xlim (compute_xlim ()); } + + void update_ydata (void) { set_ylim (compute_ylim ()); } + + void update_zdata (void) + { + set_zlim (zdata.get_limits ()); + set_zliminclude (get_zdata ().numel () > 0); + } + }; + +private: + properties xproperties; + +public: + line (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~line (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API text : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + double get_fontsize_points (double box_pix_height = 0) const; + + void set_position (const octave_value& val) + { + if (! error_state) + { + octave_value new_val (val); + + if (new_val.numel () == 2) + { + dim_vector dv (1, 3); + + new_val = new_val.resize (dv, true); + } + + if (position.set (new_val, false)) + { + set_positionmode ("manual"); + update_position (); + position.run_listeners (POSTSET); + mark_modified (); + } + else + set_positionmode ("manual"); + } + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (text) + text_label_property string u , "" + radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" + array_property position smu , Matrix (1, 3, 0.0) + double_property rotation mu , 0 + radio_property horizontalalignment mu , "{left}|center|right" + color_property color u , color_values (0, 0, 0) + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontangle u , "{normal}|italic|oblique" + radio_property fontweight u , "light|{normal}|demi|bold" + radio_property interpreter u , "{tex}|none|latex" + color_property backgroundcolor , "{none}" + string_property displayname , "" + color_property edgecolor , "{none}" + radio_property erasemode , "{normal}|none|xor|background" + bool_property editing , "off" + radio_property fontunits , "inches|centimeters|normalized|{points}|pixels" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + double_property margin , 1 + radio_property verticalalignment mu , "top|cap|{middle}|baseline|bottom" + array_property extent rG , Matrix (1, 4, 0.0) + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + bool_property xliminclude hl , "off" + bool_property yliminclude hl , "off" + bool_property zliminclude hl , "off" + // hidden properties for auto-positioning + radio_property positionmode hu , "{auto}|manual" + radio_property rotationmode hu , "{auto}|manual" + radio_property horizontalalignmentmode hu , "{auto}|manual" + radio_property verticalalignmentmode hu , "{auto}|manual" + radio_property autopos_tag h , "{none}|xlabel|ylabel|zlabel|title" + END_PROPERTIES + + Matrix get_data_position (void) const; + Matrix get_extent_matrix (void) const; + const uint8NDArray& get_pixels (void) const { return pixels; } +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text size + ft_render renderer; +#endif + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 3)); + cached_units = get_units (); + update_font (); + } + + private: + void update_position (void) + { + Matrix pos = get_data_position (); + Matrix lim; + + lim = Matrix (1, 3, pos(0)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_xlim (lim); + + lim = Matrix (1, 3, pos(1)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_ylim (lim); + + if (pos.numel () == 3) + { + lim = Matrix (1, 3, pos(2)); + lim(2) = (lim(2) <= 0 ? octave_Inf : lim(2)); + set_zliminclude ("on"); + set_zlim (lim); + } + else + set_zliminclude ("off"); + } + + void update_text_extent (void); + + void request_autopos (void); + void update_positionmode (void) { request_autopos (); } + void update_rotationmode (void) { request_autopos (); } + void update_horizontalalignmentmode (void) { request_autopos (); } + void update_verticalalignmentmode (void) { request_autopos (); } + + void update_font (void); + void update_string (void) { request_autopos (); update_text_extent (); } + void update_rotation (void) { update_text_extent (); } + void update_color (void) { update_font (); } + void update_fontname (void) { update_font (); update_text_extent (); } + void update_fontsize (void) { update_font (); update_text_extent (); } + void update_fontangle (void) { update_font (); update_text_extent (); } + void update_fontweight (void) { update_font (); update_text_extent (); } + void update_interpreter (void) { update_text_extent (); } + void update_horizontalalignment (void) { update_text_extent (); } + void update_verticalalignment (void) { update_text_extent (); } + + void update_units (void); + + private: + std::string cached_units; + uint8NDArray pixels; + }; + +private: + properties xproperties; + +public: + text (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.set_clipping ("off"); + xproperties.override_defaults (*this); + } + + ~text (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API image : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + octave_value get_color_data (void) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (image) + row_vector_property xdata u , Matrix () + row_vector_property ydata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property clim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property climinclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (2); + ydata.add_constraint (2); + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("logical"); + cdata.add_constraint ("uint8"); + cdata.add_constraint ("uint16"); + cdata.add_constraint ("int16"); + cdata.add_constraint ("real"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_xdata (void) + { + Matrix limits = xdata.get_limits (); + float dp = pixel_xsize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_xlim (limits); + } + + void update_ydata (void) + { + Matrix limits = ydata.get_limits (); + float dp = pixel_ysize (); + + limits(0) = limits(0) - dp; + limits(1) = limits(1) + dp; + set_ylim (limits); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + float pixel_size (octave_idx_type dim, const Matrix limits) + { + octave_idx_type l = dim - 1; + float dp; + + if (l > 0 && limits(0) != limits(1)) + dp = (limits(1) - limits(0))/(2*l); + else + { + if (limits(1) == limits(2)) + dp = 0.5; + else + dp = (limits(1) - limits(0))/2; + } + return dp; + } + + public: + float pixel_xsize (void) + { + return pixel_size ((get_cdata ().dims ())(1), xdata.get_limits ()); + } + + float pixel_ysize (void) + { + return pixel_size ((get_cdata ().dims ())(0), ydata.get_limits ()); + } + }; + +private: + properties xproperties; + +public: + image (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~image (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API patch : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (patch) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping l , "{scaled}|direct" + array_property faces , Matrix () + array_property facevertexalphadata , Matrix () + array_property facevertexcdata , Matrix () + array_property vertices , Matrix () + array_property vertexnormals , Matrix () + radio_property normalmode , "{auto}|manual" + color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property facelighting , "flat|{none}|gouraud|phong" + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property backfacelighting , "{reverselit}|unlit|lit" + double_property ambientstrength , 0.3 + double_property diffusestrength , 0.6 + double_property specularstrength , 0.6 + double_property specularexponent , 10.0 + double_property specularcolorreflectance , 1.0 + radio_property erasemode , "{normal}|background|xor|none" + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none|flat" + color_property markerfacecolor , "auto|{none}|flat" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + radio_property alphadatamapping l , "none|{scaled}|direct" + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + vertices.add_constraint (dim_vector (-1, 2)); + vertices.add_constraint (dim_vector (-1, 3)); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + facevertexcdata.add_constraint (dim_vector (-1, 1)); + facevertexcdata.add_constraint (dim_vector (-1, 3)); + facevertexalphadata.add_constraint (dim_vector (-1, 1)); + } + + private: + void update_xdata (void) { set_xlim (xdata.get_limits ()); } + void update_ydata (void) { set_ylim (ydata.get_limits ()); } + void update_zdata (void) { set_zlim (zdata.get_limits ()); } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + }; + +private: + properties xproperties; + +public: + patch (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~patch (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API surface : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + octave_value get_color_data (void) const; + + bool is_climinclude (void) const + { return (climinclude.is_on () && cdatamapping.is ("scaled")); } + std::string get_climinclude (void) const + { return climinclude.current_value (); } + + bool is_aliminclude (void) const + { return (aliminclude.is_on () && alphadatamapping.is ("scaled")); } + std::string get_aliminclude (void) const + { return aliminclude.current_value (); } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (surface) + array_property xdata u , Matrix () + array_property ydata u , Matrix () + array_property zdata u , Matrix () + array_property cdata u , Matrix () + radio_property cdatamapping al , "{scaled}|direct" + string_property xdatasource , "" + string_property ydatasource , "" + string_property zdatasource , "" + string_property cdatasource , "" + color_property facecolor , "{flat}|none|interp|texturemap" + double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) + color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) + radio_property linestyle , "{-}|--|:|-.|none" + double_property linewidth , 0.5 + radio_property marker , "{none}|s|o|x|+|.|*|<|>|v|^|d|p|h|@" + color_property markeredgecolor , "{auto}|none" + color_property markerfacecolor , "auto|{none}" + double_property markersize , 6 + radio_property interpreter , "{tex}|none|latex" + string_property displayname , "" + array_property alphadata u , Matrix () + radio_property alphadatamapping l , "none|direct|{scaled}" + double_property ambientstrength , 0.3 + radio_property backfacelighting , "unlit|lit|{reverselit}" + double_property diffusestrength , 0.6 + double_radio_property edgealpha , double_radio_property (1.0, radio_values ("flat|interp")) + radio_property edgelighting , "{none}|flat|gouraud|phong" + radio_property erasemode , "{normal}|none|xor|background" + radio_property facelighting , "{none}|flat|gouraud|phong" + radio_property meshstyle , "{both}|row|column" + radio_property normalmode u , "{auto}|manual" + double_property specularcolorreflectance , 1 + double_property specularexponent , 10 + double_property specularstrength , 0.9 + array_property vertexnormals u , Matrix () + // hidden properties for limit computation + row_vector_property xlim hlr , Matrix () + row_vector_property ylim hlr , Matrix () + row_vector_property zlim hlr , Matrix () + row_vector_property clim hlr , Matrix () + row_vector_property alim hlr , Matrix () + bool_property xliminclude hl , "on" + bool_property yliminclude hl , "on" + bool_property zliminclude hl , "on" + bool_property climinclude hlg , "on" + bool_property aliminclude hlg , "on" + END_PROPERTIES + + protected: + void init (void) + { + xdata.add_constraint (dim_vector (-1, -1)); + ydata.add_constraint (dim_vector (-1, -1)); + zdata.add_constraint (dim_vector (-1, -1)); + alphadata.add_constraint ("single"); + alphadata.add_constraint ("double"); + alphadata.add_constraint ("uint8"); + alphadata.add_constraint (dim_vector (-1, -1)); + vertexnormals.add_constraint (dim_vector (-1, -1, 3)); + cdata.add_constraint ("single"); + cdata.add_constraint ("double"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1)); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + + private: + void update_normals (void); + + void update_xdata (void) + { + update_normals (); + set_xlim (xdata.get_limits ()); + } + + void update_ydata (void) + { + update_normals (); + set_ylim (ydata.get_limits ()); + } + + void update_zdata (void) + { + update_normals (); + set_zlim (zdata.get_limits ()); + } + + void update_cdata (void) + { + if (cdatamapping_is ("scaled")) + set_clim (cdata.get_limits ()); + else + clim = cdata.get_limits (); + } + + void update_alphadata (void) + { + if (alphadatamapping_is ("scaled")) + set_alim (alphadata.get_limits ()); + else + alim = alphadata.get_limits (); + } + + void update_normalmode (void) + { update_normals (); } + + void update_vertexnormals (void) + { set_normalmode ("manual"); } + }; + +private: + properties xproperties; + +public: + surface (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~surface (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API hggroup : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + update_limits (); + } + + void adopt (const graphics_handle& h) + { + + base_properties::adopt (h); + update_limits (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (hggroup) + // hidden properties for limit computation + row_vector_property xlim hr , Matrix () + row_vector_property ylim hr , Matrix () + row_vector_property zlim hr , Matrix () + row_vector_property clim hr , Matrix () + row_vector_property alim hr , Matrix () + bool_property xliminclude h , "on" + bool_property yliminclude h , "on" + bool_property zliminclude h , "on" + bool_property climinclude h , "on" + bool_property aliminclude h , "on" + END_PROPERTIES + + private: + void update_limits (void) const; + + void update_limits (const graphics_handle& h) const; + + protected: + void init (void) + { } + + }; + +private: + properties xproperties; + +public: + hggroup (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~hggroup (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void update_axis_limits (const std::string& axis_type); + + void update_axis_limits (const std::string& axis_type, + const graphics_handle& h); + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uimenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + void remove_child (const graphics_handle& h) + { + base_properties::remove_child (h); + } + + void adopt (const graphics_handle& h) + { + base_properties::adopt (h); + } + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () + string_property accelerator , "" + callback_property callback , Matrix () + bool_property checked , "off" + bool_property enable , "on" + color_property foregroundcolor , color_values (0, 0, 0) + string_property label , "" + double_property position , 9 + bool_property separator , "off" + string_property fltk_label h , "" + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uimenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uimenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontextmenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontextmenu) + any_property __object__ , Matrix () + callback_property callback , Matrix () + array_property position , Matrix (1, 2, 0.0) + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (2, 1)); + visible.set (octave_value (true)); + } + }; + +private: + properties xproperties; + +public: + uicontextmenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontextmenu (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontrol : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontrol) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + callback_property callback , Matrix () + array_property cdata , Matrix () + bool_property clipping , "on" + radio_property enable , "{on}|inactive|off" + array_property extent rG , Matrix (1, 4, 0.0) + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight u , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + radio_property horizontalalignment , "{left}|center|right" + callback_property keypressfcn , Matrix () + double_property listboxtop , 1 + double_property max , 1 + double_property min , 0 + array_property position , default_control_position () + array_property sliderstep , default_control_sliderstep () + string_array_property string u , "" + radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" + string_property tooltipstring , "" + radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" + row_vector_property value , Matrix (1, 1, 1.0) + radio_property verticalalignment , "top|{middle}|bottom" + END_PROPERTIES + + private: + std::string cached_units; + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + position.add_constraint (dim_vector (1, 4)); + sliderstep.add_constraint (dim_vector (1, 2)); + cached_units = get_units (); + } + + void update_text_extent (void); + + void update_string (void) { update_text_extent (); } + void update_fontname (void) { update_text_extent (); } + void update_fontsize (void) { update_text_extent (); } + void update_fontangle (void) { update_text_extent (); } + void update_fontweight (void) { update_text_extent (); } + void update_fontunits (const caseless_str& old_units); + + void update_units (void); + + }; + +private: + properties xproperties; + +public: + uicontrol (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontrol (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipanel : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipanel) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" + double_property borderwidth , 1 + radio_property fontangle , "{normal}|italic|oblique" + string_property fontname , OCTAVE_DEFAULT_FONTNAME + double_property fontsize , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + color_property highlightcolor , color_values (1, 1, 1) + array_property position , default_panel_position () + callback_property resizefcn , Matrix () + color_property shadowcolor , color_values (0, 0, 0) + string_property title , "" + radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" + radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 4)); + } + + void update_units (const caseless_str& old_units); + void update_fontunits (const caseless_str& old_units); + + }; + +private: + properties xproperties; + +public: + uipanel (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipanel (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoolbar : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoolbar) + any_property __object__ , Matrix () + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uitoolbar (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~uitoolbar (void) { } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipushtool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipushtool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + bool_property separator , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uipushtool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipushtool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoggletool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoggletool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix () + bool_property enable , "on" + callback_property offcallback , Matrix () + callback_property oncallback , Matrix () + bool_property separator , "off" + bool_property state , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uitoggletool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uitoggletool (void) { } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +octave_value +get_property_from_handle (double handle, const std::string &property, + const std::string &func); +bool +set_property_in_handle (double handle, const std::string &property, + const octave_value &arg, const std::string &func); + +// --------------------------------------------------------------------- + +class graphics_event; + +class +base_graphics_event +{ +public: + friend class graphics_event; + + base_graphics_event (void) : count (1) { } + + virtual ~base_graphics_event (void) { } + + virtual void execute (void) = 0; + +private: + octave_refcount count; +}; + +class +graphics_event +{ +public: + typedef void (*event_fcn) (void*); + + graphics_event (void) : rep (0) { } + + graphics_event (const graphics_event& e) : rep (e.rep) + { + rep->count++; + } + + ~graphics_event (void) + { + if (rep && --rep->count == 0) + delete rep; + } + + graphics_event& operator = (const graphics_event& e) + { + if (rep != e.rep) + { + if (rep && --rep->count == 0) + delete rep; + + rep = e.rep; + if (rep) + rep->count++; + } + + return *this; + } + + void execute (void) + { if (rep) rep->execute (); } + + bool ok (void) const + { return (rep != 0); } + + static graphics_event + create_callback_event (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()); + + static graphics_event + create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()); + + static graphics_event + create_function_event (event_fcn fcn, void *data = 0); + + static graphics_event + create_set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, + bool notify_toolkit = true); +private: + base_graphics_event *rep; +}; + +class OCTINTERP_API gh_manager +{ +protected: + + gh_manager (void); + +public: + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create gh_manager!"); + + retval = false; + } + + return retval; + } + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static graphics_handle get_handle (bool integer_figure_handle) + { + return instance_ok () + ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); + } + + static void free (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_free (h); + } + + static void renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) + { + if (instance_ok ()) + instance->do_renumber_figure (old_gh, new_gh); + } + + static graphics_handle lookup (double val) + { + return instance_ok () ? instance->do_lookup (val) : graphics_handle (); + } + + static graphics_handle lookup (const octave_value& val) + { + return val.is_real_scalar () + ? lookup (val.double_value ()) : graphics_handle (); + } + + static graphics_object get_object (double val) + { + return get_object (lookup (val)); + } + + static graphics_object get_object (const graphics_handle& h) + { + return instance_ok () ? instance->do_get_object (h) : graphics_object (); + } + + static graphics_handle + make_graphics_handle (const std::string& go_name, + const graphics_handle& parent, + bool integer_figure_handle = false, + bool do_createfcn = true, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_graphics_handle (go_name, parent, + integer_figure_handle, + do_createfcn, do_notify_toolkit) + : graphics_handle (); + } + + static graphics_handle make_figure_handle (double val, + bool do_notify_toolkit = true) + { + return instance_ok () + ? instance->do_make_figure_handle (val, do_notify_toolkit) + : graphics_handle (); + } + + static void push_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_push_figure (h); + } + + static void pop_figure (const graphics_handle& h) + { + if (instance_ok ()) + instance->do_pop_figure (h); + } + + static graphics_handle current_figure (void) + { + return instance_ok () + ? instance->do_current_figure () : graphics_handle (); + } + + static Matrix handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_handle_list (show_hidden) : Matrix (); + } + + static void lock (void) + { + if (instance_ok ()) + instance->do_lock (); + } + + static bool try_lock (void) + { + if (instance_ok ()) + return instance->do_try_lock (); + else + return false; + } + + static void unlock (void) + { + if (instance_ok ()) + instance->do_unlock (); + } + + static Matrix figure_handle_list (bool show_hidden = false) + { + return instance_ok () + ? instance->do_figure_handle_list (show_hidden) : Matrix (); + } + + static void execute_listener (const graphics_handle& h, + const octave_value& l) + { + if (instance_ok ()) + instance->do_execute_listener (h, l); + } + + static void execute_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + octave_value cb; + + if (true) + { + gh_manager::auto_lock lock; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + cb = go.get (name); + } + + if (! error_state) + execute_callback (h, cb, data); + } + + static void execute_callback (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_execute_callback (h, cb, data); + } + + static void post_callback (const graphics_handle& h, + const std::string& name, + const octave_value& data = Matrix ()) + { + if (instance_ok ()) + instance->do_post_callback (h, name, data); + } + + static void post_function (graphics_event::event_fcn fcn, void* data = 0) + { + if (instance_ok ()) + instance->do_post_function (fcn, data); + } + + static void post_set (const graphics_handle& h, const std::string& name, + const octave_value& value, bool notify_toolkit = true) + { + if (instance_ok ()) + instance->do_post_set (h, name, value, notify_toolkit); + } + + static int process_events (void) + { + return (instance_ok () ? instance->do_process_events () : 0); + } + + static int flush_events (void) + { + return (instance_ok () ? instance->do_process_events (true) : 0); + } + + static void enable_event_processing (bool enable = true) + { + if (instance_ok ()) + instance->do_enable_event_processing (enable); + } + + static bool is_handle_visible (const graphics_handle& h) + { + bool retval = false; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + retval = go.is_handle_visible (); + + return retval; + } + + static void close_all_figures (void) + { + if (instance_ok ()) + instance->do_close_all_figures (); + } + +public: + class auto_lock : public octave_autolock + { + public: + auto_lock (bool wait = true) + : octave_autolock (instance_ok () + ? instance->graphics_lock + : octave_mutex (), + wait) + { } + + private: + + // No copying! + auto_lock (const auto_lock&); + auto_lock& operator = (const auto_lock&); + }; + +private: + + static gh_manager *instance; + + typedef std::map::iterator iterator; + typedef std::map::const_iterator const_iterator; + + typedef std::set::iterator free_list_iterator; + typedef std::set::const_iterator const_free_list_iterator; + + typedef std::list::iterator figure_list_iterator; + typedef std::list::const_iterator const_figure_list_iterator; + + // A map of handles to graphics objects. + std::map handle_map; + + // The available graphics handles. + std::set handle_free_list; + + // The next handle available if handle_free_list is empty. + double next_handle; + + // The allocated figure handles. Top of the stack is most recently + // created. + std::list figure_list; + + // The lock for accessing the graphics sytsem. + octave_mutex graphics_lock; + + // The list of events queued by graphics toolkits. + std::list event_queue; + + // The stack of callback objects. + std::list callback_objects; + + // A flag telling whether event processing must be constantly on. + int event_processing; + + graphics_handle do_get_handle (bool integer_figure_handle); + + void do_free (const graphics_handle& h); + + void do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh); + + graphics_handle do_lookup (double val) + { + iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); + + return (p != handle_map.end ()) ? p->first : graphics_handle (); + } + + graphics_object do_get_object (const graphics_handle& h) + { + iterator p = (h.ok () ? handle_map.find (h) : handle_map.end ()); + + return (p != handle_map.end ()) ? p->second : graphics_object (); + } + + graphics_handle do_make_graphics_handle (const std::string& go_name, + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); + + Matrix do_handle_list (bool show_hidden) + { + Matrix retval (1, handle_map.size ()); + + octave_idx_type i = 0; + for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) + { + graphics_handle h = p->first; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + Matrix do_figure_handle_list (bool show_hidden) + { + Matrix retval (1, figure_list.size ()); + + octave_idx_type i = 0; + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); + } + + retval.resize (1, i); + + return retval; + } + + void do_push_figure (const graphics_handle& h); + + void do_pop_figure (const graphics_handle& h); + + graphics_handle do_current_figure (void) const + { + graphics_handle retval; + + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (is_handle_visible (h)) + retval = h; + } + + return retval; + } + + void do_lock (void) { graphics_lock.lock (); } + + bool do_try_lock (void) { return graphics_lock.try_lock (); } + + void do_unlock (void) { graphics_lock.unlock (); } + + void do_execute_listener (const graphics_handle& h, const octave_value& l); + + void do_execute_callback (const graphics_handle& h, const octave_value& cb, + const octave_value& data); + + void do_post_callback (const graphics_handle& h, const std::string name, + const octave_value& data); + + void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); + + void do_post_set (const graphics_handle& h, const std::string name, + const octave_value& value, bool notify_toolkit = true); + + int do_process_events (bool force = false); + + void do_close_all_figures (void); + + static void restore_gcbo (void) + { + if (instance_ok ()) + instance->do_restore_gcbo (); + } + + void do_restore_gcbo (void); + + void do_post_event (const graphics_event& e); + + void do_enable_event_processing (bool enable = true); +}; + +void get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, + const Matrix& kids, char limit_type); + +OCTINTERP_API int calc_dimensions (const graphics_object& gh); + +// This function is NOT equivalent to the scripting language function gcf. +OCTINTERP_API graphics_handle gcf (void); + +// This function is NOT equivalent to the scripting language function gca. +OCTINTERP_API graphics_handle gca (void); + +OCTINTERP_API void close_all_figures (void); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/help.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/help.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1405 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "load-path.h" +#include "oct-obj.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-pr-code.h" +#include "sighandlers.h" +#include "symtab.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "quit.h" + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +std::string Vinfo_program; + +// Name of the makeinfo program to run. +static std::string Vmakeinfo_program = "makeinfo"; + +// If TRUE, don't print additional help message in help and usage +// functions. +static bool Vsuppress_verbose_help_message = false; + +#include + +typedef std::map map_type; +typedef map_type::value_type pair_type; +typedef map_type::const_iterator map_iter; + +template +std::size_t +size (T const (&)[z]) +{ + return z; +} + +const static pair_type operators[] = +{ + pair_type ("!", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !\n\ +Logical 'not' operator.\n\ +@seealso{~, not}\n\ +@end deftypefn"), + + pair_type ("~", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~\n\ +Logical 'not' operator.\n\ +@seealso{!, not}\n\ +@end deftypefn"), + + pair_type ("!=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} !=\n\ +Logical 'not equals' operator.\n\ +@seealso{~=, ne}\n\ +@end deftypefn"), + + pair_type ("~=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ~=\n\ +Logical 'not equals' operator.\n\ +@seealso{!=, ne}\n\ +@end deftypefn"), + + pair_type ("\"", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \"\n\ +String delimiter.\n\ +@end deftypefn"), + + pair_type ("#", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #\n\ +Begin comment character.\n\ +@seealso{%, #@\\{}\n\ +@end deftypefn"), + + pair_type ("%", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %\n\ +Begin comment character.\n\ +@seealso{#, %@\\{}\n\ +@end deftypefn"), + + pair_type ("#{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\{, #@\\}, #}\n\ +@end deftypefn"), + + pair_type ("%{", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@{\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\{, %@\\}, %}\n\ +@end deftypefn"), + + pair_type ("#}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} #@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@\\}, #@\\{, #}\n\ +@end deftypefn"), + + pair_type ("%}", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} %@}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@\\}, %@\\{, %}\n\ +@end deftypefn"), + + pair_type ("...", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ...\n\ +Continuation marker. Joins current line with following line.\n\ +@end deftypefn"), + + pair_type ("&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &\n\ +Element by element logical 'and' operator.\n\ +@seealso{&&, and}\n\ +@end deftypefn"), + + pair_type ("&&", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} &&\n\ +Logical 'and' operator (with short-circuit evaluation).\n\ +@seealso{&, and}\n\ +@end deftypefn"), + + pair_type ("'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} '\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +complex conjugate (Hermitian) transpose.\n\ +\n\ +The single quote character may also be used to delimit strings, but\n\ +it is better to use the double quote character, since that is never\n\ +ambiguous.\n\ +@seealso{.', transpose}\n\ +@end deftypefn"), + + pair_type ("(", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} (\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type (")", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} )\n\ +Array index or function argument delimiter.\n\ +@end deftypefn"), + + pair_type ("*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} *\n\ +Multiplication operator.\n\ +@seealso{.*, times}\n\ +@end deftypefn"), + + pair_type ("**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} **\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, ^, .**, .^, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ^\n\ +Power operator. This may return complex results for real inputs. Use\n\ +@code{realsqrt}, @code{cbrt}, @code{nthroot}, or @code{realroot} to obtain\n\ +real results when possible.\n\ +@seealso{power, **, .^, .**, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("+", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} +\n\ +Addition operator.\n\ +@seealso{plus}\n\ +@end deftypefn"), + + pair_type ("++", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ++\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{--}\n\ +@end deftypefn"), + + pair_type (",", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ,\n\ +Array index, function argument, or command separator.\n\ +@end deftypefn"), + + pair_type ("-", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} -\n\ +Subtraction or unary negation operator.\n\ +@seealso{minus}\n\ +@end deftypefn"), + + pair_type ("--", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} --\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ +operator.\n\ +@seealso{++}\n\ +@end deftypefn"), + + pair_type (".'", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .'\n\ +Matrix transpose operator. For complex matrices, computes the\n\ +transpose, @emph{not} the complex conjugate transpose.\n\ +@seealso{', transpose}\n\ +@end deftypefn"), + + pair_type (".*", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element multiplication operator.\n\ +@seealso{*, times}\n\ +@end deftypefn"), + + pair_type (".**", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .*\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{**, ^, .^, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type (".^", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .^\n\ +Element by element power operator. If several complex results are possible,\n\ +returns the one with smallest non-negative argument (angle). Use\n\ +@code{realpow}, @code{realsqrt}, @code{cbrt}, or @code{nthroot} if a\n\ +real result is preferred.\n\ +@seealso{.**, ^, **, power, realpow, realsqrt, cbrt, nthroot}\n\ +@end deftypefn"), + + pair_type ("./", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ./\n\ +Element by element right division operator.\n\ +@seealso{/, .\\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("/", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} /\n\ +Right division operator.\n\ +@seealso{./, \\, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type (".\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} .\\\n\ +Element by element left division operator.\n\ +@seealso{\\, ./, rdivide, mrdivide}\n\ +@end deftypefn"), + + pair_type ("\\", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} \\\n\ +Left division operator.\n\ +@seealso{.\\, /, ldivide, mldivide}\n\ +@end deftypefn"), + + pair_type (":", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} :\n\ +Select entire rows or columns of matrices.\n\ +@end deftypefn"), + + pair_type (";", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ;\n\ +Array row or command separator.\n\ +@seealso{,}\n\ +@end deftypefn"), + + pair_type ("<", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <\n\ +'Less than' operator.\n\ +@seealso{lt}\n\ +@end deftypefn"), + + pair_type ("<=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} <=\n\ +'Less than' or 'equals' operator.\n\ +@seealso{le}\n\ +@end deftypefn"), + + pair_type ("=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} =\n\ +Assignment operator.\n\ +@end deftypefn"), + + pair_type ("==", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ==\n\ +Equality test operator.\n\ +@seealso{eq}\n\ +@end deftypefn"), + + pair_type (">", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >\n\ +'Greater than' operator.\n\ +@seealso{gt}\n\ +@end deftypefn"), + + pair_type (">=", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} >=\n\ +'Greater than' or 'equals' operator.\n\ +@seealso{ge}\n\ +@end deftypefn"), + + pair_type ("[", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} [\n\ +Return list delimiter.\n\ +@seealso{]}\n\ +@end deftypefn"), + + pair_type ("]", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ]\n\ +Return list delimiter.\n\ +@seealso{[}\n\ +@end deftypefn"), + + pair_type ("|", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} |\n\ +Element by element logical 'or' operator.\n\ +@seealso{||, or}\n\ +@end deftypefn"), + + pair_type ("||", + "-*- texinfo -*-\n\ +@deftypefn {Operator} {} ||\n\ +Logical 'or' (with short-circuit evaluation) operator.\n\ +@seealso{|, or}\n\ +@end deftypefn"), +}; + +const static pair_type keywords[] = +{ + pair_type ("break", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} break\n\ +Exit the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, continue}\n\ +@end deftypefn"), + + pair_type ("case", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} case @{@var{value}@}\n\ +A case statement in an switch. Octave cases are exclusive and do not\n\ +fall-through as do C-language cases. A switch statement must have at least\n\ +one case. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} catch\n\ +Begin the cleanup part of a try-catch block.\n\ +@seealso{try}\n\ +@end deftypefn"), + + pair_type ("continue", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} continue\n\ +Jump to the end of the innermost enclosing do, while or for loop.\n\ +@seealso{do, while, for, parfor, break}\n\ +@end deftypefn"), + + pair_type ("do", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} do\n\ +Begin a do-until loop. This differs from a do-while loop in that the\n\ +body of the loop is executed at least once.\n\ +@seealso{while}\n\ +@end deftypefn"), + + pair_type ("else", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} else\n\ +Alternate action for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("elseif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} elseif (@var{condition})\n\ +Alternate conditional test for an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("end", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end\n\ +Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ +@code{function} block.\n\ +@seealso{for, parfor, if, do, while, function}\n\ +@end deftypefn"), + + pair_type ("end_try_catch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_try_catch\n\ +Mark the end of an @code{try-catch} block.\n\ +@seealso{try, catch}\n\ +@end deftypefn"), + + pair_type ("end_unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} end_unwind_protect\n\ +Mark the end of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("endfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfor\n\ +Mark the end of a for loop. See @code{for} for an example.\n\ +@seealso{for}\n\ +@end deftypefn"), + + pair_type ("endfunction", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endfunction\n\ +Mark the end of a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("endif", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endif\n\ +Mark the end of an if block. See @code{if} for an example.\n\ +@seealso{if}\n\ +@end deftypefn"), + + pair_type ("endparfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endparfor\n\ +Mark the end of a parfor loop. See @code{parfor} for an example.\n\ +@seealso{parfor}\n\ +@end deftypefn"), + + pair_type ("endswitch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endswitch\n\ +Mark the end of a switch block. See @code{switch} for an example.\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("endwhile", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endwhile\n\ +Mark the end of a while loop. See @code{while} for an example.\n\ +@seealso{do, while}\n\ +@end deftypefn"), + + pair_type ("for", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +Begin a for loop.\n\ +\n\ +@example\n\ +@group\n\ +for i = 1:10\n\ + i\n\ +endfor\n\ +@end group\n\ +@end example\n\ +@seealso{do, parfor, while}\n\ +@end deftypefn"), + + pair_type ("function", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} function @var{outputs} = function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function {} function (@var{input}, @dots{})\n\ +@deftypefnx {Keyword} {} function @var{outputs} = function\n\ +Begin a function body with @var{outputs} as results and @var{inputs} as\n\ +parameters.\n\ +@seealso{return}\n\ +@end deftypefn"), + + pair_type ("global", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} global\n\ +Declare variables to have global scope.\n\ +\n\ +@example\n\ +@group\n\ +global @var{x};\n\ +if (isempty (@var{x}))\n\ + x = 1;\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("if", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} if (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} else @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} endif\n\ +@deftypefnx {Keyword} {} if (@var{cond}) @dots{} elseif (@var{cond}) @dots{} else @dots{} endif\n\ +Begin an if block.\n\ +\n\ +@example\n\ +@group\n\ +x = 1;\n\ +if (x == 1)\n\ + disp (\"one\");\n\ +elseif (x == 2)\n\ + disp (\"two\");\n\ +else\n\ + disp (\"not one or two\");\n\ +endif\n\ +@end group\n\ +@end example\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("otherwise", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} otherwise\n\ +The default statement in a switch block (similar to else in an if block).\n\ +@seealso{switch}\n\ +@end deftypefn"), + + pair_type ("parfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ +Begin a for loop that may execute in parallel.\n\ +\n\ +@example\n\ +@group\n\ +parfor i = 1:10\n\ + i\n\ +endparfor\n\ +@end group\n\ +@end example\n\ +@seealso{for, do, while}\n\ +@end deftypefn"), + + pair_type ("persistent", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} persistent @var{var}\n\ +Declare variables as persistent. A variable that has been declared\n\ +persistent within a function will retain its contents in memory between\n\ +subsequent calls to the same function. The difference between persistent\n\ +variables and global variables is that persistent variables are local in \n\ +scope to a particular function and are not visible elsewhere.\n\ +@seealso{global}\n\ +@end deftypefn"), + + pair_type ("return", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} return\n\ +Return from a function.\n\ +@seealso{function}\n\ +@end deftypefn"), + + pair_type ("static", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} static\n\ +This function has been deprecated in favor of persistent.\n\ +@seealso{persistent}\n\ +@end deftypefn"), + + pair_type ("switch", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} switch @var{statement}\n\ +Begin a switch block.\n\ +\n\ +@example\n\ +@group\n\ +yesno = \"yes\"\n\ +\n\ +switch yesno\n\ + case @{\"Yes\" \"yes\" \"YES\" \"y\" \"Y\"@}\n\ + value = 1;\n\ + case @{\"No\" \"no\" \"NO\" \"n\" \"N\"@}\n\ + value = 0;\n\ + otherwise\n\ + error (\"invalid value\");\n\ +endswitch\n\ +@end group\n\ +@end example\n\ +@seealso{if, case, otherwise}\n\ +@end deftypefn"), + + pair_type ("try", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} try\n\ +Begin a try-catch block.\n\ +\n\ +If an error occurs within a try block, then the catch code will be run and\n\ +execution will proceed after the catch block (though it is often\n\ +recommended to use the lasterr function to re-throw the error after cleanup\n\ +is completed).\n\ +@seealso{catch, unwind_protect}\n\ +@end deftypefn"), + + pair_type ("until", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} until\n\ +End a do-until loop.\n\ +@seealso{do}\n\ +@end deftypefn"), + + pair_type ("unwind_protect", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect\n\ +Begin an unwind_protect block.\n\ +\n\ +If an error occurs within the first part of an unwind_protect block\n\ +the commands within the unwind_protect_cleanup block are executed before\n\ +the error is thrown. If an error is not thrown, then the\n\ +unwind_protect_cleanup block is still executed (in other words, the\n\ +unwind_protect_cleanup will be run with or without an error in the\n\ +unwind_protect block).\n\ +@seealso{unwind_protect_cleanup, try}\n\ +@end deftypefn"), + + pair_type ("unwind_protect_cleanup", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} unwind_protect_cleanup\n\ +Begin the cleanup section of an unwind_protect block.\n\ +@seealso{unwind_protect}\n\ +@end deftypefn"), + + pair_type ("varargin", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargin\n\ +Pass an arbitrary number of arguments into a function.\n\ +@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("varargout", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} varargout\n\ +Pass an arbitrary number of arguments out of a function.\n\ +@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ +@end deftypefn"), + + pair_type ("while", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} while\n\ +Begin a while loop.\n\ +@seealso{do}\n\ +@end deftypefn"), +}; + +// Return a copy of the operator or keyword names. +static string_vector +names (const map_type& lst) +{ + string_vector retval (lst.size ()); + int j = 0; + for (map_iter iter = lst.begin (); iter != lst.end (); iter ++) + retval[j++] = iter->first; + return retval; +} + +const static map_type operators_map (operators, operators + size (operators)); +const static map_type keywords_map (keywords, keywords + size (keywords)); +const static string_vector keyword_names = names (keywords_map); + +// FIXME -- It's not likely that this does the right thing now. + +string_vector +make_name_list (void) +{ + const int key_len = keyword_names.length (); + + const string_vector bif = symbol_table::built_in_function_names (); + const int bif_len = bif.length (); + + const string_vector cfl = symbol_table::cmdline_function_names (); + const int cfl_len = cfl.length (); + + const string_vector lcl = symbol_table::variable_names (); + const int lcl_len = lcl.length (); + + const string_vector ffl = load_path::fcn_names (); + const int ffl_len = ffl.length (); + + const string_vector afl = autoloaded_functions (); + const int afl_len = afl.length (); + + const int total_len + = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; + + string_vector list (total_len); + + // Put all the symbols in one big list. + + int j = 0; + int i = 0; + for (i = 0; i < key_len; i++) + list[j++] = keyword_names[i]; + + for (i = 0; i < bif_len; i++) + list[j++] = bif[i]; + + for (i = 0; i < cfl_len; i++) + list[j++] = cfl[i]; + + for (i = 0; i < lcl_len; i++) + list[j++] = lcl[i]; + + for (i = 0; i < ffl_len; i++) + list[j++] = ffl[i]; + + for (i = 0; i < afl_len; i++) + list[j++] = afl[i]; + + return list; +} + +static bool +looks_like_html (const std::string& msg) +{ + const size_t p1 = msg.find ('\n'); + std::string t = msg.substr (0, p1); + const size_t p2 = t.find ("doc_string (); + + retval = true; + + w = fcn->fcn_file_name (); + + if (w.empty ()) + w = fcn->is_user_function () + ? "command-line function" : "built-in function"; + } + } + + return retval; +} + +static bool +raw_help_from_file (const std::string& nm, std::string& h, + std::string& file, bool& symbol_found) +{ + bool retval = false; + + // FIXME -- this is a bit of a kluge... + unwind_protect frame; + frame.protect_var (reading_script_file); + reading_script_file = true; + + h = get_help_from_file (nm, symbol_found, file); + + if (h.length () > 0) + retval = true; + + return retval; +} + +static bool +raw_help_from_map (const std::string& nm, std::string& h, + const map_type& map, bool& symbol_found) +{ + map_iter idx = map.find (nm); + symbol_found = (idx != map.end ()); + h = (symbol_found) ? idx->second : ""; + return symbol_found; +} + +std::string +raw_help (const std::string& nm, bool& symbol_found) +{ + std::string h; + std::string w; + std::string f; + + (raw_help_from_symbol_table (nm, h, w, symbol_found) + || raw_help_from_file (nm, h, f, symbol_found) + || raw_help_from_map (nm, h, operators_map, symbol_found) + || raw_help_from_map (nm, h, keywords_map, symbol_found)); + + return h; +} + +static void +do_get_help_text (const std::string& name, std::string& text, + std::string& format) +{ + bool symbol_found = false; + text = raw_help (name, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text, args, , "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text (@var{name})\n\ +Return the raw help text of function @var{name}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string name = args (0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text (name, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text: invalid input"); + } + else + print_usage (); + + return retval; +} + +static void +do_get_help_text_from_file (const std::string& fname, std::string& text, + std::string& format) +{ + bool symbol_found = false; + + std::string f; + + raw_help_from_file (fname, text, f, symbol_found); + + format = "Not found"; + if (symbol_found) + { + size_t idx = -1; + if (text.empty ()) + { + format = "Not documented"; + } + else if (looks_like_texinfo (text, idx)) + { + format = "texinfo"; + text.erase (0, idx); + } + else if (looks_like_html (text)) + { + format = "html"; + } + else + { + format = "plain text"; + } + } +} + +DEFUN (get_help_text_from_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{text}, @var{format}] =} get_help_text_from_file (@var{fname})\n\ +Return the raw help text from the file @var{fname}.\n\ +\n\ +The raw help text is returned in @var{text} and the format in @var{format}\n\ +The format is a string which is one of @t{\"texinfo\"}, @t{\"html\"}, or\n\ +@t{\"plain text\"}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + const std::string fname = args(0).string_value (); + + if (! error_state) + { + std::string text; + std::string format; + + do_get_help_text_from_file (fname, text, format); + + retval(1) = format; + retval(0) = text; + } + else + error ("get_help_text_from_file: invalid input"); + } + else + print_usage (); + + return retval; +} + +// Return a cell array of strings containing the names of all +// operators. + +DEFUN (__operators__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __operators__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (operators_map))); +} + +// Return a cell array of strings containing the names of all +// keywords. + +DEFUN (__keywords__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __keywords__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (Cell (names (keywords_map))); +} + +// Return a cell array of strings containing the names of all builtin +// functions. + +DEFUN (__builtins__, , , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __builtins__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + const string_vector bif = symbol_table::built_in_function_names (); + + return octave_value (Cell (bif)); +} + +static std::string +do_which (const std::string& name, std::string& type) +{ + std::string file; + + type = std::string (); + + octave_value val = symbol_table::find_function (name); + + if (name.find_first_of ('.') == std::string::npos) + { + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + { + file = fcn->fcn_file_name (); + + if (file.empty ()) + { + if (fcn->is_user_function ()) + type = "command-line function"; + else + { + file = fcn->src_file_name (); + type = "built-in function"; + } + } + else + type = val.is_user_script () + ? std::string ("script") : std::string ("function"); + } + } + else + { + // We might find a file that contains only a doc string. + + file = load_path::find_fcn_file (name); + } + } + else + { + // File query. + + // For compatibility: "file." queries "file". + if (name.size () > 1 && name[name.size () - 1] == '.') + file = load_path::find_file (name.substr (0, name.size () - 1)); + else + file = load_path::find_file (name); + } + + + return file; +} + +std::string +do_which (const std::string& name) +{ + std::string retval; + + std::string type; + + retval = do_which (name, type); + + return retval; +} + +DEFUN (__which__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __which__ (@var{name}, @dots{})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + string_vector argv = args.make_argv ("which"); + + if (! error_state) + { + int argc = argv.length (); + + if (argc > 1) + { + octave_map m (dim_vector (1, argc-1)); + + Cell names (1, argc-1); + Cell files (1, argc-1); + Cell types (1, argc-1); + + for (int i = 1; i < argc; i++) + { + std::string name = argv[i]; + + std::string type; + + std::string file = do_which (name, type); + + names(i-1) = name; + files(i-1) = file; + types(i-1) = type; + } + + m.assign ("name", names); + m.assign ("file", files); + m.assign ("type", types); + + retval = m; + } + else + print_usage (); + } + + return retval; +} + +// FIXME -- Are we sure this function always does the right thing? +inline bool +file_is_in_dir (const std::string filename, const std::string dir) +{ + if (filename.find (dir) == 0) + { + const int dir_len = dir.size (); + const int filename_len = filename.size (); + const int max_allowed_seps = file_ops::is_dir_sep (dir[dir_len-1]) ? 0 : 1; + + int num_seps = 0; + for (int i = dir_len; i < filename_len; i++) + if (file_ops::is_dir_sep (filename[i])) + num_seps ++; + + return (num_seps <= max_allowed_seps); + } + else + return false; +} + +// Return a cell array of strings containing the names of all +// functions available in DIRECTORY. If no directory is given, search +// the current path. + +DEFUN (__list_functions__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} {@var{retval} =} __list_functions__ ()\n\ +@deftypefnx {Function File} {@var{retval} =} __list_functions__ (@var{directory})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + // Get list of functions + string_vector ffl = load_path::fcn_names (); + string_vector afl = autoloaded_functions (); + + if (args.length () == 0) + retval = Cell (ffl.append (afl)); + else + { + std::string dir = args (0).string_value (); + + if (! error_state) + { + string_vector fl = load_path::files (dir, true); + + if (! error_state) + { + // Return a sorted list with unique entries (in case of + // .m and .oct versions of the same function in a given + // directory, for example). + fl.sort (true); + + retval = Cell (fl); + } + } + else + error ("__list_functions__: DIRECTORY argument must be a string"); + } + + return retval; +} + +DEFUN (doc_cache_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} doc_cache_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} doc_cache_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} doc_cache_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave documentation cache file. A cache file significantly improves\n\ +the performance of the @code{lookfor} command. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/doc-cache},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_DOC_CACHE_FILE}}, or the command line argument\n\ +@samp{--doc-cache-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{lookfor, info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (doc_cache_file); +} + +DEFUN (texi_macros_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} texi_macros_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} texi_macros_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} texi_macros_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +file containing Texinfo macros that are prepended to documentation strings\n\ +before they are passed to makeinfo. The default value is \n\ +@file{@var{octave-home}/share/octave/@var{version}/etc/macros.texi},\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +and @var{version} is the Octave version number.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_TEXI_MACROS_FILE}}, or the command line argument\n\ +@samp{--texi-macros-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (texi_macros_file); +} + +DEFUN (info_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_file (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_file (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +Octave info file. The default value is\n\ +@file{@var{octave-home}/info/octave.info}, in\n\ +which @var{octave-home} is the root directory of the Octave installation.\n\ +The default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_FILE}}, or the command line argument\n\ +@samp{--info-file NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_program, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_file); +} + +DEFUN (info_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} info_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} info_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} info_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +info program to run. The default value is\n\ +@file{@var{octave-home}/libexec/octave/@var{version}/exec/@var{arch}/info}\n\ +in which @var{octave-home} is the root directory of the Octave installation,\n\ +@var{version} is the Octave version number, and @var{arch}\n\ +is the system type (for example, @code{i686-pc-linux-gnu}). The\n\ +default value may be overridden by the environment variable\n\ +@w{@env{OCTAVE_INFO_PROGRAM}}, or the command line argument\n\ +@samp{--info-program NAME}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{info_file, doc, help, makeinfo_program}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (info_program); +} + +DEFUN (makeinfo_program, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} makeinfo_program ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} makeinfo_program (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} makeinfo_program (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the\n\ +program that Octave runs to format help text containing\n\ +Texinfo markup commands. The default value is @code{makeinfo}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{texi_macros_file, info_file, info_program, doc, help}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (makeinfo_program); +} + +DEFUN (suppress_verbose_help_message, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} suppress_verbose_help_message ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} suppress_verbose_help_message (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} suppress_verbose_help_message (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave\n\ +will add additional help information to the end of the output from\n\ +the @code{help} command and usage messages for built-in commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (suppress_verbose_help_message); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/help.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/help.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,54 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_help_h) +#define octave_help_h 1 + +#include +#include + +class string_vector; + +extern string_vector make_name_list (void); + +extern OCTINTERP_API std::string raw_help (const std::string&, bool&); + +// Name of the doc cache file specified on the command line. +// (--doc-cache-file file) +extern std::string Vdoc_cache_file; + +// Name of the file containing local Texinfo macros that are prepended +// to doc strings before processing. +// (--texi-macros-file) +extern std::string Vtexi_macros_file; + +// Name of the info file specified on command line. +// (--info-file file) +extern std::string Vinfo_file; + +// Name of the info reader we'd like to use. +// (--info-program program) +extern std::string Vinfo_program; + +extern std::string do_which (const std::string& name); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/input.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/input.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1570 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +// Get command input interactively or from files. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "file-ops.h" +#include "quit.h" +#include "str-vec.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-map.h" +#include "oct-hist.h" +#include "toplev.h" +#include "oct-obj.h" +#include "pager.h" +#include "parse.h" +#include "pathlen.h" +#include "pt.h" +#include "pt-const.h" +#include "pt-eval.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Primary prompt string. +static std::string VPS1 = "\\s:\\#> "; + +// Secondary prompt string. +static std::string VPS2 = "> "; + +// String printed before echoed input (enabled by --echo-input). +std::string VPS4 = "+ "; + +// Echo commands as they are executed? +// +// 1 ==> echo commands read from script files +// 2 ==> echo commands from functions +// 4 ==> echo commands read from command line +// +// more than one state can be active at once. +int Vecho_executing_commands = ECHO_OFF; + +// The time we last printed a prompt. +octave_time Vlast_prompt_time = 0.0; + +// Character to append after successful command-line completion attempts. +static char Vcompletion_append_char = ' '; + +// Global pointer for eval(). +std::string current_eval_string; + +// TRUE means get input from current_eval_string. +bool get_input_from_eval_string = false; + +// TRUE means we haven't been asked for the input from +// current_eval_string yet. +bool input_from_eval_string_pending = false; + +// TRUE means that input is coming from a file that was named on +// the command line. +bool input_from_command_line_file = false; + +// TRUE means that stdin is a terminal, not a pipe or redirected file. +bool stdin_is_tty = false; + +// TRUE means we're parsing a function file. +bool reading_fcn_file = false; + +// TRUE means we're parsing a classdef file. +bool reading_classdef_file = false; + +// Simple name of function file we are reading. +std::string curr_fcn_file_name; + +// Full name of file we are reading. +std::string curr_fcn_file_full_name; + +// TRUE means we're parsing a script file. +bool reading_script_file = false; + +// If we are reading from an M-file, this is it. +FILE *ff_instream = 0; + +// TRUE means this is an interactive shell. +bool interactive = false; + +// TRUE means the user forced this shell to be interactive (-i). +bool forced_interactive = false; + +// Should we issue a prompt? +int promptflag = 1; + +// The current line of input, from wherever. +std::string current_input_line; + +// TRUE after a call to completion_matches. +bool octave_completion_matches_called = false; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +bool Vdrawnow_requested = false; + +// TRUE if we are in debugging mode. +bool Vdebugging = false; + +// If we are in debugging mode, this is the last command entered, so +// that we can repeat the previous command if the user just types RET. +static std::string last_debugging_command; + +// TRUE if we are running in the Emacs GUD mode. +static bool Vgud_mode = false; + +// The filemarker used to separate filenames from subfunction names +char Vfilemarker = '>'; + +static void +do_input_echo (const std::string& input_string) +{ + int do_echo = reading_script_file ? + (Vecho_executing_commands & ECHO_SCRIPTS) + : (Vecho_executing_commands & ECHO_CMD_LINE) && ! forced_interactive; + + if (do_echo) + { + if (forced_interactive) + { + if (promptflag > 0) + octave_stdout << command_editor::decode_prompt_string (VPS1); + else + octave_stdout << command_editor::decode_prompt_string (VPS2); + } + else + octave_stdout << command_editor::decode_prompt_string (VPS4); + + if (! input_string.empty ()) + { + octave_stdout << input_string; + + if (input_string[input_string.length () - 1] != '\n') + octave_stdout << "\n"; + } + } +} + +std::string +gnu_readline (const std::string& s, bool force_readline) +{ + octave_quit (); + + std::string retval; + + if (line_editing || force_readline) + { + bool eof; + + retval = command_editor::readline (s, eof); + + if (! eof && retval.empty ()) + retval = "\n"; + } + else + { + if (! s.empty () && (interactive || forced_interactive)) + { + FILE *stream = command_editor::get_output_stream (); + + gnulib::fputs (s.c_str (), stream); + gnulib::fflush (stream); + } + + FILE *curr_stream = command_editor::get_input_stream (); + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + curr_stream = ff_instream; + + retval = octave_fgets (curr_stream); + } + + return retval; +} + +static inline std::string +interactive_input (const std::string& s, bool force_readline = false) +{ + Vlast_prompt_time.stamp (); + + if (Vdrawnow_requested && (interactive || forced_interactive)) + { + feval ("drawnow"); + + flush_octave_stdout (); + + // We set Vdrawnow_requested to false even if there is an error + // in drawnow so that the error doesn't reappear at every prompt. + + Vdrawnow_requested = false; + + if (error_state) + return "\n"; + } + + return gnu_readline (s, force_readline); +} + +static std::string +octave_gets (void) +{ + octave_quit (); + + std::string retval; + + bool history_skip_auto_repeated_debugging_command = false; + + if ((interactive || forced_interactive) + && (! (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file))) + { + std::string ps = (promptflag > 0) ? VPS1 : VPS2; + + std::string prompt = command_editor::decode_prompt_string (ps); + + pipe_handler_error_count = 0; + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + retval = interactive_input (prompt); + + // There is no need to update the load_path cache if there is no + // user input. + if (! retval.empty () + && retval.find_first_not_of (" \t\n\r") != std::string::npos) + { + load_path::update (); + + if (Vdebugging) + last_debugging_command = retval; + else + last_debugging_command = std::string (); + } + else if (Vdebugging) + { + retval = last_debugging_command; + history_skip_auto_repeated_debugging_command = true; + } + } + else + retval = gnu_readline (""); + + current_input_line = retval; + + if (! current_input_line.empty ()) + { + if (! (input_from_startup_file || input_from_command_line_file + || history_skip_auto_repeated_debugging_command)) + command_history::add (current_input_line); + + if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) + { + octave_diary << current_input_line; + + if (current_input_line[current_input_line.length () - 1] != '\n') + octave_diary << "\n"; + } + + do_input_echo (current_input_line); + } + else if (! (reading_fcn_file || reading_script_file || reading_classdef_file)) + octave_diary << "\n"; + + return retval; +} + +// Read a line from the input stream. + +static std::string +get_user_input (void) +{ + octave_quit (); + + std::string retval; + + if (get_input_from_eval_string) + { + if (input_from_eval_string_pending) + { + input_from_eval_string_pending = false; + + retval = current_eval_string; + + size_t len = retval.length (); + + if (len > 0 && retval[len-1] != '\n') + retval.append ("\n"); + } + } + else + retval = octave_gets (); + + current_input_line = retval; + + return retval; +} + +int +octave_read (char *buf, unsigned max_size) +{ + // FIXME -- is this a safe way to buffer the input? + + static const char * const eol = "\n"; + static std::string input_buf; + static const char *pos = 0; + static size_t chars_left = 0; + + int status = 0; + if (chars_left == 0) + { + pos = 0; + + input_buf = get_user_input (); + + chars_left = input_buf.length (); + + pos = input_buf.c_str (); + } + + if (chars_left > 0) + { + size_t len = max_size > chars_left ? chars_left : max_size; + assert (len > 0); + + memcpy (buf, pos, len); + + chars_left -= len; + pos += len; + + // Make sure input ends with a new line character. + if (chars_left == 0 && buf[len-1] != '\n') + { + if (len < max_size) + { + // There is enough room to plug the newline character in + // the buffer. + buf[len++] = '\n'; + } + else + { + // There isn't enough room to plug the newline character + // in the buffer so make sure it is returned on the next + // octave_read call. + pos = eol; + chars_left = 1; + } + } + + status = len; + + } + else if (chars_left == 0) + { + status = 0; + } + else + status = -1; + + return status; +} + +// Fix things up so that input can come from file `name', printing a +// warning if the file doesn't exist. + +FILE * +get_input_from_file (const std::string& name, int warn) +{ + FILE *instream = 0; + + if (name.length () > 0) + instream = gnulib::fopen (name.c_str (), "rb"); + + if (! instream && warn) + warning ("%s: no such file or directory", name.c_str ()); + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + ff_instream = instream; + else + command_editor::set_input_stream (instream); + + return instream; +} + +// Fix things up so that input can come from the standard input. This +// may need to become much more complicated, which is why it's in a +// separate function. + +FILE * +get_input_from_stdin (void) +{ + command_editor::set_input_stream (stdin); + return command_editor::get_input_stream (); +} + +// FIXME -- make this generate file names when appropriate. + +static string_vector +generate_possible_completions (const std::string& text, std::string& prefix, + std::string& hint) +{ + string_vector names; + + prefix = ""; + + if (looks_like_struct (text)) + names = generate_struct_completions (text, prefix, hint); + else + names = make_name_list (); + + // Sort and remove duplicates. + + names.sort (true); + + return names; +} + +static bool +is_completing_dirfns (void) +{ + static std::string dirfns_commands[] = {"cd", "ls"}; + static const size_t dirfns_commands_length = 2; + + bool retval = false; + + std::string line = command_editor::get_line_buffer (); + + for (size_t i = 0; i < dirfns_commands_length; i++) + { + int index = line.find (dirfns_commands[i] + " "); + + if (index == 0) + { + retval = true; + break; + } + } + + return retval; +} + +static std::string +generate_completion (const std::string& text, int state) +{ + std::string retval; + + static std::string prefix; + static std::string hint; + + static size_t hint_len = 0; + + static int list_index = 0; + static int name_list_len = 0; + static int name_list_total_len = 0; + static string_vector name_list; + static string_vector file_name_list; + + static int matches = 0; + + if (state == 0) + { + list_index = 0; + + prefix = ""; + + hint = text; + + // No reason to display symbols while completing a + // file/directory operation. + + if (is_completing_dirfns ()) + name_list = string_vector (); + else + name_list = generate_possible_completions (text, prefix, hint); + + name_list_len = name_list.length (); + + file_name_list = command_editor::generate_filename_completions (text); + + name_list.append (file_name_list); + + name_list_total_len = name_list.length (); + + hint_len = hint.length (); + + matches = 0; + + for (int i = 0; i < name_list_len; i++) + if (hint == name_list[i].substr (0, hint_len)) + matches++; + } + + if (name_list_total_len > 0 && matches > 0) + { + while (list_index < name_list_total_len) + { + std::string name = name_list[list_index]; + + list_index++; + + if (hint == name.substr (0, hint_len)) + { + if (list_index <= name_list_len && ! prefix.empty ()) + retval = prefix + "." + name; + else + retval = name; + + // FIXME -- looks_like_struct is broken for now, + // so it always returns false. + + if (matches == 1 && looks_like_struct (retval)) + { + // Don't append anything, since we don't know + // whether it should be '(' or '.'. + + command_editor::set_completion_append_character ('\0'); + } + else + command_editor::set_completion_append_character + (Vcompletion_append_char); + + break; + } + } + } + + return retval; +} + +static std::string +quoting_filename (const std::string &text, int, char quote) +{ + if (quote) + return text; + else + return (std::string ("'") + text); +} + +void +initialize_command_input (void) +{ + // If we are using readline, this allows conditional parsing of the + // .inputrc file. + + command_editor::set_name ("Octave"); + + // FIXME -- this needs to include a comma too, but that + // causes trouble for the new struct element completion code. + + static const char *s = "\t\n !\"\'*+-/:;<=>(){}[\\]^`~"; + + command_editor::set_basic_word_break_characters (s); + + command_editor::set_completer_word_break_characters (s); + + command_editor::set_basic_quote_characters ("\""); + + command_editor::set_filename_quote_characters (" \t\n\\\"'@<>=;|&()#$`?*[!:{"); + command_editor::set_completer_quote_characters ("'\""); + + command_editor::set_completion_function (generate_completion); + + command_editor::set_quoting_function (quoting_filename); +} + +static void +get_debug_input (const std::string& prompt) +{ + octave_user_code *caller = octave_call_stack::caller_user_code (); + std::string nm; + + int curr_debug_line = octave_call_stack::current_line (); + + bool have_file = false; + + if (caller) + { + nm = caller->fcn_file_name (); + + if (nm.empty ()) + nm = caller->name (); + else + have_file = true; + } + else + curr_debug_line = -1; + + std::ostringstream buf; + + if (! nm.empty ()) + { + if (Vgud_mode) + { + static char ctrl_z = 'Z' & 0x1f; + + buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; + } + else + { + // FIXME -- we should come up with a clean way to detect + // that we are stopped on the no-op command that marks the + // end of a function or script. + + buf << "stopped in " << nm; + + if (curr_debug_line > 0) + buf << " at line " << curr_debug_line; + + if (have_file) + { + std::string line_buf + = get_file_line (nm, curr_debug_line); + + if (! line_buf.empty ()) + buf << "\n" << curr_debug_line << ": " << line_buf; + } + } + } + + std::string msg = buf.str (); + + if (! msg.empty ()) + std::cerr << msg << std::endl; + + unwind_protect frame; + + frame.protect_var (VPS1); + VPS1 = prompt; + + if (! (interactive || forced_interactive) + || (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file)) + { + frame.protect_var (forced_interactive); + forced_interactive = true; + + frame.protect_var (reading_fcn_file); + reading_fcn_file = false; + + frame.protect_var (reading_classdef_file); + reading_classdef_file = false; + + frame.protect_var (reading_script_file); + reading_script_file = false; + + frame.protect_var (input_from_startup_file); + input_from_startup_file = false; + + frame.protect_var (input_from_command_line_file); + input_from_command_line_file = false; + + frame.protect_var (get_input_from_eval_string); + get_input_from_eval_string = false; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + + // FIXME: are these safe? + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + } + + while (Vdebugging) + { + reset_error_handler (); + + reset_parser (); + + // Save current value of global_command. + frame.protect_var (global_command); + + global_command = 0; + + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + // This is the same as yyparse in parse.y. + int retval = octave_parse (); + + if (retval == 0 && global_command) + { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &global_command); + + global_command->accept (*current_evaluator); + + if (octave_completion_matches_called) + octave_completion_matches_called = false; + } + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); + + octave_quit (); + } +} + +// If the user simply hits return, this will produce an empty matrix. + +static octave_value_list +get_user_input (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + int read_as_string = 0; + + if (nargin == 2) + read_as_string++; + + std::string prompt = args(0).string_value (); + + if (error_state) + { + error ("input: unrecognized argument"); + return retval; + } + + flush_octave_stdout (); + + octave_pager_stream::reset (); + octave_diary_stream::reset (); + + octave_diary << prompt; + + std::string input_buf = interactive_input (prompt.c_str (), true); + + if (! (error_state || input_buf.empty ())) + { + if (! input_from_startup_file) + command_history::add (input_buf); + + size_t len = input_buf.length (); + + octave_diary << input_buf; + + if (input_buf[len - 1] != '\n') + octave_diary << "\n"; + + if (len < 1) + return read_as_string ? octave_value ("") : octave_value (Matrix ()); + + if (read_as_string) + { + // FIXME -- fix gnu_readline and octave_gets instead! + if (input_buf.length () == 1 && input_buf[0] == '\n') + retval(0) = ""; + else + retval(0) = input_buf; + } + else + { + int parse_status = 0; + + retval = eval_string (input_buf, true, parse_status, nargout); + + if (! Vdebugging && retval.length () == 0) + retval(0) = Matrix (); + } + } + else + error ("input: reading user-input failed!"); + + return retval; +} + +DEFUN (input, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} input (@var{prompt})\n\ +@deftypefnx {Built-in Function} {} input (@var{prompt}, \"s\")\n\ +Print a prompt and wait for user input. For example,\n\ +\n\ +@example\n\ +input (\"Pick a number, any number! \")\n\ +@end example\n\ +\n\ +@noindent\n\ +prints the prompt\n\ +\n\ +@example\n\ +Pick a number, any number!\n\ +@end example\n\ +\n\ +@noindent\n\ +and waits for the user to enter a value. The string entered by the user\n\ +is evaluated as an expression, so it may be a literal constant, a\n\ +variable name, or any other valid expression.\n\ +\n\ +Currently, @code{input} only returns one value, regardless of the number\n\ +of values produced by the evaluation of the expression.\n\ +\n\ +If you are only interested in getting a literal string value, you can\n\ +call @code{input} with the character string @code{\"s\"} as the second\n\ +argument. This tells Octave to return the string entered by the user\n\ +directly, without evaluating it first.\n\ +\n\ +Because there may be output waiting to be displayed by the pager, it is\n\ +a good idea to always call @code{fflush (stdout)} before calling\n\ +@code{input}. This will ensure that all pending output is written to\n\ +the screen before your prompt. @xref{Input and Output}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + retval = get_user_input (args, nargout); + else + print_usage (); + + return retval; +} + +bool +octave_yes_or_no (const std::string& prompt) +{ + std::string prompt_string = prompt + "(yes or no) "; + + while (1) + { + std::string input_buf = interactive_input (prompt_string, true); + + if (input_buf == "yes") + return true; + else if (input_buf == "no") + return false; + else + message (0, "Please answer yes or no."); + } +} + +DEFUN (yes_or_no, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} yes_or_no (@var{prompt})\n\ +Ask the user a yes-or-no question. Return 1 if the answer is yes.\n\ +Takes one argument, which is the string to display to ask the\n\ +question. It should end in a space; @samp{yes-or-no-p} adds\n\ +@samp{(yes or no) } to it. The user must confirm the answer with\n\ +RET and can edit it until it has been confirmed.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + std::string prompt; + + if (nargin == 1) + { + prompt = args(0).string_value (); + + if (error_state) + { + error ("yes_or_no: PROMPT must be a character string"); + return retval; + } + } + + retval = octave_yes_or_no (prompt); + } + else + print_usage (); + + return retval; +} + +octave_value +do_keyboard (const octave_value_list& args) +{ + octave_value retval; + + int nargin = args.length (); + + assert (nargin == 0 || nargin == 1); + + unwind_protect frame; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (false); + + frame.protect_var (Vdebugging); + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // FIXME -- probably we just want to print one line, not the + // entire statement, which might span many lines... + // + // tree_print_code tpc (octave_stdout); + // stmt.accept (tpc); + + Vdebugging = true; + + std::string prompt = "debug> "; + if (nargin > 0) + prompt = args(0).string_value (); + + if (! error_state) + get_debug_input (prompt); + + return retval; +} + +DEFUN (keyboard, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} keyboard ()\n\ +@deftypefnx {Built-in Function} {} keyboard (@var{prompt})\n\ +This function is normally used for simple debugging. When the\n\ +@code{keyboard} function is executed, Octave prints a prompt and waits\n\ +for user input. The input strings are then evaluated and the results\n\ +are printed. This makes it possible to examine the values of variables\n\ +within a function, and to assign new values if necessary. To leave the\n\ +prompt and return to normal execution type @samp{return} or @samp{dbcont}.\n\ +The @code{keyboard} function does not return an exit status.\n\ +\n\ +If @code{keyboard} is invoked without arguments, a default prompt of\n\ +@samp{debug> } is used.\n\ +@seealso{dbcont, dbquit}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0 || nargin == 1) + { + unwind_protect frame; + + frame.add_fcn (octave_call_stack::restore_frame, + octave_call_stack::current_frame ()); + + // Skip the frame assigned to the keyboard function. + octave_call_stack::goto_frame_relative (0); + + tree_evaluator::debug_mode = true; + + tree_evaluator::current_frame = octave_call_stack::current_frame (); + + do_keyboard (args); + } + else + print_usage (); + + return retval; +} + +DEFUN (echo, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} echo options\n\ +Control whether commands are displayed as they are executed. Valid\n\ +options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Enable echoing of commands as they are executed in script files.\n\ +\n\ +@item off\n\ +Disable echoing of commands as they are executed in script files.\n\ +\n\ +@item on all\n\ +Enable echoing of commands as they are executed in script files and\n\ +functions.\n\ +\n\ +@item off all\n\ +Disable echoing of commands as they are executed in script files and\n\ +functions.\n\ +@end table\n\ +\n\ +@noindent\n\ +With no arguments, @code{echo} toggles the current echo state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("echo"); + + if (error_state) + return retval; + + switch (argc) + { + case 1: + { + if ((Vecho_executing_commands & ECHO_SCRIPTS) + || (Vecho_executing_commands & ECHO_FUNCTIONS)) + Vecho_executing_commands = ECHO_OFF; + else + Vecho_executing_commands = ECHO_SCRIPTS; + } + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + Vecho_executing_commands = ECHO_SCRIPTS; + else if (arg == "off") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + case 3: + { + std::string arg = argv[1]; + + if (arg == "on" && argv[2] == "all") + { + int tmp = (ECHO_SCRIPTS | ECHO_FUNCTIONS); + Vecho_executing_commands = tmp; + } + else if (arg == "off" && argv[2] == "all") + Vecho_executing_commands = ECHO_OFF; + else + print_usage (); + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (completion_matches, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} completion_matches (@var{hint})\n\ +Generate possible completions given @var{hint}.\n\ +\n\ +This function is provided for the benefit of programs like Emacs which\n\ +might be controlling Octave and handling user input. The current\n\ +command number is not incremented when this function is called. This is\n\ +a feature, not a bug.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string hint = args(0).string_value (); + + if (! error_state) + { + int n = 32; + + string_vector list (n); + + int k = 0; + + for (;;) + { + std::string cmd = generate_completion (hint, k); + + if (! cmd.empty ()) + { + if (k == n) + { + n *= 2; + list.resize (n); + } + + list[k++] = cmd; + } + else + { + list.resize (k); + break; + } + } + + if (nargout > 0) + { + if (! list.empty ()) + retval = list; + else + retval = ""; + } + else + { + // We don't use string_vector::list_in_columns here + // because it will be easier for Emacs if the names + // appear in a single column. + + int len = list.length (); + + for (int i = 0; i < len; i++) + octave_stdout << list[i] << "\n"; + } + + octave_completion_matches_called = true; + } + } + else + print_usage (); + + return retval; +} + +DEFUN (read_readline_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} read_readline_init_file (@var{file})\n\ +Read the readline library initialization file @var{file}. If\n\ +@var{file} is omitted, read the default initialization file (normally\n\ +@file{~/.inputrc}).\n\ +\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + command_editor::read_init_file (); + else if (nargin == 1) + { + std::string file = args(0).string_value (); + + if (! error_state) + command_editor::read_init_file (file); + } + else + print_usage (); + + return retval; +} + +DEFUN (re_read_readline_init_file, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} re_read_readline_init_file ()\n\ +Re-read the last readline library initialization file that was read.\n\ +@xref{Readline Init File, , , readline, GNU Readline Library},\n\ +for details.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + command_editor::re_read_init_file (); + else + print_usage (); + + return retval; +} + +typedef std::map hook_fcn_map_type; + +static hook_fcn_map_type hook_fcn_map; + +static int +input_event_hook (void) +{ + if (! lexer_flags.defining_func) + { + hook_fcn_map_type::iterator p = hook_fcn_map.begin (); + + while (p != hook_fcn_map.end ()) + { + std::string hook_fcn = p->first; + octave_value user_data = p->second; + + hook_fcn_map_type::iterator q = p++; + + if (is_valid_function (hook_fcn)) + { + if (user_data.is_defined ()) + feval (hook_fcn, user_data, 0); + else + feval (hook_fcn, octave_value_list (), 0); + } + else + hook_fcn_map.erase (q); + } + + if (hook_fcn_map.empty ()) + command_editor::remove_event_hook (input_event_hook); + } + + return 0; +} + +DEFUN (add_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} add_input_event_hook (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} add_input_event_hook (@var{fcn}, @var{data})\n\ +Add the named function @var{fcn} to the list of functions to call\n\ +periodically when Octave is waiting for input. The function should\n\ +have the form\n\ +\n\ +@example\n\ +@var{fcn} (@var{data})\n\ +@end example\n\ +\n\ +If @var{data} is omitted, Octave calls the function without any\n\ +arguments.\n\ +@seealso{remove_input_event_hook}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + octave_value user_data; + + if (nargin == 2) + user_data = args(1); + + std::string hook_fcn = args(0).string_value (); + + if (! error_state) + { + if (hook_fcn_map.empty ()) + command_editor::add_event_hook (input_event_hook); + + hook_fcn_map[hook_fcn] = user_data; + } + else + error ("add_input_event_hook: expecting string as first arg"); + } + else + print_usage (); + + return retval; +} + +DEFUN (remove_input_event_hook, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} remove_input_event_hook (@var{fcn})\n\ +Remove the named function @var{fcn} from the list of functions to call\n\ +periodically when Octave is waiting for input.\n\ +@seealso{add_input_event_hook}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string hook_fcn = args(0).string_value (); + + if (! error_state) + { + hook_fcn_map_type::iterator p = hook_fcn_map.find (hook_fcn); + + if (p != hook_fcn_map.end ()) + hook_fcn_map.erase (p); + else + error ("remove_input_event_hook: %s not found in list", + hook_fcn.c_str ()); + + if (hook_fcn_map.empty ()) + command_editor::remove_event_hook (input_event_hook); + } + else + error ("remove_input_event_hook: expecting string as first arg"); + } + else + print_usage (); + + return retval; +} + +DEFUN (PS1, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS1 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS1 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS1 (@var{new_val}, \"local\")\n\ +Query or set the primary prompt string. When executing interactively,\n\ +Octave displays the primary prompt when it is ready to read a command.\n\ +\n\ +The default value of the primary prompt string is @code{\"\\s:\\#> \"}.\n\ +To change it, use a command like\n\ +\n\ +@example\n\ +PS1 (\"\\\\u@@\\\\H> \")\n\ +@end example\n\ +\n\ +@noindent\n\ +which will result in the prompt @samp{boris@@kremvax> } for the user\n\ +@samp{boris} logged in on the host @samp{kremvax.kgb.su}. Note that two\n\ +backslashes are required to enter a backslash into a double-quoted\n\ +character string. @xref{Strings}.\n\ +\n\ +You can also use ANSI escape sequences if your terminal supports them.\n\ +This can be useful for coloring the prompt. For example,\n\ +\n\ +@example\n\ +PS1 (\"\\\\[\\\\033[01;31m\\\\]\\\\s:\\\\#> \\\\[\\\\033[0m\\\\]\")\n\ +@end example\n\ +\n\ +@noindent\n\ +will give the default Octave prompt a red coloring.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS2, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS1); +} + +DEFUN (PS2, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS2 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS2 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS2 (@var{new_val}, \"local\")\n\ +Query or set the secondary prompt string. The secondary prompt is\n\ +printed when Octave is expecting additional input to complete a\n\ +command. For example, if you are typing a @code{for} loop that spans several\n\ +lines, Octave will print the secondary prompt at the beginning of\n\ +each line after the first. The default value of the secondary prompt\n\ +string is @code{\"> \"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PS1, PS4}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS2); +} + +DEFUN (PS4, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PS4 ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PS4 (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PS4 (@var{new_val}, \"local\")\n\ +Query or set the character string used to prefix output produced\n\ +when echoing commands is enabled.\n\ +The default value is @code{\"+ \"}.\n\ +@xref{Diary and Echo Commands}, for a description of echoing commands.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{echo, echo_executing_commands, PS1, PS2}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (PS4); +} + +DEFUN (completion_append_char, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} completion_append_char ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} completion_append_char (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} completion_append_char (@var{new_val}, \"local\")\n\ +Query or set the internal character variable that is appended to\n\ +successful command-line completion attempts. The default\n\ +value is @code{\" \"} (a single space).\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (completion_append_char); +} + +DEFUN (echo_executing_commands, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} echo_executing_commands ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} echo_executing_commands (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} echo_executing_commands (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls the echo state.\n\ +It may be the sum of the following values:\n\ +\n\ +@table @asis\n\ +@item 1\n\ +Echo commands read from script files.\n\ +\n\ +@item 2\n\ +Echo commands from functions.\n\ +\n\ +@item 4\n\ +Echo commands read from command line.\n\ +@end table\n\ +\n\ +More than one state can be active at once. For example, a value of 3 is\n\ +equivalent to the command @kbd{echo on all}.\n\ +\n\ +The value of @code{echo_executing_commands} may be set by the @kbd{echo}\n\ +command or the command line option @option{--echo-commands}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (echo_executing_commands); +} + +DEFUN (__request_drawnow__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __request_drawnow__ ()\n\ +@deftypefnx {Built-in Function} {} __request_drawnow__ (@var{flag})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + Vdrawnow_requested = true; + else if (nargin == 1) + Vdrawnow_requested = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (__gud_mode__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __gud_mode__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = Vgud_mode; + else if (nargin == 1) + Vgud_mode = args(0).bool_value (); + else + print_usage (); + + return retval; +} + +DEFUN (filemarker, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} filemarker ()\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} filemarker (@var{new_val}, \"local\")\n\ +Query or set the character used to separate filename from the\n\ +the subfunction names contained within the file. This can be used in\n\ +a generic manner to interact with subfunctions. For example,\n\ +\n\ +@example\n\ +help ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +returns the help string associated with the subfunction @code{mysubfunc}\n\ +of the function @code{myfunc}. Another use of @code{filemarker} is when\n\ +debugging it allows easier placement of breakpoints within subfunctions.\n\ +For example,\n\ +\n\ +@example\n\ +dbstop ([\"myfunc\", filemarker, \"mysubfunc\"])\n\ +@end example\n\ +\n\ +@noindent\n\ +will set a breakpoint at the first line of the subfunction @code{mysubfunc}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + char tmp = Vfilemarker; + octave_value retval = SET_INTERNAL_VARIABLE (filemarker); + + // The character passed must not be a legal character for a function name + if (! error_state && (::isalnum (Vfilemarker) || Vfilemarker == '_')) + { + Vfilemarker = tmp; + error ("filemarker: character can not be a valid character for a function name"); + } + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/input.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/input.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,123 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +// Use the GNU readline library for command line editing and hisory. + +#if !defined (octave_input_h) +#define octave_input_h 1 + +#include + +#include + +#include "oct-time.h" +#include "oct-obj.h" +#include "pager.h" + +class octave_value; + +extern OCTINTERP_API int octave_read (char *buf, unsigned max_size); +extern OCTINTERP_API FILE *get_input_from_file (const std::string& name, int warn = 1); +extern OCTINTERP_API FILE *get_input_from_stdin (void); + +// Global pointer for eval(). +extern std::string current_eval_string; + +// TRUE means get input from current_eval_string. +extern bool get_input_from_eval_string; + +// TRUE means we haven't been asked for the input from +// current_eval_string yet. +extern bool input_from_eval_string_pending; + +// TRUE means that input is coming from a file that was named on +// the command line. +extern bool input_from_command_line_file; + +// TRUE means that stdin is a terminal, not a pipe or redirected file. +extern bool stdin_is_tty; + +// TRUE means we're parsing a function file. +extern bool reading_fcn_file; + +// Simple name of function file we are reading. +extern std::string curr_fcn_file_name; + +// Full name of file we are reading. +extern std::string curr_fcn_file_full_name; + +// TRUE means we're parsing a script file. +extern bool reading_script_file; + +// TRUE means we're parsing a classdef file. +extern bool reading_classdef_file; + +// If we are reading from an M-file, this is it. +extern FILE *ff_instream; + +// TRUE means this is an interactive shell. +extern bool interactive; + +// TRUE means the user forced this shell to be interactive (-i). +extern bool forced_interactive; + +// Should we issue a prompt? +extern int promptflag; + +// A line of input. +extern std::string current_input_line; + +// TRUE after a call to completion_matches. +extern bool octave_completion_matches_called; + +// TRUE if the plotting system has requested a call to drawnow at +// the next user prompt. +extern OCTINTERP_API bool Vdrawnow_requested; + +// TRUE if we are in debugging mode. +extern OCTINTERP_API bool Vdebugging; + +extern std::string gnu_readline (const std::string& s, bool force_readline = false); + +extern void initialize_command_input (void); + +extern bool octave_yes_or_no (const std::string& prompt); + +extern octave_value do_keyboard (const octave_value_list& args = octave_value_list ()); + +extern std::string VPS4; + +extern char Vfilemarker; + +enum echo_state +{ + ECHO_OFF = 0, + ECHO_SCRIPTS = 1, + ECHO_FUNCTIONS = 2, + ECHO_CMD_LINE = 4 +}; + +extern int Vecho_executing_commands; + +extern octave_time Vlast_prompt_time; + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/load-path.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-path.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2327 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "input.h" +#include "load-path.h" +#include "pager.h" +#include "parse.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" + +load_path *load_path::instance = 0; +load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; +load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; +std::string load_path::command_line_path; +std::string load_path::sys_path; +load_path::abs_dir_cache_type load_path::abs_dir_cache; + +void +load_path::dir_info::update (void) +{ + file_stat fs (dir_name); + + if (fs) + { + if (is_relative) + { + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); + + if (p != abs_dir_cache.end ()) + { + // The directory is in the cache of all directories + // we have visited (indexed by its absolute name). + // If it is out of date, initialize it. Otherwise, + // copy the info from the cache. By doing that, we + // avoid unnecessary calls to stat that can slow + // things down tremendously for large directories. + + const dir_info& di = p->second; + + if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) + initialize (); + else + *this = di; + } + else + { + // We haven't seen this directory before. + + initialize (); + } + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are, but + // don't treat it as an error. + + error_state = 0; + } + } + else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) + initialize (); + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::initialize (void) +{ + is_relative = ! octave_env::absolute_pathname (dir_name); + + dir_time_last_checked = octave_time (static_cast (0)); + + file_stat fs (dir_name); + + if (fs) + { + method_file_map.clear (); + + dir_mtime = fs.mtime (); + dir_time_last_checked = octave_time (); + + get_file_list (dir_name); + + try + { + std::string abs_name = octave_env::make_absolute (dir_name); + + // FIXME -- nothing is ever removed from this cache of + // directory information, so there could be some resource + // problems. Perhaps it should be pruned from time to time. + + abs_dir_cache[abs_name] = *this; + } + catch (octave_execution_exception) + { + // Skip updating if we don't know where we are. + } + } + else + { + std::string msg = fs.error (); + warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); + } +} + +void +load_path::dir_info::get_file_list (const std::string& d) +{ + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + all_files.resize (len); + fcn_files.resize (len); + + octave_idx_type all_files_count = 0; + octave_idx_type fcn_files_count = 0; + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string full_name = file_ops::concat (d, fname); + + file_stat fs (full_name); + + if (fs) + { + if (fs.is_dir ()) + { + if (fname == "private") + get_private_file_map (full_name); + else if (fname[0] == '@') + get_method_file_map (full_name, fname.substr (1)); + } + else + { + all_files[all_files_count++] = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + std::string ext = fname.substr (pos); + + if (ext == ".m" || ext == ".oct" || ext == ".mex") + { + std::string base = fname.substr (0, pos); + + if (valid_identifier (base)) + fcn_files[fcn_files_count++] = fname; + } + } + } + } + } + + all_files.resize (all_files_count); + fcn_files.resize (fcn_files_count); + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } +} + +load_path::dir_info::fcn_file_map_type +get_fcn_files (const std::string& d) +{ + load_path::dir_info::fcn_file_map_type retval; + + dir_entry dir (d); + + if (dir) + { + string_vector flist = dir.read (); + + octave_idx_type len = flist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = flist[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + + if (valid_identifier (base)) + { + int t = 0; + + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + retval[base] |= t; + } + } + } + } + else + { + std::string msg = dir.error (); + warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); + } + + return retval; +} + +void +load_path::dir_info::get_private_file_map (const std::string& d) +{ + private_file_map = get_fcn_files (d); +} + +void +load_path::dir_info::get_method_file_map (const std::string& d, + const std::string& class_name) +{ + method_file_map[class_name].method_file_map = get_fcn_files (d); + + std::string pd = file_ops::concat (d, "private"); + + file_stat fs (pd); + + if (fs && fs.is_dir ()) + method_file_map[class_name].private_file_map = get_fcn_files (pd); +} + +bool +load_path::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new load_path (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create load path object!"); + + retval = false; + } + + return retval; +} + +// FIXME -- maybe we should also maintain a map to speed up this +// method of access. + +load_path::const_dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) const +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + const_dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +load_path::dir_info_list_iterator +load_path::find_dir_info (const std::string& dir_arg) +{ + std::string dir = file_ops::tilde_expand (dir_arg); + + dir_info_list_iterator retval = dir_info_list.begin (); + + while (retval != dir_info_list.end ()) + { + if (retval->dir_name == dir) + break; + + retval++; + } + + return retval; +} + +bool +load_path::contains (const std::string& dir) const +{ + return find_dir_info (dir) != dir_info_list.end (); +} + +void +load_path::move_fcn_map (const std::string& dir_name, + const string_vector& fcn_files, bool at_end) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } +} + +void +load_path::move_method_map (const std::string& dir_name, bool at_end) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info fi = *p; + + file_info_list.erase (p); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + + break; + } + } + } + } + } +} + +void +load_path::move (dir_info_list_iterator i, bool at_end) +{ + if (dir_info_list.size () > 1) + { + dir_info di = *i; + + dir_info_list.erase (i); + + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + std::string dir_name = di.dir_name; + + move_fcn_map (dir_name, di.fcn_files, at_end); + + // No need to move elements of private function map. + + move_method_map (dir_name, at_end); + } +} + +static void +maybe_add_path_elts (std::string& path, const std::string& dir) +{ + std::string tpath = genpath (dir); + + if (! tpath.empty ()) + { + if (path.empty ()) + path = tpath; + else + path += dir_path::path_sep_str () + tpath; + } +} + +void +load_path::do_initialize (bool set_initial_path) +{ + sys_path = ""; + + if (set_initial_path) + { + maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); + maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); + maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); + maybe_add_path_elts (sys_path, Voct_file_dir); + maybe_add_path_elts (sys_path, Vfcn_file_dir); + } + + std::string tpath = load_path::command_line_path; + + if (tpath.empty ()) + tpath = octave_env::getenv ("OCTAVE_PATH"); + + std::string xpath; + + if (! tpath.empty ()) + { + xpath = tpath; + + if (! sys_path.empty ()) + xpath += dir_path::path_sep_str () + sys_path; + } + else + xpath = sys_path; + + do_set (xpath, false, true); +} + +void +load_path::do_clear (void) +{ + dir_info_list.clear (); + fcn_map.clear (); + private_fcn_map.clear (); + method_map.clear (); +} + +static std::list +split_path (const std::string& p) +{ + std::list retval; + + size_t beg = 0; + size_t end = p.find (dir_path::path_sep_char ()); + + size_t len = p.length (); + + while (end != std::string::npos) + { + std::string elt = p.substr (beg, end-beg); + + if (! elt.empty ()) + retval.push_back (elt); + + beg = end + 1; + + if (beg == len) + break; + + end = p.find (dir_path::path_sep_char (), beg); + } + + std::string elt = p.substr (beg); + + if (! elt.empty ()) + retval.push_back (elt); + + return retval; +} + +void +load_path::do_set (const std::string& p, bool warn, bool is_init) +{ + // Use a list when we need to preserve order. + std::list elts = split_path (p); + + // Use a set when we need to search and order is not important. + std::set elts_set (elts.begin (), elts.end ()); + + if (is_init) + init_dirs = elts_set; + else + { + for (std::set::const_iterator it = init_dirs.begin (); + it != init_dirs.end (); it++) + { + if (elts_set.find (*it) == elts_set.end ()) + { + warning_with_id ("Octave:remove-init-dir", + "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); + break; + } + } + } + + // Temporarily disable add hook. + + unwind_protect frame; + frame.protect_var (add_hook); + + add_hook = 0; + + do_clear (); + + for (std::list::const_iterator i = elts.begin (); + i != elts.end (); i++) + do_append (*i, warn); + + // Restore add hook and execute for all newly added directories. + frame.run_top (); + + for (dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + if (add_hook) + add_hook (i->dir_name); + } + + // Always prepend current directory. + do_prepend (".", warn); +} + +void +load_path::do_append (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, true, warn); +} + +void +load_path::do_prepend (const std::string& dir, bool warn) +{ + if (! dir.empty ()) + do_add (dir, false, warn); +} + +// Strip trailing directory separators. + +static std::string +strip_trailing_separators (const std::string& dir_arg) +{ + std::string dir = dir_arg; + + size_t k = dir.length (); + + while (k > 1 && file_ops::is_dir_sep (dir[k-1])) + k--; + + if (k < dir.length ()) + dir.resize (k); + + return dir; +} + +void +load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) +{ + size_t len = dir_arg.length (); + + if (len > 1 && dir_arg.substr (len-2) == "//") + warning_with_id ("Octave:recursive-path-search", + "trailing `//' is no longer special in search path elements"); + + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + move (i, at_end); + else + { + file_stat fs (dir); + + if (fs) + { + if (fs.is_dir ()) + { + dir_info di (dir); + + if (! error_state) + { + if (at_end) + dir_info_list.push_back (di); + else + dir_info_list.push_front (di); + + add_to_fcn_map (di, at_end); + + add_to_private_fcn_map (di); + + add_to_method_map (di, at_end); + + if (add_hook) + add_hook (dir); + } + } + else if (warn) + warning ("addpath: %s: not a directory", dir_arg.c_str ()); + } + else if (warn) + { + std::string msg = fs.error (); + warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); + } + } + + // FIXME -- is there a better way to do this? + + i = find_dir_info ("."); + + if (i != dir_info_list.end ()) + move (i, false); +} + +void +load_path::remove_fcn_map (const std::string& dir, + const string_vector& fcn_files) +{ + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type k = 0; k < len; k++) + { + std::string fname = fcn_files[k]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == dir) + { + file_info_list.erase (p); + + if (file_info_list.empty ()) + fcn_map.erase (fname); + + break; + } + } + } +} + +void +load_path::remove_private_fcn_map (const std::string& dir) +{ + private_fcn_map_iterator p = private_fcn_map.find (dir); + + if (p != private_fcn_map.end ()) + private_fcn_map.erase (p); +} + +void +load_path::remove_method_map (const std::string& dir) +{ + for (method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + std::string class_name = i->first; + + fcn_map_type& fm = i->second; + + std::string full_dir_name = file_ops::concat (dir, "@" + class_name); + + for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) + { + file_info_list_type& file_info_list = q->second; + + if (file_info_list.size () == 1) + continue; + else + { + for (file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + if (p->dir_name == full_dir_name) + { + file_info_list.erase (p); + + // FIXME -- if there are no other elements, we + // should remove this element of fm but calling + // erase here would invalidate the iterator q. + + break; + } + } + } + } + } +} + +bool +load_path::do_remove (const std::string& dir_arg) +{ + bool retval = false; + + if (! dir_arg.empty ()) + { + if (dir_arg == ".") + { + warning ("rmpath: can't remove \".\" from path"); + + // Avoid additional warnings. + retval = true; + } + else + { + std::string dir = file_ops::tilde_expand (dir_arg); + + dir = strip_trailing_separators (dir); + + dir_info_list_iterator i = find_dir_info (dir); + + if (i != dir_info_list.end ()) + { + retval = true; + + if (remove_hook) + remove_hook (dir); + + string_vector fcn_files = i->fcn_files; + + dir_info_list.erase (i); + + remove_fcn_map (dir, fcn_files); + + remove_private_fcn_map (dir); + + remove_method_map (dir); + } + } + } + + return retval; +} + +void +load_path::do_update (void) const +{ + // I don't see a better way to do this because we need to + // preserve the correct directory ordering for new files that + // have appeared. + + fcn_map.clear (); + + private_fcn_map.clear (); + + method_map.clear (); + + for (dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + dir_info& di = *p; + + di.update (); + + add_to_fcn_map (di, true); + + add_to_private_fcn_map (di); + + add_to_method_map (di, true); + } +} + +bool +load_path::check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who) +{ + bool retval = false; + + if (type == load_path::OCT_FILE) + { + if ((type & possible_types) == load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + } + else if (type == load_path::M_FILE) + { + if ((type & possible_types) == load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == load_path::MEX_FILE) + { + if ((type & possible_types) == load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + } + else if (type == (load_path::M_FILE | load_path::OCT_FILE + | load_path::MEX_FILE)) + { + if (possible_types & load_path::OCT_FILE) + { + fname += ".oct"; + retval = true; + } + else if (possible_types & load_path::MEX_FILE) + { + fname += ".mex"; + retval = true; + } + else if (possible_types & load_path::M_FILE) + { + fname += ".m"; + retval = true; + } + } + else + error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); + + return retval; +} + +std::string +load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, + int type) const +{ + std::string retval; + + // update (); + + if (fcn.length () > 0 && fcn[0] == '@') + { + size_t pos = fcn.find ('/'); + + if (pos != std::string::npos) + { + std::string class_name = fcn.substr (1, pos-1); + std::string meth = fcn.substr (pos+1); + + retval = do_find_method (class_name, meth, dir_name); + } + else + retval = std::string (); + } + else + { + dir_name = std::string (); + + const_fcn_map_iterator p = fcn_map.find (fcn); + + if (p != fcn_map.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, fcn); + + if (check_file_type (retval, type, fi.types, + fcn, "load_path::do_find_fcn")) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::string +load_path::do_find_private_fcn (const std::string& dir, + const std::string& fcn, int type) const +{ + std::string retval; + + // update (); + + const_private_fcn_map_iterator q = private_fcn_map.find (dir); + + if (q != private_fcn_map.end ()) + { + const dir_info::fcn_file_map_type& m = q->second; + + dir_info::const_fcn_file_map_iterator p = m.find (fcn); + + if (p != m.end ()) + { + std::string fname + = file_ops::concat (file_ops::concat (dir, "private"), fcn); + + if (check_file_type (fname, type, p->second, fcn, + "load_path::find_private_fcn")) + retval = fname; + } + } + + return retval; +} + +std::string +load_path::do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, int type) const +{ + std::string retval; + + // update (); + + dir_name = std::string (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + const_fcn_map_iterator p = m.find (meth); + + if (p != m.end ()) + { + const file_info_list_type& file_info_list = p->second; + + for (const_file_info_list_iterator i = file_info_list.begin (); + i != file_info_list.end (); + i++) + { + const file_info& fi = *i; + + retval = file_ops::concat (fi.dir_name, meth); + + bool found = check_file_type (retval, type, fi.types, + meth, "load_path::do_find_method"); + + if (found) + { + dir_name = fi.dir_name; + break; + } + else + retval = std::string (); + } + } + } + + return retval; +} + +std::list +load_path::do_methods (const std::string& class_name) const +{ + std::list retval; + + // update (); + + const_method_map_iterator q = method_map.find (class_name); + + if (q != method_map.end ()) + { + const fcn_map_type& m = q->second; + + for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; +} + +std::list +load_path::do_overloads (const std::string& meth) const +{ + std::list retval; + + // update (); + + for (const_method_map_iterator q = method_map.begin (); + q != method_map.end (); q++) + { + const fcn_map_type& m = q->second; + + if (m.find (meth) != m.end ()) + retval.push_back (q->first); + } + + return retval; +} + +std::string +load_path::do_find_file (const std::string& file) const +{ + std::string retval; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + if (all_files[i] == file) + return file_ops::concat (p->dir_name, file); + } + } + } + + return retval; +} + +std::string +load_path::do_find_dir (const std::string& dir) const +{ + std::string retval; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + return dir; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + return p->dir_name; + } + } + } + + return retval; +} + +string_vector +load_path::do_find_matching_dirs (const std::string& dir) const +{ + std::list retlist; + + if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos + && (octave_env::absolute_pathname (dir) + || octave_env::rooted_relative_pathname (dir))) + { + file_stat fs (dir); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (dir); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string dname = octave_env::make_absolute (p->dir_name); + + size_t dname_len = dname.length (); + + if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) + { + dname = dname.substr (0, dname_len - 1); + dname_len--; + } + + size_t dir_len = dir.length (); + + if (dname_len >= dir_len + && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) + && dir.compare (dname.substr (dname_len - dir_len)) == 0) + { + file_stat fs (p->dir_name); + + if (fs.exists () && fs.is_dir ()) + retlist.push_back (p->dir_name); + } + } + } + + return retlist; +} + +std::string +load_path::do_find_first_of (const string_vector& flist) const +{ + std::string retval; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + return file; + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + return tfile; + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + { + dir_name = p->dir_name; + file_name = rel_flist[j]; + + goto done; + } + } + } + } + + done: + + if (! dir_name.empty ()) + retval = file_ops::concat (dir_name, file_name); + + return retval; +} + +string_vector +load_path::do_find_all_first_of (const string_vector& flist) const +{ + std::list retlist; + + std::string dir_name; + std::string file_name; + + octave_idx_type flen = flist.length (); + octave_idx_type rel_flen = 0; + + string_vector rel_flist (flen); + + for (octave_idx_type i = 0; i < flen; i++) + { + std::string file = flist[i]; + + if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) + { + if (octave_env::absolute_pathname (file) + || octave_env::rooted_relative_pathname (file)) + { + file_stat fs (file); + + if (fs.exists ()) + retlist.push_back (file); + } + else + { + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + std::string tfile = file_ops::concat (p->dir_name, file); + + file_stat fs (tfile); + + if (fs.exists ()) + retlist.push_back (tfile); + } + } + } + else + rel_flist[rel_flen++] = file; + } + + rel_flist.resize (rel_flen); + + for (const_dir_info_list_iterator p = dir_info_list.begin (); + p != dir_info_list.end (); + p++) + { + string_vector all_files = p->all_files; + + octave_idx_type len = all_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + for (octave_idx_type j = 0; j < rel_flen; j++) + { + if (all_files[i] == rel_flist[j]) + retlist.push_back + (file_ops::concat (p->dir_name, rel_flist[j])); + } + } + } + + return retlist; +} + +string_vector +load_path::do_dirs (void) const +{ + size_t len = dir_info_list.size (); + + string_vector retval (len); + + octave_idx_type k = 0; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval[k++] = i->dir_name; + + return retval; +} + +std::list +load_path::do_dir_list (void) const +{ + std::list retval; + + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + retval.push_back (i->dir_name); + + return retval; +} + +string_vector +load_path::do_files (const std::string& dir, bool omit_exts) const +{ + string_vector retval; + + const_dir_info_list_iterator p = find_dir_info (dir); + + if (p != dir_info_list.end ()) + retval = p->fcn_files; + + if (omit_exts) + { + octave_idx_type len = retval.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = retval[i]; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + retval[i] = fname.substr (0, pos); + } + } + + return retval; +} + +string_vector +load_path::do_fcn_names (void) const +{ + size_t len = fcn_map.size (); + + string_vector retval (len); + + octave_idx_type count = 0; + + for (const_fcn_map_iterator p = fcn_map.begin (); + p != fcn_map.end (); + p++) + retval[count++] = p->first; + + return retval; +} + +std::string +load_path::do_path (void) const +{ + std::string xpath; + + string_vector xdirs = load_path::dirs (); + + octave_idx_type len = xdirs.length (); + + if (len > 0) + xpath = xdirs[0]; + + for (octave_idx_type i = 1; i < len; i++) + xpath += dir_path::path_sep_str () + xdirs[i]; + + return xpath; +} + +void +print_types (std::ostream& os, int types) +{ + bool printed_type = false; + + if (types & load_path::OCT_FILE) + { + os << "oct"; + printed_type = true; + } + + if (types & load_path::MEX_FILE) + { + if (printed_type) + os << "|"; + os << "mex"; + printed_type = true; + } + + if (types & load_path::M_FILE) + { + if (printed_type) + os << "|"; + os << "m"; + printed_type = true; + } +} + +void +print_fcn_list (std::ostream& os, + const load_path::dir_info::fcn_file_map_type& lst) +{ + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + os << " " << p->first << " ("; + + print_types (os, p->second); + + os << ")\n"; + } +} + +string_vector +get_file_list (const load_path::dir_info::fcn_file_map_type& lst) +{ + octave_idx_type n = lst.size (); + + string_vector retval (n); + + octave_idx_type count = 0; + + for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); + p != lst.end (); + p++) + { + std::string nm = p->first; + + int types = p->second; + + if (types & load_path::OCT_FILE) + nm += ".oct"; + else if (types & load_path::MEX_FILE) + nm += ".mex"; + else + nm += ".m"; + + retval[count++] = nm; + } + + return retval; +} + +void +load_path::do_display (std::ostream& os) const +{ + for (const_dir_info_list_iterator i = dir_info_list.begin (); + i != dir_info_list.end (); + i++) + { + string_vector fcn_files = i->fcn_files; + + if (! fcn_files.empty ()) + { + os << "\n*** function files in " << i->dir_name << ":\n\n"; + + fcn_files.list_in_columns (os); + } + + const dir_info::method_file_map_type& method_file_map + = i->method_file_map; + + if (! method_file_map.empty ()) + { + for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); + p != method_file_map.end (); + p++) + { + os << "\n*** methods in " << i->dir_name + << "/@" << p->first << ":\n\n"; + + const dir_info::class_info& ci = p->second; + + string_vector method_files = get_file_list (ci.method_file_map); + + method_files.list_in_columns (os); + } + } + } + + for (const_private_fcn_map_iterator i = private_fcn_map.begin (); + i != private_fcn_map.end (); i++) + { + os << "\n*** private functions in " + << file_ops::concat (i->first, "private") << ":\n\n"; + + print_fcn_list (os, i->second); + } + +#if defined (DEBUG_LOAD_PATH) + + for (const_fcn_map_iterator i = fcn_map.begin (); + i != fcn_map.end (); + i++) + { + os << i->first << ":\n"; + + const file_info_list_type& file_info_list = i->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + + for (const_method_map_iterator i = method_map.begin (); + i != method_map.end (); + i++) + { + os << "CLASS " << i->first << ":\n"; + + const fcn_map_type& fm = i->second; + + for (const_fcn_map_iterator q = fm.begin (); + q != fm.end (); + q++) + { + os << " " << q->first << ":\n"; + + const file_info_list_type& file_info_list = q->second; + + for (const_file_info_list_iterator p = file_info_list.begin (); + p != file_info_list.end (); + p++) + { + os << " " << p->dir_name << " ("; + + print_types (os, p->types); + + os << ")\n"; + } + } + } + + os << "\n"; + +#endif +} + +// True if a path is contained in a path list separated by path_sep_char +static bool +in_path_list (const std::string& path_list, const std::string& path) +{ + size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); + char psc = dir_path::path_sep_char (); + while (pos != std::string::npos) + { + if ((pos == 0 || path_list[pos-1] == psc) + && (pos + ps == pls || path_list[pos + ps] == psc)) + return true; + else + pos = path_list.find (path, pos + 1); + } + + return false; +} + +void +load_path::add_to_fcn_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + string_vector fcn_files = di.fcn_files; + + octave_idx_type len = fcn_files.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string fname = fcn_files[i]; + + std::string ext; + std::string base = fname; + + size_t pos = fname.rfind ('.'); + + if (pos != std::string::npos) + { + base = fname.substr (0, pos); + ext = fname.substr (pos); + } + + file_info_list_type& file_info_list = fcn_map[base]; + + file_info_list_iterator p = file_info_list.begin (); + + while (p != file_info_list.end ()) + { + if (p->dir_name == dir_name) + break; + + p++; + } + + int t = 0; + if (ext == ".m") + t = load_path::M_FILE; + else if (ext == ".oct") + t = load_path::OCT_FILE; + else if (ext == ".mex") + t = load_path::MEX_FILE; + + if (p == file_info_list.end ()) + { + file_info fi (dir_name, t); + + if (at_end) + file_info_list.push_back (fi); + else + { + // Warn if a built-in or library function is being shadowed. + + if (! file_info_list.empty ()) + { + file_info& old = file_info_list.front (); + + // FIXME -- do we need to be more careful about the + // way we look for old.dir_name in sys_path to avoid + // partial matches? + + // Don't warn about Contents.m files since we expect + // more than one to exist in the load path. + + if (fname != "Contents.m" + && sys_path.find (old.dir_name) != std::string::npos + && in_path_list (sys_path, old.dir_name)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + + warning_with_id ("Octave:shadowed-function", + "function %s shadows a core library function", + fcn_path.c_str ()); + } + } + else if (symbol_table::is_built_in_function_name (base)) + { + std::string fcn_path = file_ops::concat (dir_name, fname); + warning_with_id ("Octave:shadowed-function", + "function %s shadows a built-in function", + fcn_path.c_str ()); + } + + file_info_list.push_front (fi); + } + } + else + { + file_info& fi = *p; + + fi.types |= t; + } + } +} + +void +load_path::add_to_private_fcn_map (const dir_info& di) const +{ + dir_info::fcn_file_map_type private_file_map = di.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[di.dir_name] = private_file_map; +} + +void +load_path::add_to_method_map (const dir_info& di, bool at_end) const +{ + std::string dir_name = di.dir_name; + + // + dir_info::method_file_map_type method_file_map = di.method_file_map; + + for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); + q != method_file_map.end (); + q++) + { + std::string class_name = q->first; + + fcn_map_type& fm = method_map[class_name]; + + std::string full_dir_name + = file_ops::concat (dir_name, "@" + class_name); + + const dir_info::class_info& ci = q->second; + + // + const dir_info::fcn_file_map_type& m = ci.method_file_map; + + for (dir_info::const_fcn_file_map_iterator p = m.begin (); + p != m.end (); + p++) + { + std::string base = p->first; + + int types = p->second; + + file_info_list_type& file_info_list = fm[base]; + + file_info_list_iterator p2 = file_info_list.begin (); + + while (p2 != file_info_list.end ()) + { + if (p2->dir_name == full_dir_name) + break; + + p2++; + } + + if (p2 == file_info_list.end ()) + { + file_info fi (full_dir_name, types); + + if (at_end) + file_info_list.push_back (fi); + else + file_info_list.push_front (fi); + } + else + { + // FIXME -- is this possible? + + file_info& fi = *p2; + + fi.types = types; + } + } + + // + dir_info::fcn_file_map_type private_file_map = ci.private_file_map; + + if (! private_file_map.empty ()) + private_fcn_map[full_dir_name] = private_file_map; + } +} + +std::string +genpath (const std::string& dirname, const string_vector& skip) +{ + std::string retval; + + dir_entry dir (dirname); + + if (dir) + { + retval = dirname; + + string_vector dirlist = dir.read (); + + octave_idx_type len = dirlist.length (); + + for (octave_idx_type i = 0; i < len; i++) + { + std::string elt = dirlist[i]; + + bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); + + if (! skip_p) + { + for (octave_idx_type j = 0; j < skip.length (); j++) + { + skip_p = (elt == skip[j]); + if (skip_p) + break; + } + + if (! skip_p) + { + std::string nm = file_ops::concat (dirname, elt); + + file_stat fs (nm); + + if (fs && fs.is_dir ()) + retval += dir_path::path_sep_str () + genpath (nm, skip); + } + } + } + } + + return retval; +} + +static void +execute_pkg_add_or_del (const std::string& dir, + const std::string& script_file) +{ + if (! octave_interpreter_ready) + return; + + unwind_protect frame; + + frame.protect_var (input_from_startup_file); + + input_from_startup_file = true; + + std::string file = file_ops::concat (dir, script_file); + + file_stat fs (file); + + if (fs.exists ()) + source_file (file, "base"); +} + +void +execute_pkg_add (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_ADD"); +} + +void +execute_pkg_del (const std::string& dir) +{ + execute_pkg_add_or_del (dir, "PKG_DEL"); +} + +DEFUN (genpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ +@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ +Return a path constructed from @var{dir} and all its subdirectories.\n\ +If additional string parameters are given, the resulting path will\n\ +exclude directories with those names.\n\ +@end deftypefn") +{ + octave_value retval; + + octave_idx_type nargin = args.length (); + + if (nargin == 1) + { + std::string dirname = args(0).string_value (); + + if (! error_state) + retval = genpath (dirname); + else + error ("genpath: DIR must be a character string"); + } + else if (nargin > 1) + { + std::string dirname = args(0).string_value (); + + string_vector skip (nargin - 1); + + for (octave_idx_type i = 1; i < nargin; i++) + { + skip[i-1] = args(i).string_value (); + + if (error_state) + break; + } + + if (! error_state) + retval = genpath (dirname, skip); + else + error ("genpath: all arguments must be character strings"); + } + else + print_usage (); + + return retval; +} + +static void +rehash_internal (void) +{ + load_path::update (); + + // FIXME -- maybe we should rename this variable since it is being + // used for more than keeping track of the prompt time. + + // This will force updated functions to be found. + Vlast_prompt_time.stamp (); +} + +DEFUN (rehash, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rehash ()\n\ +Reinitialize Octave's load path directory cache.\n\ +@end deftypefn") +{ + octave_value_list retval; + + rehash_internal (); + + return retval; +} + +DEFUN (command_line_path, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ +Return the command line path variable.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + return octave_value (load_path::get_command_line_path ()); +} + +DEFUN (restoredefaultpath, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ +Restore Octave's path to its initial state at startup.\n\ +\n\ +@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + load_path::initialize (true); + + return octave_value (load_path::system_path ()); +} + +// Return Octave's original default list of directories in which to +// search for function files. This corresponds to the path that +// exists prior to running the system's octaverc file or the user's +// ~/.octaverc file + +DEFUN (__pathorig__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + return octave_value (load_path::system_path ()); +} + +DEFUN (path, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} path (@dots{})\n\ +Modify or display Octave's load path.\n\ +\n\ +If @var{nargin} and @var{nargout} are zero, display the elements of\n\ +Octave's load path in an easy to read format.\n\ +\n\ +If @var{nargin} is zero and nargout is greater than zero, return the\n\ +current load path.\n\ +\n\ +If @var{nargin} is greater than zero, concatenate the arguments,\n\ +separating them with @code{pathsep}. Set the internal search path\n\ +to the result and return it.\n\ +\n\ +No checks are made for duplicate elements.\n\ +@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("path"); + + if (! error_state) + { + if (argc > 1) + { + std::string path = argv[1]; + + for (int i = 2; i < argc; i++) + path += dir_path::path_sep_str () + argv[i]; + + load_path::set (path, true); + + rehash_internal (); + } + + if (nargout > 0) + retval = load_path::path (); + else if (argc == 1 && nargout == 0) + { + octave_stdout << "\nOctave's search path contains the following directories:\n\n"; + + string_vector dirs = load_path::dirs (); + + dirs.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + + return retval; +} + +DEFUN (addpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ +@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ +Add @var{dir1}, @dots{} to the current function search path. If\n\ +@var{option} is \"-begin\" or 0 (the default), prepend the\n\ +directory name to the current path. If @var{option} is \"-end\"\n\ +or 1, append the directory name to the current path.\n\ +Directories added to the path must exist.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +addpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + octave_value retval; + + // Originally written by Bill Denney and Etienne Grossman. Heavily + // modified and translated to C++ by jwe. + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool append = false; + + octave_value option_arg = args(nargin-1); + + if (option_arg.is_string ()) + { + std::string option = option_arg.string_value (); + + if (option == "-end") + { + append = true; + nargin--; + } + else if (option == "-begin") + nargin--; + } + else if (option_arg.is_numeric_type ()) + { + int val = option_arg.int_value (); + + if (! error_state) + { + if (val == 0) + nargin--; + else if (val == 1) + { + append = true; + nargin--; + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + else + { + error ("addpath: expecting final argument to be 1 or 0"); + return retval; + } + } + + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + if (! append) + std::reverse (dir_elts.begin (), dir_elts.end ()); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (append) + load_path::append (dir, true); + else + load_path::prepend (dir, true); + + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} + +DEFUN (rmpath, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ +Remove @var{dir1}, @dots{} from the current function search path.\n\ +\n\ +In addition to accepting individual directory arguments, lists of\n\ +directory names separated by @code{pathsep} are also accepted. For example:\n\ +\n\ +@example\n\ +rmpath (\"dir1:/dir2:~/dir3\")\n\ +@end example\n\ +@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ +@end deftypefn") +{ + // Originally by Etienne Grossmann. Heavily modified and translated + // to C++ by jwe. + + octave_value retval; + + if (nargout > 0) + retval = load_path::path (); + + int nargin = args.length (); + + if (nargin > 0) + { + bool need_to_update = false; + + for (int i = 0; i < nargin; i++) + { + std::string arg = args(i).string_value (); + + if (! error_state) + { + std::list dir_elts = split_path (arg); + + for (std::list::const_iterator p = dir_elts.begin (); + p != dir_elts.end (); + p++) + { + std::string dir = *p; + + //dir = regexprep (dir_elts{j}, '//+', "/"); + //dir = regexprep (dir, '/$', ""); + + if (! load_path::remove (dir)) + warning ("rmpath: %s: not found", dir.c_str ()); + else + need_to_update = true; + } + } + else + error ("addpath: all arguments must be character strings"); + } + + if (need_to_update) + rehash_internal (); + } + else + print_usage (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/load-path.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-path.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,566 @@ +/* + +Copyright (C) 2006-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_load_path_h) +#define octave_load_path_h 1 + +#include +#include +#include +#include + +#include "pathsearch.h" +#include "str-vec.h" + +class +OCTINTERP_API +load_path +{ +protected: + + load_path (void) + : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), + init_dirs () { } + +public: + + typedef void (*hook_fcn_ptr) (const std::string& dir); + + ~load_path (void) { } + + static void initialize (bool set_initial_path = false) + { + if (instance_ok ()) + instance->do_initialize (set_initial_path); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void set (const std::string& p, bool warn = false) + { + if (instance_ok ()) + instance->do_set (p, warn); + } + + static void append (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_append (dir, warn); + } + + static void prepend (const std::string& dir, bool warn = false) + { + if (instance_ok ()) + instance->do_prepend (dir, warn); + } + + static bool remove (const std::string& dir) + { + return instance_ok () ? instance->do_remove (dir) : false; + } + + static void update (void) + { + if (instance_ok ()) + instance->do_update (); + } + + static std::string find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name) + { + return instance_ok () + ? instance->do_find_method (class_name, meth, dir_name) : std::string (); + } + + static std::string find_method (const std::string& class_name, + const std::string& meth) + { + std::string dir_name; + return find_method (class_name, meth, dir_name); + } + + static std::list methods (const std::string& class_name) + { + return instance_ok () + ? instance->do_methods (class_name) : std::list (); + } + + static std::list overloads (const std::string& meth) + { + return instance_ok () + ? instance->do_overloads (meth) : std::list (); + } + + static std::string find_fcn (const std::string& fcn, std::string& dir_name) + { + return instance_ok () + ? instance->do_find_fcn (fcn, dir_name) : std::string (); + } + + static std::string find_fcn (const std::string& fcn) + { + std::string dir_name; + return find_fcn (fcn, dir_name); + } + + static std::string find_private_fcn (const std::string& dir, + const std::string& fcn) + { + return instance_ok () + ? instance->do_find_private_fcn (dir, fcn) : std::string (); + } + + static std::string find_fcn_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); + } + + static std::string find_oct_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); + } + + static std::string find_mex_file (const std::string& fcn) + { + std::string dir_name; + + return instance_ok () ? + instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); + } + + static std::string find_file (const std::string& file) + { + return instance_ok () + ? instance->do_find_file (file) : std::string (); + } + + static std::string find_dir (const std::string& dir) + { + return instance_ok () + ? instance->do_find_dir (dir) : std::string (); + } + + static string_vector find_matching_dirs (const std::string& dir) + { + return instance_ok () + ? instance->do_find_matching_dirs (dir) : string_vector (); + } + + static std::string find_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_first_of (files) : std::string (); + } + + static string_vector find_all_first_of (const string_vector& files) + { + return instance_ok () ? + instance->do_find_all_first_of (files) : string_vector (); + } + + static string_vector dirs (void) + { + return instance_ok () ? instance->do_dirs () : string_vector (); + } + + static std::list dir_list (void) + { + return instance_ok () + ? instance->do_dir_list () : std::list (); + } + + static string_vector files (const std::string& dir, bool omit_exts = false) + { + return instance_ok () + ? instance->do_files (dir, omit_exts) : string_vector (); + } + + static string_vector fcn_names (void) + { + return instance_ok () ? instance->do_fcn_names () : string_vector (); + } + + static std::string path (void) + { + return instance_ok () ? instance->do_path () : std::string (); + } + + static void display (std::ostream& os) + { + if (instance_ok ()) + instance->do_display (os); + } + + static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } + + static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } + + static void set_command_line_path (const std::string& p) + { + if (command_line_path.empty ()) + command_line_path = p; + else + command_line_path += dir_path::path_sep_str () + p; + } + + static std::string get_command_line_path (void) + { + return instance_ok () ? instance->do_get_command_line_path () : std::string (); + } + + static std::string system_path (void) + { + return instance_ok () ? instance->do_system_path () : std::string (); + } + +private: + + static const int M_FILE = 1; + static const int OCT_FILE = 2; + static const int MEX_FILE = 4; + + class dir_info + { + public: + + // + typedef std::map fcn_file_map_type; + + typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; + typedef fcn_file_map_type::iterator fcn_file_map_iterator; + + struct class_info + { + class_info (void) : method_file_map (), private_file_map () { } + + class_info (const class_info& ci) + : method_file_map (ci.method_file_map), + private_file_map (ci.private_file_map) { } + + class_info& operator = (const class_info& ci) + { + if (this != &ci) + { + method_file_map = ci.method_file_map; + private_file_map = ci.private_file_map; + } + return *this; + } + + ~class_info (void) { } + + fcn_file_map_type method_file_map; + fcn_file_map_type private_file_map; + }; + + // + typedef std::map method_file_map_type; + + typedef method_file_map_type::const_iterator const_method_file_map_iterator; + typedef method_file_map_type::iterator method_file_map_iterator; + + // This default constructor is only provided so we can create a + // std::map of dir_info objects. You should not use this + // constructor for any other purpose. + dir_info (void) + : dir_name (), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { } + + dir_info (const std::string& d) + : dir_name (d), abs_dir_name (), is_relative (false), + dir_mtime (), dir_time_last_checked (), + all_files (), fcn_files (), private_file_map (), method_file_map () + { + initialize (); + } + + dir_info (const dir_info& di) + : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), + is_relative (di.is_relative), + dir_mtime (di.dir_mtime), + dir_time_last_checked (di.dir_time_last_checked), + all_files (di.all_files), fcn_files (di.fcn_files), + private_file_map (di.private_file_map), + method_file_map (di.method_file_map) { } + + ~dir_info (void) { } + + dir_info& operator = (const dir_info& di) + { + if (&di != this) + { + dir_name = di.dir_name; + abs_dir_name = di.abs_dir_name; + is_relative = di.is_relative; + dir_mtime = di.dir_mtime; + dir_time_last_checked = di.dir_time_last_checked; + all_files = di.all_files; + fcn_files = di.fcn_files; + private_file_map = di.private_file_map; + method_file_map = di.method_file_map; + } + + return *this; + } + + void update (void); + + std::string dir_name; + std::string abs_dir_name; + bool is_relative; + octave_time dir_mtime; + octave_time dir_time_last_checked; + string_vector all_files; + string_vector fcn_files; + fcn_file_map_type private_file_map; + method_file_map_type method_file_map; + + private: + + void initialize (void); + + void get_file_list (const std::string& d); + + void get_private_file_map (const std::string& d); + + void get_method_file_map (const std::string& d, + const std::string& class_name); + + friend fcn_file_map_type get_fcn_files (const std::string& d); + }; + + class file_info + { + public: + + file_info (const std::string& d, int t) : dir_name (d), types (t) { } + + file_info (const file_info& fi) + : dir_name (fi.dir_name), types (fi.types) { } + + ~file_info (void) { } + + file_info& operator = (const file_info& fi) + { + if (&fi != this) + { + dir_name = fi.dir_name; + types = fi.types; + } + + return *this; + } + + std::string dir_name; + int types; + }; + + // We maintain two ways of looking at the same information. + // + // First, a list of directories and the set of "public" files and + // private files (those found in the special "private" subdirectory) + // in each directory. + // + // Second, a map from file names (the union of all "public" files for all + // directories, but without filename extensions) to a list of + // corresponding information (directory name and file types). This + // way, we can quickly find shadowed file names and look up all + // overloaded functions (in the "@" directories used to implement + // classes). + + typedef std::list dir_info_list_type; + + typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; + typedef dir_info_list_type::iterator dir_info_list_iterator; + + typedef std::map abs_dir_cache_type; + + typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; + typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; + + typedef std::list file_info_list_type; + + typedef file_info_list_type::const_iterator const_file_info_list_iterator; + typedef file_info_list_type::iterator file_info_list_iterator; + + // + typedef std::map fcn_map_type; + + typedef fcn_map_type::const_iterator const_fcn_map_iterator; + typedef fcn_map_type::iterator fcn_map_iterator; + + // > + typedef std::map private_fcn_map_type; + + typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; + typedef private_fcn_map_type::iterator private_fcn_map_iterator; + + // > + typedef std::map method_map_type; + + typedef method_map_type::const_iterator const_method_map_iterator; + typedef method_map_type::iterator method_map_iterator; + + mutable dir_info_list_type dir_info_list; + + mutable fcn_map_type fcn_map; + + mutable private_fcn_map_type private_fcn_map; + + mutable method_map_type method_map; + + mutable std::set init_dirs; + + static load_path *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + static hook_fcn_ptr add_hook; + + static hook_fcn_ptr remove_hook; + + static std::string command_line_path; + + static std::string sys_path; + + static abs_dir_cache_type abs_dir_cache; + + static bool instance_ok (void); + + const_dir_info_list_iterator find_dir_info (const std::string& dir) const; + dir_info_list_iterator find_dir_info (const std::string& dir); + + bool contains (const std::string& dir) const; + + void move_fcn_map (const std::string& dir, + const string_vector& fcn_files, bool at_end); + + void move_method_map (const std::string& dir, bool at_end); + + void move (std::list::iterator i, bool at_end); + + void do_initialize (bool set_initial_path); + + void do_clear (void); + + void do_set (const std::string& p, bool warn, bool is_init = false); + + void do_append (const std::string& dir, bool warn); + + void do_prepend (const std::string& dir, bool warn); + + void do_add (const std::string& dir, bool at_end, bool warn); + + void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); + + void remove_private_fcn_map (const std::string& dir); + + void remove_method_map (const std::string& dir); + + bool do_remove (const std::string& dir); + + void do_update (void) const; + + static bool + check_file_type (std::string& fname, int type, int possible_types, + const std::string& fcn, const char *who); + + std::string do_find_fcn (const std::string& fcn, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_private_fcn (const std::string& dir, + const std::string& fcn, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::string do_find_method (const std::string& class_name, + const std::string& meth, + std::string& dir_name, + int type = M_FILE | OCT_FILE | MEX_FILE) const; + + std::list do_methods (const std::string& class_name) const; + + std::list do_overloads (const std::string& meth) const; + + std::string do_find_file (const std::string& file) const; + + std::string do_find_dir (const std::string& dir) const; + + string_vector do_find_matching_dirs (const std::string& dir) const; + + std::string do_find_first_of (const string_vector& files) const; + + string_vector do_find_all_first_of (const string_vector& files) const; + + string_vector do_dirs (void) const; + + std::list do_dir_list (void) const; + + string_vector do_files (const std::string& dir, bool omit_exts) const; + + string_vector do_fcn_names (void) const; + + std::string do_path (void) const; + + friend void print_types (std::ostream& os, int types); + + friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); + + friend void + print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); + + void do_display (std::ostream& os) const; + + std::string do_system_path (void) const { return sys_path; } + + std::string do_get_command_line_path (void) const { return command_line_path; } + + void add_to_fcn_map (const dir_info& di, bool at_end) const; + + void add_to_private_fcn_map (const dir_info& di) const; + + void add_to_method_map (const dir_info& di, bool at_end) const; + + friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); +}; + +extern std::string +genpath (const std::string& dir, const string_vector& skip = "private"); + +extern void execute_pkg_add (const std::string& dir); +extern void execute_pkg_del (const std::string& dir); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/load-save.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-save.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1872 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +// Author: John W. Eaton. +// HDF5 support by Steven G. Johnson +// Matlab v5 support by James R. Van Zandt + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include +#include + +#include "strftime.h" + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "file-stat.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" +#include "oct-locbuf.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-path.h" +#include "load-save.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "symtab.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +#include "ls-hdf5.h" +#include "ls-mat-ascii.h" +#include "ls-mat4.h" +#include "ls-mat5.h" +#include "ls-oct-ascii.h" +#include "ls-oct-binary.h" + +// Remove gnulib definitions, if any. +#ifdef close +#undef close +#endif +#ifdef open +#undef open +#endif + +#ifdef HAVE_ZLIB +#include "zfstream.h" +#endif + +// Write octave-workspace file if Octave crashes or is killed by a signal. +static bool Vcrash_dumps_octave_core = true; + +// The maximum amount of memory (in kilobytes) that we will attempt to +// write to the Octave core file. +static double Voctave_core_file_limit = -1.0; + +// The name of the Octave core file. +static std::string Voctave_core_file_name = "octave-workspace"; + +// The default output format. May be one of "binary", "text", +// "mat-binary", or "hdf5". +static std::string Vdefault_save_options = "-text"; + +// The output format for Octave core files. +static std::string Voctave_core_file_options = "-binary"; + +static std::string +default_save_header_format (void) +{ + return + std::string ("# Created by Octave " OCTAVE_VERSION + ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format string for the comment line at the top of text-format +// save files. Passed to strftime. Should begin with `#' and contain +// no newline characters. +static std::string Vsave_header_format_string = default_save_header_format (); + +static void +gripe_file_open (const std::string& fcn, const std::string& file) +{ + if (fcn == "load") + error ("%s: unable to open input file `%s'", fcn.c_str (), file.c_str ()); + else if (fcn == "save") + error ("%s: unable to open output file `%s'", fcn.c_str (), file.c_str ()); + else + error ("%s: unable to open file `%s'", fcn.c_str (), file.c_str ()); +} + +// Install a variable with name NAME and the value VAL in the +// symbol table. If GLOBAL is TRUE, make the variable global. + +static void +install_loaded_variable (const std::string& name, + const octave_value& val, + bool global, const std::string& /*doc*/) +{ + if (global) + { + symbol_table::symbol_record& sr = symbol_table::insert (name); + sr.clear (); + sr.mark_global (); + sr.varref () = val; + } + else + symbol_table::varref (name) = val; +} + +// Return TRUE if NAME matches one of the given globbing PATTERNS. + +static bool +matches_patterns (const string_vector& patterns, int pat_idx, + int num_pat, const std::string& name) +{ + for (int i = pat_idx; i < num_pat; i++) + { + glob_match pattern (patterns[i]); + + if (pattern.match (name)) + return true; + } + + return false; +} + +int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, bool quiet) +{ + const int magic_len = 10; + char magic[magic_len+1]; + is.read (magic, magic_len); + magic[magic_len] = '\0'; + + if (strncmp (magic, "Octave-1-L", magic_len) == 0) + swap = oct_mach_info::words_big_endian (); + else if (strncmp (magic, "Octave-1-B", magic_len) == 0) + swap = ! oct_mach_info::words_big_endian (); + else + { + if (! quiet) + error ("load: unable to read read binary file"); + return -1; + } + + char tmp = 0; + is.read (&tmp, 1); + + flt_fmt = mopt_digit_to_float_format (tmp); + + if (flt_fmt == oct_mach_info::flt_fmt_unknown) + { + if (! quiet) + error ("load: unrecognized binary format!"); + + return -1; + } + + return 0; +} + +#ifdef HAVE_ZLIB +static bool +check_gzip_magic (const std::string& fname) +{ + bool retval = false; + std::ifstream file (fname.c_str ()); + OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); + + if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && + magic[1] == 0x8b) + retval = true; + + file.close (); + return retval; +} +#endif + +static load_save_format +get_file_format (std::istream& file, const std::string& filename) +{ + load_save_format retval = LS_UNKNOWN; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (read_binary_file_header (file, swap, flt_fmt, true) == 0) + retval = LS_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + int32_t mopt, nr, nc, imag, len; + + int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, 1); + + if (! err) + retval = LS_MAT_BINARY; + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + err = read_mat5_binary_file_header (file, swap, true, filename); + + if (! err) + { + file.clear (); + file.seekg (0, std::ios::beg); + retval = LS_MAT5_BINARY; + } + else + { + file.clear (); + file.seekg (0, std::ios::beg); + + std::string tmp = extract_keyword (file, "name"); + + if (! tmp.empty ()) + retval = LS_ASCII; + } + } + } + + return retval; +} + +static load_save_format +get_file_format (const std::string& fname, const std::string& orig_fname, + bool &use_zlib) +{ + load_save_format retval = LS_UNKNOWN; + +#ifdef HAVE_HDF5 + // check this before we open the file + if (H5Fis_hdf5 (fname.c_str ()) > 0) + return LS_HDF5; +#endif /* HAVE_HDF5 */ + + std::ifstream file (fname.c_str ()); + use_zlib = false; + + if (file) + { + retval = get_file_format (file, orig_fname); + file.close (); + +#ifdef HAVE_ZLIB + if (retval == LS_UNKNOWN && check_gzip_magic (fname)) + { + gzifstream gzfile (fname.c_str ()); + use_zlib = true; + + if (gzfile) + { + retval = get_file_format (gzfile, orig_fname); + gzfile.close (); + } + } +#endif + + if (retval == LS_UNKNOWN) + { + // Try reading the file as numbers only, determining the + // number of rows and columns from the data. We don't + // even bother to check to see if the first item in the + // file is a number, so that get_complete_line() can + // skip any comments that might appear at the top of the + // file. + + retval = LS_MAT_ASCII; + } + } + else + gripe_file_open ("load", orig_fname); + + return retval; +} + +octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout) +{ + octave_value retval; + + octave_scalar_map retstruct; + + std::ostringstream output_buf; + std::list symbol_names; + + octave_idx_type count = 0; + + for (;;) + { + bool global = false; + octave_value tc; + + std::string name; + std::string doc; + + switch (format.type) + { + case LS_ASCII: + name = read_ascii_data (stream, orig_fname, global, tc, count); + break; + + case LS_BINARY: + name = read_binary_data (stream, swap, flt_fmt, orig_fname, + global, tc, doc); + break; + + case LS_MAT_ASCII: + name = read_mat_ascii_data (stream, orig_fname, tc); + break; + + case LS_MAT_BINARY: + name = read_mat_binary_data (stream, orig_fname, tc); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + name = read_hdf5_data (stream, orig_fname, global, tc, doc); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + name = read_mat5_binary_element (stream, orig_fname, swap, + global, tc); + break; + + default: + gripe_unrecognized_data_fmt ("load"); + break; + } + + if (error_state || stream.eof () || name.empty ()) + break; + else if (! error_state && ! name.empty ()) + { + if (tc.is_defined ()) + { + if (format == LS_MAT_ASCII && argv_idx < argc) + warning ("load: loaded ASCII file `%s' -- ignoring extra args", + orig_fname.c_str ()); + + if (format == LS_MAT_ASCII + || argv_idx == argc + || matches_patterns (argv, argv_idx, argc, name)) + { + count++; + if (list_only) + { + if (verbose) + { + if (count == 1) + output_buf + << "type rows cols name\n" + << "==== ==== ==== ====\n"; + + output_buf + << std::setiosflags (std::ios::left) + << std::setw (16) << tc.type_name () . c_str () + << std::setiosflags (std::ios::right) + << std::setw (7) << tc.rows () + << std::setw (7) << tc.columns () + << " " << name << "\n"; + } + else + symbol_names.push_back (name); + } + else + { + if (nargout == 1) + { + if (format == LS_MAT_ASCII) + retval = tc; + else + retstruct.assign (name, tc); + } + else + install_loaded_variable (name, tc, global, doc); + } + } + + // Only attempt to read one item from a headless text file. + + if (format == LS_MAT_ASCII) + break; + } + else + error ("load: unable to load variable `%s'", name.c_str ()); + } + else + { + if (count == 0) + error ("load: are you sure `%s' is an Octave data file?", + orig_fname.c_str ()); + + break; + } + } + + if (list_only && count) + { + if (verbose) + { + std::string msg = output_buf.str (); + + if (nargout > 0) + retval = msg; + else + octave_stdout << msg; + } + else + { + if (nargout > 0) + retval = Cell (string_vector (symbol_names)); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + + octave_stdout << "\n"; + } + } + } + else if (retstruct.nfields () != 0) + retval = retstruct; + + return retval; +} + +std::string +find_file_to_load (const std::string& name, const std::string& orig_name) +{ + std::string fname = name; + + if (! (octave_env::absolute_pathname (fname) + || octave_env::rooted_relative_pathname (fname))) + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + std::string tmp + = octave_env::make_absolute (load_path::find_file (fname)); + + if (! tmp.empty ()) + { + warning_with_id ("Octave:load-file-in-path", + "load: file found in load path"); + fname = tmp; + } + } + } + + size_t dot_pos = fname.rfind ("."); + size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); + + if (dot_pos == std::string::npos + || (sep_pos != std::string::npos && dot_pos < sep_pos)) + { + // Either no '.' in name or no '.' appears after last directory + // separator. + + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + fname = find_file_to_load (fname + ".mat", orig_name); + } + else + { + file_stat fs (fname); + + if (! (fs.exists () && fs.is_reg ())) + { + fname = ""; + + error ("load: unable to find file %s", orig_name.c_str ()); + } + } + + return fname; +} + + +DEFUN (load, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} load file\n\ +@deftypefnx {Command} {} load options file\n\ +@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ +@deftypefnx {Command} {} load file options\n\ +@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ +Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ +@var{file}. If no variables are specified then all variables found in the\n\ +file will be loaded. As with @code{save}, the list of variables to extract\n\ +can be full names or use a pattern syntax. The format of the file is\n\ +automatically detected but may be overridden by supplying the appropriate\n\ +option.\n\ +\n\ +If load is invoked using the functional form\n\ +\n\ +@example\n\ +load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +If a variable that is not marked as global is loaded from a file when a\n\ +global symbol with the same name already exists, it is loaded in the\n\ +global symbol table. Also, if a variable is marked as global in a file\n\ +and a local symbol exists, the local symbol is moved to the global\n\ +symbol table and given the value from the file.\n\ +\n\ +If invoked with a single output argument, Octave returns data instead\n\ +of inserting variables in the symbol table. If the data file contains\n\ +only numbers (TAB- or space-delimited columns), a matrix of values is\n\ +returned. Otherwise, @code{load} returns a structure with members\n\ + corresponding to the names of the variables in the file.\n\ +\n\ +The @code{load} command can read data stored in Octave's text and\n\ +binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ +support, it can also load gzip-compressed files. It will automatically\n\ +detect the type of file and do conversion from different floating point\n\ +formats (currently only IEEE big and little endian, though other formats\n\ +may be added in the future).\n\ +\n\ +Valid options for @code{load} are listed in the following table.\n\ +\n\ +@table @code\n\ +@item -force\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave now overwrites variables currently in memory with\n\ +those of the same name found in the file.\n\ +\n\ +@item -ascii\n\ +Force Octave to assume the file contains columns of numbers in text format\n\ +without any header or other information. Data in the file will be loaded\n\ +as a single numeric matrix with the name of the variable derived from the\n\ +name of the file.\n\ +\n\ +@item -binary\n\ +Force Octave to assume the file is in Octave's binary format.\n\ +\n\ +@item -hdf5\n\ +Force Octave to assume the file is in @sc{hdf5} format.\n\ +(@sc{hdf5} is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ +skip some datasets in formats that it cannot support. This format is\n\ +only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ +\n\ +@item -import\n\ +This option is accepted for backward compatibility but is ignored.\n\ +Octave can now support multi-dimensional HDF data and automatically\n\ +modifies variable names if they are invalid Octave identifiers.\n\ +\n\ +@item -mat\n\ +@itemx -mat-binary\n\ +@itemx -6\n\ +@itemx -v6\n\ +@itemx -7\n\ +@itemx -v7\n\ +Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ +format.\n\ +\n\ +@item -mat4-binary\n\ +@itemx -4\n\ +@itemx -v4\n\ +@itemx -V4\n\ +Force Octave to assume the file is in the binary format written by\n\ +@sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Force Octave to assume the file is in Octave's text format.\n\ +@end table\n\ +@seealso{save, dlmwrite, csvwrite, fwrite}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("load"); + + if (error_state) + return retval; + + int i = 1; + std::string orig_fname = ""; + + // Function called with Matlab-style ["filename", options] syntax + if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') + { + orig_fname = argv[1]; + i++; + } + + // It isn't necessary to have the default load format stored in a + // user preference variable since we can determine the type of file + // as we are reading. + + load_save_format format = LS_UNKNOWN; + + bool list_only = false; + bool verbose = false; + + //for (i; i < argc; i++) + for (; i < argc; i++) + { + if (argv[i] == "-force" || argv[i] == "-f") + { + // Silently ignore this + // warning ("load: -force ignored"); + } + else if (argv[i] == "-list" || argv[i] == "-l") + { + list_only = true; + } + else if (argv[i] == "-verbose" || argv[i] == "-v") + { + verbose = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" + || argv[i] == "-6" || argv[i] == "-v6") + { + format = LS_MAT5_BINARY; + } + else if (argv[i] == "-7" || argv[i] == "-v7") + { + format = LS_MAT7_BINARY; + } + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("load: octave executable was not linked with HDF5 library"); + return retval; +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-import" || argv[i] == "-i") + { + warning ("load: -import ignored"); + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else + break; + } + + if (orig_fname == "") + { + if (i == argc) + { + print_usage (); + return retval; + } + else + orig_fname = argv[i]; + } + else + i--; + + oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; + + bool swap = false; + + if (orig_fname == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("load: cannot read HDF5 format from stdin"); + else +#endif /* HAVE_HDF5 */ + if (format != LS_UNKNOWN) + { + // FIXME -- if we have already seen EOF on a + // previous call, how do we fix up the state of std::cin so + // that we can get additional input? I'm afraid that we + // can't fix this using std::cin only. + + retval = do_load (std::cin, orig_fname, format, flt_fmt, + list_only, swap, verbose, argv, i, argc, + nargout); + } + else + error ("load: must specify file format if reading from stdin"); + } + else + { + std::string fname = file_ops::tilde_expand (orig_fname); + + fname = find_file_to_load (fname, orig_fname); + + if (error_state) + return retval; + + bool use_zlib = false; + + if (format == LS_UNKNOWN) + format = get_file_format (fname, orig_fname, use_zlib); + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + i++; + + hdf5_ifstream hdf5_file (fname.c_str ()); + + if (hdf5_file.file_id >= 0) + { + retval = do_load (hdf5_file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + hdf5_file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here; the "else" above has to + // go with the "if" below!!!!! + if (format != LS_UNKNOWN) + { + i++; + + // Always open in binary mode and handle various + // line-endings explicitly. + std::ios::openmode mode = std::ios::in | std::ios::binary; + +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + gripe_file_open ("load", orig_fname); + } + else +#endif + { + std::ifstream file (fname.c_str (), mode); + + if (file) + { + if (format == LS_BINARY) + { + if (read_binary_file_header (file, swap, flt_fmt) < 0) + { + if (file) file.close (); + return retval; + } + } + else if (format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + { + if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) + { + if (file) file.close (); + return retval; + } + } + + retval = do_load (file, orig_fname, format, + flt_fmt, list_only, swap, verbose, + argv, i, argc, nargout); + + file.close (); + } + else + error ("load: unable to open input file `%s'", + orig_fname.c_str ()); + } + } + } + + return retval; +} + +// Return TRUE if PATTERN has any special globbing chars in it. + +static bool +glob_pattern_p (const std::string& pattern) +{ + int open = 0; + + int len = pattern.length (); + + for (int i = 0; i < len; i++) + { + char c = pattern[i]; + + switch (c) + { + case '?': + case '*': + return true; + + 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 true; + continue; + + case '\\': + if (i == len - 1) + return false; + + default: + continue; + } + } + + return false; +} + +static void +do_save (std::ostream& os, const octave_value& tc, + const std::string& name, const std::string& help, + bool global, load_save_format fmt, bool save_as_floats) +{ + switch (fmt.type) + { + case LS_ASCII: + save_ascii_data (os, tc, name, global, 0); + break; + + case LS_BINARY: + save_binary_data (os, tc, name, help, global, save_as_floats); + break; + + case LS_MAT_ASCII: + if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, + fmt.opts & LS_MAT_ASCII_TABS)) + warning ("save: unable to save %s in ASCII format", name.c_str ()); + break; + + case LS_MAT_BINARY: + save_mat_binary_data (os, tc, name); + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: + save_hdf5_data (os, tc, name, help, global, save_as_floats); + break; +#endif /* HAVE_HDF5 */ + + case LS_MAT5_BINARY: + save_mat5_binary_element (os, tc, name, global, false, save_as_floats); + break; + + case LS_MAT7_BINARY: + save_mat5_binary_element (os, tc, name, global, true, save_as_floats); + break; + + default: + gripe_unrecognized_data_fmt ("save"); + break; + } +} + +// Save the info from SR on stream OS in the format specified by FMT. + +void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats) +{ + octave_value val = sr.varval (); + + if (val.is_defined ()) + { + std::string name = sr.name (); + std::string help; + bool global = sr.is_global (); + + do_save (os, val, name, help, global, fmt, save_as_floats); + } +} + +// save fields of a scalar structure STR matching PATTERN on stream OS +// in the format specified by FMT. + +static size_t +save_fields (std::ostream& os, const octave_scalar_map& m, + const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + glob_match pat (pattern); + + size_t saved = 0; + + for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) + { + std::string empty_str; + + if (pat.match (m.key (p))) + { + do_save (os, m.contents (p), m.key (p), empty_str, + 0, fmt, save_as_floats); + + saved++; + } + } + + return saved; +} + +// Save variables with names matching PATTERN on stream OS in the +// format specified by FMT. + +static size_t +save_vars (std::ostream& os, const std::string& pattern, + load_save_format fmt, bool save_as_floats) +{ + std::list vars = symbol_table::glob (pattern); + + size_t saved = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + do_save (os, *p, fmt, save_as_floats); + + if (error_state) + break; + + saved++; + } + + return saved; +} + +static string_vector +parse_save_options (const string_vector &argv, + load_save_format &format, bool &append, + bool &save_as_floats, bool &use_zlib) +{ + string_vector retval; + int argc = argv.length (); + + bool do_double = false, do_tabs = false; + + for (int i = 0; i < argc; i++) + { + if (argv[i] == "-append") + { + append = true; + } + else if (argv[i] == "-ascii" || argv[i] == "-a") + { + format = LS_MAT_ASCII; + } + else if (argv[i] == "-double") + { + do_double = true; + } + else if (argv[i] == "-tabs") + { + do_tabs = true; + } + else if (argv[i] == "-text" || argv[i] == "-t") + { + format = LS_ASCII; + } + else if (argv[i] == "-binary" || argv[i] == "-b") + { + format = LS_BINARY; + } + else if (argv[i] == "-hdf5" || argv[i] == "-h") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } + else if (argv[i] == "-mat-binary" || argv[i] == "-mat" + || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" + || argv[i] == "-V6") + { + format = LS_MAT5_BINARY; + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-mat7-binary" || argv[i] == "-7" + || argv[i] == "-v7" || argv[i] == "-V7") + { + format = LS_MAT7_BINARY; + } +#endif + else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" + || argv[i] == "-v4" || argv[i] == "-4") + { + format = LS_MAT_BINARY; + } + else if (argv[i] == "-float-binary" || argv[i] == "-f") + { + format = LS_BINARY; + save_as_floats = true; + } + else if (argv[i] == "-float-hdf5") + { +#ifdef HAVE_HDF5 + format = LS_HDF5; + save_as_floats = true; +#else /* ! HAVE_HDF5 */ + error ("save: octave executable was not linked with HDF5 library"); +#endif /* ! HAVE_HDF5 */ + } +#ifdef HAVE_ZLIB + else if (argv[i] == "-zip" || argv[i] == "-z") + { + use_zlib = true; + } +#endif + else + retval.append (argv[i]); + } + + if (do_double) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_LONG; + else + warning ("save: \"-double\" option only has an effect with \"-ascii\""); + } + + if (do_tabs) + { + if (format == LS_MAT_ASCII) + format.opts |= LS_MAT_ASCII_TABS; + else + warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); + } + + return retval; +} + +static string_vector +parse_save_options (const std::string &arg, load_save_format &format, + bool &append, bool &save_as_floats, + bool &use_zlib) +{ + std::istringstream is (arg); + std::string str; + string_vector argv; + + while (! is.eof ()) + { + is >> str; + argv.append (str); + } + + return parse_save_options (argv, format, append, save_as_floats, + use_zlib); +} + +void +write_header (std::ostream& os, load_save_format format) +{ + switch (format.type) + { + case LS_BINARY: + { + os << (oct_mach_info::words_big_endian () + ? "Octave-1-B" : "Octave-1-L"); + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); + + os.write (&tmp, 1); + } + break; + + case LS_MAT5_BINARY: + case LS_MAT7_BINARY: + { + char const * versionmagic; + int16_t number = *(reinterpret_cast("\x00\x01")); + struct tm bdt; + time_t now; + char headertext[128]; + + time (&now); + bdt = *gmtime (&now); + memset (headertext, ' ', 124); + // ISO 8601 format date + nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " + OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); + + // The first pair of bytes give the version of the MAT file + // format. The second pair of bytes form a magic number which + // signals a MAT file. MAT file data are always written in + // native byte order. The order of the bytes in the second + // pair indicates whether the file was written by a big- or + // little-endian machine. However, the version number is + // written in the *opposite* byte order from everything else! + if (number == 1) + versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian + else + versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian + + memcpy (headertext+124, versionmagic, 4); + os.write (headertext, 128); + } + + break; + +#ifdef HAVE_HDF5 + case LS_HDF5: +#endif /* HAVE_HDF5 */ + case LS_ASCII: + { + octave_localtime now; + + std::string comment_string = now.strftime (Vsave_header_format_string); + + if (! comment_string.empty ()) + { +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream& hs = dynamic_cast (os); + H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); + } + else +#endif /* HAVE_HDF5 */ + os << comment_string << "\n"; + } + } + break; + + default: + break; + } +} + +static void +save_vars (const string_vector& argv, int argv_idx, int argc, + std::ostream& os, load_save_format fmt, + bool save_as_floats, bool write_header_info) +{ + if (write_header_info) + write_header (os, fmt); + + if (argv_idx == argc) + { + save_vars (os, "*", fmt, save_as_floats); + } + else if (argv[argv_idx] == "-struct") + { + if (++argv_idx >= argc) + { + error ("save: missing struct name"); + return; + } + + std::string struct_name = argv[argv_idx]; + + if (! symbol_table::is_variable (struct_name)) + { + error ("save: no such variable: `%s'", struct_name.c_str ()); + return; + } + + octave_value struct_var = symbol_table::varref (struct_name); + + if (! struct_var.is_map () || struct_var.numel () != 1) + { + error ("save: `%s' is not a scalar structure", + struct_name.c_str ()); + return; + } + octave_scalar_map struct_var_map = struct_var.scalar_map_value (); + + ++argv_idx; + + if (argv_idx < argc) + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_fields (os, struct_var_map, argv[i], fmt, + save_as_floats)) + { + warning ("save: no such field `%s.%s'", + struct_name.c_str (), argv[i].c_str ()); + } + } + } + else + save_fields (os, struct_var_map, "*", fmt, save_as_floats); + } + else + { + for (int i = argv_idx; i < argc; i++) + { + if (! save_vars (os, argv[i], fmt, save_as_floats)) + warning ("save: no such variable `%s'", argv[i].c_str ()); + } + } +} + +static void +dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, + bool save_as_floats) +{ + write_header (os, fmt); + + std::list vars + = symbol_table::all_variables (symbol_table::top_scope (), 0); + + double save_mem_size = 0; + + typedef std::list::const_iterator const_vars_iterator; + + for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) + { + octave_value val = p->varval (); + + if (val.is_defined ()) + { + std::string name = p->name (); + std::string help; + bool global = p->is_global (); + + double val_size = val.byte_size () / 1024; + + // FIXME -- maybe we should try to throw out the largest first... + + if (Voctave_core_file_limit < 0 + || save_mem_size + val_size < Voctave_core_file_limit) + { + save_mem_size += val_size; + + do_save (os, val, name, help, global, fmt, save_as_floats); + + if (error_state) + break; + } + } + } + + message (0, "save to `%s' complete", fname); +} + +void +dump_octave_core (void) +{ + if (Vcrash_dumps_octave_core) + { + // FIXME -- should choose better file name? + + const char *fname = Voctave_core_file_name.c_str (); + + message (0, "attempting to save variables to `%s'...", fname); + + load_save_format format = LS_BINARY; + + bool save_as_floats = false; + + bool append = false; + + bool use_zlib = false; + + parse_save_options (Voctave_core_file_options, format, append, + save_as_floats, use_zlib); + + std::ios::openmode mode = std::ios::out; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + + mode |= append ? std::ios::ate : std::ios::trunc; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + hdf5_ofstream file (fname, mode); + + if (file.file_id >= 0) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! The open brace below must + // go with the else above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + else +#endif + { + std::ofstream file (fname, mode); + + if (file) + { + dump_octave_core (file, fname, format, save_as_floats); + + file.close (); + } + else + warning ("unable to open `%s' for writing...", fname); + } + } + } +} + + +DEFUN (save, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} save file\n\ +@deftypefnx {Command} {} save options file\n\ +@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ +@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ +Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ +@var{file}. The special filename @samp{-} may be used to write\n\ +output to the terminal. If no variable names are listed, Octave saves\n\ +all the variables in the current scope. Otherwise, full variable names or\n\ +pattern syntax can be used to specify the variables to save.\n\ +If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ +of the scalar structure @var{STRUCT} are saved as if they were variables\n\ +with corresponding names.\n\ +Valid options for the @code{save} command are listed in the following table.\n\ +Options that modify the output format override the format specified by\n\ +@code{default_save_options}.\n\ +\n\ +If save is invoked using the functional form\n\ +\n\ +@example\n\ +save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +then the @var{options}, @var{file}, and variable name arguments\n\ +(@var{v1}, @dots{}) must be specified as character strings.\n\ +\n\ +@table @code\n\ +@item -append\n\ +Append to the destination instead of overwriting.\n\ +\n\ +@item -ascii\n\ +Save a single matrix in a text file without header or any other information.\n\ +\n\ +@item -binary\n\ +Save the data in Octave's binary data format.\n\ +\n\ +@item -float-binary\n\ +Save the data in Octave's binary data format but only using single\n\ +precision. Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -hdf5\n\ +Save the data in @sc{hdf5} format.\n\ +(HDF5 is a free, portable binary format developed by the National\n\ +Center for Supercomputing Applications at the University of Illinois.)\n\ +This format is only available if Octave was built with a link to the\n\ +@sc{hdf5} libraries.\n\ +\n\ +@item -float-hdf5\n\ +Save the data in @sc{hdf5} format but only using single precision.\n\ +Only use this format if you know that all the\n\ +values to be saved can be represented in single precision.\n\ +\n\ +@item -V7\n\ +@itemx -v7\n\ +@itemx -7\n\ +@itemx -mat7-binary\n\ +Save the data in @sc{matlab}'s v7 binary data format.\n\ +\n\ +@item -V6\n\ +@itemx -v6\n\ +@itemx -6\n\ +@itemx -mat\n\ +@itemx -mat-binary\n\ +Save the data in @sc{matlab}'s v6 binary data format.\n\ +\n\ +@item -V4\n\ +@itemx -v4\n\ +@itemx -4\n\ +@itemx -mat4-binary\n\ +Save the data in the binary format written by @sc{matlab} version 4.\n\ +\n\ +@item -text\n\ +Save the data in Octave's text data format. (default).\n\ +\n\ +@item -zip\n\ +@itemx -z\n\ +Use the gzip algorithm to compress the file. This works equally on files\n\ +that are compressed with gzip outside of octave, and gzip can equally be\n\ +used to convert the files for backward compatibility.\n\ +This option is only available if Octave was built with a link to the zlib\n\ +libraries.\n\ +@end table\n\ +\n\ +The list of variables to save may use wildcard patterns containing\n\ +the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ +match all lower and uppercase alphabetic characters.\n\ +\n\ +Wildcards may also be used in the field name specifications when using\n\ +the @option{-struct} modifier (but not in the struct name itself).\n\ +\n\ +@end table\n\ +\n\ +Except when using the @sc{matlab} binary data file format or the\n\ +@samp{-ascii} format, saving global\n\ +variables also saves the global status of the variable. If the variable\n\ +is restored at a later time using @samp{load}, it will be restored as a\n\ +global variable.\n\ +\n\ +The command\n\ +\n\ +@example\n\ +save -binary data a b*\n\ +@end example\n\ +\n\ +@noindent\n\ +saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ +the file @file{data} in Octave's binary format.\n\ +@seealso{load, default_save_options, save_header_format_string, dlmread, csvread, fread}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length (); + + string_vector argv = args.make_argv (); + + if (error_state) + return retval; + + // Here is where we would get the default save format if it were + // stored in a user preference variable. + + bool save_as_floats = false; + + load_save_format format = LS_ASCII; + + bool append = false; + + bool use_zlib = false; + + // get default options + parse_save_options (Vdefault_save_options, format, append, save_as_floats, + use_zlib); + + // override from command line + argv = parse_save_options (argv, format, append, save_as_floats, + use_zlib); + argc = argv.length (); + int i = 0; + + if (error_state) + return retval; + + if (i == argc) + { + print_usage (); + return retval; + } + + if (save_as_floats && format == LS_ASCII) + { + error ("save: cannot specify both -ascii and -float-binary"); + return retval; + } + + if (argv[i] == "-") + { + i++; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + error ("save: cannot write HDF5 format to stdout"); + else +#endif /* HAVE_HDF5 */ + // don't insert any commands here! the brace below must go + // with the "else" above! + { + if (append) + warning ("save: ignoring -append option for output to stdout"); + + // FIXME -- should things intended for the screen end up + // in a octave_value (string)? + + save_vars (argv, i, argc, octave_stdout, format, + save_as_floats, true); + } + } + + // Guard against things like `save a*', which are probably mistakes... + + else if (i == argc - 1 && glob_pattern_p (argv[i])) + { + print_usage (); + return retval; + } + else + { + std::string fname = file_ops::tilde_expand (argv[i]); + + i++; + + // Matlab v7 files are always compressed + if (format == LS_MAT7_BINARY) + use_zlib = false; + + std::ios::openmode mode + = append ? (std::ios::app | std::ios::ate) : std::ios::out; + + if (format == LS_BINARY +#ifdef HAVE_HDF5 + || format == LS_HDF5 +#endif + || format == LS_MAT_BINARY + || format == LS_MAT5_BINARY + || format == LS_MAT7_BINARY) + mode |= std::ios::binary; + +#ifdef HAVE_HDF5 + if (format == LS_HDF5) + { + // FIXME. It should be possible to append to HDF5 files. + if (append) + { + error ("save: appending to HDF5 files is not implemented"); + return retval; + } + + bool write_header_info = ! (append && + H5Fis_hdf5 (fname.c_str ()) > 0); + + hdf5_ofstream hdf5_file (fname.c_str (), mode); + + if (hdf5_file.file_id != -1) + { + save_vars (argv, i, argc, hdf5_file, format, + save_as_floats, write_header_info); + + hdf5_file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif /* HAVE_HDF5 */ + // don't insert any statements here! The brace below must go + // with the "else" above! + { +#ifdef HAVE_ZLIB + if (use_zlib) + { + gzofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + else +#endif + { + std::ofstream file (fname.c_str (), mode); + + if (file) + { + bool write_header_info = ! file.tellp (); + + save_vars (argv, i, argc, file, format, + save_as_floats, write_header_info); + + file.close (); + } + else + { + gripe_file_open ("save", fname); + return retval; + } + } + } + } + + return retval; +} + +DEFUN (crash_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it\n\ +crashes or receives a hangup, terminate or similar signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); +} + +DEFUN (default_save_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} default_save_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} default_save_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} default_save_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the default options\n\ +for the @code{save} command, and defines the default format.\n\ +Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ +The default value is @option{-text}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{save}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (default_save_options); +} + +DEFUN (octave_core_file_limit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum amount\n\ +of memory (in kilobytes) of the top-level workspace that Octave will\n\ +attempt to save when writing data to the crash dump file (the name of\n\ +the file is specified by @var{octave_core_file_name}). If\n\ +@var{octave_core_file_options} flags specify a binary format,\n\ +then @var{octave_core_file_limit} will be approximately the maximum\n\ +size of the file. If a text file format is used, then the file could\n\ +be much larger than the limit. The default value is -1 (unlimited)\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (octave_core_file_limit); +} + +DEFUN (octave_core_file_name, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the name of the file\n\ +used for saving data from the top-level workspace if Octave aborts.\n\ +The default value is @code{\"octave-workspace\"}\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); +} + +DEFUN (octave_core_file_options, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options used for\n\ +saving the workspace data if Octave aborts. The value of\n\ +@code{octave_core_file_options} should follow the same format as the\n\ +options for the @code{save} function. The default value is Octave's binary\n\ +format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); +} + +DEFUN (save_header_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format\n\ +string used for the comment line written at the beginning of\n\ +text-format data files saved by Octave. The format string is\n\ +passed to @code{strftime} and should begin with the character\n\ +@samp{#} and contain no newline characters. If the value of\n\ +@code{save_header_format_string} is the empty string,\n\ +the header comment is omitted from text-format data files. The\n\ +default value is\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end smallexample\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, save}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (save_header_format_string); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/load-save.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/load-save.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,90 @@ +/* + +Copyright (C) 1994-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_load_save_h) +#define octave_load_save_h 1 + +#include +#include + +class octave_value; + +// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. +// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. +enum load_save_format_type + { + LS_ASCII, + LS_BINARY, + LS_MAT_ASCII, + LS_MAT_BINARY, + LS_MAT5_BINARY, + LS_MAT7_BINARY, +#ifdef HAVE_HDF5 + LS_HDF5, +#endif /* HAVE_HDF5 */ + LS_UNKNOWN + }; + +enum load_save_format_options +{ + // LS_MAT_ASCII options (not exclusive) + LS_MAT_ASCII_LONG = 1, + LS_MAT_ASCII_TABS = 2, + // LS_MAT_BINARY options + LS_MAT_BINARY_V5 = 1, + LS_MAT_BINARY_V7, + // zero means no option. + LS_NO_OPTION = 0 +}; + +class load_save_format +{ +public: + load_save_format (load_save_format_type t, + load_save_format_options o = LS_NO_OPTION) + : type (t), opts (o) { } + operator int (void) const + { return type; } + int type, opts; +}; + +extern void dump_octave_core (void); + +extern int +read_binary_file_header (std::istream& is, bool& swap, + oct_mach_info::float_format& flt_fmt, + bool quiet = false); + +extern octave_value +do_load (std::istream& stream, const std::string& orig_fname, + load_save_format format, oct_mach_info::float_format flt_fmt, + bool list_only, bool swap, bool verbose, + const string_vector& argv, int argv_idx, int argc, int nargout); + +extern void +do_save (std::ostream& os, const symbol_table::symbol_record& sr, + load_save_format fmt, bool save_as_floats); + +extern void +write_header (std::ostream& os, load_save_format format); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/ls-oct-ascii.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/ls-oct-ascii.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,432 @@ +/* + +Copyright (C) 1996-2012 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 3 of the License, 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, see +. + +*/ + +// Author: John W. Eaton. + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include +#include +#include + +#include "byte-swap.h" +#include "data-conv.h" +#include "file-ops.h" +#include "glob-match.h" +#include "lo-mappers.h" +#include "mach-info.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "load-save.h" +#include "ls-ascii-helper.h" +#include "ls-oct-ascii.h" +#include "oct-obj.h" +#include "oct-map.h" +#include "ov-cell.h" +#include "pager.h" +#include "pt-exp.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" +#include "dMatrix.h" + +// The number of decimal digits to use when writing ascii data. +static int Vsave_precision = 16; + +// Functions for reading ascii data. + +// Extract a KEYWORD and its value from stream IS, returning the +// associated value in a new string. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n + +std::string +extract_keyword (std::istream& is, const char *keyword, const bool next_only) +{ + std::string retval; + + int ch = is.peek (); + if (next_only && ch != '%' && ch != '#') + return retval; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + std::ostringstream value; + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + retval = read_until_newline (is, false); + break; + } + else if (next_only) + break; + else + skip_until_newline (is, false); + } + } + + int len = retval.length (); + + if (len > 0) + { + while (len) + { + c = retval[len-1]; + + if (c == ' ' || c == '\t') + len--; + else + { + retval.resize (len); + break; + } + } + } + + return retval; +} + +// Extract one value (scalar, matrix, string, etc.) from stream IS and +// place it in TC, returning the name of the variable. If the value +// is tagged as global in the file, return TRUE in GLOBAL. +// +// Each type supplies its own function to load the data, and so this +// function is extensible. +// +// FILENAME is used for error messages. +// +// The data is expected to be in the following format: +// +// The input file must have a header followed by some data. +// +// All lines in the header must begin with a `#' character. +// +// The header must contain a list of keyword and value pairs with the +// keyword and value separated by a colon. +// +// Keywords must appear in the following order: +// +// # name: +// # type: +// # +// +// Where, for the built in types are: +// +// : a valid identifier +// +// : +// | global +// +// : scalar +// | complex scalar +// | matrix +// | complex matrix +// | bool +// | bool matrix +// | string +// | range +// +// : +// | +// +// : # rows: +// : # columns: +// +// : # elements: +// : # length: (once before each string) +// +// For backward compatibility the type "string array" is treated as a +// "string" type. Also "string" can have a single element with no elements +// line such that +// +// : # length: +// +// Formatted ASCII data follows the header. +// +// Example: +// +// # name: foo +// # type: matrix +// # rows: 2 +// # columns: 2 +// 2 4 +// 1 3 +// +// Example: +// +// # name: foo +// # type: string +// # elements: 5 +// # length: 4 +// this +// # length: 2 +// is +// # length: 1 +// a +// # length: 6 +// string +// # length: 5 +// array +// +// FIXME -- this format is fairly rigid, and doesn't allow for +// arbitrary comments. Someone should fix that. It does allow arbitrary +// types however. + +// Ugh. The signature of the compare method is not standard in older +// versions of the GNU libstdc++. Do this instead: + +#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) + +std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count) +{ + // Read name for this entry or break on EOF. + + std::string name = extract_keyword (is, "name"); + + if (name.empty ()) + { + if (count == 0) + error ("load: empty name keyword or no data found in file `%s'", + filename.c_str ()); + + return std::string (); + } + + if (! (name == ".nargin." || name == ".nargout." + || name == CELL_ELT_TAG || valid_identifier (name))) + { + error ("load: bogus identifier `%s' found in file `%s'", + name.c_str (), filename.c_str ()); + return std::string (); + } + + // Look for type keyword. + + std::string tag = extract_keyword (is, "type"); + + if (! tag.empty ()) + { + std::string typ; + size_t pos = tag.rfind (' '); + + if (pos != std::string::npos) + { + global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); + + typ = global ? tag.substr (7) : tag; + } + else + typ = tag; + + // Special case for backward compatiablity. A small bit of cruft + if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) + tc = charMatrix (); + else + tc = octave_value_typeinfo::lookup_type (typ); + + if (! tc.load_ascii (is)) + error ("load: trouble reading ascii file `%s'", filename.c_str ()); + } + else + error ("load: failed to extract keyword specifying value type"); + + if (error_state) + { + error ("load: reading file %s", filename.c_str ()); + return std::string (); + } + + return name; +} + +// Save the data from TC along with the corresponding NAME, and global +// flag MARK_AS_GLOBAL on stream OS in the plain text format described +// above for load_ascii_data. If NAME is empty, the name: line is not +// generated. PRECISION specifies the number of decimal digits to print. +// +// Assumes ranges and strings cannot contain Inf or NaN values. +// +// Returns 1 for success and 0 for failure. + +// FIXME -- should probably write the help string here too. + +bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, + int precision) +{ + bool success = true; + + if (! name.empty ()) + os << "# name: " << name << "\n"; + + octave_value val = val_arg; + + if (mark_as_global) + os << "# type: global " << val.type_name () << "\n"; + else + os << "# type: " << val.type_name () << "\n"; + + if (! precision) + precision = Vsave_precision; + + long old_precision = os.precision (); + os.precision (precision); + + success = val.save_ascii (os); + + // Insert an extra pair of newline characters after the data so that + // multiple data elements may be handled separately by gnuplot (see + // the description of the index qualifier for the plot command in the + // gnuplot documentation). + os << "\n\n"; + + os.precision (old_precision); + + return (os && success); +} + +bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name) +{ + return save_ascii_data (os, t, name, false, 6); +} + +// Maybe this should be a static function in tree-plot.cc? + +// If TC is matrix, save it on stream OS in a format useful for +// making a 3-dimensional plot with gnuplot. If PARAMETRIC is +// TRUE, assume a parametric 3-dimensional plot will be generated. + +bool +save_three_d (std::ostream& os, const octave_value& tc, bool parametric) +{ + bool fail = false; + + octave_idx_type nr = tc.rows (); + octave_idx_type nc = tc.columns (); + + if (tc.is_real_matrix ()) + { + os << "# 3D data...\n" + << "# type: matrix\n" + << "# total rows: " << nr << "\n" + << "# total columns: " << nc << "\n"; + + long old_precision = os.precision (); + os.precision (6); + + if (parametric) + { + octave_idx_type extras = nc % 3; + if (extras) + warning ("ignoring last %d columns", extras); + + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc-extras; i += 3) + { + os << tmp.extract (0, i, nr-1, i+2); + if (i+3 < nc-extras) + os << "\n"; + } + } + else + { + Matrix tmp = tc.matrix_value (); + nr = tmp.rows (); + + for (octave_idx_type i = 0; i < nc; i++) + { + os << tmp.extract (0, i, nr-1, i); + if (i+1 < nc) + os << "\n"; + } + } + + os.precision (old_precision); + } + else + { + ::error ("for now, I can only save real matrices in 3D format"); + fail = true; + } + + return (os && ! fail); +} + +DEFUN (save_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the number of\n\ +digits to keep when saving data in text format.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, INT_MAX); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/ls-oct-ascii.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/ls-oct-ascii.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,189 @@ +/* + +Copyright (C) 2003-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_ls_oct_ascii_h) +#define octave_ls_oct_ascii_h 1 + +#include + +#include +#include + +#include "str-vec.h" + +#include "ls-ascii-helper.h" + +// Flag for cell elements +#define CELL_ELT_TAG "" + +// Used when converting Inf to something that gnuplot can read. + +#ifndef OCT_RBV +#define OCT_RBV DBL_MAX / 100.0 +#endif + +extern OCTINTERP_API std::string +extract_keyword (std::istream& is, const char *keyword, + const bool next_only = false); + +extern OCTINTERP_API std::string +read_ascii_data (std::istream& is, const std::string& filename, bool& global, + octave_value& tc, octave_idx_type count); + +extern OCTINTERP_API bool +save_ascii_data (std::ostream& os, const octave_value& val_arg, + const std::string& name, bool mark_as_global, int precision); + +extern OCTINTERP_API bool +save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, + const std::string& name); + +extern OCTINTERP_API bool +save_three_d (std::ostream& os, const octave_value& t, + bool parametric = false); + +// Match KEYWORD on stream IS, placing the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const char *keyword, T& value, + const bool next_only = false) +{ + bool status = false; + value = T (); + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); + + if (match) + { + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + break; + } + else if (next_only) + break; + } + } + return status; +} + +template +bool +extract_keyword (std::istream& is, const std::string& kw, T& value, + const bool next_only = false) +{ + return extract_keyword (is, kw.c_str (), value, next_only); +} + +// Match one of the elements in KEYWORDS on stream IS, placing the +// matched keyword in KW and the associated value in VALUE, +// returning TRUE if successful and FALSE otherwise. +// +// Input should look something like: +// +// [%#][ \t]*keyword[ \t]*int-value.*\n + +template +bool +extract_keyword (std::istream& is, const string_vector& keywords, + std::string& kw, T& value, const bool next_only = false) +{ + bool status = false; + kw = ""; + value = 0; + + char c; + while (is.get (c)) + { + if (c == '%' || c == '#') + { + std::ostringstream buf; + + while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) + ; // Skip whitespace and comment characters. + + if (isalpha (c)) + buf << c; + + while (is.get (c) && isalpha (c)) + buf << c; + + std::string tmp = buf.str (); + + for (int i = 0; i < keywords.length (); i++) + { + int match = (tmp == keywords[i]); + + if (match) + { + kw = keywords[i]; + + while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) + ; // Skip whitespace and the colon. + + is.putback (c); + if (c != '\n' && c != '\r') + is >> value; + if (is) + status = true; + skip_until_newline (is, false); + return status; + } + } + + if (next_only) + break; + } + } + return status; +} + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/module.mk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/module.mk Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,65 @@ +EXTRA_DIST += \ + interpfcn/module.mk + +INTERPFCN_INCLUDES = \ + interpfcn/data.h \ + interpfcn/debug.h \ + interpfcn/defun.h \ + interpfcn/dirfns.h \ + interpfcn/error.h \ + interpfcn/file-io.h \ + interpfcn/help.h \ + interpfcn/input.h \ + interpfcn/load-path.h \ + interpfcn/load-save.h \ + interpfcn/ls-oct-ascii.h \ + interpfcn/oct-hist.h \ + interpfcn/pager.h \ + interpfcn/pr-output.h \ + interpfcn/profiler.h \ + interpfcn/sighandlers.h \ + interpfcn/symtab.h \ + interpfcn/sysdep.h \ + interpfcn/toplev.h \ + interpfcn/utils.h \ + interpfcn/variables.h + +INTERPFCN_SRC = \ + interpfcn/data.cc \ + interpfcn/debug.cc \ + interpfcn/defaults.cc \ + interpfcn/defun.cc \ + interpfcn/dirfns.cc \ + interpfcn/error.cc \ + interpfcn/file-io.cc \ + interpfcn/graphics.cc \ + interpfcn/help.cc \ + interpfcn/input.cc \ + interpfcn/load-path.cc \ + interpfcn/load-save.cc \ + interpfcn/ls-oct-ascii.cc \ + interpfcn/oct-hist.cc \ + interpfcn/pager.cc \ + interpfcn/pr-output.cc \ + interpfcn/profiler.cc \ + interpfcn/sighandlers.cc \ + interpfcn/symtab.cc \ + interpfcn/sysdep.cc \ + interpfcn/toplev.cc \ + interpfcn/utils.cc \ + interpfcn/variables.cc + +## defaults.h and graphics.h must depend on Makefile. Calling configure +## may change default/config values. However, calling configure will also +## regenerate the Makefiles from Makefile.am and trigger the rules below. +interpfcn/defaults.h: interpfcn/defaults.in.h Makefile + @$(do_subst_default_vals) + +interpfcn/graphics.h: interpfcn/graphics.in.h genprops.awk Makefile + $(AWK) -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + +interpfcn/graphics-props.cc: interpfcn/graphics.in.h genprops.awk Makefile + $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t + mv $@-t $@ + diff -r 069c552587a0 -r 959953dba519 src/interpfcn/oct-hist.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/oct-hist.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,781 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +/* + +The functions listed below were adapted from similar functions from +GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free +Software Foundation, Inc. + + do_history edit_history_readline + do_edit_history edit_history_add_hist + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include + +#include + +#include +#include + +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "oct-env.h" +#include "oct-time.h" +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means input is coming from temporary history file. +bool input_from_tmp_history_file = false; + +static std::string +default_history_file (void) +{ + std::string file; + + std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); + + if (! env_file.empty ()) + file = env_file; + + if (file.empty ()) + file = file_ops::concat (octave_env::get_home_directory (), + ".octave_hist"); + + return file; +} + +static int +default_history_size (void) +{ + int size = 1024; + + std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); + + if (! env_size.empty ()) + { + int val; + + if (sscanf (env_size.c_str (), "%d", &val) == 1) + size = val > 0 ? val : 0; + } + + return size; +} + +static std::string +default_history_timestamp_format (void) +{ + return + std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") + + octave_env::get_user_name () + + std::string ("@") + + octave_env::get_host_name () + + std::string (">"); +} + +// The format of the timestamp marker written to the history file when +// Octave exits. +static std::string Vhistory_timestamp_format_string + = default_history_timestamp_format (); + +// Display, save, or load history. Stolen and modified from bash. +// +// Arg of -w FILENAME means write file, arg of -r FILENAME +// means read file, arg of -q means don't number lines. Arg of N +// means only display that many items. + +static void +do_history (int argc, const string_vector& argv) +{ + int numbered_output = 1; + + unwind_protect frame; + + frame.add_fcn (command_history::set_file, command_history::file ()); + + int i; + for (i = 1; i < argc; i++) + { + std::string option = argv[i]; + + if (option == "-r" || option == "-w" || option == "-a" + || option == "-n") + { + if (i < argc - 1) + command_history::set_file (argv[i+1]); + + if (option == "-a") + // Append `new' lines to file. + command_history::append (); + + else if (option == "-w") + // Write entire history. + command_history::write (); + + else if (option == "-r") + // Read entire file. + command_history::read (); + + else if (option == "-n") + // Read `new' history from file. + command_history::read_range (); + + else + panic_impossible (); + + return; + } + else if (argv[i] == "-q") + numbered_output = 0; + else if (argv[i] == "--") + { + i++; + break; + } + else + break; + } + + int limit = -1; + + if (i < argc) + { + if (sscanf (argv[i].c_str (), "%d", &limit) != 1) + { + if (argv[i][0] == '-') + error ("history: unrecognized option `%s'", argv[i].c_str ()); + else + error ("history: bad non-numeric arg `%s'", argv[i].c_str ()); + + return; + } + + if (limit < 0) + limit = -limit; + } + + string_vector hlist = command_history::list (limit, numbered_output); + + int len = hlist.length (); + + for (i = 0; i < len; i++) + octave_stdout << hlist[i] << "\n"; +} + +// Read the edited history lines from STREAM and return them +// one at a time. This can read unlimited length lines. The +// caller should free the storage. + +static char * +edit_history_readline (std::fstream& stream) +{ + char c; + int line_len = 128; + int lindex = 0; + char *line = new char [line_len]; + line[0] = '\0'; + + while (stream.get (c)) + { + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [line_len += 128]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + if (c == '\n') + { + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; + } + else + line[lindex++] = c; + } + + if (! lindex) + { + delete [] line; + return 0; + } + + if (lindex + 2 >= line_len) + { + char *tmp_line = new char [lindex+3]; + strcpy (tmp_line, line); + delete [] line; + line = tmp_line; + } + + // Finish with newline if none in file. + + line[lindex++] = '\n'; + line[lindex++] = '\0'; + return line; +} + +// Use `command' to replace the last entry in the history list, which, +// by this time, is `run_history blah...'. The intent is that the +// new command becomes the history entry, and that `fc' should never +// appear in the history list. This way you can do `run_history' to +// your heart's content. + +static void +edit_history_repl_hist (const std::string& command) +{ + if (! command.empty ()) + { + string_vector hlist = command_history::list (); + + int len = hlist.length (); + + if (len > 0) + { + int i = len - 1; + + std::string histent = command_history::get_entry (i); + + if (! histent.empty ()) + { + std::string cmd = command; + + int cmd_len = cmd.length (); + + if (cmd[cmd_len - 1] == '\n') + cmd.resize (cmd_len - 1); + + if (! cmd.empty ()) + command_history::replace_entry (i, cmd); + } + } + } +} + +static void +edit_history_add_hist (const std::string& line) +{ + if (! line.empty ()) + { + std::string tmp = line; + + int len = tmp.length (); + + if (len > 0 && tmp[len-1] == '\n') + tmp.resize (len - 1); + + if (! tmp.empty ()) + command_history::add (tmp); + } +} + +static std::string +mk_tmp_hist_file (int argc, const string_vector& argv, + int insert_curr, const char *warn_for) +{ + std::string retval; + + string_vector hlist = command_history::list (); + + int hist_count = hlist.length (); + + // The current command line is already part of the history list by + // the time we get to this point. Delete it from the list. + + hist_count -= 2; + + if (! insert_curr) + command_history::remove (hist_count); + + hist_count--; + + // If no numbers have been specified, the default is to edit the + // last command in the history list. + + int hist_end = hist_count; + int hist_beg = hist_count; + int reverse = 0; + + // Process options. + + int usage_error = 0; + if (argc == 3) + { + if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1 + || sscanf (argv[2].c_str (), "%d", &hist_end) != 1) + usage_error = 1; + else + { + hist_beg--; + hist_end--; + } + } + else if (argc == 2) + { + if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1) + usage_error = 1; + else + { + hist_beg--; + hist_end = hist_beg; + } + } + + if (hist_beg < 0 || hist_end < 0 || hist_beg > hist_count + || hist_end > hist_count) + { + error ("%s: history specification out of range", warn_for); + return retval; + } + + if (usage_error) + { + usage ("%s [first] [last]", warn_for); + return retval; + } + + if (hist_end < hist_beg) + { + int t = hist_end; + hist_end = hist_beg; + hist_beg = t; + reverse = 1; + } + + std::string name = octave_tempnam ("", "oct-"); + + std::fstream file (name.c_str (), std::ios::out); + + if (! file) + { + error ("%s: couldn't open temporary file `%s'", warn_for, + name.c_str ()); + return retval; + } + + if (reverse) + { + for (int i = hist_end; i >= hist_beg; i--) + file << hlist[i] << "\n"; + } + else + { + for (int i = hist_beg; i <= hist_end; i++) + file << hlist[i] << "\n"; + } + + file.close (); + + return name; +} + +static void +unlink_cleanup (const char *file) +{ + gnulib::unlink (file); +} + +static void +do_edit_history (int argc, const string_vector& argv) +{ + std::string name = mk_tmp_hist_file (argc, argv, 0, "edit_history"); + + if (name.empty ()) + return; + + // Call up our favorite editor on the file of commands. + + std::string cmd = VEDITOR; + cmd.append (" \""); + cmd.append (name); + cmd.append ("\""); + + // Ignore interrupts while we are off editing commands. Should we + // maybe avoid using system()? + + volatile octave_interrupt_handler old_interrupt_handler + = octave_ignore_interrupts (); + + system (cmd.c_str ()); + + octave_set_interrupt_handler (old_interrupt_handler); + + // Write the commands to the history file since source_file + // disables command line history while it executes. + + std::fstream file (name.c_str (), std::ios::in); + + char *line; + int first = 1; + while ((line = edit_history_readline (file)) != 0) + { + // Skip blank lines. + + if (line[0] == '\n') + { + delete [] line; + continue; + } + + if (first) + { + first = 0; + edit_history_repl_hist (line); + } + else + edit_history_add_hist (line); + } + + file.close (); + + // Turn on command echo, so the output from this will make better + // sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +static void +do_run_history (int argc, const string_vector& argv) +{ + std::string name = mk_tmp_hist_file (argc, argv, 1, "run_history"); + + if (name.empty ()) + return; + + // Turn on command echo so the output from this will make better + // sense. + + unwind_protect frame; + + frame.add_fcn (unlink_cleanup, name.c_str ()); + frame.protect_var (Vecho_executing_commands); + frame.protect_var (input_from_tmp_history_file); + + Vecho_executing_commands = ECHO_CMD_LINE; + input_from_tmp_history_file = true; + + source_file (name); +} + +void +initialize_history (bool read_history_file) +{ + command_history::initialize (read_history_file, + default_history_file (), + default_history_size (), + octave_env::getenv ("OCTAVE_HISTCONTROL")); +} + +void +octave_history_write_timestamp (void) +{ + octave_localtime now; + + std::string timestamp = now.strftime (Vhistory_timestamp_format_string); + + if (! timestamp.empty ()) + command_history::add (timestamp); +} + +DEFUN (edit_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} edit_history [@var{first}] [@var{last}]\n\ +If invoked with no arguments, @code{edit_history} allows you to edit the\n\ +history list using the editor named by the variable @w{@env{EDITOR}}. The\n\ +commands to be edited are first copied to a temporary file. When you\n\ +exit the editor, Octave executes the commands that remain in the file.\n\ +It is often more convenient to use @code{edit_history} to define functions\n\ +rather than attempting to enter them directly on the command line.\n\ +By default, the block of commands is executed as soon as you exit the\n\ +editor. To avoid executing any commands, simply delete all the lines\n\ +from the buffer before exiting the editor.\n\ +\n\ +The @code{edit_history} command takes two optional arguments specifying\n\ +the history numbers of first and last commands to edit. For example,\n\ +the command\n\ +\n\ +@example\n\ +edit_history 13\n\ +@end example\n\ +\n\ +@noindent\n\ +extracts all the commands from the 13th through the last in the history\n\ +list. The command\n\ +\n\ +@example\n\ +edit_history 13 169\n\ +@end example\n\ +\n\ +@noindent\n\ +only extracts commands 13 through 169. Specifying a larger number for\n\ +the first command than the last command reverses the list of commands\n\ +before placing them in the buffer to be edited. If both arguments are\n\ +omitted, the previous command in the history list is used.\n\ +@seealso{run_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("edit_history"); + + if (error_state) + return retval; + + do_edit_history (argc, argv); + + return retval; +} + +DEFUN (history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} history options\n\ +If invoked with no arguments, @code{history} displays a list of commands\n\ +that you have executed. Valid options are:\n\ +\n\ +@table @code\n\ +@item -w @var{file}\n\ +Write the current history to the file @var{file}. If the name is\n\ +omitted, use the default history file (normally @file{~/.octave_hist}).\n\ +\n\ +@item -r @var{file}\n\ +Read the file @var{file}, appending its contents to the current\n\ +history list. If the name is omitted, use the default history file\n\ +(normally @file{~/.octave_hist}).\n\ +\n\ +@item @var{n}\n\ +Display only the most recent @var{n} lines of history.\n\ +\n\ +@item -q\n\ +Don't number the displayed lines of history. This is useful for cutting\n\ +and pasting commands using the X Window System.\n\ +@end table\n\ +\n\ +For example, to display the five most recent commands that you have\n\ +typed without displaying line numbers, use the command\n\ +@kbd{history -q 5}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("history"); + + if (error_state) + return retval; + + do_history (argc, argv); + + return retval; +} + +DEFUN (run_history, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} run_history [@var{first}] [@var{last}]\n\ +Similar to @code{edit_history}, except that the editor is not invoked,\n\ +and the commands are simply executed as they appear in the history list.\n\ +@seealso{edit_history}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("run_history"); + + if (error_state) + return retval; + + do_run_history (argc, argv); + + return retval; +} + +DEFUN (history_control, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ +Query or set the internal variable that specifies how commands are saved\n\ +to the history list. The default value is an empty character string,\n\ +but may be overridden by the environment variable\n\ +@w{@env{OCTAVE_HISTCONTROL}}.\n\ +\n\ +The value of @code{history_control} is a colon-separated list of values\n\ +controlling how commands are saved on the history list. If the list\n\ +of values includes @code{ignorespace}, lines which begin with a space\n\ +character are not saved in the history list. A value of @code{ignoredups}\n\ +causes lines matching the previous history entry to not be saved.\n\ +A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ +@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ +matching the current line to be removed from the history list before that\n\ +line is saved. Any value not in the above list is ignored. If\n\ +@code{history_control} is the empty string, all commands are saved on\n\ +the history list, subject to the value of @code{saving_history}.\n\ +@seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ +@end deftypefn") +{ + std::string old_history_control = command_history::histcontrol (); + + std::string tmp = old_history_control; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_control"); + + if (tmp != old_history_control) + command_history::process_histcontrol (tmp); + + return retval; +} + +DEFUN (history_size, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ +Query or set the internal variable that specifies how many entries\n\ +to store in the history file. The default value is @code{1024},\n\ +but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ +@seealso{history_file, history_timestamp_format_string, saving_history}\n\ +@end deftypefn") +{ + int old_history_size = command_history::size (); + + int tmp = old_history_size; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_size", -1, INT_MAX); + + if (tmp != old_history_size) + command_history::set_size (tmp); + + return retval; +} + +DEFUN (history_file, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ +Query or set the internal variable that specifies the name of the\n\ +file used to store command history. The default value is\n\ +@file{~/.octave_hist}, but may be overridden by the environment\n\ +variable @w{@env{OCTAVE_HISTFILE}}.\n\ +@seealso{history_size, saving_history, history_timestamp_format_string}\n\ +@end deftypefn") +{ + std::string old_history_file = command_history::file (); + + std::string tmp = old_history_file; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_file"); + + if (tmp != old_history_file) + command_history::set_file (tmp); + + return retval; +} + +DEFUN (history_timestamp_format_string, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the format string\n\ +for the comment line that is written to the history file when Octave\n\ +exits. The format string is passed to @code{strftime}. The default\n\ +value is\n\ +\n\ +@example\n\ +\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{strftime, history_file, history_size, saving_history}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (history_timestamp_format_string); +} + +DEFUN (saving_history, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} saving_history ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} saving_history (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} saving_history (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether commands entered\n\ +on the command line are saved in the history file.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ +@end deftypefn") +{ + bool old_saving_history = ! command_history::ignoring_entries (); + + bool tmp = old_saving_history; + + octave_value retval = set_internal_variable (tmp, args, nargout, + "saving_history"); + + if (tmp != old_saving_history) + command_history::ignore_entries (! tmp); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/oct-hist.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/oct-hist.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,38 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_octave_hist_h) +#define octave_octave_hist_h 1 + +#include + +#include "cmd-hist.h" + +extern void initialize_history (bool read_history_file = false); + +// Write timestamp to history file. +extern void octave_history_write_timestamp (void); + +// TRUE means input is coming from temporary history file. +extern bool input_from_tmp_history_file; + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/pager.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pager.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,715 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include "cmd-edit.h" +#include "oct-env.h" +#include "singleton-cleanup.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "oct-obj.h" +#include "pager.h" +#include "procstream.h" +#include "sighandlers.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Our actual connection to the external pager. +static oprocstream *external_pager = 0; + +// TRUE means we write to the diary file. +static bool write_to_diary_file = false; + +// The name of the current diary file. +static std::string diary_file; + +// The diary file. +static std::ofstream external_diary_file; + +static std::string +default_pager (void) +{ + std::string pager_binary = octave_env::getenv ("PAGER"); + +#ifdef OCTAVE_DEFAULT_PAGER + if (pager_binary.empty ()) + pager_binary = OCTAVE_DEFAULT_PAGER; +#endif + + return pager_binary; +} + +// The shell command to run as the pager. +static std::string VPAGER = default_pager (); + +// The options to pass to the pager. +static std::string VPAGER_FLAGS; + +// TRUE means that if output is going to the pager, it is sent as soon +// as it is available. Otherwise, it is buffered and only sent to the +// pager when it is time to print another prompt. +static bool Vpage_output_immediately = false; + +// TRUE means all output intended for the screen should be passed +// through the pager. +static bool Vpage_screen_output = true; + +static bool really_flush_to_pager = false; + +static bool flushing_output_to_pager = false; + +static void +clear_external_pager (void) +{ + if (external_pager) + { + octave_child_list::remove (external_pager->pid ()); + + delete external_pager; + external_pager = 0; + } +} + +static bool +pager_event_handler (pid_t pid, int status) +{ + bool retval = false; + + if (pid > 0) + { + if (WIFEXITED (status) || WIFSIGNALLED (status)) + { + // Avoid warning() since that will put us back in the pager, + // which would be bad news. + + std::cerr << "warning: connection to external pager lost (pid = " + << pid << ")" << std::endl; + std::cerr << "warning: flushing pending output (please wait)" + << std::endl; + + // Request removal of this PID from the list of child + // processes. + + retval = true; + } + } + + return retval; +} + +static std::string +pager_command (void) +{ + std::string cmd = VPAGER; + + if (! (cmd.empty () || VPAGER_FLAGS.empty ())) + cmd += " " + VPAGER_FLAGS; + + return cmd; +} + +static void +do_sync (const char *msg, int len, bool bypass_pager) +{ + if (msg && len > 0) + { + if (bypass_pager) + { + std::cout.write (msg, len); + std::cout.flush (); + } + else + { + if (! external_pager) + { + std::string pgr = pager_command (); + + if (! pgr.empty ()) + { + external_pager = new oprocstream (pgr.c_str ()); + + if (external_pager) + octave_child_list::insert (external_pager->pid (), + pager_event_handler); + } + } + + if (external_pager) + { + if (external_pager->good ()) + { + external_pager->write (msg, len); + + external_pager->flush (); + +#if defined (EPIPE) + if (errno == EPIPE) + external_pager->setstate (std::ios::failbit); +#endif + } + else + { + // FIXME -- omething is not right with the + // pager. If it died then we should receive a + // signal for that. If there is some other problem, + // then what? + } + } + else + { + std::cout.write (msg, len); + std::cout.flush (); + } + } + } +} + +// Assume our terminal wraps long lines. + +static bool +more_than_a_screenful (const char *s, int len) +{ + if (s) + { + int available_rows = command_editor::terminal_rows () - 2; + + int cols = command_editor::terminal_cols (); + + int count = 0; + + int chars_this_line = 0; + + for (int i = 0; i < len; i++) + { + if (*s++ == '\n') + { + count += chars_this_line / cols + 1; + chars_this_line = 0; + } + else + chars_this_line++; + } + + if (count > available_rows) + return true; + } + + return false; +} + +int +octave_pager_buf::sync (void) +{ + if (! interactive + || really_flush_to_pager + || (Vpage_screen_output && Vpage_output_immediately) + || ! Vpage_screen_output) + { + char *buf = eback (); + + int len = pptr () - buf; + + bool bypass_pager = (! interactive + || ! Vpage_screen_output + || (really_flush_to_pager + && Vpage_screen_output + && ! Vpage_output_immediately + && ! more_than_a_screenful (buf, len))); + + if (len > 0) + { + do_sync (buf, len, bypass_pager); + + flush_current_contents_to_diary (); + + seekoff (0, std::ios::beg); + } + } + + return 0; +} + +void +octave_pager_buf::flush_current_contents_to_diary (void) +{ + char *buf = eback () + diary_skip; + + size_t len = pptr () - buf; + + octave_diary.write (buf, len); + + diary_skip = 0; +} + +void +octave_pager_buf::set_diary_skip (void) +{ + diary_skip = pptr () - eback (); +} + +int +octave_diary_buf::sync (void) +{ + if (write_to_diary_file && external_diary_file) + { + char *buf = eback (); + + int len = pptr () - buf; + + if (len > 0) + external_diary_file.write (buf, len); + } + + seekoff (0, std::ios::beg); + + return 0; +} + +octave_pager_stream *octave_pager_stream::instance = 0; + +octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) +{ + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +octave_pager_stream::~octave_pager_stream (void) +{ + flush (); + delete pb; +} + +std::ostream& +octave_pager_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +void +octave_pager_stream::flush_current_contents_to_diary (void) +{ + if (instance_ok ()) + instance->do_flush_current_contents_to_diary (); +} + +void +octave_pager_stream::set_diary_skip (void) +{ + if (instance_ok ()) + instance->do_set_diary_skip (); +} + +// Reinitialize the pager buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_pager_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_pager_stream::do_flush_current_contents_to_diary (void) +{ + if (pb) + pb->flush_current_contents_to_diary (); +} + +void +octave_pager_stream::do_set_diary_skip (void) +{ + if (pb) + pb->set_diary_skip (); +} + +void +octave_pager_stream::do_reset (void) +{ + delete pb; + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + +bool +octave_pager_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_pager_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create pager_stream object!"); + + retval = false; + } + + return retval; +} + +octave_diary_stream *octave_diary_stream::instance = 0; + +octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) +{ + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +octave_diary_stream::~octave_diary_stream (void) +{ + flush (); + delete db; +} + +std::ostream& +octave_diary_stream::stream (void) +{ + return instance_ok () ? *instance : std::cout; +} + +// Reinitialize the diary buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_diary_stream::reset (void) +{ + if (instance_ok ()) + instance->do_reset (); +} + +void +octave_diary_stream::do_reset (void) +{ + delete db; + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + +bool +octave_diary_stream::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_diary_stream (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create diary_stream object!"); + + retval = false; + } + + return retval; +} + +void +flush_octave_stdout (void) +{ + if (! flushing_output_to_pager) + { + unwind_protect frame; + + frame.protect_var (really_flush_to_pager); + frame.protect_var (flushing_output_to_pager); + + really_flush_to_pager = true; + flushing_output_to_pager = true; + + octave_stdout.flush (); + + clear_external_pager (); + } +} + +static void +close_diary_file (void) +{ + // Try to flush the current buffer to the diary now, so that things + // like + // + // function foo () + // diary on; + // ... + // diary off; + // endfunction + // + // will do the right thing. + + octave_pager_stream::flush_current_contents_to_diary (); + + if (external_diary_file.is_open ()) + { + octave_diary.flush (); + external_diary_file.close (); + } +} + +static void +open_diary_file (void) +{ + close_diary_file (); + + // If there is pending output in the pager buf, it should not go + // into the diary file. + + octave_pager_stream::set_diary_skip (); + + external_diary_file.open (diary_file.c_str (), std::ios::app); + + if (! external_diary_file) + error ("diary: can't open diary file `%s'", diary_file.c_str ()); +} + +DEFUN (diary, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} diary options\n\ +Record a list of all commands @emph{and} the output they produce, mixed\n\ +together just as you see them on your terminal. Valid options are:\n\ +\n\ +@table @code\n\ +@item on\n\ +Start recording your session in a file called @file{diary} in your\n\ +current working directory.\n\ +\n\ +@item off\n\ +Stop recording your session in the diary file.\n\ +\n\ +@item @var{file}\n\ +Record your session in the file named @var{file}.\n\ +@end table\n\ +\n\ +With no arguments, @code{diary} toggles the current diary state.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("diary"); + + if (error_state) + return retval; + + if (diary_file.empty ()) + diary_file = "diary"; + + switch (argc) + { + case 1: + write_to_diary_file = ! write_to_diary_file; + open_diary_file (); + break; + + case 2: + { + std::string arg = argv[1]; + + if (arg == "on") + { + write_to_diary_file = true; + open_diary_file (); + } + else if (arg == "off") + { + close_diary_file (); + write_to_diary_file = false; + } + else + { + diary_file = arg; + write_to_diary_file = true; + open_diary_file (); + } + } + break; + + default: + print_usage (); + break; + } + + return retval; +} + +DEFUN (more, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} more\n\ +@deftypefnx {Command} {} more on\n\ +@deftypefnx {Command} {} more off\n\ +Turn output pagination on or off. Without an argument, @code{more}\n\ +toggles the current state.\n\ +The current state can be determined via @code{page_screen_output}.\n\ +@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("more"); + + if (error_state) + return retval; + + if (argc == 2) + { + std::string arg = argv[1]; + + if (arg == "on") + Vpage_screen_output = true; + else if (arg == "off") + Vpage_screen_output = false; + else + error ("more: unrecognized argument `%s'", arg.c_str ()); + } + else if (argc == 1) + Vpage_screen_output = ! Vpage_screen_output; + else + print_usage (); + + return retval; +} + +DEFUN (terminal_size, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} terminal_size ()\n\ +Return a two-element row vector containing the current size of the\n\ +terminal window in characters (rows and columns).\n\ +@seealso{list_in_columns}\n\ +@end deftypefn") +{ + RowVector size (2, 0.0); + + size(0) = command_editor::terminal_rows (); + size(1) = command_editor::terminal_cols (); + + return octave_value (size); +} + +DEFUN (page_output_immediately, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave sends\n\ +output to the pager as soon as it is available. Otherwise, Octave\n\ +buffers its output and waits until just before the prompt is printed to\n\ +flush it to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_output_immediately); +} + +DEFUN (page_screen_output, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether output intended\n\ +for the terminal window that is longer than one page is sent through a\n\ +pager. This allows you to view one screenful at a time. Some pagers\n\ +(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ +backward on the output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (page_screen_output); +} + +DEFUN (PAGER, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the program to use\n\ +to display terminal output on your system. The default value is\n\ +normally @code{\"less\"}, @code{\"more\"}, or\n\ +@code{\"pg\"}, depending on what programs are installed on your system.\n\ +@xref{Installation}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); +} + +DEFUN (PAGER_FLAGS, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the options to pass\n\ +to the pager.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ +@end deftypefn") +{ + return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/pager.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pager.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,150 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_pager_h) +#define octave_pager_h 1 + +#include +#include +#include + +#include + +class +OCTINTERP_API +octave_pager_buf : public std::stringbuf +{ +public: + + octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } + + void flush_current_contents_to_diary (void); + + void set_diary_skip (void); + +protected: + + int sync (void); + +private: + + size_t diary_skip; +}; + +class +OCTINTERP_API +octave_pager_stream : public std::ostream +{ +protected: + + octave_pager_stream (void); + +public: + + ~octave_pager_stream (void); + + static void flush_current_contents_to_diary (void); + + static void set_diary_skip (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_flush_current_contents_to_diary (void); + + void do_set_diary_skip (void); + + void do_reset (void); + + static octave_pager_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_pager_buf *pb; + + // No copying! + + octave_pager_stream (const octave_pager_stream&); + + octave_pager_stream& operator = (const octave_pager_stream&); +}; + +class +OCTINTERP_API +octave_diary_buf : public std::stringbuf +{ +public: + + octave_diary_buf (void) : std::stringbuf () { } + +protected: + + int sync (void); +}; + +class +OCTINTERP_API +octave_diary_stream : public std::ostream +{ +protected: + + octave_diary_stream (void); + +public: + + ~octave_diary_stream (void); + + static std::ostream& stream (void); + + static void reset (void); + +private: + + void do_reset (void); + + static octave_diary_stream *instance; + + static bool instance_ok (void); + + static void cleanup_instance (void) { delete instance; instance = 0; } + + octave_diary_buf *db; + + // No copying! + + octave_diary_stream (const octave_diary_stream&); + + octave_diary_stream& operator = (const octave_diary_stream&); +}; + +#define octave_stdout (octave_pager_stream::stream ()) + +#define octave_diary (octave_diary_stream::stream ()) + +extern OCTINTERP_API void flush_octave_stdout (void); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/pr-output.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pr-output.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,4089 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include +#include + +#include "Array-util.h" +#include "CMatrix.h" +#include "Range.h" +#include "cmd-edit.h" +#include "dMatrix.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-cmplx.h" +#include "quit.h" +#include "str-vec.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "oct-stream.h" +#include "pager.h" +#include "pr-output.h" +#include "sysdep.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// TRUE means use a scaled fixed point format for `format long' and +// `format short'. +static bool Vfixed_point_format = false; + +// The maximum field width for a number printed by the default output +// routines. +static int Voutput_max_field_width = 10; + +// The precision of the numbers printed by the default output +// routines. +static int Voutput_precision = 5; + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +bool Vprint_empty_dimensions = true; + +// TRUE means that the rows of big matrices should be split into +// smaller slices that fit on the screen. +static bool Vsplit_long_rows = true; + +// TRUE means don't do any fancy formatting. +static bool free_format = false; + +// TRUE means print plus sign for nonzero, blank for zero. +static bool plus_format = false; + +// First char for > 0, second for < 0, third for == 0. +static std::string plus_format_chars = "+ "; + +// TRUE means always print in a rational approximation +static bool rat_format = false; + +// Used to force the length of the rational approximation string for Frats +static int rat_string_len = -1; + +// TRUE means always print like dollars and cents. +static bool bank_format = false; + +// TRUE means print data in hexadecimal format. +static int hex_format = 0; + +// TRUE means print data in binary-bit-pattern format. +static int bit_format = 0; + +// TRUE means don't put newlines around the column number headers. +bool Vcompact_format = false; + +// TRUE means use an e format. +static bool print_e = false; + +// TRUE means use a g format. +static bool print_g = false; + +// TRUE means print E instead of e for exponent field. +static bool print_big_e = false; + +// TRUE means use an engineering format. +static bool print_eng = false; + +class pr_engineering_float; +class pr_formatted_float; +class pr_rational_float; + +static int +current_output_max_field_width (void) +{ + return Voutput_max_field_width; +} + +static int +current_output_precision (void) +{ + return Voutput_precision; +} + +class +float_format +{ +public: + + float_format (int w = current_output_max_field_width (), + int p = current_output_precision (), int f = 0) + : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } + + float_format (int w, int e, int p, int f) + : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } + + float_format (const float_format& ff) + : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } + + float_format& operator = (const float_format& ff) + { + if (&ff != this) + { + fw = ff.fw; + ex = ff.ex; + prec = ff.prec; + fmt = ff.fmt; + up = ff.up; + sp = ff.sp; + } + + return *this; + } + + ~float_format (void) { } + + float_format& scientific (void) { fmt = std::ios::scientific; return *this; } + float_format& fixed (void) { fmt = std::ios::fixed; return *this; } + float_format& general (void) { fmt = 0; return *this; } + + float_format& uppercase (void) { up = std::ios::uppercase; return *this; } + float_format& lowercase (void) { up = 0; return *this; } + + float_format& precision (int p) { prec = p; return *this; } + + float_format& width (int w) { fw = w; return *this; } + + float_format& trailing_zeros (bool tz = true) + { sp = tz ? std::ios::showpoint : 0; return *this; } + + friend std::ostream& operator << (std::ostream& os, + const pr_engineering_float& pef); + + friend std::ostream& operator << (std::ostream& os, + const pr_formatted_float& pff); + + friend std::ostream& operator << (std::ostream& os, + const pr_rational_float& prf); + +private: + + // Field width. Zero means as wide as necessary. + int fw; + + // Exponent Field width. Zero means as wide as necessary. + int ex; + + // Precision. + int prec; + + // Format. + int fmt; + + // E or e. + int up; + + // Show trailing zeros. + int sp; +}; + +static int +calc_scale_exp (const int& x) +{ + if (! print_eng) + return x; + else + return x - 3*static_cast (x/3); + /* The expression above is equivalent to x - (x % 3). + * According to the ISO specification for C++ the modulo operator is + * compiler dependent if any of the arguments are negative. Since this + * function will need to work on negative arguments, and we want to avoid + * portability issues, we re-implement the modulo function to the desired + * behavior (truncation). There may be a gnulib replacement. + * + * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . + * "the binary % operator yields the remainder from the division of the first + * expression by the second. .... If both operands are nonnegative then the + * remainder is nonnegative; if not, the sign of the remainder is + * implementation-defined". */ +} + +static int +engineering_exponent (const double& x) +{ + int ex = 0; + if (x != 0) + { + double absval = (x < 0.0 ? -x : x); + int logabsval = static_cast (gnulib::floor (log10 (absval))); + /* Avoid using modulo function with negative arguments for portability. + * See extended comment at calc_scale_exp */ + if (logabsval < 0.0) + ex = logabsval - 2 + ((-logabsval + 2) % 3); + else + ex = logabsval - (logabsval % 3); + } + return ex; +} + +static int +num_digits (const double& x) +{ + return 1 + (print_eng + ? engineering_exponent (x) + : static_cast (gnulib::floor (log10 (x)))); +} + +class +pr_engineering_float +{ +public: + + const float_format& f; + + double val; + + int exponent (void) const + { + return engineering_exponent (val); + } + + double mantissa (void) const + { + return val / std::pow (10.0, exponent ()); + } + + pr_engineering_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_engineering_float& pef) +{ + if (pef.f.fw >= 0) + os << std::setw (pef.f.fw - pef.f.ex); + + if (pef.f.prec >= 0) + os << std::setprecision (pef.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pef.f.fmt | pef.f.up | pef.f.sp)); + + os << pef.mantissa (); + + int ex = pef.exponent (); + if (ex < 0) + { + os << std::setw (0) << "e-"; + ex = -ex; + } + else + os << std::setw (0) << "e+"; + + os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex + << std::setfill (' '); + + os.flags (oflags); + + return os; +} + +class +pr_formatted_float +{ +public: + + const float_format& f; + + double val; + + pr_formatted_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_formatted_float& pff) +{ + if (pff.f.fw >= 0) + os << std::setw (pff.f.fw); + + if (pff.f.prec >= 0) + os << std::setprecision (pff.f.prec); + + std::ios::fmtflags oflags = + os.flags (static_cast + (pff.f.fmt | pff.f.up | pff.f.sp)); + + os << pff.val; + + os.flags (oflags); + + return os; +} + +static inline std::string +rational_approx (double val, int len) +{ + std::string s; + + if (len <= 0) + len = 10; + + if (xisinf (val)) + s = "1/0"; + else if (xisnan (val)) + s = "0/0"; + else if (val < INT_MIN || val > INT_MAX || D_NINT (val) == val) + { + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << xround (val); + s = buf.str (); + } + else + { + double lastn = 1.; + double lastd = 0.; + double n = xround (val); + double d = 1.; + double frac = val - n; + int m = 0; + + std::ostringstream buf2; + buf2.flags (std::ios::fixed); + buf2 << std::setprecision (0) << static_cast(n); + s = buf2.str (); + + while (1) + { + double flip = 1. / frac; + double step = xround (flip); + double nextn = n; + double nextd = d; + + // Have we converged to 1/intmax ? + if (m > 100 || fabs (frac) < 1 / static_cast(INT_MAX)) + { + lastn = n; + lastd = d; + break; + } + + frac = flip - step; + n = n * step + lastn; + d = d * step + lastd; + lastn = nextn; + lastd = nextd; + + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(n) + << "/" << static_cast(d); + m++; + + if (n < 0 && d < 0) + { + // Double negative, string can be two characters longer.. + if (buf.str ().length () > static_cast(len + 2) && + m > 1) + break; + } + else if (buf.str ().length () > static_cast(len) && + m > 1) + break; + + s = buf.str (); + } + + if (lastd < 0.) + { + // Move sign to the top + lastd = - lastd; + lastn = - lastn; + std::ostringstream buf; + buf.flags (std::ios::fixed); + buf << std::setprecision (0) << static_cast(lastn) + << "/" << static_cast(lastd); + s = buf.str (); + } + } + + return s; +} + +class +pr_rational_float +{ +public: + + const float_format& f; + + double val; + + pr_rational_float (const float_format& f_arg, double val_arg) + : f (f_arg), val (val_arg) { } +}; + +std::ostream& +operator << (std::ostream& os, const pr_rational_float& prf) +{ + int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); + std::string s = rational_approx (prf.val, fw); + + if (fw >= 0) + os << std::setw (fw); + + std::ios::fmtflags oflags = + os.flags (static_cast + (prf.f.fmt | prf.f.up | prf.f.sp)); + + if (fw > 0 && s.length () > static_cast(fw)) + os << "*"; + else + os << s; + + os.flags (oflags); + + return os; +} + +// Current format for real numbers and the real part of complex +// numbers. +static float_format *curr_real_fmt = 0; + +// Current format for the imaginary part of complex numbers. +static float_format *curr_imag_fmt = 0; + +static double +pr_max_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = -DBL_MAX; + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val > result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +static double +pr_min_internal (const Matrix& m) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + double result = DBL_MAX; + + bool all_inf_or_nan = true; + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = 0; i < nr; i++) + { + double val = m(i,j); + if (xisinf (val) || xisnan (val)) + continue; + + all_inf_or_nan = false; + + if (val < result) + result = val; + } + + if (all_inf_or_nan) + result = 0.0; + + return result; +} + +// FIXME -- it would be nice to share more code among these +// functions,.. + +static void +set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 0; + rd = 0; + } + else if (bank_format) + { + fw = digits < 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + fw = 1 + digits; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + if (digits > 0) + { + ld = digits; + rd = prec > digits ? prec - digits : prec; + digits++; + } + else + { + ld = 1; + rd = prec > digits ? prec - digits : prec; + digits = -digits + 1; + } + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (digits > 100) + ex++; + + if (print_eng) + { + fw = 4 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 2 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && (inf_or_nan || int_only)) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (double d, int& fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = (xisinf (d) || xisnan (d)); + + bool int_only = (! inf_or_nan && D_NINT (d) == d); + + double d_abs = d < 0.0 ? -d : d; + + int digits = (inf_or_nan || d_abs == 0.0) + ? 0 : num_digits (d_abs); + + set_real_format (digits, inf_or_nan, int_only, fw); +} + +static inline void +set_format (double d) +{ + int fw; + set_format (d, fw); +} + +static void +set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && fw < 4) + fw = 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 2; + if (inf_or_nan && fw < 4) + fw = 4; + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits <= 0 ? 2 : digits + 1; + if (inf_or_nan && fw < 4) + fw = 4; + rd = fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = 1 + ld + 1 + rd; + if (inf_or_nan && fw < 4) + fw = 4; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 4 + prec + ex; + if (inf_or_nan && fw < 6) + fw = 6; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 2 + prec + ex; + if (inf_or_nan && fw < 4) + fw = 4; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && int_or_inf_or_nan) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Matrix& m, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + bool inf_or_nan = m.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); + + Matrix m_abs = m.abs (); + double max_abs = pr_max_internal (m_abs); + double min_abs = pr_min_internal (m_abs); + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); +} + +static inline void +set_format (const Matrix& m) +{ + int fw; + double scale; + set_format (m, fw, scale); +} + +static void +set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, + int int_only, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 0; + r_fw = 0; + rd = 0; + } + else if (bank_format) + { + int digits = r_x; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (inf_or_nan || int_only) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && (inf_or_nan || int_only)) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const Complex& c, int& r_fw, int& i_fw) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double rp = c.real (); + double ip = c.imag (); + + bool inf_or_nan = (xisinf (c) || xisnan (c)); + + bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); + + double r_abs = rp < 0.0 ? -rp : rp; + double i_abs = ip < 0.0 ? -ip : ip; + + int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) + ? 0 : num_digits (r_abs); + + int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) + ? 0 : num_digits (i_abs); + + int x_max, x_min; + + if (r_x > i_x) + { + x_max = r_x; + x_min = i_x; + } + else + { + x_max = i_x; + x_min = r_x; + } + + set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); +} + +static inline void +set_format (const Complex& c) +{ + int r_fw, i_fw; + set_format (c, r_fw, i_fw); +} + +static void +set_complex_matrix_format (int x_max, int x_min, int r_x_max, + int r_x_min, bool inf_or_nan, + int int_or_inf_or_nan, int& r_fw, int& i_fw) +{ + static float_format r_fmt; + static float_format i_fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + i_fw = 9; + r_fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = r_x_max > r_x_min ? r_x_max : r_x_min; + i_fw = 0; + r_fw = digits <= 0 ? 4 : digits + 3; + if (inf_or_nan && r_fw < 4) + r_fw = 4; + rd = 2; + } + else if (hex_format) + { + r_fw = 2 * sizeof (double); + i_fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + r_fw = 8 * sizeof (double); + i_fw = 8 * sizeof (double); + rd = 0; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + i_fw = rd + 1; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + else if (int_or_inf_or_nan) + { + int digits = x_max > x_min ? x_max : x_min; + i_fw = digits <= 0 ? 1 : digits; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + rd = r_fw; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + i_fw = ld + 1 + rd; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) + { + if (print_g) + { + r_fmt = float_format (); + i_fmt = float_format (); + } + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + i_fw = 3 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 5) + { + i_fw = 5; + r_fw = 6; + } + r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); + i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); + } + else + { + i_fw = 1 + prec + ex; + r_fw = i_fw + 1; + if (inf_or_nan && i_fw < 3) + { + i_fw = 3; + r_fw = 4; + } + r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); + i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + { + r_fmt.uppercase (); + i_fmt.uppercase (); + } + } + else if (! bank_format && int_or_inf_or_nan) + { + r_fmt = float_format (r_fw, rd); + i_fmt = float_format (i_fw, rd); + } + else + { + r_fmt = float_format (r_fw, rd, std::ios::fixed); + i_fmt = float_format (i_fw, rd, std::ios::fixed); + } + + curr_real_fmt = &r_fmt; + curr_imag_fmt = &i_fmt; +} + +static void +set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + Matrix rp = real (cm); + Matrix ip = imag (cm); + + bool inf_or_nan = cm.any_element_is_inf_or_nan (); + + bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () + && ip.all_elements_are_int_or_inf_or_nan ()); + + Matrix r_m_abs = rp.abs (); + double r_max_abs = pr_max_internal (r_m_abs); + double r_min_abs = pr_min_internal (r_m_abs); + + Matrix i_m_abs = ip.abs (); + double i_max_abs = pr_max_internal (i_m_abs); + double i_min_abs = pr_min_internal (i_m_abs); + + int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); + + int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); + + int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); + + int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); + + int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; + int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; + + scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, + int_or_inf_or_nan, r_fw, i_fw); +} + +static inline void +set_format (const ComplexMatrix& cm) +{ + int r_fw, i_fw; + double scale; + set_format (cm, r_fw, i_fw, scale); +} + +static void +set_range_format (int x_max, int x_min, int all_ints, int& fw) +{ + static float_format fmt; + + int prec = Voutput_precision; + + int ld, rd; + + if (rat_format) + { + fw = 9; + rd = 0; + } + else if (bank_format) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits < 0 ? 5 : digits + 4; + rd = 2; + } + else if (hex_format) + { + fw = 2 * sizeof (double); + rd = 0; + } + else if (bit_format) + { + fw = 8 * sizeof (double); + rd = 0; + } + else if (all_ints) + { + int digits = x_max > x_min ? x_max : x_min; + fw = digits + 1; + rd = fw; + } + else if (Vfixed_point_format && ! print_g) + { + rd = prec; + fw = rd + 3; + } + else + { + int ld_max, rd_max; + if (x_max > 0) + { + ld_max = x_max; + rd_max = prec > x_max ? prec - x_max : prec; + x_max++; + } + else + { + ld_max = 1; + rd_max = prec > x_max ? prec - x_max : prec; + x_max = -x_max + 1; + } + + int ld_min, rd_min; + if (x_min > 0) + { + ld_min = x_min; + rd_min = prec > x_min ? prec - x_min : prec; + x_min++; + } + else + { + ld_min = 1; + rd_min = prec > x_min ? prec - x_min : prec; + x_min = -x_min + 1; + } + + ld = ld_max > ld_min ? ld_max : ld_min; + rd = rd_max > rd_min ? rd_max : rd_min; + + fw = ld + rd + 3; + } + + if (! (rat_format || bank_format || hex_format || bit_format) + && (print_e + || print_eng || print_g + || (! Vfixed_point_format && fw > Voutput_max_field_width))) + { + if (print_g) + fmt = float_format (); + else + { + int ex = 4; + if (x_max > 100 || x_min > 100) + ex++; + + if (print_eng) + { + fw = 5 + prec + ex; + fmt = float_format (fw, ex, prec - 1, std::ios::fixed); + } + else + { + fw = 3 + prec + ex; + fmt = float_format (fw, prec - 1, std::ios::scientific); + } + } + + if (print_big_e) + fmt.uppercase (); + } + else if (! bank_format && all_ints) + fmt = float_format (fw, rd); + else + fmt = float_format (fw, rd, std::ios::fixed); + + curr_real_fmt = &fmt; +} + +static void +set_format (const Range& r, int& fw, double& scale) +{ + curr_real_fmt = 0; + curr_imag_fmt = 0; + + if (free_format) + return; + + double r_min = r.base (); + double r_max = r.limit (); + + if (r_max < r_min) + { + double tmp = r_max; + r_max = r_min; + r_min = tmp; + } + + bool all_ints = r.all_elements_are_ints (); + + double max_abs = r_max < 0.0 ? -r_max : r_max; + double min_abs = r_min < 0.0 ? -r_min : r_min; + + int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); + + int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); + + scale = (x_max == 0 || all_ints) ? 1.0 + : std::pow (10.0, calc_scale_exp (x_max - 1)); + + set_range_format (x_max, x_min, all_ints, fw); +} + +static inline void +set_format (const Range& r) +{ + int fw; + double scale; + set_format (r, fw, scale); +} + +union equiv +{ + double d; + unsigned char i[sizeof (double)]; +}; + +#define PRINT_CHAR_BITS(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +#define PRINT_CHAR_BITS_SWAPPED(os, c) \ + do \ + { \ + unsigned char ctmp = c; \ + char stmp[9]; \ + stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ + stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ + stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ + stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ + stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ + stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ + stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ + stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ + stmp[8] = '\0'; \ + os << stmp; \ + } \ + while (0) + +static void +pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) +{ + if (fmt) + { + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + equiv tmp; + tmp.d = d; + + // Unless explicitly asked for, always print in big-endian + // format. + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + // FIXME -- will bad things happen if we are + // interrupted before resetting the format flags and fill + // character? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + os << std::setw (2) << static_cast (tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmp.i[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + equiv tmp; + tmp.d = d; + + // FIXME -- is it correct to swap bytes for VAX + // formats and not for Cray? + + oct_mach_info::float_format flt_fmt = + oct_mach_info::native_float_format (); + + if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian + || flt_fmt == oct_mach_info::flt_fmt_cray + || flt_fmt == oct_mach_info::flt_fmt_unknown) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sizeof (double); i++) + PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); + } + else + { + for (int i = sizeof (double) - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmp.i[i]); + } + } + } + else if (octave_is_NA (d)) + { + if (fw > 0) + os << std::setw (fw) << "NA"; + else + os << "NA"; + } + else if (rat_format) + os << pr_rational_float (*fmt, d); + else if (xisinf (d)) + { + const char *s; + if (d < 0.0) + s = "-Inf"; + else + s = "Inf"; + + if (fw > 0) + os << std::setw (fw) << s; + else + os << s; + } + else if (xisnan (d)) + { + if (fw > 0) + os << std::setw (fw) << "NaN"; + else + os << "NaN"; + } + else if (print_eng) + os << pr_engineering_float (*fmt, d); + else + os << pr_formatted_float (*fmt, d); + } + else + os << d; +} + +static inline void +pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + d /= scale; + + pr_any_float (curr_real_fmt, os, d, fw); +} + +static inline void +pr_imag_float (std::ostream& os, double d, int fw = 0) +{ + pr_any_float (curr_imag_fmt, os, d, fw); +} + +static void +pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, + int i_fw = 0, double scale = 1.0) +{ + Complex tmp + = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; + + double r = tmp.real (); + + pr_float (os, r, r_fw); + + if (! bank_format) + { + double i = tmp.imag (); + if (! (hex_format || bit_format) && lo_ieee_signbit (i)) + { + os << " - "; + i = -i; + pr_imag_float (os, i, i_fw); + } + else + { + if (hex_format || bit_format) + os << " "; + else + os << " + "; + + pr_imag_float (os, i, i_fw); + } + os << "i"; + } +} + +static void +print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) +{ + assert (nr == 0 || nc == 0); + + if (pr_as_read_syntax) + { + if (nr == 0 && nc == 0) + os << "[]"; + else + os << "zeros (" << nr << ", " << nc << ")"; + } + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << nr << "x" << nc << ")"; + } +} + +static void +print_empty_nd_array (std::ostream& os, const dim_vector& dims, + bool pr_as_read_syntax) +{ + assert (dims.any_zero ()); + + if (pr_as_read_syntax) + os << "zeros (" << dims.str (',') << ")"; + else + { + os << "[]"; + + if (Vprint_empty_dimensions) + os << "(" << dims.str () << ")"; + } +} + +static void +pr_scale_header (std::ostream& os, double scale) +{ + if (Vfixed_point_format && ! print_g && scale != 1.0) + { + os << " " + << std::setw (8) << std::setprecision (1) + << std::setiosflags (std::ios::scientific|std::ios::left) + << scale + << std::resetiosflags (std::ios::scientific|std::ios::left) + << " *\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +static void +pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, + octave_idx_type lim, octave_idx_type col, int extra_indent) +{ + if (total_width > max_width && Vsplit_long_rows) + { + if (col != 0) + { + if (Vcompact_format) + os << "\n"; + else + os << "\n\n"; + } + + octave_idx_type num_cols = lim - col; + + os << std::setw (extra_indent) << ""; + + if (num_cols == 1) + os << " Column " << col + 1 << ":\n"; + else if (num_cols == 2) + os << " Columns " << col + 1 << " and " << lim << ":\n"; + else + os << " Columns " << col + 1 << " through " << lim << ":\n"; + + if (! Vcompact_format) + os << "\n"; + } +} + +template +/* static */ inline void +pr_plus_format (std::ostream& os, const T& val) +{ + if (val > T (0)) + os << plus_format_chars[0]; + else if (val < T (0)) + os << plus_format_chars[1]; + else + os << plus_format_chars[2]; +} + +void +octave_print_internal (std::ostream& os, double d, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, d); + } + else + { + set_format (d); + if (free_format) + os << d; + else + pr_float (os, d); + } +} + +void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (m, fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << m; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_float (os, m(i,j), fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw; + double scale = 1.0; + set_format (Matrix (m.diag ()), fw, scale); + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_float (os, m(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_float (tmp_oss, 0.0, fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_float (os, m(i,j), fw, scale); + else + os << std::setw (zero_fw) << '0'; + + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +template +void print_nd_array (std::ostream& os, const NDA_T& nda, + bool pr_as_read_syntax) +{ + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else + { + + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + octave_quit (); + + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + octave_value page + = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); + + if (i != m - 1) + { + page.print_with_name (os, nm); + } + else + { + page.print_name_tag (os, nm); + page.print_raw (os); + } + + if (i < m) + NDA_T::increment_index (ra_idx, dims, 2); + } + } +} + +void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +template <> +/* static */ inline void +pr_plus_format<> (std::ostream& os, const Complex& c) +{ + double rp = c.real (); + double ip = c.imag (); + + if (rp == 0.0) + { + if (ip == 0.0) + os << " "; + else + os << "i"; + } + else if (ip == 0.0) + pr_plus_format (os, rp); + else + os << "c"; +} + +void +octave_print_internal (std::ostream& os, const Complex& c, + bool /* pr_as_read_syntax */) +{ + if (plus_format) + { + pr_plus_format (os, c); + } + else + { + set_format (c); + if (free_format) + os << c; + else + pr_complex (os, c); + } +} + +void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (cm, r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << cm; + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (i == 0 && j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(i,j)); + } + + col += inc; + + if (col >= nc) + { + if (i == nr - 1) + os << " ]"; + else + os << ";\n"; + } + else + os << " ...\n"; + } + } + } + else + { + pr_scale_header (os, scale); + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = cm.rows (); + octave_idx_type nc = cm.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, cm(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int r_fw, i_fw; + double scale = 1.0; + set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); + int column_width = i_fw + r_fw; + column_width += (rat_format || bank_format || hex_format + || bit_format) ? 2 : 7; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << ComplexMatrix (cm); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + os << "diag ("; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + pr_complex (os, cm(j,j)); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + os << ")"; + } + else + { + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + pr_scale_header (os, scale); + + // kluge. Get the true width of a number. + int zero_fw; + + { + std::ostringstream tmp_oss; + pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); + zero_fw = tmp_oss.str ().length (); + } + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + if (i == j) + pr_complex (os, cm(i,j), r_fw, i_fw, scale); + else + os << std::setw (zero_fw) << '0'; + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_idx_type nr = m.rows (); + octave_idx_type nc = m.columns (); + + if (nr == 0 || nc == 0) + print_empty_matrix (os, nr, nc, pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < nr; i++) + { + for (octave_idx_type j = 0; j < nc; j++) + { + octave_quit (); + + pr_plus_format (os, m(i,j)); + } + + if (i < nr - 1) + os << "\n"; + } + } + else + { + int fw = 2; + int column_width = fw + 2; + octave_idx_type total_width = nc * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (pr_as_read_syntax) + max_width -= 4; + else + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + os << Matrix (m); + + if (pr_as_read_syntax) + os << "]"; + + return; + } + + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + if (pr_as_read_syntax) + { + Array pvec = m.pvec (); + bool colp = m.is_col_perm (); + + os << "eye ("; + if (colp) os << ":, "; + + octave_idx_type col = 0; + while (col < nc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + if (j == 0) + os << "[ "; + else + { + if (j > col && j < lim) + os << ", "; + else + os << " "; + } + + os << pvec (j); + } + + col += inc; + + if (col >= nc) + os << " ]"; + else + os << " ...\n"; + } + if (! colp) os << ", :"; + os << ")"; + } + else + { + os << "Permutation Matrix\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type col = 0; col < nc; col += inc) + { + octave_idx_type lim = col + inc < nc ? col + inc : nc; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type i = 0; i < nr; i++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type j = col; j < lim; j++) + { + octave_quit (); + + os << " "; + + os << std::setw (fw) << m(i,j); + } + + if (i < nr - 1) + os << "\n"; + } + } + } + } +} + +void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +// FIXME -- write single precision versions of the printing functions. + +void +octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) +{ + octave_print_internal (os, double (d), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax) +{ + octave_print_internal (os, Complex (c), pr_as_read_syntax); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax, int extra_indent) +{ + double base = r.base (); + double increment = r.inc (); + double limit = r.limit (); + octave_idx_type num_elem = r.nelem (); + + if (plus_format && ! pr_as_read_syntax) + { + for (octave_idx_type i = 0; i < num_elem; i++) + { + octave_quit (); + + double val = base + i * increment; + + pr_plus_format (os, val); + } + } + else + { + int fw = 0; + double scale = 1.0; + set_format (r, fw, scale); + + if (pr_as_read_syntax) + { + if (free_format) + { + os << base << " : "; + if (increment != 1.0) + os << increment << " : "; + os << limit; + } + else + { + pr_float (os, base, fw); + os << " : "; + if (increment != 1.0) + { + pr_float (os, increment, fw); + os << " : "; + } + pr_float (os, limit, fw); + } + } + else + { + int column_width = fw + 2; + octave_idx_type total_width = num_elem * column_width; + octave_idx_type max_width = command_editor::terminal_cols (); + + if (free_format) + { + os << r; + return; + } + + octave_idx_type inc = num_elem; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + max_width -= extra_indent; + + if (max_width < 0) + max_width = 0; + + pr_scale_header (os, scale); + + octave_idx_type col = 0; + while (col < num_elem) + { + octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + os << std::setw (extra_indent) << ""; + + for (octave_idx_type i = col; i < lim; i++) + { + octave_quit (); + + double val = base + i * increment; + + if (i == num_elem - 1) + { + // See the comments in Range::matrix_value. + + if ((increment > 0 && val > limit) + || (increment < 0 && val < limit)) + val = limit; + } + + os << " "; + + pr_float (os, val, fw, scale); + } + + col += inc; + } + } + } +} + +void +octave_print_internal (std::ostream& os, const boolMatrix& bm, + bool pr_as_read_syntax, + int extra_indent) +{ + Matrix tmp (bm); + octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const boolNDArray& nda, + bool pr_as_read_syntax, + int extra_indent) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax, + int /* extra_indent FIXME */, + bool pr_as_string) +{ + if (pr_as_string) + { + octave_idx_type nstr = chm.rows (); + + if (pr_as_read_syntax && nstr > 1) + os << "[ "; + + if (nstr != 0) + { + for (octave_idx_type i = 0; i < nstr; i++) + { + octave_quit (); + + std::string row = chm.row_as_string (i); + + if (pr_as_read_syntax) + { + os << "\"" << undo_string_escapes (row) << "\""; + + if (i < nstr - 1) + os << "; "; + } + else + { + os << row; + + if (i < nstr - 1) + os << "\n"; + } + } + } + + if (pr_as_read_syntax && nstr > 1) + os << " ]"; + } + else + { + os << "sorry, printing char matrices not implemented yet\n"; + } +} + +void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax, int extra_indent, + bool pr_as_string) +{ + switch (nda.ndims ()) + { + case 1: + case 2: + octave_print_internal (os, nda.matrix_value (), + pr_as_read_syntax, extra_indent, pr_as_string); + break; + + default: + print_nd_array (os, nda, pr_as_read_syntax); + break; + } +} + +void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax, int extra_indent) +{ + Array nda (dim_vector (1, 1), s); + + octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); +} + +void +octave_print_internal (std::ostream& os, const Array& nda, + bool pr_as_read_syntax, int /* extra_indent */) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + { + os << nda(0); + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + // FIXME -- need to do some more work to put these + // in neatly aligned columns... + + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + for (octave_idx_type jj = 0; jj < n_cols; jj++) + os << " " << page(ii,jj); + + os << "\n"; + } + + if (i < m - 1) + os << "\n"; + + if (i < m) + increment_index (ra_idx, dims, 2); + } + } +} + +template +class +octave_print_conv +{ +public: + typedef T print_conv_type; +}; + +#define PRINT_CONV(T1, T2) \ + template <> \ + class \ + octave_print_conv \ + { \ + public: \ + typedef T2 print_conv_type; \ + } + +PRINT_CONV (octave_int8, octave_int16); +PRINT_CONV (octave_uint8, octave_uint16); + +#undef PRINT_CONV + +template +/* static */ inline void +pr_int (std::ostream& os, const T& d, int fw = 0) +{ + size_t sz = d.byte_size (); + const unsigned char * tmpi = d.iptr (); + + // Unless explicitly asked for, always print in big-endian + // format for hex and bit formats. + // + // {bit,hex}_format == 1: print big-endian + // {bit,hex}_format == 2: print native + + if (hex_format) + { + char ofill = os.fill ('0'); + + std::ios::fmtflags oflags + = os.flags (std::ios::right | std::ios::hex); + + if (hex_format > 1 || oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + os << std::setw (2) << static_cast (tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + os << std::setw (2) << static_cast (tmpi[i]); + } + + os.fill (ofill); + os.setf (oflags); + } + else if (bit_format) + { + if (oct_mach_info::words_big_endian ()) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS (os, tmpi[i]); + } + else + { + if (bit_format > 1) + { + for (size_t i = 0; i < sz; i++) + PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); + } + else + { + for (int i = sz - 1; i >= 0; i--) + PRINT_CHAR_BITS (os, tmpi[i]); + } + } + } + else + { + os << std::setw (fw) + << typename octave_print_conv::print_conv_type (d); + + if (bank_format) + os << ".00"; + } +} + +// FIXME -- all this mess with abs is an attempt to avoid seeing +// +// warning: comparison of unsigned expression < 0 is always false +// +// from GCC. Isn't there a better way + +template +/* static */ inline T +abs (T x) +{ + return x < 0 ? -x : x; +} + +#define INSTANTIATE_ABS(T) \ + template /* static */ T abs (T) + +INSTANTIATE_ABS(signed char); +INSTANTIATE_ABS(short); +INSTANTIATE_ABS(int); +INSTANTIATE_ABS(long); +INSTANTIATE_ABS(long long); + +#define SPECIALIZE_UABS(T) \ + template <> \ + /* static */ inline unsigned T \ + abs (unsigned T x) \ + { \ + return x; \ + } + +SPECIALIZE_UABS(char) +SPECIALIZE_UABS(short) +SPECIALIZE_UABS(int) +SPECIALIZE_UABS(long) +SPECIALIZE_UABS(long long) + +template void +pr_int (std::ostream&, const octave_int8&, int); + +template void +pr_int (std::ostream&, const octave_int16&, int); + +template void +pr_int (std::ostream&, const octave_int32&, int); + +template void +pr_int (std::ostream&, const octave_int64&, int); + +template void +pr_int (std::ostream&, const octave_uint8&, int); + +template void +pr_int (std::ostream&, const octave_uint16&, int); + +template void +pr_int (std::ostream&, const octave_uint32&, int); + +template void +pr_int (std::ostream&, const octave_uint64&, int); + +template +void +octave_print_internal_template (std::ostream& os, const octave_int& val, + bool) +{ + if (plus_format) + { + pr_plus_format (os, val); + } + else + { + if (free_format) + os << typename octave_print_conv >::print_conv_type (val); + else + pr_int (os, val); + } +} + +#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ + { \ + octave_print_internal_template (os, val, dummy); \ + } + +PRINT_INT_SCALAR_INTERNAL (int8_t) +PRINT_INT_SCALAR_INTERNAL (uint8_t) +PRINT_INT_SCALAR_INTERNAL (int16_t) +PRINT_INT_SCALAR_INTERNAL (uint16_t) +PRINT_INT_SCALAR_INTERNAL (int32_t) +PRINT_INT_SCALAR_INTERNAL (uint32_t) +PRINT_INT_SCALAR_INTERNAL (int64_t) +PRINT_INT_SCALAR_INTERNAL (uint64_t) + +template +/* static */ inline void +octave_print_internal_template (std::ostream& os, const intNDArray& nda, + bool pr_as_read_syntax, int extra_indent) +{ + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else if (nda.length () == 1) + octave_print_internal_template (os, nda(0), pr_as_read_syntax); + else if (plus_format && ! pr_as_read_syntax) + { + int ndims = nda.ndims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + dim_vector dims = nda.dims (); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + + pr_plus_format (os, page(ii,jj)); + } + + if ((ii < nr - 1) || (i < m -1)) + os << "\n"; + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } + else + { + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + int fw = 0; + if (hex_format) + fw = 2 * nda(0).byte_size (); + else if (bit_format) + fw = nda(0).nbits (); + else + { + bool isneg = false; + int digits = 0; + + for (octave_idx_type i = 0; i < dims.numel (); i++) + { + int new_digits = static_cast + (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); + + if (new_digits > digits) + digits = new_digits; + + if (! isneg) + isneg = (abs (nda(i).value ()) != nda(i).value ()); + } + + fw = digits + isneg; + } + + int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); + octave_idx_type total_width = nc * column_width; + int max_width = command_editor::terminal_cols () - extra_indent; + octave_idx_type inc = nc; + if (total_width > max_width && Vsplit_long_rows) + { + inc = max_width / column_width; + if (inc == 0) + inc++; + } + + for (octave_idx_type i = 0; i < m; i++) + { + if (m > 1) + { + std::string nm = "ans(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; + } + + Array idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + Array page (nda.index (idx), dim_vector (nr, nc)); + + if (free_format) + { + if (pr_as_read_syntax) + os << "[\n"; + + for (octave_idx_type ii = 0; ii < nr; ii++) + { + for (octave_idx_type jj = 0; jj < nc; jj++) + { + octave_quit (); + os << " "; + os << typename octave_print_conv::print_conv_type (page(ii,jj)); + } + os << "\n"; + } + + if (pr_as_read_syntax) + os << "]"; + } + else + { + octave_idx_type n_rows = page.rows (); + octave_idx_type n_cols = page.cols (); + + for (octave_idx_type col = 0; col < n_cols; col += inc) + { + octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; + + pr_col_num_header (os, total_width, max_width, lim, col, + extra_indent); + + for (octave_idx_type ii = 0; ii < n_rows; ii++) + { + os << std::setw (extra_indent) << ""; + + for (octave_idx_type jj = col; jj < lim; jj++) + { + octave_quit (); + os << " "; + pr_int (os, page(ii,jj), fw); + } + if ((ii < n_rows - 1) || (i < m -1)) + os << "\n"; + } + } + } + + if (i < m - 1) + { + os << "\n"; + increment_index (ra_idx, dims, 2); + } + } + } +} + +#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ + OCTINTERP_API void \ + octave_print_internal (std::ostream& os, const intNDArray& nda, \ + bool pr_as_read_syntax, int extra_indent) \ + { \ + octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ + } + +PRINT_INT_ARRAY_INTERNAL (octave_int8) +PRINT_INT_ARRAY_INTERNAL (octave_uint8) +PRINT_INT_ARRAY_INTERNAL (octave_int16) +PRINT_INT_ARRAY_INTERNAL (octave_uint16) +PRINT_INT_ARRAY_INTERNAL (octave_int32) +PRINT_INT_ARRAY_INTERNAL (octave_uint32) +PRINT_INT_ARRAY_INTERNAL (octave_int64) +PRINT_INT_ARRAY_INTERNAL (octave_uint64) + +void +octave_print_internal (std::ostream&, const Cell&, bool, int, bool) +{ + panic_impossible (); +} + +DEFUN (rats, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ +Convert @var{x} into a rational approximation represented as a string.\n\ +You can convert the string back into a matrix as follows:\n\ +\n\ +@example\n\ +@group\n\ +r = rats (hilb (4));\n\ +x = str2num (r)\n\ +@end group\n\ +@end example\n\ +\n\ +The optional second argument defines the maximum length of the string\n\ +representing the elements of @var{x}. By default @var{len} is 9.\n\ +@seealso{format, rat}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin < 1 || nargin > 2 || nargout > 1) + print_usage (); + else + { + unwind_protect frame; + + frame.protect_var (rat_string_len); + + rat_string_len = 9; + + if (nargin == 2) + rat_string_len = args(1).nint_value (); + + if (! error_state) + { + octave_value arg = args(0); + + if (arg.is_numeric_type ()) + { + frame.protect_var (rat_format); + + rat_format = true; + + std::ostringstream buf; + args(0).print (buf); + std::string s = buf.str (); + + std::list lst; + + size_t n = 0; + size_t s_len = s.length (); + + while (n < s_len) + { + size_t m = s.find ('\n', n); + + if (m == std::string::npos) + { + lst.push_back (s.substr (n)); + break; + } + else + { + lst.push_back (s.substr (n, m - n)); + n = m + 1; + } + } + + retval = string_vector (lst); + } + else + error ("rats: X must be numeric"); + } + } + + return retval; +} + +DEFUN (disp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} disp (@var{x})\n\ +Display the value of @var{x}. For example:\n\ +\n\ +@example\n\ +@group\n\ +disp (\"The value of pi is:\"), disp (pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{disp} always ends with a newline.\n\ +\n\ +If an output value is requested, @code{disp} prints nothing and\n\ +returns the formatted output in a string.\n\ +@seealso{fdisp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 && nargout < 2) + { + if (nargout == 0) + args(0).print (octave_stdout); + else + { + octave_value arg = args(0); + std::ostringstream buf; + arg.print (buf); + retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); + } + } + else + print_usage (); + + return retval; +} + +DEFUN (fdisp, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ +Display the value of @var{x} on the stream @var{fid}. For example:\n\ +\n\ +@example\n\ +@group\n\ +fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ +\n\ + @print{} the value of pi is:\n\ + @print{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Note that the output from @code{fdisp} always ends with a newline.\n\ +@seealso{disp}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2) + { + int fid = octave_stream_list::get_file_number (args (0)); + + octave_stream os = octave_stream_list::lookup (fid, "fdisp"); + + if (! error_state) + { + std::ostream *osp = os.output_stream (); + + if (osp) + args(1).print (*osp); + else + error ("fdisp: stream FID not open for writing"); + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! format short +%! fd = tmpfile (); +%! for r = [0, Inf -Inf, NaN] +%! for i = [0, Inf -Inf, NaN] +%! fdisp (fd, complex (r, i)); +%! endfor +%! endfor +%! fclose (fd); + +%!test +%! foo.real = pi * ones (3,20,3); +%! foo.complex = pi * ones (3,20,3) + 1i; +%! foo.char = repmat ("- Hello World -", [3, 20]); +%! foo.cell = {foo.real, foo.complex, foo.char}; +%! fields = fieldnames (foo); +%! for f = 1:numel (fields) +%! format loose; +%! loose = disp (foo.(fields{f})); +%! format compact; +%! compact = disp (foo.(fields{f})); +%! expected = strrep (loose, "\n\n", "\n"); +%! assert (expected, compact); +%! endfor +*/ + +static void +init_format_state (void) +{ + free_format = false; + plus_format = false; + rat_format = false; + bank_format = false; + hex_format = 0; + bit_format = 0; + Vcompact_format = false; + print_e = false; + print_big_e = false; + print_g = false; + print_eng = false; +} + +static void +set_output_prec_and_fw (int prec, int fw) +{ + Voutput_precision = prec; + Voutput_max_field_width = fw; +} + +static void +set_format_style (int argc, const string_vector& argv) +{ + int idx = 1; + + if (--argc > 0) + { + std::string arg = argv[idx++]; + + if (arg == "short") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option `short %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (5, 10); + } + else if (arg == "long") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg == "e") + { + init_format_state (); + print_e = true; + } + else if (arg == "E") + { + init_format_state (); + print_e = true; + print_big_e = true; + } + else if (arg == "g") + { + init_format_state (); + print_g = true; + } + else if (arg == "G") + { + init_format_state (); + print_g = true; + print_big_e = true; + } + else if (arg == "eng") + { + init_format_state (); + print_eng = true; + } + else + { + error ("format: unrecognized option `long %s'", + arg.c_str ()); + return; + } + } + else + init_format_state (); + + set_output_prec_and_fw (15, 20); + } + else if (arg == "hex") + { + init_format_state (); + hex_format = 1; + } + else if (arg == "native-hex") + { + init_format_state (); + hex_format = 2; + } + else if (arg == "bit") + { + init_format_state (); + bit_format = 1; + } + else if (arg == "native-bit") + { + init_format_state (); + bit_format = 2; + } + else if (arg == "+" || arg == "plus") + { + if (--argc > 0) + { + arg = argv[idx++]; + + if (arg.length () == 3) + plus_format_chars = arg; + else + { + error ("format: invalid option for plus format"); + return; + } + } + else + plus_format_chars = "+ "; + + init_format_state (); + plus_format = true; + } + else if (arg == "rat") + { + init_format_state (); + rat_format = true; + } + else if (arg == "bank") + { + init_format_state (); + bank_format = true; + } + else if (arg == "free") + { + init_format_state (); + free_format = true; + } + else if (arg == "none") + { + init_format_state (); + free_format = true; + } + else if (arg == "compact") + { + Vcompact_format = true; + } + else if (arg == "loose") + { + Vcompact_format = false; + } + else + error ("format: unrecognized format state `%s'", arg.c_str ()); + } + else + { + init_format_state (); + set_output_prec_and_fw (5, 10); + } +} + +DEFUN (format, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} format\n\ +@deftypefnx {Command} {} format options\n\ +Reset or specify the format of the output produced by @code{disp} and\n\ +Octave's normal echoing mechanism. This command only affects the display\n\ +of numbers but not how they are stored or computed. To change the internal\n\ +representation from the default double use one of the conversion functions\n\ +such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ +\n\ +By default, Octave displays 5 significant digits in a human readable form\n\ +(option @samp{short} paired with @samp{loose} format for matrices).\n\ +If @code{format} is invoked without any options, this default format\n\ +is restored.\n\ +\n\ +Valid formats for floating point numbers are listed in the following\n\ +table.\n\ +\n\ +@table @code\n\ +@item short\n\ +Fixed point format with 5 significant figures in a field that is a maximum\n\ +of 10 characters wide. (default).\n\ +\n\ +If Octave is unable to format a matrix so that columns line up on the\n\ +decimal point and all numbers fit within the maximum field width then\n\ +it switches to an exponential @samp{e} format.\n\ +\n\ +@item long\n\ +Fixed point format with 15 significant figures in a field that is a maximum\n\ +of 20 characters wide.\n\ +\n\ +As with the @samp{short} format, Octave will switch to an exponential\n\ +@samp{e} format if it is unable to format a matrix properly using the\n\ +current format.\n\ +\n\ +@item short e\n\ +@itemx long e\n\ +Exponential format. The number to be represented is split between a mantissa\n\ +and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ +short format and 15 digits in the long format.\n\ +For example, with the @samp{short e} format, @code{pi} is displayed as\n\ +@code{3.1416e+00}.\n\ +\n\ +@item short E\n\ +@itemx long E\n\ +Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +For example, with the @samp{long E} format, @code{pi} is displayed as\n\ +@code{3.14159265358979E+00}.\n\ +\n\ +@item short g\n\ +@itemx long g\n\ +Optimally choose between fixed point and exponential format based on\n\ +the magnitude of the number.\n\ +For example, with the @samp{short g} format,\n\ +@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ + 9.8696\n\ + 97.409\n\ + 9488.5\n\ + 9.0032e+07\n\ + 8.1058e+15\n\ +@end group\n\ +@end example\n\ +\n\ +@item short eng\n\ +@itemx long eng\n\ +Identical to @samp{short e} or @samp{long e} but displays the value\n\ +using an engineering format, where the exponent is divisible by 3. For\n\ +example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ +@code{31.4159e+00}.\n\ +\n\ +@item long G\n\ +@itemx short G\n\ +Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ +@samp{E} to indicate the exponent.\n\ +\n\ +@item free\n\ +@itemx none\n\ +Print output in free format, without trying to line up columns of\n\ +matrices on the decimal point. This also causes complex numbers to be\n\ +formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ +of like this @samp{0.60419 + 0.60709i}.\n\ +@end table\n\ +\n\ +The following formats affect all numeric output (floating point and\n\ +integer types).\n\ +\n\ +@table @code\n\ +@item +\n\ +@itemx + @var{chars}\n\ +@itemx plus\n\ +@itemx plus @var{chars}\n\ +Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ +matrix elements. This format can be very useful for examining the\n\ +structure of a large sparse matrix.\n\ +\n\ +The optional argument @var{chars} specifies a list of 3 characters to use\n\ +for printing values greater than zero, less than zero and equal to zero.\n\ +For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ +is displayed as\n\ +\n\ +@example\n\ +@group\n\ +ans =\n\ +\n\ ++.-\n\ +-.+\n\ +@end group\n\ +@end example\n\ +\n\ +@item bank\n\ +Print in a fixed format with two digits to the right of the decimal\n\ +point.\n\ +\n\ +@item native-hex\n\ +Print the hexadecimal representation of numbers as they are stored in\n\ +memory. For example, on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first, the value of\n\ +@code{pi} when printed in @code{native-hex} format is\n\ +@code{400921fb54442d18}.\n\ +\n\ +@item hex\n\ +The same as @code{native-hex}, but always print the most significant\n\ +byte first.\n\ +\n\ +@item native-bit\n\ +Print the bit representation of numbers as stored in memory.\n\ +For example, the value of @code{pi} is\n\ +\n\ +@example\n\ +@group\n\ +01000000000010010010000111111011\n\ +01010100010001000010110100011000\n\ +@end group\n\ +@end example\n\ +\n\ +(shown here in two 32 bit sections for typesetting purposes) when\n\ +printed in native-bit format on a workstation which stores 8 byte real values\n\ +in IEEE format with the least significant byte first.\n\ +\n\ +@item bit\n\ +The same as @code{native-bit}, but always print the most significant\n\ +bits first.\n\ +\n\ +@item rat\n\ +Print a rational approximation, i.e., values are approximated\n\ +as the ratio of small integers.\n\ +For example, with the @samp{rat} format,\n\ +@code{pi} is displayed as @code{355/113}.\n\ +@end table\n\ +\n\ +The following two options affect the display of all matrices.\n\ +\n\ +@table @code\n\ +@item compact\n\ +Remove blank lines around column number labels and between\n\ +matrices producing more compact output with more data per page.\n\ +\n\ +@item loose\n\ +Insert blank lines above and below column number labels and between matrices\n\ +to produce a more readable output with less data per page. (default).\n\ +@end table\n\ +@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("format"); + + if (error_state) + return retval; + + set_format_style (argc, argv); + + return retval; +} + +DEFUN (fixed_point_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will\n\ +use a scaled format to print matrix values such that the largest\n\ +element may be written with a single leading digit with the scaling\n\ +factor is printed on the first line of output. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:1> logspace (1, 7, 5)'\n\ +ans =\n\ +\n\ + 1.0e+07 *\n\ +\n\ + 0.00000\n\ + 0.00003\n\ + 0.00100\n\ + 0.03162\n\ + 1.00000\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +Notice that first value appears to be zero when it is actually 1. For\n\ +this reason, you should be careful when setting\n\ +@code{fixed_point_format} to a nonzero value.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, output_max_field_width, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (fixed_point_format); +} + +DEFUN (print_empty_dimensions, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether the\n\ +dimensions of empty matrices are printed along with the empty matrix\n\ +symbol, @samp{[]}. For example, the expression\n\ +\n\ +@example\n\ +zeros (3, 0)\n\ +@end example\n\ +\n\ +@noindent\n\ +will print\n\ +\n\ +@example\n\ +ans = [](3x0)\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (print_empty_dimensions); +} + +DEFUN (split_long_rows, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether rows of a matrix\n\ +may be split when displayed to a terminal window. If the rows are split,\n\ +Octave will display the matrix in a series of smaller pieces, each of\n\ +which can fit within the limits of your terminal width and each set of\n\ +rows is labeled so that you can easily see which columns are currently\n\ +being displayed. For example:\n\ +\n\ +@example\n\ +@group\n\ +octave:13> rand (2,10)\n\ +ans =\n\ +\n\ + Columns 1 through 6:\n\ +\n\ + 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ + 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ +\n\ + Columns 7 through 10:\n\ +\n\ + 0.90174 0.11854 0.72313 0.73326\n\ + 0.44672 0.94303 0.56564 0.82150\n\ +@end group\n\ +@end example\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (split_long_rows); +} + +DEFUN (output_max_field_width, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the maximum width\n\ +of a numeric output field.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_precision}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, INT_MAX); +} + +DEFUN (output_precision, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the minimum number of\n\ +significant figures to display for numeric output.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{format, fixed_point_format, output_max_field_width}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, INT_MAX); +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/pr-output.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/pr-output.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,262 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_pr_output_h) +#define octave_pr_output_h 1 + +#include + +#include "oct-cmplx.h" + +template class Array; +class ComplexMatrix; +class FloatComplexMatrix; +class ComplexDiagMatrix; +class FloatComplexDiagMatrix; +class ComplexNDArray; +class FloatComplexNDArray; +class Matrix; +class FloatMatrix; +class DiagMatrix; +class FloatDiagMatrix; +class NDArray; +class FloatNDArray; +class Range; +class boolMatrix; +class boolNDArray; +class charMatrix; +class charNDArray; +class PermMatrix; +class Cell; + +#include "intNDArray.h" +#include "oct-inttypes.h" + + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, bool d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, double d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, float d, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Matrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const DiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const NDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Complex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplex& c, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const ComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const PermMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Range& r, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolMatrix& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const boolNDArray& m, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charMatrix& chm, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const charNDArray& nda, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const std::string& s, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Array& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const intNDArray& sa, + bool pr_as_read_syntax = false, + int extra_indent = 0); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const octave_int& sa, + bool pr_as_read_syntax = false); + +extern OCTINTERP_API void +octave_print_internal (std::ostream& os, const Cell& cell, + bool pr_as_read_syntax = false, + int extra_indent = 0, + bool pr_as_string = false); + +// TRUE means that the dimensions of empty objects should be printed +// like this: x = [](2x0). +extern bool Vprint_empty_dimensions; + +// TRUE means don't put empty lines in output +extern bool Vcompact_format; + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/profiler.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/profiler.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,470 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include "defun.h" +#include "oct-time.h" +#include "ov-struct.h" +#include "pager.h" +#include "profiler.h" + +profile_data_accumulator::enter::enter (profile_data_accumulator& a, + const std::string& f) + : acc (a) +{ + if (acc.is_active ()) + { + fcn = f; + acc.enter_function (fcn); + } + else + fcn = ""; +} + +profile_data_accumulator::enter::~enter () +{ + if (fcn != "") + acc.exit_function (fcn); +} + +profile_data_accumulator::stats::stats () + : time (0.0), calls (0), recursive (false), + parents (), children () +{} + +octave_value +profile_data_accumulator::stats::function_set_value (const function_set& list) +{ + const octave_idx_type n = list.size (); + + RowVector retval (n); + octave_idx_type i = 0; + for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) + { + retval(i) = *p; + ++i; + } + assert (i == n); + + return retval; +} + +profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) + : parent (p), fcn_id (f), children (), time (0.0), calls (0) +{} + +profile_data_accumulator::tree_node::~tree_node () +{ + for (child_map::iterator i = children.begin (); i != children.end (); ++i) + delete i->second; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::enter (octave_idx_type fcn) +{ + tree_node* retval; + + child_map::iterator pos = children.find (fcn); + if (pos == children.end ()) + { + retval = new tree_node (this, fcn); + children[fcn] = retval; + } + else + retval = pos->second; + + ++retval->calls; + return retval; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::exit (octave_idx_type fcn) +{ + assert (parent); + assert (fcn_id == fcn); + + return parent; +} + +void +profile_data_accumulator::tree_node::build_flat (flat_profile& data) const +{ + // If this is not the top-level node, update profile entry for this function. + if (fcn_id != 0) + { + stats& entry = data[fcn_id - 1]; + + entry.time += time; + entry.calls += calls; + + assert (parent); + if (parent->fcn_id != 0) + { + entry.parents.insert (parent->fcn_id); + data[parent->fcn_id - 1].children.insert (fcn_id); + } + + if (!entry.recursive) + for (const tree_node* i = parent; i; i = i->parent) + if (i->fcn_id == fcn_id) + { + entry.recursive = true; + break; + } + } + + // Recurse on children. + for (child_map::const_iterator i = children.begin (); + i != children.end (); ++i) + i->second->build_flat (data); +} + +octave_value +profile_data_accumulator::tree_node::get_hierarchical (double* total) const +{ + /* Note that we don't generate the entry just for this node, but rather + a struct-array with entries for all children. This way, the top-node + (for which we don't want a real entry) generates already the final + hierarchical profile data. */ + + const octave_idx_type n = children.size (); + + Cell rv_indices (n, 1); + Cell rv_times (n, 1); + Cell rv_totals (n, 1); + Cell rv_calls (n, 1); + Cell rv_children (n, 1); + + octave_idx_type i = 0; + for (child_map::const_iterator p = children.begin (); + p != children.end (); ++p) + { + const tree_node& entry = *p->second; + double child_total = entry.time; + + rv_indices(i) = octave_value (p->first); + rv_times(i) = octave_value (entry.time); + rv_calls(i) = octave_value (entry.calls); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; + + ++i; + } + assert (i == n); + + octave_map retval; + + retval.assign ("Index", rv_indices); + retval.assign ("SelfTime", rv_times); + retval.assign ("TotalTime", rv_totals); + retval.assign ("NumCalls", rv_calls); + retval.assign ("Children", rv_children); + + return retval; +} + +profile_data_accumulator::profile_data_accumulator () + : known_functions (), fcn_index (), + enabled (false), call_tree (NULL), last_time (-1.0) +{} + +profile_data_accumulator::~profile_data_accumulator () +{ + if (call_tree) + delete call_tree; +} + +void +profile_data_accumulator::set_active (bool value) +{ + if (value) + { + // Create a call-tree top-node if there isn't yet one. + if (!call_tree) + call_tree = new tree_node (NULL, 0); + + // Let the top-node be the active one. This ensures we have a clean + // fresh start collecting times. + active_fcn = call_tree; + } + else + { + // Make sure we start with fresh timing if we're re-enabled later. + last_time = -1.0; + } + + enabled = value; +} + +void +profile_data_accumulator::enter_function (const std::string& fcn) +{ + // The enter class will check and only call us if the profiler is active. + assert (is_active ()); + assert (call_tree); + + // If there is already an active function, add to its time before + // pushing the new one. + if (active_fcn != call_tree) + add_current_time (); + + // Map the function's name to its index. + octave_idx_type fcn_idx; + fcn_index_map::iterator pos = fcn_index.find (fcn); + if (pos == fcn_index.end ()) + { + known_functions.push_back (fcn); + fcn_idx = known_functions.size (); + fcn_index[fcn] = fcn_idx; + } + else + fcn_idx = pos->second; + + active_fcn = active_fcn->enter (fcn_idx); + last_time = query_time (); +} + +void +profile_data_accumulator::exit_function (const std::string& fcn) +{ + assert (call_tree); + assert (active_fcn != call_tree); + + // Usually, if we are disabled this function is not even called. But the + // call disabling the profiler is an exception. So also check here + // and only record the time if enabled. + if (is_active ()) + add_current_time (); + + fcn_index_map::iterator pos = fcn_index.find (fcn); + assert (pos != fcn_index.end ()); + active_fcn = active_fcn->exit (pos->second); + + // If this was an "inner call", we resume executing the parent function + // up the stack. So note the start-time for this! + last_time = query_time (); +} + +void +profile_data_accumulator::reset (void) +{ + if (is_active ()) + { + error ("Can't reset active profiler."); + return; + } + + known_functions.clear (); + fcn_index.clear (); + + if (call_tree) + { + delete call_tree; + call_tree = NULL; + } + + last_time = -1.0; +} + +octave_value +profile_data_accumulator::get_flat (void) const +{ + octave_value retval; + + const octave_idx_type n = known_functions.size (); + + flat_profile flat (n); + + if (call_tree) + { + call_tree->build_flat (flat); + + Cell rv_names (n, 1); + Cell rv_times (n, 1); + Cell rv_calls (n, 1); + Cell rv_recursive (n, 1); + Cell rv_parents (n, 1); + Cell rv_children (n, 1); + + for (octave_idx_type i = 0; i != n; ++i) + { + rv_names(i) = octave_value (known_functions[i]); + rv_times(i) = octave_value (flat[i].time); + rv_calls(i) = octave_value (flat[i].calls); + rv_recursive(i) = octave_value (flat[i].recursive); + rv_parents(i) = stats::function_set_value (flat[i].parents); + rv_children(i) = stats::function_set_value (flat[i].children); + } + + octave_map m; + + m.assign ("FunctionName", rv_names); + m.assign ("TotalTime", rv_times); + m.assign ("NumCalls", rv_calls); + m.assign ("IsRecursive", rv_recursive); + m.assign ("Parents", rv_parents); + m.assign ("Children", rv_children); + + retval = m; + } + else + { + static const char *fn[] = + { + "FunctionName", + "TotalTime", + "NumCalls", + "IsRecursive", + "Parents", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +octave_value +profile_data_accumulator::get_hierarchical (void) const +{ + octave_value retval; + + if (call_tree) + retval = call_tree->get_hierarchical (); + else + { + static const char *fn[] = + { + "Index", + "SelfTime", + "NumCalls", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +double +profile_data_accumulator::query_time (void) const +{ + octave_time now; + + // FIXME -- is this volatile declaration really needed? + // See bug #34210 for additional details. + volatile double dnow = now.double_value (); + + return dnow; +} + +void +profile_data_accumulator::add_current_time (void) +{ + const double t = query_time (); + assert (last_time >= 0.0 && last_time <= t); + + assert (call_tree && active_fcn != call_tree); + active_fcn->add_time (t - last_time); +} + +profile_data_accumulator profiler; + +// Enable or disable the profiler data collection. +DEFUN (__profiler_enable__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_enable ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + const int nargin = args.length (); + if (nargin > 0) + { + if (nargin > 1) + { + print_usage (); + return retval; + } + + profiler.set_active (args(0).bool_value ()); + } + + retval(0) = profiler.is_active (); + + return retval; +} + +// Clear all collected profiling data. +DEFUN (__profiler_reset__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_reset ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_reset: ignoring extra arguments"); + + profiler.reset (); + + return retval; +} + +// Query the timings collected by the profiler. +DEFUN (__profiler_data__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_data ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_data: ignoring extra arguments"); + + retval(0) = profiler.get_flat (); + if (nargout > 1) + retval(1) = profiler.get_hierarchical (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/profiler.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/profiler.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2012 Daniel Kraft + +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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_profiler_h) +#define octave_profiler_h 1 + +#include +#include +#include +#include +#include + +class octave_value; + +class +OCTINTERP_API +profile_data_accumulator +{ +public: + + // This is a utility class that can be used to call the enter/exit + // functions in a manner protected from stack unwinding. + class enter + { + private: + + profile_data_accumulator& acc; + std::string fcn; + + public: + + enter (profile_data_accumulator&, const std::string&); + virtual ~enter (void); + + private: + + // No copying! + enter (const enter&); + enter& operator = (const enter&); + }; + + profile_data_accumulator (void); + virtual ~profile_data_accumulator (); + + bool is_active (void) const { return enabled; } + void set_active (bool); + + void reset (void); + + octave_value get_flat (void) const; + octave_value get_hierarchical (void) const; + +private: + + // One entry in the flat profile (i.e., a collection of data for a single + // function). This is filled in when building the flat profile from the + // hierarchical call tree. + struct stats + { + stats (); + + double time; + unsigned calls; + + bool recursive; + + typedef std::set function_set; + function_set parents; + function_set children; + + // Convert a function_set list to an Octave array of indices. + static octave_value function_set_value (const function_set&); + }; + + typedef std::vector flat_profile; + + // Store data for one node in the call-tree of the hierarchical profiler + // data we collect. + class tree_node + { + public: + + tree_node (tree_node*, octave_idx_type); + virtual ~tree_node (); + + void add_time (double dt) { time += dt; } + + // Enter a child function. It is created in the list of children if it + // wasn't already there. The now-active child node is returned. + tree_node* enter (octave_idx_type); + + // Exit function. As a sanity-check, it is verified that the currently + // active function actually is the one handed in here. Returned is the + // then-active node, which is our parent. + tree_node* exit (octave_idx_type); + + void build_flat (flat_profile&) const; + + // Get the hierarchical profile for this node and its children. If total + // is set, accumulate total time of the subtree in that variable as + // additional return value. + octave_value get_hierarchical (double* total = NULL) const; + + private: + + tree_node* parent; + octave_idx_type fcn_id; + + typedef std::map child_map; + child_map children; + + // This is only time spent *directly* on this level, excluding children! + double time; + + unsigned calls; + + // No copying! + tree_node (const tree_node&); + tree_node& operator = (const tree_node&); + }; + + // Each function we see in the profiler is given a unique index (which + // simply counts starting from 1). We thus have to map profiler-names to + // those indices. For all other stuff, we identify functions by their index. + + typedef std::vector function_set; + typedef std::map fcn_index_map; + + function_set known_functions; + fcn_index_map fcn_index; + + bool enabled; + + tree_node* call_tree; + tree_node* active_fcn; + + // Store last timestamp we had, when the currently active function was called. + double last_time; + + // These are private as only the unwind-protecting inner class enter + // should be allowed to call them. + void enter_function (const std::string&); + void exit_function (const std::string&); + + // Query a timestamp, used for timing calls (obviously). + // This is not static because in the future, maybe we want a flag + // in the profiler or something to choose between cputime, wall-time, + // user-time, system-time, ... + double query_time () const; + + // Add the time elapsed since last_time to the function we're currently in. + // This is called from two different positions, thus it is useful to have + // it as a seperate function. + void add_current_time (void); + + // No copying! + profile_data_accumulator (const profile_data_accumulator&); + profile_data_accumulator& operator = (const profile_data_accumulator&); +}; + +// The instance used. +extern OCTINTERP_API profile_data_accumulator profiler; + +// Helper macro to profile a block of code. +#define BEGIN_PROFILER_BLOCK(name) \ + { \ + profile_data_accumulator::enter pe (profiler, (name)); +#define END_PROFILER_BLOCK \ + } + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/sighandlers.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sighandlers.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1054 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include + +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "oct-syscalls.h" +#include "quit.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "load-save.h" +#include "oct-map.h" +#include "pager.h" +#include "pt-bp.h" +#include "pt-eval.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +int pipe_handler_error_count = 0; + +// TRUE means we can be interrupted. +bool can_interrupt = false; + +// TRUE means we should try to enter the debugger on SIGINT. +static bool Vdebug_on_interrupt = false; + +// Allow users to avoid writing octave-workspace for SIGHUP (sent by +// closing gnome-terminal, for example). Note that this variable has +// no effect if Vcrash_dumps_octave_core is FALSE. +static bool Vsighup_dumps_octave_core = true; + +// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. +static bool Vsigterm_dumps_octave_core = true; + +// List of signals we have caught since last call to octave_signal_handler. +static bool octave_signals_caught[NSIG]; + +// Signal handler return type. +#ifndef BADSIG +#define BADSIG (void (*)(int))-1 +#endif + +// The following is a workaround for an apparent bug in GCC 4.1.2 and +// possibly earlier versions. See Octave bug report #30685 for details. +#if defined (__GNUC__) +# if ! (__GNUC__ > 4 \ + || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ + || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) +# undef GNULIB_NAMESPACE +# define GNULIB_NAMESPACE +# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" +# endif +#endif + +#define BLOCK_SIGNAL(sig, nvar, ovar) \ + do \ + { \ + GNULIB_NAMESPACE::sigemptyset (&nvar); \ + GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ + GNULIB_NAMESPACE::sigemptyset (&ovar); \ + GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ + } \ + while (0) + +#if !defined (SIGCHLD) && defined (SIGCLD) +#define SIGCHLD SIGCLD +#endif + +#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) +#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) + +// Called from octave_quit () to actually do something about the signals +// we have caught. + +void +octave_signal_handler (void) +{ + // The list of signals is relatively short, so we will just go + // linearly through the list. + + for (int i = 0; i < NSIG; i++) + { + if (octave_signals_caught[i]) + { + octave_signals_caught[i] = false; + + switch (i) + { +#ifdef SIGCHLD + case SIGCHLD: + { + volatile octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + sigset_t set, oset; + + BLOCK_CHILD (set, oset); + + octave_child_list::wait (); + + octave_set_interrupt_handler (saved_interrupt_handler); + + UNBLOCK_CHILD (oset); + + octave_child_list::reap (); + } + break; +#endif + + case SIGFPE: + std::cerr << "warning: floating point exception" << std::endl; + break; + +#ifdef SIGPIPE + case SIGPIPE: + std::cerr << "warning: broken pipe" << std::endl; + break; +#endif + } + } + } +} + +static void +my_friendly_exit (const char *sig_name, int sig_number, + bool save_vars = true) +{ + static bool been_there_done_that = false; + + if (been_there_done_that) + { +#if defined (SIGABRT) + octave_set_signal_handler (SIGABRT, SIG_DFL); +#endif + + std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; + + MINGW_SIGNAL_CLEANUP (); + + abort (); + } + else + { + been_there_done_that = true; + + std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; + + if (save_vars) + dump_octave_core (); + + if (sig_number < 0) + { + MINGW_SIGNAL_CLEANUP (); + + exit (1); + } + else + { + octave_set_signal_handler (sig_number, SIG_DFL); + + GNULIB_NAMESPACE::raise (sig_number); + } + } +} + +sig_handler * +octave_set_signal_handler (int sig, sig_handler *handler, + bool restart_syscalls) +{ + struct sigaction act, oact; + + act.sa_handler = handler; + act.sa_flags = 0; + +#if defined (SIGALRM) + if (sig == SIGALRM) + { +#if defined (SA_INTERRUPT) + act.sa_flags |= SA_INTERRUPT; +#endif + } +#endif +#if defined (SA_RESTART) +#if defined (SIGALRM) + else +#endif + // FIXME -- Do we also need to explicitly disable SA_RESTART? + if (restart_syscalls) + act.sa_flags |= SA_RESTART; +#endif + + GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); + GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); + + GNULIB_NAMESPACE::sigaction (sig, &act, &oact); + + return oact.sa_handler; +} + +static void +generic_sig_handler (int sig) +{ + my_friendly_exit (strsignal (sig), sig); +} + +// Handle SIGCHLD. + +#ifdef SIGCHLD +static void +sigchld_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGCHLD] = true; +} +#endif /* defined (SIGCHLD) */ + +#ifdef SIGFPE +#if defined (__alpha__) +static void +sigfpe_handler (int /* sig */) +{ + if (can_interrupt && octave_interrupt_state >= 0) + { + octave_signal_caught = 1; + + octave_signals_caught[SIGFPE] = true; + + octave_interrupt_state++; + } +} +#endif /* defined (__alpha__) */ +#endif /* defined (SIGFPE) */ + +#if defined (SIGHUP) || defined (SIGTERM) +static void +sig_hup_or_term_handler (int sig) +{ + switch (sig) + { +#if defined (SIGHUP) + case SIGHUP: + { + if (Vsighup_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + +#if defined (SIGTERM) + case SIGTERM: + { + if (Vsigterm_dumps_octave_core) + dump_octave_core (); + } + break; +#endif + + default: + break; + } + + clean_up_and_exit (0); +} +#endif + +#if 0 +#if defined (SIGWINCH) +static void +sigwinch_handler (int /* sig */) +{ + command_editor::resize_terminal (); +} +#endif +#endif + +// Handle SIGINT by restarting the parser (see octave.cc). +// +// This also has to work for SIGBREAK (on systems that have it), so we +// use the value of sig, instead of just assuming that it is called +// for SIGINT only. + +static void +user_abort (const char *sig_name, int sig_number) +{ + if (! octave_initialized) + exit (1); + + if (can_interrupt) + { + if (Vdebug_on_interrupt) + { + if (! octave_debug_on_interrupt_state) + { + tree_evaluator::debug_mode = true; + octave_debug_on_interrupt_state = true; + + return; + } + else + { + // Clear the flag and do normal interrupt stuff. + + tree_evaluator::debug_mode + = bp_table::have_breakpoints () || Vdebugging; + octave_debug_on_interrupt_state = false; + } + } + + if (octave_interrupt_immediately) + { + if (octave_interrupt_state == 0) + octave_interrupt_state = 1; + + octave_jump_to_enclosing_context (); + } + else + { + // If we are already cleaning up from a previous interrupt, + // take note of the fact that another interrupt signal has + // arrived. + + if (octave_interrupt_state < 0) + octave_interrupt_state = 0; + + octave_signal_caught = 1; + octave_interrupt_state++; + + if (interactive && octave_interrupt_state == 2) + std::cerr << "Press Control-C again to abort." << std::endl; + + if (octave_interrupt_state >= 3) + my_friendly_exit (sig_name, sig_number, true); + } + } + +} + +static void +sigint_handler (int sig) +{ +#ifdef USE_W32_SIGINT + if (w32_in_main_thread ()) + user_abort (strsignal (sig), sig); + else + w32_raise (sig); +#else + user_abort (strsignal (sig), sig); +#endif +} + +#ifdef SIGPIPE +static void +sigpipe_handler (int /* sig */) +{ + octave_signal_caught = 1; + + octave_signals_caught[SIGPIPE] = true; + + // Don't loop forever on account of this. + + if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) + octave_interrupt_state++; +} +#endif /* defined (SIGPIPE) */ + +#ifdef USE_W32_SIGINT +static BOOL CALLBACK +w32_sigint_handler (DWORD sig) +{ + const char *sig_name; + + switch (sig) + { + case CTRL_BREAK_EVENT: + sig_name = "Ctrl-Break"; + break; + case CTRL_C_EVENT: + sig_name = "Ctrl-C"; + break; + case CTRL_CLOSE_EVENT: + sig_name = "close console"; + break; + case CTRL_LOGOFF_EVENT: + sig_name = "logoff"; + break; + case CTRL_SHUTDOWN_EVENT: + sig_name = "shutdown"; + break; + default: + sig_name = "unknown console event"; + break; + } + + switch (sig) + { + case CTRL_BREAK_EVENT: + case CTRL_C_EVENT: + w32_raise (SIGINT); + break; + + case CTRL_CLOSE_EVENT: + clean_up_and_exit (0); + break; + case CTRL_LOGOFF_EVENT: + case CTRL_SHUTDOWN_EVENT: + default: + // We should do the following: + // clean_up_and_exit (0); + // We can't because we aren't running in the normal Octave thread. + user_abort (sig_name, sig); + break; + } + + // Return TRUE if the event was handled, or FALSE if another handler + // should be called. + // FIXME check that windows terminates the thread. + return TRUE; +} +#endif /* w32_sigint_handler */ + + +octave_interrupt_handler +octave_catch_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); +#endif + +#ifdef USE_W32_SIGINT + + // Intercept windows console control events. + // Note that the windows console signal handlers chain, so if + // install_signal_handlers is called more than once in the same program, + // then first call the following to avoid duplicates: + // + // SetConsoleCtrlHandler (w32_sigint_handler, FALSE); + + if (! SetConsoleCtrlHandler (w32_sigint_handler, TRUE)) + error ("SetConsoleCtrlHandler failed with %ld\n", GetLastError ()); + + w32_set_quiet_shutdown (); + +#endif + + return retval; +} + +octave_interrupt_handler +octave_ignore_interrupts (void) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); +#endif + + return retval; +} + +octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, + bool restart_syscalls) +{ + octave_interrupt_handler retval; + +#ifdef SIGINT + retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, + restart_syscalls); +#endif + +#ifdef SIGBREAK + retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, + restart_syscalls); +#endif + + return retval; +} + +// Install all the handlers for the signals we might care about. + +void +install_signal_handlers (void) +{ + for (int i = 0; i < NSIG; i++) + octave_signals_caught[i] = false; + + octave_catch_interrupts (); + +#ifdef SIGABRT + octave_set_signal_handler (SIGABRT, generic_sig_handler); +#endif + +#ifdef SIGALRM + octave_set_signal_handler (SIGALRM, generic_sig_handler); +#endif + +#ifdef SIGBUS + octave_set_signal_handler (SIGBUS, generic_sig_handler); +#endif + +#ifdef SIGCHLD + octave_set_signal_handler (SIGCHLD, sigchld_handler); +#endif + + // SIGCLD + // SIGCONT + +#ifdef SIGEMT + octave_set_signal_handler (SIGEMT, generic_sig_handler); +#endif + +#ifdef SIGFPE +#if defined (__alpha__) + octave_set_signal_handler (SIGFPE, sigfpe_handler); +#else + octave_set_signal_handler (SIGFPE, generic_sig_handler); +#endif +#endif + +#ifdef SIGHUP + octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); +#endif + +#ifdef SIGILL + octave_set_signal_handler (SIGILL, generic_sig_handler); +#endif + + // SIGINFO + // SIGINT + +#ifdef SIGIOT + octave_set_signal_handler (SIGIOT, generic_sig_handler); +#endif + +#ifdef SIGLOST + octave_set_signal_handler (SIGLOST, generic_sig_handler); +#endif + +#ifdef SIGPIPE + octave_set_signal_handler (SIGPIPE, sigpipe_handler); +#endif + +#ifdef SIGPOLL + octave_set_signal_handler (SIGPOLL, SIG_IGN); +#endif + + // SIGPROF + // SIGPWR + +#ifdef SIGQUIT + octave_set_signal_handler (SIGQUIT, generic_sig_handler); +#endif + +#ifdef SIGSEGV + octave_set_signal_handler (SIGSEGV, generic_sig_handler); +#endif + + // SIGSTOP + +#ifdef SIGSYS + octave_set_signal_handler (SIGSYS, generic_sig_handler); +#endif + +#ifdef SIGTERM + octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); +#endif + +#ifdef SIGTRAP + octave_set_signal_handler (SIGTRAP, generic_sig_handler); +#endif + + // SIGTSTP + // SIGTTIN + // SIGTTOU + // SIGURG + +#ifdef SIGUSR1 + octave_set_signal_handler (SIGUSR1, generic_sig_handler); +#endif + +#ifdef SIGUSR2 + octave_set_signal_handler (SIGUSR2, generic_sig_handler); +#endif + +#ifdef SIGVTALRM + octave_set_signal_handler (SIGVTALRM, generic_sig_handler); +#endif + +#ifdef SIGIO + octave_set_signal_handler (SIGIO, SIG_IGN); +#endif + +#if 0 +#ifdef SIGWINCH + octave_set_signal_handler (SIGWINCH, sigwinch_handler); +#endif +#endif + +#ifdef SIGXCPU + octave_set_signal_handler (SIGXCPU, generic_sig_handler); +#endif + +#ifdef SIGXFSZ + octave_set_signal_handler (SIGXFSZ, generic_sig_handler); +#endif + +} + +static octave_scalar_map +make_sig_struct (void) +{ + octave_scalar_map m; + +#ifdef SIGABRT + m.assign ("ABRT", SIGABRT); +#endif + +#ifdef SIGALRM + m.assign ("ALRM", SIGALRM); +#endif + +#ifdef SIGBUS + m.assign ("BUS", SIGBUS); +#endif + +#ifdef SIGCHLD + m.assign ("CHLD", SIGCHLD); +#endif + +#ifdef SIGCLD + m.assign ("CLD", SIGCLD); +#endif + +#ifdef SIGCONT + m.assign ("CONT", SIGCONT); +#endif + +#ifdef SIGEMT + m.assign ("EMT", SIGEMT); +#endif + +#ifdef SIGFPE + m.assign ("FPE", SIGFPE); +#endif + +#ifdef SIGHUP + m.assign ("HUP", SIGHUP); +#endif + +#ifdef SIGILL + m.assign ("ILL", SIGILL); +#endif + +#ifdef SIGINFO + m.assign ("INFO", SIGINFO); +#endif + +#ifdef SIGINT + m.assign ("INT", SIGINT); +#endif + +#ifdef SIGIOT + m.assign ("IOT", SIGIOT); +#endif + +#ifdef SIGLOST + m.assign ("LOST", SIGLOST); +#endif + +#ifdef SIGPIPE + m.assign ("PIPE", SIGPIPE); +#endif + +#ifdef SIGPOLL + m.assign ("POLL", SIGPOLL); +#endif + +#ifdef SIGPROF + m.assign ("PROF", SIGPROF); +#endif + +#ifdef SIGPWR + m.assign ("PWR", SIGPWR); +#endif + +#ifdef SIGQUIT + m.assign ("QUIT", SIGQUIT); +#endif + +#ifdef SIGSEGV + m.assign ("SEGV", SIGSEGV); +#endif + +#ifdef SIGSTOP + m.assign ("STOP", SIGSTOP); +#endif + +#ifdef SIGSYS + m.assign ("SYS", SIGSYS); +#endif + +#ifdef SIGTERM + m.assign ("TERM", SIGTERM); +#endif + +#ifdef SIGTRAP + m.assign ("TRAP", SIGTRAP); +#endif + +#ifdef SIGTSTP + m.assign ("TSTP", SIGTSTP); +#endif + +#ifdef SIGTTIN + m.assign ("TTIN", SIGTTIN); +#endif + +#ifdef SIGTTOU + m.assign ("TTOU", SIGTTOU); +#endif + +#ifdef SIGURG + m.assign ("URG", SIGURG); +#endif + +#ifdef SIGUSR1 + m.assign ("USR1", SIGUSR1); +#endif + +#ifdef SIGUSR2 + m.assign ("USR2", SIGUSR2); +#endif + +#ifdef SIGVTALRM + m.assign ("VTALRM", SIGVTALRM); +#endif + +#ifdef SIGIO + m.assign ("IO", SIGIO); +#endif + +#ifdef SIGWINCH + m.assign ("WINCH", SIGWINCH); +#endif + +#ifdef SIGXCPU + m.assign ("XCPU", SIGXCPU); +#endif + +#ifdef SIGXFSZ + m.assign ("XFSZ", SIGXFSZ); +#endif + + return m; +} + +octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; + +bool +octave_child_list::instance_ok (void) +{ + bool retval = true; + + if (! instance) + { + instance = new octave_child_list_rep (); + + if (instance) + singleton_cleanup_list::add (cleanup_instance); + } + + if (! instance) + { + ::error ("unable to create child list object!"); + + retval = false; + } + + return retval; +} + +void +octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) +{ + if (instance_ok ()) + instance->insert (pid, f); +} + +void +octave_child_list::reap (void) +{ + if (instance_ok ()) + instance->reap (); +} + +bool +octave_child_list::wait (void) +{ + return (instance_ok ()) ? instance->wait () : false; +} + +class pid_equal +{ +public: + + pid_equal (pid_t v) : val (v) { } + + bool operator () (const octave_child& oc) const { return oc.pid == val; } + +private: + + pid_t val; +}; + +void +octave_child_list::remove (pid_t pid) +{ + if (instance_ok ()) + instance->remove_if (pid_equal (pid)); +} + +#define OCL_REP octave_child_list::octave_child_list_rep + +void +OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) +{ + append (octave_child (pid, f)); +} + +void +OCL_REP::reap (void) +{ + // Mark the record for PID invalid. + + for (iterator p = begin (); p != end (); p++) + { + // The call to the octave_child::child_event_handler might + // invalidate the iterator (for example, by calling + // octave_child_list::remove), so we increment the iterator + // here. + + octave_child& oc = *p; + + if (oc.have_status) + { + oc.have_status = 0; + + octave_child::child_event_handler f = oc.handler; + + if (f && f (oc.pid, oc.status)) + oc.pid = -1; + } + } + + remove_if (pid_equal (-1)); +} + +// Wait on our children and record any changes in their status. + +bool +OCL_REP::wait (void) +{ + bool retval = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_child& oc = *p; + + pid_t pid = oc.pid; + + if (pid > 0) + { + int status; + + if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) + { + oc.have_status = 1; + + oc.status = status; + + retval = true; + + break; + } + } + } + + return retval; +} + +DEFUN (SIG, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} SIG ()\n\ +Return a structure containing Unix signal names and their defined values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + { + static octave_scalar_map m = make_sig_struct (); + + retval = m; + } + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (SIG ())) +%!assert (! isempty (SIG ())) + +%!error SIG (1) +*/ + +DEFUN (debug_on_interrupt, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave will try\n\ +to enter debugging mode when it receives an interrupt signal (typically\n\ +generated with @kbd{C-c}). If a second interrupt signal is received\n\ +before reaching the debugging mode, a normal interrupt will occur.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (debug_on_interrupt); +} + +/* +%!test +%! orig_val = debug_on_interrupt (); +%! old_val = debug_on_interrupt (! orig_val); +%! assert (orig_val, old_val); +%! assert (debug_on_interrupt (), ! orig_val); +%! debug_on_interrupt (orig_val); +%! assert (debug_on_interrupt (), orig_val); + +%!error (debug_on_interrupt (1, 2)) +*/ + +DEFUN (sighup_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a hangup signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); +} + +/* +%!test +%! orig_val = sighup_dumps_octave_core (); +%! old_val = sighup_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sighup_dumps_octave_core (), ! orig_val); +%! sighup_dumps_octave_core (orig_val); +%! assert (sighup_dumps_octave_core (), orig_val); + +%!error (sighup_dumps_octave_core (1, 2)) +*/ + +DEFUN (sigterm_dumps_octave_core, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ +Query or set the internal variable that controls whether Octave tries\n\ +to save all current variables to the file \"octave-workspace\" if it receives\n\ +a terminate signal.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); +} + +/* +%!test +%! orig_val = sigterm_dumps_octave_core (); +%! old_val = sigterm_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sigterm_dumps_octave_core (), ! orig_val); +%! sigterm_dumps_octave_core (orig_val); +%! assert (sigterm_dumps_octave_core (), orig_val); + +%!error (sigterm_dumps_octave_core (1, 2)) +*/ diff -r 069c552587a0 -r 959953dba519 src/interpfcn/sighandlers.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sighandlers.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,177 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +/* + +The signal blocking macros defined below were adapted from similar +functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 +Free Software Foundation, Inc. + +*/ + +// This file should always be included after config.h! + +#if !defined (octave_sighandlers_h) +#define octave_sighandlers_h 1 + +// Include signal.h, not csignal since the latter might only define +// the ANSI standard C signal interface. + +#include + +#include "syswait.h" +#include "siglist.h" + +#include "base-list.h" + +typedef void sig_handler (int); + +// FIXME -- the data should probably be private... + +struct +octave_interrupt_handler +{ +#ifdef SIGINT + sig_handler *int_handler; +#endif + +#ifdef SIGBREAK + sig_handler *brk_handler; +#endif +}; + +// Nonzero means we have already printed a message for this series of +// SIGPIPES. We assume that the writer will eventually give up. +extern int pipe_handler_error_count; + +// TRUE means we can be interrupted. +extern OCTINTERP_API bool can_interrupt; + +extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, + bool restart_syscalls = true); + +extern OCTINTERP_API void install_signal_handlers (void); + +extern OCTINTERP_API void octave_signal_handler (void); + +extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); + +extern OCTINTERP_API octave_interrupt_handler +octave_set_interrupt_handler (const volatile octave_interrupt_handler&, + bool restart_syscalls = true); + +// extern void ignore_sigchld (void); + +// Maybe this should be in a separate file? + +class +OCTINTERP_API +octave_child +{ +public: + + // Do whatever to handle event for child with PID (might not + // actually be dead, could just be stopped). Return true if + // the list element corresponding to PID should be removed from + // list. This function should not call any functions that modify + // the octave_child_list. + + typedef bool (*child_event_handler) (pid_t, int); + + octave_child (pid_t id = -1, child_event_handler f = 0) + : pid (id), handler (f), have_status (0), status (0) { } + + octave_child (const octave_child& oc) + : pid (oc.pid), handler (oc.handler), + have_status (oc.have_status), status (oc.status) { } + + octave_child& operator = (const octave_child& oc) + { + if (&oc != this) + { + pid = oc.pid; + handler = oc.handler; + have_status = oc.have_status; + status = oc.status; + } + return *this; + } + + ~octave_child (void) { } + + // The process id of this child. + pid_t pid; + + // The function we call if an event happens for this child. + child_event_handler handler; + + // Nonzero if this child has stopped or terminated. + sig_atomic_t have_status; + + // The status of this child; 0 if running, otherwise a status value + // from waitpid. + int status; +}; + +class +OCTINTERP_API +octave_child_list +{ +protected: + + octave_child_list (void) { } + + class octave_child_list_rep : public octave_base_list + { + public: + + void insert (pid_t pid, octave_child::child_event_handler f); + + void reap (void); + + bool wait (void); + }; + +public: + + ~octave_child_list (void) { } + + static void insert (pid_t pid, octave_child::child_event_handler f); + + static void reap (void); + + static bool wait (void); + + static void remove (pid_t pid); + +private: + + static bool instance_ok (void); + + static octave_child_list_rep *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } +}; + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/symtab.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/symtab.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1744 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague, a.s. + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "singleton-cleanup.h" + +#include "debug.h" +#include "defun.h" +#include "dirfns.h" +#include "input.h" +#include "load-path.h" +#include "ov-fcn.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "pt-arg-list.h" +#include "symtab.h" +#include "unwind-prot.h" +#include "utils.h" + +symbol_table *symbol_table::instance = 0; + +symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; + +std::map symbol_table::all_instances; + +std::map symbol_table::global_table; + +std::map symbol_table::fcn_table; + +std::map > symbol_table::class_precedence_table; + +std::map > symbol_table::parent_map; + +const symbol_table::scope_id symbol_table::xglobal_scope = 0; +const symbol_table::scope_id symbol_table::xtop_scope = 1; + +symbol_table::scope_id symbol_table::xcurrent_scope = 1; + +symbol_table::context_id symbol_table::xcurrent_context = 0; + +// Should Octave always check to see if function files have changed +// since they were last compiled? +static int Vignore_function_time_stamp = 1; + +void +symbol_table::scope_id_cache::create_instance (void) +{ + instance = new scope_id_cache (); + + singleton_cleanup_list::add (cleanup_instance); +} + +symbol_table::context_id +symbol_table::symbol_record::symbol_record_rep::active_context (void) const +{ + octave_user_function *fcn = curr_fcn; + + // FIXME -- If active_context () == -1, then it does not make much + // sense to use this symbol_record. This means an attempt at accessing + // a variable from a function that has not been called yet is + // happening. This should be cleared up when an implementing closures. + + return fcn && fcn->active_context () != static_cast (-1) + ? fcn->active_context () : xcurrent_context; +} + +void +symbol_table::symbol_record::symbol_record_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + octave_value val = varval (); + + os << prefix << name; + + if (val.is_defined ()) + { + os << " [" + << (is_local () ? "l" : "") + << (is_automatic () ? "a" : "") + << (is_formal () ? "f" : "") + << (is_hidden () ? "h" : "") + << (is_inherited () ? "i" : "") + << (is_global () ? "g" : "") + << (is_persistent () ? "p" : "") + << "] "; + val.dump (os); + } + + os << "\n"; +} + +octave_value +symbol_table::symbol_record::find (const octave_value_list& args) const +{ + octave_value retval; + + if (is_global ()) + retval = symbol_table::global_varref (name ()); + else + { + retval = varval (); + + if (retval.is_undefined ()) + { + // Use cached fcn_info pointer if possible. + if (rep->finfo) + retval = rep->finfo->find (args); + else + { + retval = symbol_table::find_function (name (), args); + + if (retval.is_defined ()) + rep->finfo = get_fcn_info (name ()); + } + } + } + + return retval; +} + +// Check the load path to see if file that defined this is still +// visible. If the file is no longer visible, then erase the +// definition and move on. If the file is visible, then we also +// need to check to see whether the file has changed since the the +// function was loaded/parsed. However, this check should only +// happen once per prompt (for files found from relative path +// elements, we also check if the working directory has changed +// since the last time the function was loaded/parsed). +// +// FIXME -- perhaps this should be done for all loaded functions when +// the prompt is printed or the directory has changed, and then we +// would not check for it when finding symbol definitions. + +static inline bool +load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, + octave_value& function, + const std::string& dispatch_type = std::string ()) +{ + bool retval = false; + + octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); + + if (fcn) + { + retval = true; + + function = octave_value (fcn); + } + else + function = octave_value (); + + return retval; +} + +bool +out_of_date_check (octave_value& function, + const std::string& dispatch_type, + bool check_relative) +{ + bool retval = false; + + octave_function *fcn = function.function_value (true); + + if (fcn) + { + // FIXME -- we need to handle subfunctions properly here. + + if (! fcn->is_subfunction ()) + { + std::string ff = fcn->fcn_file_name (); + + if (! ff.empty ()) + { + octave_time tc = fcn->time_checked (); + + bool relative = check_relative && fcn->is_relative (); + + if (tc < Vlast_prompt_time + || (relative && tc < Vlast_chdir_time)) + { + bool clear_breakpoints = false; + std::string nm = fcn->name (); + + bool is_same_file = false; + + std::string file; + std::string dir_name; + + if (check_relative) + { + int nm_len = nm.length (); + + if (octave_env::absolute_pathname (nm) + && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" + || nm.substr (nm_len-4) == ".mex")) + || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) + file = nm; + else + { + // We don't want to make this an absolute name, + // because load_fcn_file looks at the name to + // decide whether it came from a relative lookup. + + if (! dispatch_type.empty ()) + { + file = load_path::find_method (dispatch_type, nm, + dir_name); + + if (file.empty ()) + { + const std::list& plist + = symbol_table::parent_classes (dispatch_type); + std::list::const_iterator it + = plist.begin (); + + while (it != plist.end ()) + { + file = load_path::find_method (*it, nm, dir_name); + if (! file.empty ()) + break; + + it++; + } + } + } + + // Maybe it's an autoload? + if (file.empty ()) + file = lookup_autoload (nm); + + if (file.empty ()) + file = load_path::find_fcn (nm, dir_name); + } + + if (! file.empty ()) + is_same_file = same_file (file, ff); + } + else + { + is_same_file = true; + file = ff; + } + + if (file.empty ()) + { + // Can't see this function from current + // directory, so we should clear it. + + function = octave_value (); + + clear_breakpoints = true; + } + else if (is_same_file) + { + // Same file. If it is out of date, then reload it. + + octave_time ottp = fcn->time_parsed (); + time_t tp = ottp.unix_time (); + + fcn->mark_fcn_file_up_to_date (octave_time ()); + + if (! (Vignore_function_time_stamp == 2 + || (Vignore_function_time_stamp + && fcn->is_system_fcn_file ()))) + { + file_stat fs (ff); + + if (fs) + { + if (fs.is_newer (tp)) + { + retval = load_out_of_date_fcn (ff, dir_name, + function, + dispatch_type); + + clear_breakpoints = true; + } + } + else + { + function = octave_value (); + + clear_breakpoints = true; + } + } + } + else + { + // Not the same file, so load the new file in + // place of the old. + + retval = load_out_of_date_fcn (file, dir_name, function, + dispatch_type); + + clear_breakpoints = true; + } + + // If the function has been replaced then clear any + // breakpoints associated with it + if (clear_breakpoints) + bp_table::remove_all_breakpoints_in_file (nm, true); + } + } + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_private_function + (const std::string& dir_name) +{ + octave_value retval; + + std::string file_name = load_path::find_private_fcn (dir_name, name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + { + std::string class_name; + + size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + { + std::string tmp = dir_name.substr (pos+1); + + if (tmp[0] == '@') + class_name = tmp.substr (1); + } + + fcn->mark_as_private_function (class_name); + + retval = octave_value (fcn); + + private_functions[dir_name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) +{ + octave_value retval; + + std::string dir_name; + + std::string file_name = load_path::find_method (name, name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); + + if (fcn) + { + retval = octave_value (fcn); + + class_constructors[name] = retval; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::load_class_method + (const std::string& dispatch_type) +{ + octave_value retval; + + if (name == dispatch_type) + retval = load_class_constructor (); + else + { + std::string dir_name; + + std::string file_name = load_path::find_method (dispatch_type, name, + dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + dispatch_type); + + if (fcn) + { + retval = octave_value (fcn); + + class_methods[dispatch_type] = retval; + } + } + + if (retval.is_undefined ()) + { + // Search parent classes + + const std::list& plist = parent_classes (dispatch_type); + + std::list::const_iterator it = plist.begin (); + + while (it != plist.end ()) + { + retval = find_method (*it); + + if (retval.is_defined ()) + { + class_methods[dispatch_type] = retval; + break; + } + + it++; + } + } + } + + return retval; +} + +void +symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private + (scope_id scope, const std::string& class_name) +{ + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + { + octave_function *fcn = p->second.function_value (); + + if (fcn) + fcn->mark_as_private_function (class_name); + } +} + +void +symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const +{ + if (dispatch_map.empty ()) + os << "dispatch: " << name << " is not overloaded" << std::endl; + else + { + os << "Overloaded function " << name << ":\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << " " << name << " (" << p->first << ", ...) -> " + << p->second << " (" << p->first << ", ...)\n"; + + os << std::endl; + } +} + +std::string +symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const +{ + std::string retval; + + if (! dispatch_map.empty ()) + { + retval = "Overloaded function:\n\n"; + + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + retval += " " + p->second + " (" + p->first + ", ...)\n\n"; + } + + return retval; +} + +// :-) JWE, can you parse this? Returns a 2D array with second dimension equal +// to btyp_num_types (static constant). Only the leftmost dimension can be +// variable in C/C++. Typedefs are boring. + +static builtin_type_t (*build_sup_table (void))[btyp_num_types] +{ + static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; + for (int i = 0; i < btyp_num_types; i++) + for (int j = 0; j < btyp_num_types; j++) + { + builtin_type_t ityp = static_cast (i); + builtin_type_t jtyp = static_cast (j); + // FIXME: Is this really right? + bool use_j = + (jtyp == btyp_func_handle || ityp == btyp_bool + || (btyp_isarray (ityp) + && (! btyp_isarray (jtyp) + || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) + || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) + && (jtyp == btyp_float || jtyp == btyp_float_complex))))); + + sup_table[i][j] = use_j ? jtyp : ityp; + } + + return sup_table; +} + +std::string +get_dispatch_type (const octave_value_list& args, + builtin_type_t& builtin_type) +{ + static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); + std::string dispatch_type; + + int n = args.length (); + + if (n > 0) + { + int i = 0; + builtin_type = args(0).builtin_type (); + if (builtin_type != btyp_unknown) + { + for (i = 1; i < n; i++) + { + builtin_type_t bti = args(i).builtin_type (); + if (bti != btyp_unknown) + builtin_type = sup_table[builtin_type][bti]; + else + { + builtin_type = btyp_unknown; + break; + } + } + } + + if (builtin_type == btyp_unknown) + { + // There's a non-builtin class in the argument list. + dispatch_type = args(i).class_name (); + + for (int j = i+1; j < n; j++) + { + octave_value arg = args(j); + + if (arg.builtin_type () == btyp_unknown) + { + std::string cname = arg.class_name (); + + // Only switch to type of ARG if it is marked superior + // to the current DISPATCH_TYPE. + if (! symbol_table::is_superiorto (dispatch_type, cname) + && symbol_table::is_superiorto (cname, dispatch_type)) + dispatch_type = cname; + } + } + } + else + dispatch_type = btyp_class_name[builtin_type]; + } + else + builtin_type = btyp_unknown; + + return dispatch_type; +} + +std::string +get_dispatch_type (const octave_value_list& args) +{ + builtin_type_t builtin_type; + return get_dispatch_type (args, builtin_type); +} + +// Find the definition of NAME according to the following precedence +// list: +// +// variable +// subfunction +// private function +// class method +// class constructor +// legacy dispatch +// command-line function +// autoload function +// function on the path +// built-in function +// +// Matlab documentation states that constructors have higher precedence +// than methods, but that does not seem to be the case. + +octave_value +symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, + bool local_funcs) +{ + octave_value retval = xfind (args, local_funcs); + + if (! (error_state || retval.is_defined ())) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = xfind (args, local_funcs); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, + bool local_funcs) +{ + if (local_funcs) + { + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + // Private function. + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, "", false); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + } + + // Class methods. + + if (! args.empty ()) + { + std::string dispatch_type = get_dispatch_type (args); + + octave_value fcn = find_method (dispatch_type); + + if (fcn.is_defined ()) + return fcn; + } + + // Class constructors. The class name and function name are the same. + + str_val_iterator q = class_constructors.find (name); + + if (q == class_constructors.end ()) + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, name); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_constructor (); + + if (val.is_defined ()) + return val; + } + } + + // Legacy dispatch. + + if (! args.empty () && ! dispatch_map.empty ()) + { + std::string dispatch_type = args(0).type_name (); + + std::string fname; + + dispatch_map_iterator p = dispatch_map.find (dispatch_type); + + if (p == dispatch_map.end ()) + p = dispatch_map.find ("any"); + + if (p != dispatch_map.end ()) + { + fname = p->second; + + octave_value fcn + = symbol_table::find_function (fname, args); + + if (fcn.is_defined ()) + return fcn; + } + } + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Autoload? + + octave_value fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Function on the path. + + fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Built-in function (might be undefined). + + return built_in_function; +} + +// Find the definition of NAME according to the following precedence +// list: +// +// built-in function +// function on the path +// autoload function +// command-line function +// private function +// subfunction + +// This function is used to implement the "builtin" function, which +// searches for "built-in" functions. In Matlab, "builtin" only +// returns functions that are actually built-in to the interpreter. +// But since the list of built-in functions is different in Octave and +// Matlab, we also search up the precedence list until we find +// something that matches. Note that we are only searching by name, +// so class methods, constructors, and legacy dispatch functions are +// skipped. + +octave_value +symbol_table::fcn_info::fcn_info_rep::builtin_find (void) +{ + octave_value retval = x_builtin_find (); + + if (! retval.is_defined ()) + { + // It is possible that the user created a file on the fly since + // the last prompt or chdir, so try updating the load path and + // searching again. + + load_path::update (); + + retval = x_builtin_find (); + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) +{ + // Built-in function. + if (built_in_function.is_defined ()) + return built_in_function; + + // Function on the path. + + octave_value fcn = find_user_function (); + + if (fcn.is_defined ()) + return fcn; + + // Autoload? + + fcn = find_autoload (); + + if (fcn.is_defined ()) + return fcn; + + // Command-line function. + + if (cmdline_function.is_defined ()) + return cmdline_function; + + // Private function. + + octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); + + if (curr_fcn) + { + std::string dir_name = curr_fcn->dir_name (); + + if (! dir_name.empty ()) + { + str_val_iterator q = private_functions.find (dir_name); + + if (q == private_functions.end ()) + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_private_function (dir_name); + + if (val.is_defined ()) + return val; + } + } + } + } + + // Subfunction. I think it only makes sense to check for + // subfunctions if we are currently executing a function defined + // from a .m file. + + for (scope_id scope = xcurrent_scope; scope >= 0;) + { + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. + + return r->second; + } + + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; + } + + return octave_value (); +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) +{ + octave_value retval; + + str_val_iterator q = class_methods.find (dispatch_type); + + if (q == class_methods.end ()) + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + else + { + octave_value& fval = q->second; + + if (fval.is_defined ()) + out_of_date_check (fval, dispatch_type); + + if (fval.is_defined ()) + return fval; + else + { + octave_value val = load_class_method (dispatch_type); + + if (val.is_defined ()) + return val; + } + } + + return retval; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_autoload (void) +{ + octave_value retval; + + // Autoloaded function. + + if (autoload_function.is_defined ()) + out_of_date_check (autoload_function); + + if (! autoload_function.is_defined ()) + { + std::string file_name = lookup_autoload (name); + + if (! file_name.empty ()) + { + size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); + + std::string dir_name = file_name.substr (0, pos); + + octave_function *fcn = load_fcn_from_file (file_name, dir_name, + "", name, true); + + if (fcn) + autoload_function = octave_value (fcn); + } + } + + return autoload_function; +} + +octave_value +symbol_table::fcn_info::fcn_info_rep::find_user_function (void) +{ + // Function on the path. + + if (function_on_path.is_defined ()) + out_of_date_check (function_on_path); + + if (! (error_state || function_on_path.is_defined ())) + { + std::string dir_name; + + std::string file_name = load_path::find_fcn (name, dir_name); + + if (! file_name.empty ()) + { + octave_function *fcn = load_fcn_from_file (file_name, dir_name); + + if (fcn) + function_on_path = octave_value (fcn); + } + } + + return function_on_path; +} + +// Insert INF_CLASS in the set of class names that are considered +// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently +// marked as superior to SUP_CLASS. + +bool +symbol_table::set_class_relationship (const std::string& sup_class, + const std::string& inf_class) +{ + class_precedence_table_const_iterator p + = class_precedence_table.find (inf_class); + + if (p != class_precedence_table.end ()) + { + const std::set& inferior_classes = p->second; + + std::set::const_iterator q + = inferior_classes.find (sup_class); + + if (q != inferior_classes.end ()) + return false; + } + + class_precedence_table[sup_class].insert (inf_class); + + return true; +} + +// Has class A been marked as superior to class B? Also returns +// TRUE if B has been marked as inferior to A, since we only keep +// one table, and convert inferiort information to a superiorto +// relationship. Two calls are required to determine whether there +// is no relationship between two classes: +// +// if (symbol_table::is_superiorto (a, b)) +// // A is superior to B, or B has been marked inferior to A. +// else if (symbol_table::is_superiorto (b, a)) +// // B is superior to A, or A has been marked inferior to B. +// else +// // No relation. + +bool +symbol_table::is_superiorto (const std::string& a, const std::string& b) +{ + bool retval = false; + + class_precedence_table_const_iterator p = class_precedence_table.find (a); + + if (p != class_precedence_table.end ()) + { + const std::set& inferior_classes = p->second; + std::set::const_iterator q = inferior_classes.find (b); + + if (q != inferior_classes.end ()) + retval = true; + } + + return retval; +} + +static std::string +fcn_file_name (const octave_value& fcn) +{ + const octave_function *f = fcn.function_value (); + + return f ? f->fcn_file_name () : std::string (); +} + +void +symbol_table::fcn_info::fcn_info_rep::dump + (std::ostream& os, const std::string& prefix) const +{ + os << prefix << name + << " [" + << (cmdline_function.is_defined () ? "c" : "") + << (built_in_function.is_defined () ? "b" : "") + << "]\n"; + + std::string tprefix = prefix + " "; + + if (autoload_function.is_defined ()) + os << tprefix << "autoload: " + << fcn_file_name (autoload_function) << "\n"; + + if (function_on_path.is_defined ()) + os << tprefix << "function from path: " + << fcn_file_name (function_on_path) << "\n"; + + if (! subfunctions.empty ()) + { + for (scope_val_const_iterator p = subfunctions.begin (); + p != subfunctions.end (); p++) + os << tprefix << "subfunction: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! private_functions.empty ()) + { + for (str_val_const_iterator p = private_functions.begin (); + p != private_functions.end (); p++) + os << tprefix << "private: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_constructors.empty ()) + { + for (str_val_const_iterator p = class_constructors.begin (); + p != class_constructors.end (); p++) + os << tprefix << "constructor: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! class_methods.empty ()) + { + for (str_val_const_iterator p = class_methods.begin (); + p != class_methods.end (); p++) + os << tprefix << "method: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } + + if (! dispatch_map.empty ()) + { + for (dispatch_map_const_iterator p = dispatch_map.begin (); + p != dispatch_map.end (); p++) + os << tprefix << "dispatch: " << fcn_file_name (p->second) + << " [" << p->first << "]\n"; + } +} + +void +symbol_table::install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope) +{ + install_subfunction (name, fcn, parent_scope); + + // Stash the nest_parent for resolving variables after parsing is done. + octave_function *fv = fcn.function_value (); + + symbol_table *fcn_table_loc = get_instance (fv->scope ()); + + symbol_table *parent_table = get_instance (parent_scope); + + parent_table->add_nest_child (*fcn_table_loc); +} + +octave_value +symbol_table::find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst + ? inst->do_find (name, args, skip_variables, local_funcs) + : octave_value (); +} + +octave_value +symbol_table::builtin_find (const std::string& name) +{ + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_builtin_find (name) : octave_value (); +} + +octave_value +symbol_table::find_function (const std::string& name, + const octave_value_list& args, + bool local_funcs) +{ + octave_value retval; + + if (! name.empty () && name[0] == '@') + { + // Look for a class specific function. + std::string dispatch_type = + name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); + + std::string method = + name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, + std::string::npos); + + retval = find_method (method, dispatch_type); + } + else + { + size_t pos = name.find_first_of (Vfilemarker); + + if (pos == std::string::npos) + retval = find (name, args, true, local_funcs); + else + { + std::string fcn_scope = name.substr (0, pos); + scope_id stored_scope = xcurrent_scope; + xcurrent_scope = xtop_scope; + octave_value parent = find_function (name.substr (0, pos), + octave_value_list (), false); + + if (parent.is_defined ()) + { + octave_function *parent_fcn = parent.function_value (); + + if (parent_fcn) + { + xcurrent_scope = parent_fcn->scope (); + + if (xcurrent_scope > 1) + retval = find_function (name.substr (pos + 1), args); + } + } + + xcurrent_scope = stored_scope; + } + } + + return retval; +} + +void +symbol_table::dump (std::ostream& os, scope_id scope) +{ + if (scope == xglobal_scope) + dump_global (os); + else + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + { + os << "*** dumping symbol table scope " << scope + << " (" << inst->table_name << ")\n\n"; + + std::map sfuns + = symbol_table::subfunctions_defined_in_scope (scope); + + if (! sfuns.empty ()) + { + os << " subfunctions defined in this scope:\n"; + + for (std::map::const_iterator p = sfuns.begin (); + p != sfuns.end (); p++) + os << " " << p->first << "\n"; + + os << "\n"; + } + + inst->do_dump (os); + } + } +} + +void +symbol_table::dump_global (std::ostream& os) +{ + if (! global_table.empty ()) + { + os << "*** dumping global symbol table\n\n"; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + } +} + +void +symbol_table::dump_functions (std::ostream& os) +{ + if (! fcn_table.empty ()) + { + os << "*** dumping globally visible functions from symbol table\n" + << " (c=commandline, b=built-in)\n\n"; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void +symbol_table::stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name) +{ + // FIXME -- is this the best way to do this? Maybe it would be + // better if we had a map from scope to list of subfunctions + // stored with the function. Do we? + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + { + octave_value& fcn = tmp.second; + + octave_user_function *f = fcn.user_function_value (); + + if (f) + f->stash_dir_name (dir_name); + } + } +} + +octave_value +symbol_table::do_find (const std::string& name, + const octave_value_list& args, + bool skip_variables, + bool local_funcs) +{ + octave_value retval; + + // Variable. + + if (! skip_variables) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record sr = p->second; + + // FIXME -- should we be using something other than varref here? + + if (sr.is_global ()) + return symbol_table::global_varref (name); + else + { + octave_value& val = sr.varref (); + + if (val.is_defined ()) + return val; + } + } + } + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find (args, local_funcs); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find (args, local_funcs); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +octave_value +symbol_table::do_builtin_find (const std::string& name) +{ + octave_value retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.builtin_find (); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.builtin_find (); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + + return retval; +} + +void +symbol_table::do_dump (std::ostream& os) +{ + if (! persistent_table.empty ()) + { + os << " persistent variables in this scope:\n\n"; + + for (persistent_table_const_iterator p = persistent_table.begin (); + p != persistent_table.end (); p++) + { + std::string nm = p->first; + octave_value val = p->second; + + os << " " << nm << " "; + val.dump (os); + os << "\n"; + } + + os << "\n"; + } + + if (! table.empty ()) + { + os << " other symbols in this scope (l=local; a=auto; f=formal\n" + << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + p->second.dump (os, " "); + + os << "\n"; + } +} + +void symbol_table::cleanup (void) +{ + // Clear variables in top scope. + all_instances[xtop_scope]->clear_variables (); + + // Clear function table. This is a hard clear, ignoring mlocked functions. + fcn_table.clear (); + + // Clear variables in global scope. + // FIXME: are there any? + all_instances[xglobal_scope]->clear_variables (); + + // Clear global variables. + global_table.clear (); + + // Delete all possibly remaining scopes. + for (all_instances_iterator iter = all_instances.begin (); + iter != all_instances.end (); iter++) + { + scope_id scope = iter->first; + if (scope != xglobal_scope && scope != xtop_scope) + scope_id_cache::free (scope); + + // First zero the table entry to avoid possible duplicate delete. + symbol_table *inst = iter->second; + iter->second = 0; + + // Now delete the scope. Note that there may be side effects, such as + // deleting other scopes. + delete inst; + } +} + +void +symbol_table::do_update_nest (void) +{ + if (nest_parent || nest_children.size ()) + curr_fcn->mark_as_nested_function (); + + if (nest_parent) + { + // fix bad symbol_records + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + { + symbol_record &ours = ti->second; + symbol_record parents; + if (! ours.is_formal () + && nest_parent->look_nonlocal (ti->first, parents)) + { + if (ours.is_global () || ours.is_persistent ()) + ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); + + if (! ours.is_formal ()) + { + ours.invalidate (); + ti->second = parents; + } + } + else + ours.set_curr_fcn (curr_fcn); + } + } + else if (nest_children.size ()) + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + ti->second.set_curr_fcn (curr_fcn); + + for (std::vector::iterator iter = nest_children.begin (); + iter != nest_children.end (); ++iter) + (*iter)->do_update_nest (); +} + +DEFUN (ignore_function_time_stamp, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ +Query or set the internal variable that controls whether Octave checks\n\ +the time stamp on files each time it looks up functions defined in\n\ +function files. If the internal variable is set to @code{\"system\"},\n\ +Octave will not automatically recompile function files in subdirectories of\n\ +@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ +they were last compiled, but will recompile other function files in the\n\ +search path if they change. If set to @code{\"all\"}, Octave will not\n\ +recompile any function files unless their definitions are removed with\n\ +@code{clear}. If set to \"none\", Octave will always check time stamps\n\ +on files to determine whether functions defined in function files\n\ +need to recompiled.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + { + switch (Vignore_function_time_stamp) + { + case 1: + retval = "system"; + break; + + case 2: + retval = "all"; + break; + + default: + retval = "none"; + break; + } + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (sval == "all") + Vignore_function_time_stamp = 2; + else if (sval == "system") + Vignore_function_time_stamp = 1; + else if (sval == "none") + Vignore_function_time_stamp = 0; + else + error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); + } + else + error ("ignore_function_time_stamp: expecting argument to be character string"); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +/* +%!shared old_state +%! old_state = ignore_function_time_stamp (); +%!test +%! state = ignore_function_time_stamp ("all"); +%! assert (state, old_state); +%! assert (ignore_function_time_stamp (), "all"); +%! state = ignore_function_time_stamp ("system"); +%! assert (state, "all"); +%! assert (ignore_function_time_stamp (), "system"); +%! ignore_function_time_stamp (old_state); + +## Test input validation +%!error (ignore_function_time_stamp ("all", "all")) +%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) +%!error (ignore_function_time_stamp (42)) +*/ + +DEFUN (__current_scope__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + retval(1) = symbol_table::current_context (); + retval(0) = symbol_table::current_scope (); + + return retval; +} + +DEFUN (__dump_symtab_info__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ +@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + symbol_table::dump_functions (octave_stdout); + + symbol_table::dump_global (octave_stdout); + + std::list lst = symbol_table::scopes (); + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + symbol_table::dump (octave_stdout, *p); + } + else if (nargin == 1) + { + octave_value arg = args(0); + + if (arg.is_string ()) + { + std::string s_arg = arg.string_value (); + + if (s_arg == "scopes") + { + std::list lst = symbol_table::scopes (); + + RowVector v (lst.size ()); + + octave_idx_type k = 0; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + v.xelem (k++) = *p; + + retval = v; + } + else if (s_arg == "functions") + { + symbol_table::dump_functions (octave_stdout); + } + else + error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); + } + else + { + int s = arg.int_value (); + + if (! error_state) + symbol_table::dump (octave_stdout, s); + else + error ("__dump_symtab_info__: expecting string or scope id"); + } + } + else + print_usage (); + + return retval; +} + +#if 0 + +// FIXME -- should we have functions like this in Octave? + +DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") +{ + octave_value retval; + + if (args.length () == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + symbol_table::varref (name) = args(1); + else + error ("set_variable: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} + +DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + retval = symbol_table::varval (name); + + if (retval.is_undefined ()) + error ("variable_value: `%s' is not a variable in the current scope", + name.c_str ()); + } + else + error ("variable_value: expecting variable name as first argument"); + } + else + print_usage (); + + return retval; +} +#endif + + +/* +bug #34497: 'clear -f' does not work for command line functions + +This test relies on bar being a core function that is implemented in an m-file. +If the first assert fails, this is no longer the case and the tests need to be +updated to use some other function. + +%!assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear -f bar; +%! assert (! strcmp (which ("bar"), "")); + +%!function x = bar () +%! x = 5; +%!endfunction +%!test +%! assert (bar == 5); +%! assert (strcmp (which ("bar"), "")); +%! clear bar; +%! assert (! strcmp (which ("bar"), "")); + */ diff -r 069c552587a0 -r 959953dba519 src/interpfcn/symtab.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/symtab.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2660 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_symtab_h) +#define octave_symtab_h 1 + +#include +#include +#include +#include +#include + +#include "glob-match.h" +#include "regexp.h" + +class tree_argument_list; +class octave_user_function; + +#include "oct-obj.h" +#include "oct-refcount.h" +#include "ov.h" + +class +OCTINTERP_API +symbol_table +{ +public: + + typedef int scope_id; + typedef size_t context_id; + + class + scope_id_cache + { + protected: + + typedef std::set::iterator set_iterator; + typedef std::set::const_iterator set_const_iterator; + + // We start with 2 because we allocate 0 for the global symbols + // and 1 for the top-level workspace. + + scope_id_cache (void) : next_available (2), in_use (), free_list () { } + + public: + + ~scope_id_cache (void) { } + + static scope_id alloc (void) + { + return instance_ok () ? instance->do_alloc () : -1; + } + + static void free (scope_id scope) + { + if (instance_ok ()) + return instance->do_free (scope); + } + + static std::list scopes (void) + { + return instance_ok () ? instance->do_scopes () : std::list (); + } + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create scope_id_cache object!"); + + retval = false; + } + + return retval; + } + + private: + + // No copying! + + scope_id_cache (const scope_id_cache&); + + scope_id_cache& operator = (const scope_id_cache&); + + static scope_id_cache *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + // The next available scope not in the free list. + scope_id next_available; + + // The set of scope IDs that are currently allocated. + std::set in_use; + + // The set of scope IDs that are currently available. + std::set free_list; + + scope_id do_alloc (void) + { + scope_id retval; + + set_iterator p = free_list.begin (); + + if (p != free_list.end ()) + { + retval = *p; + free_list.erase (p); + } + else + retval = next_available++; + + in_use.insert (retval); + + return retval; + } + + void do_free (scope_id scope) + { + set_iterator p = in_use.find (scope); + + if (p != in_use.end ()) + { + in_use.erase (p); + free_list.insert (scope); + } + else + error ("free_scope: scope %d not found!", scope); + } + + std::list do_scopes (void) const + { + std::list retval; + + for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) + retval.push_back (*p); + + retval.sort (); + + return retval; + } + }; + + class fcn_info; + + class + symbol_record + { + public: + + // generic variable + static const unsigned int local = 1; + + // varargin, argn, .nargin., .nargout. + // (FIXME -- is this really used now?) + static const unsigned int automatic = 2; + + // formal parameter + static const unsigned int formal = 4; + + // not listed or cleared (.nargin., .nargout.) + static const unsigned int hidden = 8; + + // inherited from parent scope; not cleared at function exit + static const unsigned int inherited = 16; + + // global (redirects to global scope) + static const unsigned int global = 32; + + // not cleared at function exit + static const unsigned int persistent = 64; + + // temporary variables forced into symbol table for parsing + static const unsigned int forced = 128; + + private: + + class + symbol_record_rep + { + public: + + symbol_record_rep (scope_id s, const std::string& nm, + const octave_value& v, unsigned int sc) + : decl_scope (s), curr_fcn (0), name (nm), value_stack (), + storage_class (sc), finfo (), valid (true), count (1) + { + value_stack.push_back (v); + } + + void force_variable (context_id context = xdefault_context) + { + if (context == xdefault_context) + context = active_context (); + + octave_value& val = varref (context); + + if (! val.is_defined ()) + mark_forced (); + } + + octave_value& varref (context_id context = xdefault_context) + { + if (is_global ()) + return symbol_table::global_varref (name); + else if (is_persistent ()) + return symbol_table::persistent_varref (name); + else + { + if (context == xdefault_context) + context = active_context (); + + context_id n = value_stack.size (); + while (n++ <= context) + value_stack.push_back (octave_value ()); + + return value_stack[context]; + } + } + + octave_value varval (context_id context = xdefault_context) const + { + if (is_global ()) + return symbol_table::global_varval (name); + else if (is_persistent ()) + return symbol_table::persistent_varval (name); + else + { + if (context == xdefault_context) + context = active_context (); + + if (context < value_stack.size ()) + return value_stack[context]; + else + return octave_value (); + } + } + + void push_context (scope_id s) + { + if (! (is_persistent () || is_global ()) + && s == scope ()) + value_stack.push_back (octave_value ()); + } + + // If pop_context returns 0, we are out of values and this element + // of the symbol table should be deleted. This can happen for + // functions like + // + // function foo (n) + // if (n > 0) + // foo (n-1); + // else + // eval ("x = 1"); + // endif + // endfunction + // + // Here, X should only exist in the final stack frame. + + size_t pop_context (scope_id s) + { + size_t retval = 1; + + if (! (is_persistent () || is_global ()) + && s == scope ()) + { + value_stack.pop_back (); + retval = value_stack.size (); + } + + return retval; + } + + void clear (void) { clear (scope ()); } + + void clear (scope_id s) + { + if (! (is_hidden () || is_inherited ()) + && s == scope ()) + { + if (is_global ()) + unmark_global (); + + if (is_persistent ()) + { + symbol_table::persistent_varref (name) + = varval (); + + unmark_persistent (); + } + + varref () = octave_value (); + } + } + + bool is_defined (context_id context = xdefault_context) const + { + if (context == xdefault_context) + context = active_context (); + + return varval (context).is_defined (); + } + + bool is_valid (void) const + { + return valid; + } + + bool is_variable (context_id context) const + { + if (context == xdefault_context) + context = active_context (); + + return (! is_local () || is_defined (context) || is_forced ()); + } + + bool is_local (void) const { return storage_class & local; } + bool is_automatic (void) const { return storage_class & automatic; } + bool is_formal (void) const { return storage_class & formal; } + bool is_hidden (void) const { return storage_class & hidden; } + bool is_inherited (void) const { return storage_class & inherited; } + bool is_global (void) const { return storage_class & global; } + bool is_persistent (void) const { return storage_class & persistent; } + bool is_forced (void) const { return storage_class & forced; } + + void mark_local (void) { storage_class |= local; } + void mark_automatic (void) { storage_class |= automatic; } + void mark_formal (void) { storage_class |= formal; } + void mark_hidden (void) { storage_class |= hidden; } + void mark_inherited (void) { storage_class |= inherited; } + void mark_global (void) + { + if (is_persistent ()) + error ("can't make persistent variable %s global", name.c_str ()); + else + storage_class |= global; + } + void mark_persistent (void) + { + if (is_global ()) + error ("can't make global variable %s persistent", name.c_str ()); + else + storage_class |= persistent; + } + void mark_forced (void) { storage_class |= forced; } + + void unmark_local (void) { storage_class &= ~local; } + void unmark_automatic (void) { storage_class &= ~automatic; } + void unmark_formal (void) { storage_class &= ~formal; } + void unmark_hidden (void) { storage_class &= ~hidden; } + void unmark_inherited (void) { storage_class &= ~inherited; } + void unmark_global (void) { storage_class &= ~global; } + void unmark_persistent (void) { storage_class &= ~persistent; } + void unmark_forced (void) { storage_class &= ~forced; } + + void init_persistent (void) + { + if (! is_defined ()) + { + mark_persistent (); + + varref () = symbol_table::persistent_varval (name); + } + // FIXME -- this causes trouble with recursive calls. + // else + // error ("unable to declare existing variable persistent"); + } + + void invalidate (void) + { + valid = false; + } + + void erase_persistent (void) + { + unmark_persistent (); + symbol_table::erase_persistent (name); + } + + context_id active_context (void) const; + + scope_id scope (void) const { return decl_scope; } + + void set_curr_fcn (octave_user_function *fcn) + { + curr_fcn = fcn; + } + + symbol_record_rep *dup (scope_id new_scope) const + { + return new symbol_record_rep (new_scope, name, varval (), + storage_class); + } + + void dump (std::ostream& os, const std::string& prefix) const; + + scope_id decl_scope; + + octave_user_function* curr_fcn; + + std::string name; + + std::deque value_stack; + + unsigned int storage_class; + + fcn_info *finfo; + + bool valid; + + octave_refcount count; + + private: + + // No copying! + + symbol_record_rep (const symbol_record_rep& ov); + + symbol_record_rep& operator = (const symbol_record_rep&); + }; + + public: + + symbol_record (scope_id s = xcurrent_scope, + const std::string& nm = std::string (), + const octave_value& v = octave_value (), + unsigned int sc = local) + : rep (new symbol_record_rep (s, nm, v, sc)) { } + + symbol_record (const symbol_record& sr) + : rep (sr.rep) + { + rep->count++; + } + + symbol_record& operator = (const symbol_record& sr) + { + if (this != &sr) + { + if (--rep->count == 0) + delete rep; + + rep = sr.rep; + rep->count++; + } + + return *this; + } + + ~symbol_record (void) + { + if (--rep->count == 0) + delete rep; + } + + symbol_record dup (scope_id new_scope) const + { + return symbol_record (rep->dup (new_scope)); + } + + const std::string& name (void) const { return rep->name; } + + octave_value + find (const octave_value_list& args = octave_value_list ()) const; + + void force_variable (context_id context = xdefault_context) + { + rep->force_variable (context); + } + + octave_value& varref (context_id context = xdefault_context) + { + return rep->varref (context); + } + + octave_value varval (context_id context = xdefault_context) const + { + return rep->varval (context); + } + + void push_context (scope_id s) { rep->push_context (s); } + + size_t pop_context (scope_id s) { return rep->pop_context (s); } + + void clear (void) { rep->clear (); } + + void clear (scope_id s) { rep->clear (s); } + + bool is_defined (context_id context = xdefault_context) const + { + return rep->is_defined (context); + } + + bool is_valid (void) const + { + return rep->is_valid (); + } + + bool is_variable (context_id context = xdefault_context) const + { + return rep->is_variable (context); + } + + bool is_local (void) const { return rep->is_local (); } + bool is_automatic (void) const { return rep->is_automatic (); } + bool is_formal (void) const { return rep->is_formal (); } + bool is_global (void) const { return rep->is_global (); } + bool is_hidden (void) const { return rep->is_hidden (); } + bool is_inherited (void) const { return rep->is_inherited (); } + bool is_persistent (void) const { return rep->is_persistent (); } + bool is_forced (void) const { return rep->is_forced (); } + + void mark_local (void) { rep->mark_local (); } + void mark_automatic (void) { rep->mark_automatic (); } + void mark_formal (void) { rep->mark_formal (); } + void mark_hidden (void) { rep->mark_hidden (); } + void mark_inherited (void) { rep->mark_inherited (); } + void mark_global (void) { rep->mark_global (); } + void mark_persistent (void) { rep->mark_persistent (); } + void mark_forced (void) { rep->mark_forced (); } + + void unmark_local (void) { rep->unmark_local (); } + void unmark_automatic (void) { rep->unmark_automatic (); } + void unmark_formal (void) { rep->unmark_formal (); } + void unmark_hidden (void) { rep->unmark_hidden (); } + void unmark_inherited (void) { rep->unmark_inherited (); } + void unmark_global (void) { rep->unmark_global (); } + void unmark_persistent (void) { rep->unmark_persistent (); } + void unmark_forced (void) { rep->unmark_forced (); } + + void init_persistent (void) { rep->init_persistent (); } + + void erase_persistent (void) { rep->erase_persistent (); } + + void invalidate (void) { rep->invalidate (); } + + context_id active_context (void) const { return rep->active_context (); } + + scope_id scope (void) const { return rep->scope (); } + + unsigned int xstorage_class (void) const { return rep->storage_class; } + + void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + symbol_record_rep *rep; + + symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } + }; + + // Always access a symbol from the current scope. + // Useful for scripts, as they may be executed in more than one scope. + class + symbol_reference + { + public: + symbol_reference (void) : scope (-1) {} + + symbol_reference (symbol_record record, + scope_id curr_scope = symbol_table::current_scope ()) + : scope (curr_scope), sym (record) + {} + + symbol_reference& operator = (const symbol_reference& ref) + { + scope = ref.scope; + sym = ref.sym; + return *this; + } + + // The name is the same regardless of scope. + const std::string& name (void) const { return sym.name (); } + + symbol_record *operator-> (void) + { + update (); + return &sym; + } + + symbol_record *operator-> (void) const + { + update (); + return &sym; + } + + // can be used to place symbol_reference in maps, we don't overload < as + // it doesn't make any sense for symbol_reference + struct comparator + { + bool operator ()(const symbol_reference& lhs, + const symbol_reference& rhs) const + { + return lhs.name () < rhs.name (); + } + }; + private: + void update (void) const + { + scope_id curr_scope = symbol_table::current_scope (); + if (scope != curr_scope || ! sym.is_valid ()) + { + scope = curr_scope; + sym = symbol_table::insert (sym.name ()); + } + } + + mutable scope_id scope; + mutable symbol_record sym; + }; + + class + fcn_info + { + public: + + typedef std::map dispatch_map_type; + + typedef std::map::const_iterator scope_val_const_iterator; + typedef std::map::iterator scope_val_iterator; + + typedef std::map::const_iterator str_val_const_iterator; + typedef std::map::iterator str_val_iterator; + + typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; + typedef dispatch_map_type::iterator dispatch_map_iterator; + + private: + + class + fcn_info_rep + { + public: + + fcn_info_rep (const std::string& nm) + : name (nm), subfunctions (), private_functions (), + class_constructors (), class_methods (), dispatch_map (), + cmdline_function (), autoload_function (), function_on_path (), + built_in_function (), count (1) { } + + octave_value load_private_function (const std::string& dir_name); + + octave_value load_class_constructor (void); + + octave_value load_class_method (const std::string& dispatch_type); + + octave_value find (const octave_value_list& args, bool local_funcs); + + octave_value builtin_find (void); + + octave_value find_method (const std::string& dispatch_type); + + octave_value find_autoload (void); + + octave_value find_user_function (void); + + bool is_user_function_defined (void) const + { + return function_on_path.is_defined (); + } + + octave_value find_function (const octave_value_list& args, bool local_funcs) + { + return find (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.lock (); + } + + void unlock_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + p->second.unlock (); + } + + std::pair + subfunction_defined_in_scope (scope_id scope) const + { + scope_val_const_iterator p = subfunctions.find (scope); + + return p == subfunctions.end () + ? std::pair () + : std::pair (name, p->second); + } + + void erase_subfunction (scope_id scope) + { + scope_val_iterator p = subfunctions.find (scope); + + if (p != subfunctions.end ()) + subfunctions.erase (p); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name); + + void install_cmdline_function (const octave_value& f) + { + cmdline_function = f; + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + subfunctions[scope] = f; + } + + void install_user_function (const octave_value& f) + { + function_on_path = f; + } + + void install_built_in_function (const octave_value& f) + { + built_in_function = f; + } + + template + void + clear_unlocked (std::map& map) + { + typename std::map::iterator p = map.begin (); + + while (p != map.end ()) + { + if (p->second.islocked ()) + p++; + else + map.erase (p++); + } + } + + void clear_autoload_function (void) + { + if (! autoload_function.islocked ()) + autoload_function = octave_value (); + } + + // We also clear command line functions here, as these are both + // "user defined" + void clear_user_function (void) + { + if (! function_on_path.islocked ()) + { + function_on_path.erase_subfunctions (); + + function_on_path = octave_value (); + } + + if (! cmdline_function.islocked ()) + cmdline_function = octave_value (); + } + + void clear_mex_function (void) + { + if (function_on_path.is_mex_function ()) + clear_user_function (); + } + + void clear (void) + { + clear_unlocked (subfunctions); + clear_unlocked (private_functions); + clear_unlocked (class_constructors); + clear_unlocked (class_methods); + clear_autoload_function (); + clear_user_function (); + } + + void add_dispatch (const std::string& type, const std::string& fname) + { + dispatch_map[type] = fname; + } + + void clear_dispatch (const std::string& type) + { + dispatch_map_iterator p = dispatch_map.find (type); + + if (p != dispatch_map.end ()) + dispatch_map.erase (p); + } + + void print_dispatch (std::ostream& os) const; + + std::string help_for_dispatch (void) const; + + dispatch_map_type get_dispatch (void) const { return dispatch_map; } + + void dump (std::ostream& os, const std::string& prefix) const; + + std::string name; + + // Scope id to function object. + std::map subfunctions; + + // Directory name to function object. + std::map private_functions; + + // Class name to function object. + std::map class_constructors; + + // Dispatch type to function object. + std::map class_methods; + + // Legacy dispatch map (dispatch type name to function name). + dispatch_map_type dispatch_map; + + octave_value cmdline_function; + + octave_value autoload_function; + + octave_value function_on_path; + + octave_value built_in_function; + + octave_refcount count; + + private: + + octave_value xfind (const octave_value_list& args, bool local_funcs); + + octave_value x_builtin_find (void); + + // No copying! + + fcn_info_rep (const fcn_info_rep&); + + fcn_info_rep& operator = (const fcn_info_rep&); + }; + + public: + + fcn_info (const std::string& nm = std::string ()) + : rep (new fcn_info_rep (nm)) { } + + fcn_info (const fcn_info& fi) : rep (fi.rep) + { + rep->count++; + } + + fcn_info& operator = (const fcn_info& fi) + { + if (this != &fi) + { + if (--rep->count == 0) + delete rep; + + rep = fi.rep; + rep->count++; + } + + return *this; + } + + ~fcn_info (void) + { + if (--rep->count == 0) + delete rep; + } + + octave_value find (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find (args, local_funcs); + } + + octave_value builtin_find (void) + { + return rep->builtin_find (); + } + + octave_value find_method (const std::string& dispatch_type) const + { + return rep->find_method (dispatch_type); + } + + octave_value find_built_in_function (void) const + { + return rep->built_in_function; + } + + octave_value find_cmdline_function (void) const + { + return rep->cmdline_function; + } + + octave_value find_autoload (void) + { + return rep->find_autoload (); + } + + octave_value find_user_function (void) + { + return rep->find_user_function (); + } + + bool is_user_function_defined (void) const + { + return rep->is_user_function_defined (); + } + + octave_value find_function (const octave_value_list& args = octave_value_list (), + bool local_funcs = true) + { + return rep->find_function (args, local_funcs); + } + + void lock_subfunction (scope_id scope) + { + rep->lock_subfunction (scope); + } + + void unlock_subfunction (scope_id scope) + { + rep->unlock_subfunction (scope); + } + + std::pair + subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const + { + return rep->subfunction_defined_in_scope (scope); + } + + void erase_subfunction (scope_id scope) + { + rep->erase_subfunction (scope); + } + + void mark_subfunction_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + rep->mark_subfunction_in_scope_as_private (scope, class_name); + } + + void install_cmdline_function (const octave_value& f) + { + rep->install_cmdline_function (f); + } + + void install_subfunction (const octave_value& f, scope_id scope) + { + rep->install_subfunction (f, scope); + } + + void install_user_function (const octave_value& f) + { + rep->install_user_function (f); + } + + void install_built_in_function (const octave_value& f) + { + rep->install_built_in_function (f); + } + + void clear (void) { rep->clear (); } + + void clear_user_function (void) { rep->clear_user_function (); } + + void clear_autoload_function (void) { rep->clear_autoload_function (); } + + void clear_mex_function (void) { rep->clear_mex_function (); } + + void add_dispatch (const std::string& type, const std::string& fname) + { + rep->add_dispatch (type, fname); + } + + void clear_dispatch (const std::string& type) + { + rep->clear_dispatch (type); + } + + void print_dispatch (std::ostream& os) const + { + rep->print_dispatch (os); + } + + std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } + + dispatch_map_type get_dispatch (void) const + { + return rep->get_dispatch (); + } + + void + dump (std::ostream& os, const std::string& prefix = std::string ()) const + { + rep->dump (os, prefix); + } + + private: + + fcn_info_rep *rep; + }; + + static scope_id global_scope (void) { return xglobal_scope; } + static scope_id top_scope (void) { return xtop_scope; } + + static scope_id current_scope (void) { return xcurrent_scope; } + + static context_id current_context (void) { return xcurrent_context; } + + static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } + + static void set_scope (scope_id scope) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + all_instances[scope] = instance = inst; + } + else + instance = p->second; + + xcurrent_scope = scope; + xcurrent_context = 0; + } + } + + static void set_scope_and_context (scope_id scope, context_id context) + { + if (scope == xglobal_scope) + error ("can't set scope to global"); + else + { + if (scope != xcurrent_scope) + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + error ("scope not found!"); + else + { + instance = p->second; + + xcurrent_scope = scope; + + xcurrent_context = context; + } + } + else + xcurrent_context = context; + } + } + + static void erase_scope (scope_id scope) + { + assert (scope != xglobal_scope); + + all_instances_iterator p = all_instances.find (scope); + + if (p != all_instances.end ()) + { + delete p->second; + + all_instances.erase (p); + + free_scope (scope); + } + } + + static void erase_subfunctions_in_scope (scope_id scope) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.erase_subfunction (scope); + } + + static void + mark_subfunctions_in_scope_as_private (scope_id scope, + const std::string& class_name) + { + for (fcn_table_iterator q = fcn_table.begin (); + q != fcn_table.end (); q++) + q->second.mark_subfunction_in_scope_as_private (scope, class_name); + } + + static scope_id dup_scope (scope_id scope) + { + scope_id retval = -1; + + symbol_table *inst = get_instance (scope); + + if (inst) + { + scope_id new_scope = alloc_scope (); + + symbol_table *new_symbol_table = new symbol_table (scope); + + if (new_symbol_table) + { + all_instances[new_scope] = new_symbol_table; + + inst->do_dup_scope (*new_symbol_table); + + retval = new_scope; + } + } + + return retval; + } + + static std::list scopes (void) + { + return scope_id_cache::scopes (); + } + + static symbol_record + find_symbol (const std::string& name, scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_find_symbol (name) : + symbol_record (scope); + } + + static void + inherit (scope_id scope, scope_id donor_scope, context_id donor_context) + { + symbol_table *inst = get_instance (scope); + + if (inst) + { + symbol_table *donor_symbol_table = get_instance (donor_scope); + + if (donor_symbol_table) + inst->do_inherit (*donor_symbol_table, donor_context); + } + } + + static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } + + // Find a value corresponding to the given name in the table. + static octave_value + find (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool skip_variables = false, + bool local_funcs = true); + + static octave_value builtin_find (const std::string& name); + + // Insert a new name in the table. + static symbol_record& insert (const std::string& name) + { + static symbol_record foobar; + + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_insert (name) : foobar; + } + + static void force_variable (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_force_variable (name, context); + } + + static octave_value& varref (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + static octave_value foobar; + + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varref (name, context) : foobar; + } + + static octave_value varval (const std::string& name, + scope_id scope = xcurrent_scope, + context_id context = xdefault_context) + { + symbol_table *inst = get_instance (scope); + + return inst ? inst->do_varval (name, context) : octave_value (); + } + + static octave_value& + global_varref (const std::string& name) + { + global_table_iterator p = global_table.find (name); + + return (p == global_table.end ()) ? global_table[name] : p->second; + } + + static octave_value + global_varval (const std::string& name) + { + global_table_const_iterator p = global_table.find (name); + + return (p != global_table.end ()) ? p->second : octave_value (); + } + + static octave_value& + top_level_varref (const std::string& name) + { + return varref (name, top_scope (), 0); + } + + static octave_value + top_level_varval (const std::string& name) + { + return varval (name, top_scope (), 0); + } + + static octave_value& persistent_varref (const std::string& name) + { + static octave_value foobar; + + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varref (name) : foobar; + } + + static octave_value persistent_varval (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_persistent_varval (name) : octave_value (); + } + + static void erase_persistent (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_erase_persistent (name); + } + + static bool is_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_variable (name) : false; + } + + static bool + is_built_in_function_name (const std::string& name) + { + octave_value val = find_built_in_function (name); + + return val.is_defined (); + } + + static octave_value + find_method (const std::string& name, const std::string& dispatch_type) + { + fcn_table_const_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + return p->second.find_method (dispatch_type); + else + { + fcn_info finfo (name); + + octave_value fcn = finfo.find_method (dispatch_type); + + if (fcn.is_defined ()) + fcn_table[name] = finfo; + + return fcn; + } + } + + static octave_value + find_built_in_function (const std::string& name) + { + fcn_table_const_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_built_in_function () : octave_value (); + } + + static octave_value + find_autoload (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_autoload () : octave_value (); + } + + static octave_value + find_function (const std::string& name, + const octave_value_list& args = octave_value_list (), + bool local_funcs = true); + + static octave_value find_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + return (p != fcn_table.end ()) + ? p->second.find_user_function () : octave_value (); + } + + static void install_cmdline_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_cmdline_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_cmdline_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void install_subfunction (const std::string& name, + const octave_value& fcn, + scope_id scope) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_subfunction (fcn, scope); + } + else + { + fcn_info finfo (name); + + finfo.install_subfunction (fcn, scope); + + fcn_table[name] = finfo; + } + } + + static void install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope); + + static void update_nest (scope_id scope) + { + symbol_table *inst = get_instance (scope); + if (inst) + inst->do_update_nest (); + } + + static void install_user_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_user_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_user_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void install_built_in_function (const std::string& name, + const octave_value& fcn) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.install_built_in_function (fcn); + } + else + { + fcn_info finfo (name); + + finfo.install_built_in_function (fcn); + + fcn_table[name] = finfo; + } + } + + static void clear (const std::string& name) + { + clear_variable (name); + } + + static void clear_all (void) + { + clear_variables (); + + clear_global_pattern ("*"); + + clear_functions (); + } + + static void clear_variables (scope_id scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_variables (); + } + + // This is split for unwind_protect. + static void clear_variables (void) + { + clear_variables (xcurrent_scope); + } + + static void clear_objects (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_clear_objects (); + } + + static void unmark_forced_variables (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + + if (inst) + inst->do_unmark_forced_variables (); + } + + static void clear_functions (void) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + p->second.clear (); + } + + static void clear_function (const std::string& name) + { + clear_user_function (name); + } + + static void clear_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global (name); + } + + static void clear_variable (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable (name); + } + + static void clear_symbol (const std::string& name) + { + // FIXME -- are we supposed to do both here? + + clear_variable (name); + clear_function (name); + } + + static void clear_function_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + if (pattern.match (p->first)) + p->second.clear_user_function (); + } + } + + static void clear_global_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_global_pattern (pat); + } + + static void clear_variable_pattern (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_pattern (pat); + } + + static void clear_variable_regexp (const std::string& pat) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_clear_variable_regexp (pat); + } + + static void clear_symbol_pattern (const std::string& pat) + { + // FIXME -- are we supposed to do both here? + + clear_variable_pattern (pat); + clear_function_pattern (pat); + } + + static void clear_user_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_user_function (); + } + // FIXME -- is this necessary, or even useful? + // else + // error ("clear: no such function `%s'", name.c_str ()); + } + + // This clears oct and mex files, incl. autoloads. + static void clear_dld_function (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_autoload_function (); + finfo.clear_user_function (); + } + } + + static void clear_mex_functions (void) + { + for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) + { + fcn_info& finfo = p->second; + + finfo.clear_mex_function (); + } + } + + static bool set_class_relationship (const std::string& sup_class, + const std::string& inf_class); + + static bool is_superiorto (const std::string& a, const std::string& b); + + static void alias_built_in_function (const std::string& alias, + const std::string& name) + { + octave_value fcn = find_built_in_function (name); + + if (fcn.is_defined ()) + { + fcn_info finfo (alias); + + finfo.install_built_in_function (fcn); + + fcn_table[alias] = finfo; + } + else + panic ("alias: `%s' is undefined", name.c_str ()); + } + + static void add_dispatch (const std::string& name, const std::string& type, + const std::string& fname) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.add_dispatch (type, fname); + } + else + { + fcn_info finfo (name); + + finfo.add_dispatch (type, fname); + + fcn_table[name] = finfo; + } + } + + static void clear_dispatch (const std::string& name, const std::string& type) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.clear_dispatch (type); + } + } + + static void print_dispatch (std::ostream& os, const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + finfo.print_dispatch (os); + } + } + + static fcn_info::dispatch_map_type get_dispatch (const std::string& name) + { + fcn_info::dispatch_map_type retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.get_dispatch (); + } + + return retval; + } + + static std::string help_for_dispatch (const std::string& name) + { + std::string retval; + + fcn_table_iterator p = fcn_table.find (name); + + if (p != fcn_table.end ()) + { + fcn_info& finfo = p->second; + + retval = finfo.help_for_dispatch (); + } + + return retval; + } + + static void push_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::push_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_push_context (); + } + } + + static void pop_context (void) + { + if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) + error ("invalid call to xymtab::pop_context"); + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_pop_context (); + } + } + + // For unwind_protect. + static void pop_context (void *) { pop_context (); } + + static void mark_automatic (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_automatic (name); + } + + static void mark_hidden (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_hidden (name); + } + + static void mark_global (const std::string& name) + { + symbol_table *inst = get_instance (xcurrent_scope); + + if (inst) + inst->do_mark_global (name); + } + + static std::list + all_variables (scope_id scope = xcurrent_scope, + context_id context = xdefault_context, + bool defined_only = true) + { + symbol_table *inst = get_instance (scope); + + return inst + ? inst->do_all_variables (context, defined_only) : std::list (); + } + + static std::list glob (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern) : std::list (); + } + + static std::list regexp (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern) : std::list (); + } + + static std::list glob_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_glob (pattern, true) : std::list (); + } + + static std::list regexp_variables (const std::string& pattern) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_regexp (pattern, true) : std::list (); + } + + static std::list + glob_global_variables (const std::string& pattern) + { + std::list retval; + + glob_match pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from glob_variables and glob_global_variables + // may be handled the same way. + + if (pat.match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list + regexp_global_variables (const std::string& pattern) + { + std::list retval; + + ::regexp pat (pattern); + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + { + // We generate a list of symbol_record objects so that + // the results from regexp_variables and regexp_global_variables + // may be handled the same way. + + if (pat.is_match (p->first)) + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, + symbol_record::global)); + } + + return retval; + } + + static std::list glob_variables (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = glob_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list regexp_variables + (const string_vector& patterns) + { + std::list retval; + + size_t len = patterns.length (); + + for (size_t i = 0; i < len; i++) + { + std::list tmp = regexp_variables (patterns[i]); + + retval.insert (retval.begin (), tmp.begin (), tmp.end ()); + } + + return retval; + } + + static std::list user_function_names (void) + { + std::list retval; + + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + if (p->second.is_user_function_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list global_variable_names (void) + { + std::list retval; + + for (global_table_const_iterator p = global_table.begin (); + p != global_table.end (); p++) + retval.push_back (p->first); + + retval.sort (); + + return retval; + } + + static std::list top_level_variable_names (void) + { + symbol_table *inst = get_instance (xtop_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list variable_names (void) + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_variable_names () : std::list (); + } + + static std::list built_in_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_built_in_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static std::list cmdline_function_names (void) + { + std::list retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_cmdline_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + + static bool is_local_variable (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return false; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_local_variable (name) : false; + } + } + + static bool is_global (const std::string& name) + { + if (xcurrent_scope == xglobal_scope) + return true; + else + { + symbol_table *inst = get_instance (xcurrent_scope); + + return inst ? inst->do_is_global (name) : false; + } + } + + static void dump (std::ostream& os, scope_id scope = xcurrent_scope); + + static void dump_global (std::ostream& os); + + static void dump_functions (std::ostream& os); + + static void cache_name (scope_id scope, const std::string& name) + { + symbol_table *inst = get_instance (scope, false); + + if (inst) + inst->do_cache_name (name); + } + + static void lock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.lock_subfunction (scope); + } + + static void unlock_subfunctions (scope_id scope = xcurrent_scope) + { + for (fcn_table_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + p->second.unlock_subfunction (scope); + } + + static void free_scope (scope_id scope) + { + if (scope == xglobal_scope || scope == xtop_scope) + error ("can't free global or top-level scopes!"); + else + symbol_table::scope_id_cache::free (scope); + } + + static void stash_dir_name_for_subfunctions (scope_id scope, + const std::string& dir_name); + + static void add_to_parent_map (const std::string& classname, + const std::list& parent_list) + { + parent_map[classname] = parent_list; + } + + static std::list + parent_classes (const std::string& dispatch_type) + { + std::list retval; + + const_parent_map_iterator it = parent_map.find (dispatch_type); + + if (it != parent_map.end ()) + retval = it->second; + + for (std::list::const_iterator lit = retval.begin (); + lit != retval.end (); lit++) + { + // Search for parents of parents and append them to the list. + + // FIXME -- should we worry about a circular inheritance graph? + + std::list parents = parent_classes (*lit); + + if (! parents.empty ()) + retval.insert (retval.end (), parents.begin (), parents.end ()); + } + + return retval; + } + + static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) + { + symbol_table *inst = get_instance (scope); + return inst->curr_fcn; + } + + static void set_curr_fcn (octave_user_function *curr_fcn, + scope_id scope = xcurrent_scope) + { + assert (scope != xtop_scope && scope != xglobal_scope); + symbol_table *inst = get_instance (scope); + // FIXME: normally, functions should not usurp each other's scope. + // If for any incredible reason this is needed, call + // set_user_function (0, scope) first. This may cause problems with + // nested functions, as the curr_fcn of symbol_records must be updated. + assert (inst->curr_fcn == 0 || curr_fcn == 0); + inst->curr_fcn = curr_fcn; + } + + static void cleanup (void); + +private: + + // No copying! + + symbol_table (const symbol_table&); + + symbol_table& operator = (const symbol_table&); + + typedef std::map::const_iterator table_const_iterator; + typedef std::map::iterator table_iterator; + + typedef std::map::const_iterator global_table_const_iterator; + typedef std::map::iterator global_table_iterator; + + typedef std::map::const_iterator persistent_table_const_iterator; + typedef std::map::iterator persistent_table_iterator; + + typedef std::map::const_iterator all_instances_const_iterator; + typedef std::map::iterator all_instances_iterator; + + typedef std::map::const_iterator fcn_table_const_iterator; + typedef std::map::iterator fcn_table_iterator; + + // The scope of this symbol table. + scope_id my_scope; + + // Name for this table (usually the file name of the function + // corresponding to the scope); + std::string table_name; + + // Map from symbol names to symbol info. + std::map table; + + // Child nested functions. + std::vector nest_children; + + // Parent nested function (may be null). + symbol_table *nest_parent; + + // The associated user code (may be null). + octave_user_function *curr_fcn; + + // Map from names of global variables to values. + static std::map global_table; + + // Map from names of persistent variables to values. + std::map persistent_table; + + // Pointer to symbol table for current scope (variables only). + static symbol_table *instance; + + // Map from scope id to symbol table instances. + static std::map all_instances; + + // Map from function names to function info (subfunctions, private + // functions, class constructors, class methods, etc.) + static std::map fcn_table; + + // Mape from class names to set of classes that have lower + // precedence. + static std::map > class_precedence_table; + + typedef std::map >::const_iterator class_precedence_table_const_iterator; + typedef std::map >::iterator class_precedence_table_iterator; + + // Map from class names to parent class names. + static std::map > parent_map; + + typedef std::map >::const_iterator const_parent_map_iterator; + typedef std::map >::iterator parent_map_iterator; + + static const scope_id xglobal_scope; + static const scope_id xtop_scope; + + static scope_id xcurrent_scope; + + static context_id xcurrent_context; + + static const context_id xdefault_context = static_cast (-1); + + symbol_table (scope_id scope) + : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), + curr_fcn (0), persistent_table () { } + + ~symbol_table (void) { } + + static symbol_table *get_instance (scope_id scope, bool create = true) + { + symbol_table *retval = 0; + + bool ok = true; + + if (scope != xglobal_scope) + { + if (scope == xcurrent_scope) + { + if (! instance && create) + { + symbol_table *inst = new symbol_table (scope); + + if (inst) + { + all_instances[scope] = instance = inst; + + if (scope == xtop_scope) + instance->do_cache_name ("top-level"); + } + } + + if (! instance) + ok = false; + + retval = instance; + } + else + { + all_instances_iterator p = all_instances.find (scope); + + if (p == all_instances.end ()) + { + if (create) + { + retval = new symbol_table (scope); + + if (retval) + all_instances[scope] = retval; + else + ok = false; + } + else + ok = false; + } + else + retval = p->second; + } + } + + if (! ok) + error ("unable to %s symbol_table object for scope %d!", + create ? "create" : "find", scope); + + return retval; + } + + void add_nest_child (symbol_table& st) + { + assert (!st.nest_parent); + nest_children.push_back (&st); + st.nest_parent = this; + } + + void insert_symbol_record (const symbol_record& sr) + { + table[sr.name ()] = sr; + } + + void + do_dup_scope (symbol_table& new_symbol_table) const + { + for (table_const_iterator p = table.begin (); p != table.end (); p++) + new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); + } + + symbol_record do_find_symbol (const std::string& name) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + return do_insert (name); + else + return p->second; + } + + void do_inherit (symbol_table& donor_table, context_id donor_context) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (! (sr.is_automatic () || sr.is_formal ())) + { + std::string nm = sr.name (); + + if (nm != "__retval__") + { + octave_value val = donor_table.do_varval (nm, donor_context); + + if (val.is_defined ()) + { + sr.varref (0) = val; + + sr.mark_inherited (); + } + } + } + } + } + + static fcn_info *get_fcn_info (const std::string& name) + { + fcn_table_iterator p = fcn_table.find (name); + return p != fcn_table.end () ? &p->second : 0; + } + + octave_value + do_find (const std::string& name, const octave_value_list& args, + bool skip_variables, bool local_funcs); + + octave_value do_builtin_find (const std::string& name); + + symbol_record& do_insert (const std::string& name) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record parent_symbol; + + if (nest_parent && nest_parent->look_nonlocal (name, parent_symbol)) + return table[name] = parent_symbol; + else + return table[name] = symbol_record (my_scope, name, octave_value ()); + } + else + return p->second; + } + + void do_force_variable (const std::string& name, context_id context) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name); + + sr.force_variable (context); + } + else + p->second.force_variable (context); + } + + octave_value& do_varref (const std::string& name, context_id context) + { + table_iterator p = table.find (name); + + if (p == table.end ()) + { + symbol_record& sr = do_insert (name); + + return sr.varref (context); + } + else + return p->second.varref (context); + } + + octave_value do_varval (const std::string& name, context_id context) const + { + table_const_iterator p = table.find (name); + + return (p != table.end ()) ? p->second.varval (context) : octave_value (); + } + + octave_value& do_persistent_varref (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + return (p == persistent_table.end ()) + ? persistent_table[name] : p->second; + } + + octave_value do_persistent_varval (const std::string& name) + { + persistent_table_const_iterator p = persistent_table.find (name); + + return (p != persistent_table.end ()) ? p->second : octave_value (); + } + + void do_erase_persistent (const std::string& name) + { + persistent_table_iterator p = persistent_table.find (name); + + if (p != persistent_table.end ()) + persistent_table.erase (p); + } + + bool do_is_variable (const std::string& name) const + { + bool retval = false; + + table_const_iterator p = table.find (name); + + if (p != table.end ()) + { + const symbol_record& sr = p->second; + + retval = sr.is_variable (); + } + + return retval; + } + + void do_push_context (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.push_context (my_scope); + } + + void do_pop_context (void) + { + for (table_iterator p = table.begin (); p != table.end (); ) + { + if (p->second.pop_context (my_scope) == 0) + table.erase (p++); + else + p++; + } + } + + void do_clear_variables (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.clear (my_scope); + } + + void do_clear_objects (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + octave_value& val = sr.varref (); + if (val.is_object ()) + p->second.clear (my_scope); + } + } + + void do_unmark_forced_variables (void) + { + for (table_iterator p = table.begin (); p != table.end (); p++) + p->second.unmark_forced (); + } + + void do_clear_global (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + { + symbol_record& sr = p->second; + + if (sr.is_global ()) + sr.unmark_global (); + } + + global_table_iterator q = global_table.find (name); + + if (q != global_table.end ()) + global_table.erase (q); + + } + + void do_clear_variable (const std::string& name) + { + table_iterator p = table.find (name); + + if (p != table.end ()) + p->second.clear (my_scope); + } + + void do_clear_global_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_global () && pattern.match (sr.name ())) + sr.unmark_global (); + } + + + for (global_table_iterator q = global_table.begin (); + q != global_table.end ();) + { + if (pattern.match (q->first)) + global_table.erase (q++); //Gotta be careful to not + //invalidate iterators + else + q++; + } + + + } + + void do_clear_variable_pattern (const std::string& pat) + { + glob_match pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_clear_variable_regexp (const std::string& pat) + { + ::regexp pattern (pat); + + for (table_iterator p = table.begin (); p != table.end (); p++) + { + symbol_record& sr = p->second; + + if (sr.is_defined () || sr.is_global ()) + { + if (pattern.is_match (sr.name ())) + sr.clear (my_scope); + } + } + } + + void do_mark_automatic (const std::string& name) + { + do_insert (name).mark_automatic (); + } + + void do_mark_hidden (const std::string& name) + { + do_insert (name).mark_hidden (); + } + + void do_mark_global (const std::string& name) + { + do_insert (name).mark_global (); + } + + std::list + do_all_variables (context_id context, bool defined_only) const + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + const symbol_record& sr = p->second; + + if (defined_only && ! sr.is_defined (context)) + continue; + + retval.push_back (sr); + } + + return retval; + } + + std::list do_glob (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + glob_match pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_regexp (const std::string& pattern, + bool vars_only = false) const + { + std::list retval; + + ::regexp pat (pattern); + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (pat.is_match (p->first)) + { + const symbol_record& sr = p->second; + + if (vars_only && ! sr.is_variable ()) + continue; + + retval.push_back (sr); + } + } + + return retval; + } + + std::list do_variable_names (void) + { + std::list retval; + + for (table_const_iterator p = table.begin (); p != table.end (); p++) + { + if (p->second.is_variable ()) + retval.push_back (p->first); + } + + retval.sort (); + + return retval; + } + + static std::map + subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) + { + std::map retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + std::pair tmp + = p->second.subfunction_defined_in_scope (scope); + + std::string nm = tmp.first; + + if (! nm.empty ()) + retval[nm] = tmp.second; + } + + return retval; + } + + bool do_is_local_variable (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return (p != table.end () + && ! p->second.is_global () + && p->second.is_defined ()); + } + + bool do_is_global (const std::string& name) const + { + table_const_iterator p = table.find (name); + + return p != table.end () && p->second.is_global (); + } + + void do_dump (std::ostream& os); + + void do_cache_name (const std::string& name) { table_name = name; } + + void do_update_nest (void); + + bool look_nonlocal (const std::string& name, symbol_record& result) + { + table_iterator p = table.find (name); + if (p == table.end ()) + { + if (nest_parent) + return nest_parent->look_nonlocal (name, result); + } + else if (! p->second.is_automatic ()) + { + result = p->second; + return true; + } + + return false; + } +}; + +extern bool out_of_date_check (octave_value& function, + const std::string& dispatch_type = std::string (), + bool check_relative = true); + +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args); +extern OCTINTERP_API std::string +get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/sysdep.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sysdep.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,905 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include + +#include +#include + +#if defined (HAVE_TERMIOS_H) +#include +#elif defined (HAVE_TERMIO_H) +#include +#elif defined (HAVE_SGTTY_H) +#include +#endif + +#if defined (HAVE_CONIO_H) +#include +#endif + +#if defined (HAVE_SYS_IOCTL_H) +#include +#endif + +#if defined (HAVE_FLOATINGPOINT_H) +#include +#endif + +#if defined (HAVE_IEEEFP_H) +#include +#endif + +#include "cmd-edit.h" +#include "file-ops.h" +#include "lo-mappers.h" +#include "lo-math.h" +#include "mach-info.h" +#include "oct-env.h" +#include "quit.h" + +#include "Cell.h" +#include "defun.h" +#include "error.h" +#include "input.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "toplev.h" +#include "utils.h" +#include "file-stat.h" + +#ifndef STDIN_FILENO +#define STDIN_FILENO 1 +#endif + +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) +static void +BSD_init (void) +{ +#if defined (HAVE_FLOATINGPOINT_H) + // Disable trapping on common exceptions. +#ifndef FP_X_DNML +#define FP_X_DNML 0 +#endif + fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); +#endif +} +#endif + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + +#define WIN32_LEAN_AND_MEAN +#include + +static void +w32_set_octave_home (void) +{ + std::string bin_dir; + + HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE +#ifdef TH32CS_SNAPMODULE32 + | TH32CS_SNAPMODULE32 +#endif + , 0); + + if (h != INVALID_HANDLE_VALUE) + { + MODULEENTRY32 mod_info; + + ZeroMemory (&mod_info, sizeof (mod_info)); + mod_info.dwSize = sizeof (mod_info); + + if (Module32First (h, &mod_info)) + { + do + { + std::string mod_name (mod_info.szModule); + + if (mod_name.find ("octinterp") != std::string::npos) + { + bin_dir = mod_info.szExePath; + if (bin_dir[bin_dir.length () - 1] != '\\') + bin_dir.append (1, '\\'); + break; + } + } + while (Module32Next (h, &mod_info)); + } + + CloseHandle (h); + } + + if (! bin_dir.empty ()) + { + size_t pos = bin_dir.rfind ("\\bin\\"); + + if (pos != std::string::npos) + octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); + } +} + +void +w32_set_quiet_shutdown (void) +{ + // Let the user close the console window or shutdown without the + // pesky dialog. + // + // FIXME -- should this be user configurable? + SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); +} + +void +MINGW_signal_cleanup (void) +{ + w32_set_quiet_shutdown (); + + w32_raise_final (); +} +#endif + +#if defined (__MINGW32__) +static void +MINGW_init (void) +{ + w32_set_octave_home (); + + // Init mutex to protect setjmp/longjmp and get main thread context + w32_sigint_init (); + + w32_set_quiet_shutdown (); +} +#endif + +#if defined (_MSC_VER) +static void +MSVC_init (void) +{ + w32_set_octave_home (); + + // Init mutex to protect setjmp/longjmp and get main thread context + w32_sigint_init (); + + w32_set_quiet_shutdown (); +} +#endif + + +// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. + +bool +same_file_internal (const std::string& file1, const std::string& file2) +{ +#ifdef OCTAVE_USE_WINDOWS_API + + bool retval = false; + + // Windows native code + // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx + + HANDLE hfile1 = CreateFile (file1.c_str (), 0, FILE_SHARE_READ, 0, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if (hfile1 != INVALID_HANDLE_VALUE) + { + HANDLE hfile2 = CreateFile (file2.c_str (), 0, FILE_SHARE_READ, 0, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + + if (hfile2 != INVALID_HANDLE_VALUE) + { + BY_HANDLE_FILE_INFORMATION hfi1; + BY_HANDLE_FILE_INFORMATION hfi2; + + if (GetFileInformationByHandle (hfile1, &hfi1) + && GetFileInformationByHandle (hfile2, &hfi2)) + + retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber + && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh + && hfi1.nFileIndexLow == hfi2.nFileIndexLow); + + CloseHandle (hfile2); + } + + CloseHandle (hfile1); + } + + return retval; + +#else + + // POSIX Code + + file_stat fs_file1 (file1); + file_stat fs_file2 (file2); + + return (fs_file1 && fs_file2 + && fs_file1.ino () == fs_file2.ino () + && fs_file1.dev () == fs_file2.dev ()); + +#endif +} + +void +sysdep_init (void) +{ +#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) + BSD_init (); +#elif defined (__MINGW32__) + MINGW_init (); +#elif defined (_MSC_VER) + MSVC_init (); +#endif +} + +void +sysdep_cleanup (void) +{ + MINGW_SIGNAL_CLEANUP (); +} + +// Set terminal in raw mode. From less-177. +// +// Change terminal to "raw mode", or restore to "normal" mode. +// "Raw mode" means +// 1. An outstanding read will complete on receipt of a single keystroke. +// 2. Input is not echoed. +// 3. On output, \n is mapped to \r\n. +// 4. \t is NOT expanded into spaces. +// 5. Signal-causing characters such as ctrl-C (interrupt), +// etc. are NOT disabled. +// It doesn't matter whether an input \n is mapped to \r, or vice versa. + +void +raw_mode (bool on, bool wait) +{ + static bool curr_on = false; + + int tty_fd = STDIN_FILENO; + if (! gnulib::isatty (tty_fd)) + { + if (interactive) + error ("stdin is not a tty!"); + return; + } + + if (on == curr_on) + return; + +#if defined (HAVE_TERMIOS_H) + { + struct termios s; + static struct termios save_term; + + if (on) + { + // Get terminal modes. + + tcgetattr (tty_fd, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + s.c_cc[VTIME] = 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); + } +#elif defined (HAVE_TERMIO_H) + { + struct termio s; + static struct termio save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TCGETA, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + + // Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = wait ? 1 : 0; + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TCSETAW, &s); + } +#elif defined (HAVE_SGTTY_H) + { + struct sgttyb s; + static struct sgttyb save_term; + + if (on) + { + // Get terminal modes. + + ioctl (tty_fd, TIOCGETP, &s); + + // Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.sg_ospeed; +// erase_char = s.sg_erase; +// kill_char = s.sg_kill; + + // Set the modes to the way we want them. + + s.sg_flags |= CBREAK; + s.sg_flags &= ~(ECHO); + } + else + { + // Restore saved modes. + + s = save_term; + } + + ioctl (tty_fd, TIOCSETN, &s); + } +#else + warning ("no support for raw mode console I/O on this system"); + + // Make sure the current mode doesn't toggle. + on = curr_on; +#endif + + curr_on = on; +} + +FILE * +octave_popen (const char *command, const char *mode) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + if (mode && mode[0] && ! mode[1]) + { + char tmode[3]; + tmode[0] = mode[0]; + tmode[1] = 'b'; + tmode[2] = 0; + + return _popen (command, tmode); + } + else + return _popen (command, mode); +#else + return popen (command, mode); +#endif +} + +int +octave_pclose (FILE *f) +{ +#if defined (__MINGW32__) || defined (_MSC_VER) + return _pclose (f); +#else + return pclose (f); +#endif +} + +// Read one character from the terminal. + +int +octave_kbhit (bool wait) +{ +#ifdef HAVE__KBHIT + int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); +#else + raw_mode (true, wait); + + // Get current handler. + octave_interrupt_handler saved_interrupt_handler + = octave_ignore_interrupts (); + + // Restore it, disabling system call restarts (if possible) so the + // read can be interrupted. + + octave_set_interrupt_handler (saved_interrupt_handler, false); + + int c = std::cin.get (); + + if (std::cin.fail () || std::cin.eof ()) + std::cin.clear (); + + // Restore it, enabling system call restarts (if possible). + octave_set_interrupt_handler (saved_interrupt_handler, true); + + raw_mode (false, true); +#endif + + return c; +} + +std::string +get_P_tmpdir (void) +{ +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) + + std::string retval; + +#if defined (P_tmpdir) + retval = P_tmpdir; +#endif + + // Apparently some versions of MinGW and MSVC either don't define + // P_tmpdir, or they define it to a single backslash, neither of which + // is particularly helpful. + + if (retval.empty () || retval == "\\") + { + retval = octave_env::getenv ("TEMP"); + + if (retval.empty ()) + retval = octave_env::getenv ("TMP"); + + if (retval.empty ()) + retval = "c:\\temp"; + } + + return retval; + +#elif defined (P_tmpdir) + + return P_tmpdir; + +#else + + return "/tmp"; + +#endif +} + +DEFUN (clc, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} clc ()\n\ +@deftypefnx {Built-in Function} {} home ()\n\ +Clear the terminal screen and move the cursor to the upper left corner.\n\ +@end deftypefn") +{ + command_editor::clear_screen (); + + return octave_value_list (); +} + +DEFALIAS (home, clc); + +DEFUN (getenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} getenv (@var{var})\n\ +Return the value of the environment variable @var{var}. For example,\n\ +\n\ +@example\n\ +getenv (\"PATH\")\n\ +@end example\n\ +\n\ +@noindent\n\ +returns a string containing the value of your path.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = octave_env::getenv (name); + } + else + print_usage (); + + return retval; +} + +DEFUN (putenv, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ +@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ +Set the value of the environment variable @var{var} to @var{value}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 1) + { + std::string var = args(0).string_value (); + + if (! error_state) + { + std::string val = (nargin == 2 + ? args(1).string_value () : std::string ()); + + if (! error_state) + octave_env::putenv (var, val); + else + error ("putenv: VALUE must be a string"); + } + else + error ("putenv: VAR must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFALIAS (setenv, putenv); + +/* +%!assert (ischar (getenv ("OCTAVE_HOME"))) +%!test +%! setenv ("dummy_variable_that_cannot_matter", "foobar"); +%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); +*/ + +// FIXME -- perhaps kbhit should also be able to print a prompt? + +DEFUN (kbhit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} kbhit ()\n\ +Read a single keystroke from the keyboard. If called with one\n\ +argument, don't wait for a keypress. For example,\n\ +\n\ +@example\n\ +x = kbhit ();\n\ +@end example\n\ +\n\ +@noindent\n\ +will set @var{x} to the next character typed at the keyboard as soon as\n\ +it is typed.\n\ +\n\ +@example\n\ +x = kbhit (1);\n\ +@end example\n\ +\n\ +@noindent\n\ +identical to the above example, but don't wait for a keypress,\n\ +returning the empty string if no key is available.\n\ +@end deftypefn") +{ + octave_value retval; + + // FIXME -- add timeout and default value args? + + if (interactive || forced_interactive) + { + feval ("drawnow"); + + int c = octave_kbhit (args.length () == 0); + + if (c == -1) + c = 0; + + char *s = new char [2]; + s[0] = c; + s[1] = '\0'; + retval = s; + } + + return retval; +} + +DEFUN (pause, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ +Suspend the execution of the program. If invoked without any arguments,\n\ +Octave waits until you type a character. With a numeric argument, it\n\ +pauses for the given number of seconds. For example, the following\n\ +statement prints a message and then waits 5 seconds before clearing the\n\ +screen.\n\ +\n\ +@example\n\ +@group\n\ +fprintf (stderr, \"wait please...\\n\");\n\ +pause (5);\n\ +clc;\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (! (nargin == 0 || nargin == 1)) + { + print_usage (); + return retval; + } + + if (nargin == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (! xisnan (dval)) + { + feval ("drawnow"); + + if (xisinf (dval)) + { + flush_octave_stdout (); + octave_kbhit (); + } + else + octave_sleep (dval); + } + else + warning ("pause: NaN is an invalid delay"); + } + } + else + { + feval ("drawnow"); + flush_octave_stdout (); + octave_kbhit (); + } + + return retval; +} + +/* +%!test +%! pause (1); + +%!error (pause (1, 2)) +*/ + +DEFUN (sleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ +Suspend the execution of the program for the given number of seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("sleep: NaN is an invalid delay"); + else + { + feval ("drawnow"); + octave_sleep (dval); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! sleep (1); + +%!error (sleep ()) +%!error (sleep (1, 2)) +*/ + +DEFUN (usleep, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ +Suspend the execution of the program for the given number of\n\ +microseconds. On systems where it is not possible to sleep for periods\n\ +of time less than one second, @code{usleep} will pause the execution for\n\ +@code{round (@var{microseconds} / 1e6)} seconds.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + double dval = args(0).double_value (); + + if (! error_state) + { + if (xisnan (dval)) + warning ("usleep: NaN is an invalid delay"); + else + { + feval ("drawnow"); + + int delay = NINT (dval); + + if (delay > 0) + octave_usleep (delay); + } + } + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! usleep (1000); + +%!error (usleep ()) +%!error (usleep (1, 2)) +*/ + +// FIXME -- maybe this should only return 1 if IEEE floating +// point functions really work. + +DEFUN (isieee, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isieee ()\n\ +Return true if your computer @emph{claims} to conform to the IEEE standard\n\ +for floating point calculations. No actual tests are performed.\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian + || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); +} + +/* +%!assert (islogical (isieee ())) +*/ + +DEFUN (native_float_format, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} native_float_format ()\n\ +Return the native floating point format as a string\n\ +@end deftypefn") +{ + oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); + + return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); +} + +/* +%!assert (ischar (native_float_format ())) +*/ + +DEFUN (tilde_expand, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ +Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ +tilde character, (@samp{~}), all of the characters preceding the first\n\ +slash (or all characters, if there is no slash) are treated as a\n\ +possible user name, and the tilde and the following characters up to the\n\ +slash are replaced by the home directory of the named user. If the\n\ +tilde is followed immediately by a slash, the tilde is replaced by the\n\ +home directory of the user running Octave. For example:\n\ +\n\ +@example\n\ +@group\n\ +tilde_expand (\"~joeuser/bin\")\n\ + @result{} \"/home/joeuser/bin\"\n\ +tilde_expand (\"~/bin\")\n\ + @result{} \"/home/jwe/bin\"\n\ +@end group\n\ +@end example\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + octave_value arg = args(0); + + string_vector sv = arg.all_strings (); + + if (! error_state) + { + sv = file_ops::tilde_expand (sv); + + if (arg.is_cellstr ()) + retval = Cell (arg.dims (), sv); + else + retval = sv; + } + else + error ("tilde_expand: expecting argument to be char or cellstr object"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isempty (getenv ("HOME"))) +%! setenv ("HOME", "foobar"); +%! endif +%! home = getenv ("HOME"); +%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); +%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); +%! assert (tilde_expand ("foo/bar"), "foo/bar"); +*/ diff -r 069c552587a0 -r 959953dba519 src/interpfcn/sysdep.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/sysdep.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,58 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_sysdep_h) +#define octave_sysdep_h 1 + +#include + +#include + +#include "lo-ieee.h" +#include "lo-sysdep.h" + +extern void sysdep_init (void); + +extern void sysdep_cleanup (void); + +extern OCTINTERP_API void raw_mode (bool, bool wait = true); + +extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); +extern OCTINTERP_API int octave_pclose (FILE *f); + +extern OCTINTERP_API int octave_kbhit (bool wait = true); + +extern OCTINTERP_API std::string get_P_tmpdir (void); + +extern void w32_set_quiet_shutdown (void); + +#if defined (__WIN32__) && ! defined (_POSIX_VERSION) +extern void MINGW_signal_cleanup (void); +#define USE_W32_SIGINT 1 +#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () +#else +#define MINGW_SIGNAL_CLEANUP() do { } while (0) +#endif + +extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/toplev.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/toplev.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1537 @@ +/* + +Copyright (C) 1995-2012 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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "lo-error.h" +#include "lo-mappers.h" +#include "oct-env.h" +#include "oct-locbuf.h" +#include "quit.h" +#include "singleton-cleanup.h" +#include "str-vec.h" + +#include "defaults.h" +#include "defun.h" +#include "error.h" +#include "file-io.h" +#include "graphics.h" +#include "input.h" +#include "lex.h" +#include "oct-conf.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "pager.h" +#include "parse.h" +#include "pathsearch.h" +#include "procstream.h" +#include "pt-eval.h" +#include "pt-jump.h" +#include "pt-stmt.h" +#include "sighandlers.h" +#include "sysdep.h" +#include "syswait.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" +#include "version.h" + +void (*octave_exit) (int) = ::exit; + +// TRUE means the quit() call is allowed. +bool quit_allowed = true; + +// TRUE means we are exiting via the builtin exit or quit functions. +bool quitting_gracefully = false; +// This stores the exit status. +int exit_status = 0; + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +bool octave_interpreter_ready = false; + +// TRUE means we've processed all the init code and we are good to go. +bool octave_initialized = false; + +// Current command to execute. +tree_statement_list *global_command = 0; + +octave_call_stack *octave_call_stack::instance = 0; + +void +octave_call_stack::create_instance (void) +{ + instance = new octave_call_stack (); + + if (instance) + { + instance->do_push (0, symbol_table::top_scope (), 0); + + singleton_cleanup_list::add (cleanup_instance); + } +} + +int +octave_call_stack::do_current_line (void) const +{ + tree_statement *stmt = do_current_statement (); + + return stmt ? stmt->line () : -1; +} + +int +octave_call_stack::do_current_column (void) const +{ + tree_statement *stmt = do_current_statement (); + + return stmt ? stmt->column () : -1; +} + +int +octave_call_stack::do_caller_user_code_line (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + tree_statement *stmt = elt.stmt; + + if (stmt) + { + retval = stmt->line (); + break; + } + } + } + + return retval; +} + +int +octave_call_stack::do_caller_user_code_column (void) const +{ + int retval = -1; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + tree_statement *stmt = elt.stmt; + + if (stmt) + { + retval = stmt->column (); + break; + } + } + } + + return retval; +} + +size_t +octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const +{ + size_t retval = 0; + + curr_user_frame = 0; + + // Look for the caller of dbstack. + size_t frame = cs[curr_frame].prev; + + bool found = false; + + size_t k = cs.size (); + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + octave_function *f = (*p).fcn; + + if (--k == frame) + found = true; + + if (f && f->is_user_code ()) + { + if (! found) + curr_user_frame++; + + retval++; + } + } + + // We counted how many user frames were not the one, in reverse. + // Now set curr_user_frame to be the index in the other direction. + curr_user_frame = retval - curr_user_frame - 1; + + return retval; +} + +octave_user_code * +octave_call_stack::do_caller_user_code (size_t nskip) const +{ + octave_user_code *retval = 0; + + const_iterator p = cs.end (); + + while (p != cs.begin ()) + { + const call_stack_elt& elt = *(--p); + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + retval = dynamic_cast (f); + break; + } + } + } + + return retval; +} + +// Use static fields for the best efficiency. +// NOTE: C++0x will allow these two to be merged into one. +static const char *bt_fieldnames[] = { "file", "name", "line", + "column", "scope", "context", 0 }; +static const octave_fields bt_fields (bt_fieldnames); + +octave_map +octave_call_stack::empty_backtrace (void) +{ + return octave_map (dim_vector (0, 1), bt_fields); +} + +octave_map +octave_call_stack::do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const +{ + size_t user_code_frames = do_num_user_code_frames (curr_user_frame); + + size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; + + // Our list is reversed. + curr_user_frame = nframes - curr_user_frame - 1; + + octave_map retval (dim_vector (nframes, 1), bt_fields); + + Cell& file = retval.contents (0); + Cell& name = retval.contents (1); + Cell& line = retval.contents (2); + Cell& column = retval.contents (3); + Cell& scope = retval.contents (4); + Cell& context = retval.contents (5); + + if (nframes > 0) + { + int k = 0; + + for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) + { + const call_stack_elt& elt = *p; + + octave_function *f = elt.fcn; + + if (f && f->is_user_code ()) + { + if (nskip > 0) + nskip--; + else + { + scope(k) = elt.scope; + context(k) = elt.context; + + file(k) = f->fcn_file_name (); + std::string parent_fcn_name = f->parent_fcn_name (); + if (parent_fcn_name == std::string ()) + name(k) = f->name (); + else + name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); + + tree_statement *stmt = elt.stmt; + + if (stmt) + { + line(k) = stmt->line (); + column(k) = stmt->column (); + } + else + { + line(k) = -1; + column(k) = -1; + } + + k++; + } + } + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame (size_t n, bool verbose) +{ + bool retval = false; + + if (n < cs.size ()) + { + retval = true; + + curr_frame = n; + + const call_stack_elt& elt = cs[n]; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + octave_function *f = elt.fcn; + std::string nm = f ? f->name () : std::string (""); + + tree_statement *s = elt.stmt; + int l = -1; + int c = -1; + if (s) + { + l = s->line (); + c = s->column (); + } + + octave_stdout << "stopped in " << nm + << " at line " << l << " column " << c + << " (" << elt.scope << "[" << elt.context << "])" + << std::endl; + } + } + + return retval; +} + +bool +octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) +{ + bool retval = false; + + int incr = 0; + + if (nskip < 0) + incr = -1; + else if (nskip > 0) + incr = 1; + + // Start looking with the caller of dbup/dbdown/keyboard. + size_t frame = cs[curr_frame].prev; + + while (true) + { + if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) + break; + + frame += incr; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (nskip > 0) + nskip--; + else if (nskip < 0) + nskip++; + + if (nskip == 0) + { + curr_frame = frame; + cs[cs.size () - 1].prev = curr_frame; + + symbol_table::set_scope_and_context (elt.scope, elt.context); + + if (verbose) + { + std::ostringstream buf; + + if (f) + { + tree_statement *s = elt.stmt; + + int l = s ? s->line () : -1; + + buf << "stopped in " << f->name () + << " at line " << l << std::endl; + } + else + buf << "at top level" << std::endl; + + octave_stdout << buf.str (); + } + + retval = true; + break; + } + } + + // There is no need to set scope and context here. That will + // happen when the dbup/dbdown/keyboard frame is popped and we + // jump to the new "prev" frame set above. + } + + return retval; +} + +void +octave_call_stack::do_goto_caller_frame (void) +{ + size_t frame = curr_frame; + + bool skipped = false; + + while (frame != 0) + { + frame = cs[frame].prev; + + const call_stack_elt& elt = cs[frame]; + + octave_function *f = elt.fcn; + + if (frame == 0 || (f && f->is_user_code ())) + { + if (! skipped) + // We found the current user code frame, so skip it. + skipped = true; + else + { + // We found the caller user code frame. + call_stack_elt tmp (elt); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); + + break; + } + } + } +} + +void +octave_call_stack::do_goto_base_frame (void) +{ + call_stack_elt tmp (cs[0]); + tmp.prev = curr_frame; + + curr_frame = cs.size (); + + cs.push_back (tmp); + + symbol_table::set_scope_and_context (tmp.scope, tmp.context); +} + +void +octave_call_stack::do_backtrace_error_message (void) const +{ + if (error_state > 0) + { + error_state = -1; + + error ("called from:"); + } + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs.back (); + + octave_function *fcn = elt.fcn; + tree_statement *stmt = elt.stmt; + + std::string fcn_name = "?unknown?"; + + if (fcn) + { + fcn_name = fcn->fcn_file_name (); + + if (fcn_name.empty ()) + fcn_name = fcn->name (); + } + + int line = stmt ? stmt->line () : -1; + int column = stmt ? stmt->column () : -1; + + error (" %s at line %d, column %d", + fcn_name.c_str (), line, column); + } +} + +void +recover_from_exception (void) +{ + can_interrupt = true; + octave_interrupt_immediately = 0; + octave_interrupt_state = 0; + octave_signal_caught = 0; + octave_exception_state = octave_no_exception; + octave_restore_signal_mask (); + octave_catch_interrupts (); +} + +int +main_loop (void) +{ + octave_save_signal_mask (); + + can_interrupt = true; + + octave_signal_hook = octave_signal_handler; + octave_interrupt_hook = 0; + octave_bad_alloc_hook = 0; + + octave_catch_interrupts (); + + octave_initialized = true; + + // The big loop. + + int retval = 0; + do + { + try + { + unwind_protect frame; + + reset_error_handler (); + + reset_parser (); + + if (symbol_table::at_top_level ()) + tree_evaluator::reset_debug_state (); + + // Do this with an unwind-protect cleanup function so that + // the forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + frame.protect_var (global_command); + + global_command = 0; + + // This is the same as yyparse in parse.y. + retval = octave_parse (); + + if (retval == 0) + { + if (global_command) + { + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of + // an interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); + + global_command->accept (*current_evaluator); + + octave_quit (); + + if (! (interactive || forced_interactive)) + { + bool quit = (tree_return_command::returning + || tree_break_command::breaking); + + if (tree_return_command::returning) + tree_return_command::returning = 0; + + if (tree_break_command::breaking) + tree_break_command::breaking--; + + if (quit) + break; + } + + if (error_state) + { + if (! (interactive || forced_interactive)) + { + // We should exit with a non-zero status. + retval = 1; + break; + } + } + else + { + if (octave_completion_matches_called) + octave_completion_matches_called = false; + else + command_editor::increment_current_command_number (); + } + } + else if (parser_end_of_input) + break; + } + } + catch (octave_interrupt_exception) + { + recover_from_exception (); + octave_stdout << "\n"; + if (quitting_gracefully) + { + clean_up_and_exit (exit_status); + break; // If user has overriden the exit func. + } + } + catch (octave_execution_exception) + { + recover_from_exception (); + std::cerr + << "error: unhandled execution exception -- trying to return to prompt" + << std::endl; + } + catch (std::bad_alloc) + { + recover_from_exception (); + std::cerr + << "error: memory exhausted or requested size too large for range of Octave's index type -- trying to return to prompt" + << std::endl; + } + } + while (retval == 0); + + return retval; +} + +// Fix up things before exiting. + +void +clean_up_and_exit (int retval) +{ + do_octave_atexit (); + + if (octave_exit) + (*octave_exit) (retval == EOF ? 0 : retval); +} + +DEFUN (quit, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exit (@var{status})\n\ +@deftypefnx {Built-in Function} {} quit (@var{status})\n\ +Exit the current Octave session. If the optional integer value\n\ +@var{status} is supplied, pass that value to the operating system as the\n\ +Octave's exit status. The default value is zero.\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (! quit_allowed) + error ("quit: not supported in embedded mode"); + else + { + if (args.length () > 0) + { + int tmp = args(0).nint_value (); + + if (! error_state) + exit_status = tmp; + } + + if (! error_state) + { + // Instead of simply calling exit, we simulate an interrupt + // with a request to exit cleanly so that no matter where the + // call to quit occurs, we will run the unwind_protect stack, + // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before + // exiting. + + quitting_gracefully = true; + + octave_interrupt_state = -1; + + octave_throw_interrupt_exception (); + } + } + + return retval; +} + +DEFALIAS (exit, quit); + +DEFUN (warranty, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} warranty ()\n\ +Describe the conditions for copying and distributing Octave.\n\ +@end deftypefn") +{ + octave_value_list retval; + + octave_stdout << "\n" \ + OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ +\n\ +GNU Octave free software; you can redistribute it and/or modify\n\ +it under the terms of the GNU General Public License as published by\n\ +the Free Software Foundation; either version 3 of the License, or\n\ +(at your option) any later version.\n\ +\n\ +GNU Octave is distributed in the hope that it will be useful,\n\ +but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ +GNU General Public License for more details.\n\ +\n\ +You should have received a copy of the GNU General Public License\n\ +along with this program. If not, see .\n\ +\n"; + + return retval; +} + +// Execute a shell command. + +static int +wait_for_input (int fid) +{ + int retval = -1; + +#if defined (HAVE_SELECT) + if (fid >= 0) + { + fd_set set; + + FD_ZERO (&set); + FD_SET (fid, &set); + + retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); + } +#else + retval = 1; +#endif + + return retval; +} + +static octave_value_list +run_command_and_return_output (const std::string& cmd_str) +{ + octave_value_list retval; + unwind_protect frame; + + iprocstream *cmd = new iprocstream (cmd_str.c_str ()); + + frame.add_delete (cmd); + frame.add_fcn (octave_child_list::remove, cmd->pid ()); + + if (*cmd) + { + int fid = cmd->file_number (); + + std::ostringstream output_buf; + + char ch; + + for (;;) + { + if (cmd->get (ch)) + output_buf.put (ch); + else + { + if (! cmd->eof () && errno == EAGAIN) + { + cmd->clear (); + + if (wait_for_input (fid) != 1) + break; + } + else + break; + } + } + + int cmd_status = cmd->close (); + + if (WIFEXITED (cmd_status)) + cmd_status = WEXITSTATUS (cmd_status); + else + cmd_status = 127; + + retval(1) = output_buf.str (); + retval(0) = cmd_status; + } + else + error ("unable to start subprocess for `%s'", cmd_str.c_str ()); + + return retval; +} + +enum system_exec_type { et_sync, et_async }; + +DEFUN (system, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ +@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ +@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ +Execute a shell command specified by @var{string}.\n\ +If the optional argument @var{type} is \"async\", the process\n\ +is started in the background and the process ID of the child process\n\ +is returned immediately. Otherwise, the child process is started and\n\ +Octave waits until it exits. If the @var{type} argument is omitted, it\n\ +defaults to the value \"sync\".\n\ +\n\ +If @var{system} is called with one or more output arguments, or if the\n\ +optional argument @var{return_output} is true and the subprocess is started\n\ +synchronously, then the output from the command is returned as a variable. \n\ +Otherwise, if the subprocess is executed synchronously, its output is sent\n\ +to the standard output. To send the output of a command executed with\n\ +@code{system} through the pager, use a command like\n\ +\n\ +@example\n\ +@group\n\ +[output, text] = system (\"cmd\");\n\ +disp (text);\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +or\n\ +\n\ +@example\n\ +printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ +@end example\n\ +\n\ +The @code{system} function can return two values. The first is the\n\ +exit status of the command and the second is any output from the\n\ +command that was written to the standard output stream. For example,\n\ +\n\ +@example\n\ +[status, output] = system (\"echo foo; exit 2\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will set the variable @code{output} to the string @samp{foo}, and the\n\ +variable @code{status} to the integer @samp{2}.\n\ +\n\ +For commands run asynchronously, @var{status} is the process id of the\n\ +command shell that is started to run the command.\n\ +@seealso{unix, dos}\n\ +@end deftypefn") +{ + octave_value_list retval; + + unwind_protect frame; + + int nargin = args.length (); + + if (nargin > 0 && nargin < 4) + { + bool return_output = (nargin == 1 && nargout > 1); + + system_exec_type type = et_sync; + + if (nargin == 3) + { + std::string type_str = args(2).string_value (); + + if (! error_state) + { + if (type_str == "sync") + type = et_sync; + else if (type_str == "async") + type = et_async; + else + { + error ("system: TYPE must be \"sync\" or \"async\""); + return retval; + } + } + else + { + error ("system: TYPE must be a character string"); + return retval; + } + } + + if (nargin > 1) + { + return_output = args(1).is_true (); + + if (error_state) + { + error ("system: RETURN_OUTPUT must be boolean value true or false"); + return retval; + } + } + + if (return_output && type == et_async) + { + error ("system: can't return output from commands run asynchronously"); + return retval; + } + + std::string cmd_str = args(0).string_value (); + + if (! error_state) + { +#if defined (__WIN32__) && ! defined (__CYGWIN__) + // Work around weird double-quote handling on Windows systems. + if (type == et_sync) + cmd_str = "\"" + cmd_str + "\""; +#endif + + if (type == et_async) + { + // FIXME -- maybe this should go in sysdep.cc? +#ifdef HAVE_FORK + pid_t pid = fork (); + + if (pid < 0) + error ("system: fork failed -- can't create child process"); + else if (pid == 0) + { + // FIXME -- should probably replace this + // call with something portable. + + execl ("/bin/sh", "sh", "-c", cmd_str.c_str (), + static_cast (0)); + + panic_impossible (); + } + else + retval(0) = pid; +#elif defined (__WIN32__) + STARTUPINFO si; + PROCESS_INFORMATION pi; + ZeroMemory (&si, sizeof (si)); + ZeroMemory (&pi, sizeof (pi)); + OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); + strcpy (xcmd_str, cmd_str.c_str ()); + + if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) + error ("system: CreateProcess failed -- can't create child process"); + else + { + retval(0) = pi.dwProcessId; + CloseHandle (pi.hProcess); + CloseHandle (pi.hThread); + } +#else + error ("asynchronous system calls are not supported"); +#endif + } + else if (return_output) + retval = run_command_and_return_output (cmd_str); + else + { + int status = system (cmd_str.c_str ()); + + // The value in status is as returned by waitpid. If + // the process exited normally, extract the actual exit + // status of the command. Otherwise, return 127 as a + // failure code. + + if (WIFEXITED (status)) + status = WEXITSTATUS (status); + + retval(0) = status; + } + } + else + error ("system: expecting string as first argument"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! cmd = ls_command (); +%! [status, output] = system (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); + +%!error system () +%!error system (1, 2, 3) +*/ + +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::list octave_atexit_functions; + +void +do_octave_atexit (void) +{ + static bool deja_vu = false; + + while (! octave_atexit_functions.empty ()) + { + std::string fcn = octave_atexit_functions.front (); + + octave_atexit_functions.pop_front (); + + OCTAVE_SAFE_CALL (reset_error_handler, ()); + + OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + if (! deja_vu) + { + deja_vu = true; + + // Do this explicitly so that destructors for mex file objects + // are called, so that functions registered with mexAtExit are + // called. + OCTAVE_SAFE_CALL (clear_mex_functions, ()); + + OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); + + // FIXME -- is this needed? Can it cause any trouble? + OCTAVE_SAFE_CALL (raw_mode, (0)); + + OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); + + if (! command_history::ignoring_entries ()) + OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); + + OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); + + OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); + + OCTAVE_SAFE_CALL (close_files, ()); + + OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); + + OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); + + OCTAVE_SAFE_CALL (cleanup_parser, ()); + + OCTAVE_SAFE_CALL (sysdep_cleanup, ()); + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + + if (! quitting_gracefully && (interactive || forced_interactive)) + { + octave_stdout << "\n"; + + // Yes, we want this to be separate from the call to + // flush_octave_stdout above. + + OCTAVE_SAFE_CALL (flush_octave_stdout, ()); + } + + // Don't call singleton_cleanup_list::cleanup until we have the + // problems with registering/unregistering types worked out. For + // example, uncomment the following line, then use the make_int + // function from the examples directory to create an integer + // object and then exit Octave. Octave should crash with a + // segfault when cleaning up the typinfo singleton. We need some + // way to force new octave_value_X types that are created in + // .oct files to be unregistered when the .oct file shared library + // is unloaded. + // + // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); + + OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); + } +} + +void +octave_add_atexit_function (const std::string& fname) +{ + octave_atexit_functions.push_front (fname); +} + +bool +octave_remove_atexit_function (const std::string& fname) +{ + bool found = false; + + for (std::list::iterator p = octave_atexit_functions.begin (); + p != octave_atexit_functions.end (); p++) + { + if (*p == fname) + { + octave_atexit_functions.erase (p); + found = true; + break; + } + } + + return found; +} + + +DEFUN (atexit, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ +@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ +Register a function to be called when Octave exits. For example,\n\ +\n\ +@example\n\ +@group\n\ +function last_words ()\n\ + disp (\"Bye bye\");\n\ +endfunction\n\ +atexit (\"last_words\");\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +will print the message \"Bye bye\" when Octave exits.\n\ +\n\ +The additional argument @var{flag} will register or unregister\n\ +@var{fcn} from the list of functions to be called when Octave\n\ +exits. If @var{flag} is true, the function is registered, and if\n\ +@var{flag} is false, it is unregistered. For example,\n\ +after registering the function @code{last_words} above,\n\ +\n\ +@example\n\ +atexit (\"last_words\", false);\n\ +@end example\n\ +\n\ +@noindent\n\ +will remove the function from the list and Octave will not call\n\ +@code{last_words} when it exits.\n\ +\n\ +Note that @code{atexit} only removes the first occurrence of a function\n\ +from the list, so if a function was placed in the list multiple\n\ +times with @code{atexit}, it must also be removed from the list\n\ +multiple times.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + bool add_mode = true; + + if (nargin == 2) + { + add_mode = args(1).bool_value (); + + if (error_state) + error ("atexit: FLAG argument must be a logical value"); + } + + if (! error_state) + { + if (add_mode) + octave_add_atexit_function (arg); + else + { + bool found = octave_remove_atexit_function (arg); + + if (nargout > 0) + retval(0) = found; + } + } + } + else + error ("atexit: FCN argument must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (octave_config_info, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} octave_config_info ()\n\ +@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ +Return a structure containing configuration and installation\n\ +information for Octave.\n\ +\n\ +If @var{option} is a string, return the configuration information for the\n\ +specified option.\n\ +\n\ +@end deftypefn") +{ + octave_value retval; + +#if defined (ENABLE_DYNAMIC_LINKING) + bool octave_supports_dynamic_linking = true; +#else + bool octave_supports_dynamic_linking = false; +#endif + + static bool initialized = false; + static octave_scalar_map m; + + struct conf_info_struct + { + bool subst_home; + const char *key; + const char *val; + }; + + static const conf_info_struct conf_info[] = + { + { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, + { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, + { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, + { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, + { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, + { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, + { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, + { false, "AR", OCTAVE_CONF_AR }, + { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, + { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, + { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, + { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, + { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, + { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, + { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, + { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, + { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, + { false, "CC", OCTAVE_CONF_CC }, + { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, + { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, + { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, + { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, + { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, + { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, + { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, + { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, + { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, + { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, + { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, + { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, + { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, + { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, + { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, + { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, + { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, + { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, + { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, + { false, "CXX", OCTAVE_CONF_CXX }, + { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, + { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, + { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, + { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, + { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, + { false, "DEFS", OCTAVE_CONF_DEFS }, + { false, "DL_LD", OCTAVE_CONF_DL_LD }, + { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, + { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, + { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, + { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, + { false, "F77", OCTAVE_CONF_F77 }, + { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, + { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, + { false, "FC", OCTAVE_CONF_FC }, + { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, + { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, + { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, + { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, + { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, + { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, + { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, + { false, "FLIBS", OCTAVE_CONF_FLIBS }, + { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, + { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, + { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, + { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, + { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, + { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, + { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, + { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, + { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, + { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, + { false, "INCFLAGS", OCTAVE_CONF_INCFLAGS }, + { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, + { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, + { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, + { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, + { false, "LEX", OCTAVE_CONF_LEX }, + { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, + { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, + { false, "LIBCRUFT", OCTAVE_CONF_LIBCRUFT }, + { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, + { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, + { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, + { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, + { false, "LIBS", OCTAVE_CONF_LIBS }, + { false, "LN_S", OCTAVE_CONF_LN_S }, + { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, + { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, + { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, + { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, + { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, + { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, + { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, + { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, + { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, + { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, + { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, + { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, + { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, + { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, + { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, + { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, + { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, + { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, + { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, + { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, + { false, "RANLIB", OCTAVE_CONF_RANLIB }, + { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, + { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, + { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, + { false, "SED", OCTAVE_CONF_SED }, + { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, + { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, + { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, + { false, "SH_LD", OCTAVE_CONF_SH_LD }, + { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, + { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, + { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, + { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, + { false, "UGLY_DEFS", OCTAVE_CONF_UGLY_DEFS }, + { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, + { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, + { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, + { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, + { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, + { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, + { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, + { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, + { false, "YACC", OCTAVE_CONF_YACC }, + { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, + { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, + { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, + { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, + { false, "api_version", OCTAVE_API_VERSION }, + { true, "archlibdir", OCTAVE_ARCHLIBDIR }, + { true, "bindir", OCTAVE_BINDIR }, + { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, + { false, "config_opts", OCTAVE_CONF_config_opts }, + { true, "datadir", OCTAVE_DATADIR }, + { true, "datarootdir", OCTAVE_DATAROOTDIR }, + { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, + { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, + { true, "imagedir", OCTAVE_IMAGEDIR }, + { true, "includedir", OCTAVE_INCLUDEDIR }, + { true, "infodir", OCTAVE_INFODIR }, + { true, "infofile", OCTAVE_INFOFILE }, + { true, "libdir", OCTAVE_LIBDIR }, + { true, "libexecdir", OCTAVE_LIBEXECDIR }, + { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, + { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, + { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, + { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, + { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, + { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, + { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, + { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, + { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, + { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, + { true, "man1dir", OCTAVE_MAN1DIR }, + { false, "man1ext", OCTAVE_MAN1EXT }, + { true, "mandir", OCTAVE_MANDIR }, + { true, "octfiledir", OCTAVE_OCTFILEDIR }, + { true, "octetcdir", OCTAVE_OCTETCDIR }, + { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, + { true, "octlibdir", OCTAVE_OCTLIBDIR }, + { true, "prefix", OCTAVE_PREFIX }, + { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, + { false, "version", OCTAVE_VERSION }, + { false, 0, 0 } + }; + + if (! initialized) + { + m.assign ("dld", octave_value (octave_supports_dynamic_linking)); + + oct_mach_info::float_format ff = oct_mach_info::native_float_format (); + m.assign ("float_format", + octave_value (oct_mach_info::float_format_as_string (ff))); + + m.assign ("words_big_endian", + octave_value (oct_mach_info::words_big_endian ())); + + m.assign ("words_little_endian", + octave_value (oct_mach_info::words_little_endian ())); + + int i = 0; + + while (true) + { + const conf_info_struct& elt = conf_info[i++]; + + const char *key = elt.key; + + if (key) + { + if (elt.subst_home) + m.assign (key, subst_octave_home (elt.val)); + else + m.assign (key, elt.val); + } + else + break; + } + + bool unix_system = true; + bool mac_system = false; + bool windows_system = false; + +#if defined (WIN32) + windows_system = true; +#if !defined (__CYGWIN__) + unix_system = false; +#endif +#endif + +#if defined (OCTAVE_USE_OS_X_API) + mac_system = true; +#endif + + m.assign ("unix", octave_value (unix_system)); + m.assign ("mac", octave_value (mac_system)); + m.assign ("windows", octave_value (windows_system)); + + initialized = true; + } + + int nargin = args.length (); + + if (nargin == 1) + { + std::string arg = args(0).string_value (); + + if (! error_state) + { + Cell c = m.contents (arg.c_str ()); + + if (c.is_empty ()) + error ("octave_config_info: no info for `%s'", arg.c_str ()); + else + retval = c(0); + } + } + else if (nargin == 0) + retval = m; + else + print_usage (); + + return retval; +} + +/* +%!assert (ischar (octave_config_info ("version"))) +%!test +%! x = octave_config_info (); +%! assert (isstruct (x)); +%! assert (! isempty (x)); + +%!error octave_config_info (1, 2) +*/ + +#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) + +int debug_new_delete = 0; + +typedef void (*vfp)(void); +extern vfp __new_handler; + +void * +__builtin_new (size_t sz) +{ + void *p; + + /* malloc (0) is unpredictable; avoid it. */ + if (sz == 0) + sz = 1; + p = malloc (sz); + while (p == 0) + { + (*__new_handler) (); + p = malloc (sz); + } + + if (debug_new_delete) + std::cerr << "__builtin_new: " << p << std::endl; + + return p; +} + +void +__builtin_delete (void *ptr) +{ + if (debug_new_delete) + std::cerr << "__builtin_delete: " << ptr << std::endl; + + if (ptr) + free (ptr); +} + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/toplev.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/toplev.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,455 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_toplev_h) +#define octave_toplev_h 1 + +#include + +#include +#include + +class octave_value; +class octave_value_list; +class octave_function; +class octave_user_script; +class tree_statement; +class tree_statement_list; +class charMatrix; + +#include "quit.h" + +#include "input.h" +#include "oct-map.h" + + +typedef void (*octave_exit_func) (int); +extern OCTINTERP_API octave_exit_func octave_exit; + +extern OCTINTERP_API bool quit_allowed; + +extern OCTINTERP_API bool quitting_gracefully; + +extern OCTINTERP_API int exit_status; + +extern OCTINTERP_API void +clean_up_and_exit (int); + +extern OCTINTERP_API void recover_from_exception (void); + +extern OCTINTERP_API int main_loop (void); + +extern OCTINTERP_API void +do_octave_atexit (void); + +extern OCTINTERP_API void +octave_add_atexit_function (const std::string& fname); + +extern OCTINTERP_API bool +octave_remove_atexit_function (const std::string& fname); + +// Current command to execute. +extern OCTINTERP_API tree_statement_list *global_command; + +// TRUE means we are ready to interpret commands, but not everything +// is ready for interactive use. +extern OCTINTERP_API bool octave_interpreter_ready; + +// TRUE means we've processed all the init code and we are good to go. +extern OCTINTERP_API bool octave_initialized; + +class +OCTINTERP_API +octave_call_stack +{ +private: + + struct call_stack_elt + { + call_stack_elt (octave_function *f, symbol_table::scope_id s, + symbol_table::context_id c, size_t p = 0) + : fcn (f), stmt (0), scope (s), context (c), prev (p) { } + + call_stack_elt (const call_stack_elt& elt) + : fcn (elt.fcn), stmt (elt.stmt), scope (elt.scope), + context (elt.context), prev (elt.prev) { } + + octave_function *fcn; + tree_statement *stmt; + symbol_table::scope_id scope; + symbol_table::context_id context; + size_t prev; + }; + +protected: + + octave_call_stack (void) : cs (), curr_frame (0) { } + +public: + + typedef std::deque::iterator iterator; + typedef std::deque::const_iterator const_iterator; + + typedef std::deque::reverse_iterator reverse_iterator; + typedef std::deque::const_reverse_iterator const_reverse_iterator; + + static void create_instance (void); + + static bool instance_ok (void) + { + bool retval = true; + + if (! instance) + create_instance (); + + if (! instance) + { + ::error ("unable to create call stack object!"); + + retval = false; + } + + return retval; + } + + // Current function (top of stack). + static octave_function *current (void) + { + return instance_ok () ? instance->do_current () : 0; + } + + // Current statement (top of stack). + static tree_statement *current_statement (void) + { + return instance_ok () ? instance->do_current_statement () : 0; + } + + // Current line in current function. + static int current_line (void) + { + return instance_ok () ? instance->do_current_line () : -1; + } + + // Current column in current function. + static int current_column (void) + { + return instance_ok () ? instance->do_current_column () : -1; + } + + // Line in user code caller. + static int caller_user_code_line (void) + { + return instance_ok () ? instance->do_caller_user_code_line () : -1; + } + + // Column in user code caller. + static int caller_user_code_column (void) + { + return instance_ok () ? instance->do_caller_user_code_column () : -1; + } + + // Caller function, may be built-in. + static octave_function *caller (void) + { + return instance_ok () ? instance->do_caller () : 0; + } + + static size_t current_frame (void) + { + return instance_ok () ? instance->do_current_frame () : 0; + } + + static size_t size (void) + { + return instance_ok () ? instance->do_size () : 0; + } + + static size_t num_user_code_frames (octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_num_user_code_frames (curr_user_frame) : 0; + } + + static symbol_table::scope_id current_scope (void) + { + return instance_ok () ? instance->do_current_scope () : 0; + } + + static symbol_table::context_id current_context (void) + { + return instance_ok () ? instance->do_current_context () : 0; + } + + // Function at location N on the call stack (N == 0 is current), may + // be built-in. + static octave_function *element (size_t n) + { + return instance_ok () ? instance->do_element (n) : 0; + } + + // First user-defined function on the stack. + static octave_user_code *caller_user_code (size_t nskip = 0) + { + return instance_ok () ? instance->do_caller_user_code (nskip) : 0; + } + + static void + push (octave_function *f, + symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (f, scope, context); + } + + static void + push (symbol_table::scope_id scope = symbol_table::current_scope (), + symbol_table::context_id context = symbol_table::current_context ()) + { + if (instance_ok ()) + instance->do_push (0, scope, context); + } + + static void set_statement (tree_statement *s) + { + if (instance_ok ()) + instance->do_set_statement (s); + } + + static bool goto_frame (size_t n = 0, bool verbose = false) + { + return instance_ok () ? instance->do_goto_frame (n, verbose) : false; + } + + static void restore_frame (size_t n) + { + goto_frame (n); + } + + static bool goto_frame_relative (int n, bool verbose = false) + { + return instance_ok () + ? instance->do_goto_frame_relative (n, verbose) : false; + } + + static void goto_caller_frame (void) + { + if (instance_ok ()) + instance->do_goto_caller_frame (); + } + + static void goto_base_frame (void) + { + if (instance_ok ()) + instance->do_goto_base_frame (); + } + + static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) + { + return instance_ok () + ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); + } + + static octave_map empty_backtrace (void); + + static void pop (void) + { + if (instance_ok ()) + instance->do_pop (); + } + + static void clear (void) + { + if (instance_ok ()) + instance->do_clear (); + } + + static void backtrace_error_message (void) + { + if (instance_ok ()) + instance->do_backtrace_error_message (); + } + +private: + + // The current call stack. + std::deque cs; + + size_t curr_frame; + + static octave_call_stack *instance; + + static void cleanup_instance (void) { delete instance; instance = 0; } + + int do_current_line (void) const; + + int do_current_column (void) const; + + int do_caller_user_code_line (void) const; + + int do_caller_user_code_column (void) const; + + octave_function *do_caller (void) const + { + return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; + } + + size_t do_current_frame (void) { return curr_frame; } + + size_t do_size (void) { return cs.size (); } + + size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; + + symbol_table::scope_id do_current_scope (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].scope : 0; + } + + symbol_table::context_id do_current_context (void) const + { + return curr_frame > 0 && curr_frame < cs.size () + ? cs[curr_frame].context : 0; + } + + octave_function *do_element (size_t n) + { + octave_function *retval = 0; + + if (cs.size () > n) + { + call_stack_elt& elt = cs[n]; + retval = elt.fcn; + } + + return retval; + } + + octave_user_code *do_caller_user_code (size_t nskip) const; + + void do_push (octave_function *f, symbol_table::scope_id scope, + symbol_table::context_id context) + { + size_t prev_frame = curr_frame; + curr_frame = cs.size (); + cs.push_back (call_stack_elt (f, scope, context, prev_frame)); + symbol_table::set_scope_and_context (scope, context); + } + + octave_function *do_current (void) const + { + octave_function *retval = 0; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.fcn; + } + + return retval; + } + + tree_statement *do_current_statement (void) const + { + tree_statement *retval = 0; + + if (! cs.empty ()) + { + const call_stack_elt& elt = cs[curr_frame]; + retval = elt.stmt; + } + + return retval; + } + + void do_set_statement (tree_statement *s) + { + if (! cs.empty ()) + { + call_stack_elt& elt = cs.back (); + elt.stmt = s; + } + } + + octave_map do_backtrace (size_t nskip, + octave_idx_type& curr_user_frame) const; + + bool do_goto_frame (size_t n, bool verbose); + + bool do_goto_frame_relative (int n, bool verbose); + + void do_goto_caller_frame (void); + + void do_goto_base_frame (void); + + void do_pop (void) + { + if (cs.size () > 1) + { + const call_stack_elt& elt = cs.back (); + curr_frame = elt.prev; + cs.pop_back (); + const call_stack_elt& new_elt = cs[curr_frame]; + symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); + } + } + + void do_clear (void) { cs.clear (); } + + void do_backtrace_error_message (void) const; +}; + +// Call a function with exceptions handled to avoid problems with +// errors while shutting down. + +#define OCTAVE_IGNORE_EXCEPTION(E) \ + catch (E) \ + { \ + std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ + recover_from_exception (); \ + } + +#define OCTAVE_SAFE_CALL(F, ARGS) \ + do \ + { \ + try \ + { \ + unwind_protect frame; \ + \ + frame.protect_var (Vdebug_on_error); \ + frame.protect_var (Vdebug_on_warning); \ + \ + Vdebug_on_error = false; \ + Vdebug_on_warning = false; \ + \ + F ARGS; \ + } \ + OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ + OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ + OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ + \ + if (error_state) \ + error_state = 0; \ + } \ + while (0) + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/utils.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/utils.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,1432 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include + +#include +#include + +#include "vasnprintf.h" + +#include "quit.h" + +#include "dir-ops.h" +#include "file-ops.h" +#include "file-stat.h" +#include "lo-mappers.h" +#include "lo-utils.h" +#include "oct-cmplx.h" +#include "oct-env.h" +#include "pathsearch.h" +#include "str-vec.h" + +#include "Cell.h" +#include +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-errno.h" +#include "oct-hist.h" +#include "oct-obj.h" +#include "ov-range.h" +#include "pager.h" +#include "parse.h" +#include "sysdep.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Return TRUE if S is a valid identifier. + +bool +valid_identifier (const char *s) +{ + if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) + return false; + + while (*++s != '\0') + if (! (isalnum (*s) || *s == '_' || *s == '$')) + return false; + + return true; +} + +bool +valid_identifier (const std::string& s) +{ + return valid_identifier (s.c_str ()); +} + +DEFUN (isvarname, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ +Return true if @var{name} is a valid variable name.\n\ +@seealso{iskeyword, exist, who}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("isvarname"); + + if (error_state) + return retval; + + if (argc == 2) + retval = valid_identifier (argv[1]) && ! is_keyword (argv[1]); + else + print_usage (); + + return retval; +} + +/* +%!assert (isvarname ("foo"), true) +%!assert (isvarname ("_foo"), true) +%!assert (isvarname ("_1"), true) +%!assert (isvarname ("1foo"), false) +%!assert (isvarname (""), false) + +%!error isvarname () +%!error isvarname ("foo", "bar"); +*/ + +// Return TRUE if F and G are both names for the same file. + +bool +same_file (const std::string& f, const std::string& g) +{ + return same_file_internal (f, g); +} + +int +almost_match (const std::string& std, const std::string& s, int min_match_len, + int case_sens) +{ + int stdlen = std.length (); + int slen = s.length (); + + return (slen <= stdlen + && slen >= min_match_len + && (case_sens + ? (strncmp (std.c_str (), s.c_str (), slen) == 0) + : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); +} + +// Ugh. + +int +keyword_almost_match (const char * const *std, int *min_len, const std::string& s, + int min_toks_to_match, int max_toks) +{ + int status = 0; + int tok_count = 0; + int toks_matched = 0; + + if (s.empty () || max_toks < 1) + return status; + + char *kw = strsave (s.c_str ()); + + char *t = kw; + while (*t != '\0') + { + if (*t == '\t') + *t = ' '; + t++; + } + + char *beg = kw; + while (*beg == ' ') + beg++; + + if (*beg == '\0') + return status; + + + const char **to_match = new const char * [max_toks + 1]; + const char * const *s1 = std; + const char **s2 = to_match; + + if (! s1 || ! s2) + goto done; + + s2[tok_count] = beg; + char *end; + while ((end = strchr (beg, ' ')) != 0) + { + *end = '\0'; + beg = end + 1; + + while (*beg == ' ') + beg++; + + if (*beg == '\0') + break; + + tok_count++; + if (tok_count >= max_toks) + goto done; + + s2[tok_count] = beg; + } + s2[tok_count+1] = 0; + + s2 = to_match; + + for (;;) + { + if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) + goto done; + + toks_matched++; + + s1++; + s2++; + + if (! *s2) + { + status = (toks_matched >= min_toks_to_match); + goto done; + } + + if (! *s1) + goto done; + } + + done: + + delete [] kw; + delete [] to_match; + + return status; +} + +// Return non-zero if either NR or NC is zero. Return -1 if this +// should be considered fatal; return 1 if this is ok. + +int +empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) +{ + return (nr == 0 || nc == 0); +} + +// See if the given file is in the path. + +std::string +search_path_for_file (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + return octave_env::make_absolute (p.find_first_of (names)); +} + +// Find all locations of the given file in the path. + +string_vector +search_path_for_all_files (const std::string& path, const string_vector& names) +{ + dir_path p (path); + + string_vector sv = p.find_all_first_of (names); + + octave_idx_type len = sv.length (); + + for (octave_idx_type i = 0; i < len; i++) + sv[i] = octave_env::make_absolute (sv[i]); + + return sv; +} + +static string_vector +make_absolute (const string_vector& sv) +{ + octave_idx_type len = sv.length (); + + string_vector retval (len); + + for (octave_idx_type i = 0; i < len; i++) + retval[i] = octave_env::make_absolute (sv[i]); + + return retval; +} + +DEFUN (file_in_loadpath, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ +\n\ +Return the absolute name of @var{file} if it can be found in\n\ +the list of directories specified by @code{path}.\n\ +If no file is found, return an empty character string.\n\ +\n\ +If the first argument is a cell array of strings, search each\n\ +directory of the loadpath for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the second optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_path, path}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + string_vector names = args(0).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 1) + retval = octave_env::make_absolute (load_path::find_first_of (names)); + else if (nargin == 2) + { + std::string opt = args(1).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (load_path::find_all_first_of (names))); + else + error ("file_in_loadpath: invalid option"); + } + } + else + error ("file_in_loadpath: FILE argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_loadpath ("plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_loadpath () +%!error file_in_loadpath ("foo", "bar", 1) +*/ + +DEFUN (file_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ +@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ +Return the absolute name of @var{file} if it can be found in\n\ +@var{path}. The value of @var{path} should be a colon-separated list of\n\ +directories in the format described for @code{path}. If no file\n\ +is found, return an empty character string. For example:\n\ +\n\ +@example\n\ +@group\n\ +file_in_path (EXEC_PATH, \"sh\")\n\ + @result{} \"/bin/sh\"\n\ +@end group\n\ +@end example\n\ +\n\ +If the second argument is a cell array of strings, search each\n\ +directory of the path for element of the cell array and return\n\ +the first that matches.\n\ +\n\ +If the third optional argument @code{\"all\"} is supplied, return\n\ +a cell array containing the list of all files that have the same\n\ +name in the path. If no files are found, return an empty cell array.\n\ +@seealso{file_in_loadpath}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + { + std::string path = args(0).string_value (); + + if (! error_state) + { + string_vector names = args(1).all_strings (); + + if (! error_state && names.length () > 0) + { + if (nargin == 2) + retval = search_path_for_file (path, names); + else if (nargin == 3) + { + std::string opt = args(2).string_value (); + + if (! error_state && opt == "all") + retval = Cell (make_absolute + (search_path_for_all_files (path, names))); + else + error ("file_in_path: invalid option"); + } + } + else + error ("file_in_path: all arguments must be strings"); + } + else + error ("file_in_path: PATH must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! f = file_in_path (path (), "plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); + +%!error file_in_path () +%!error file_in_path ("foo") +%!error file_in_path ("foo", "bar", "baz", 1) +*/ + +std::string +file_in_path (const std::string& name, const std::string& suffix) +{ + std::string nm = name; + + if (! suffix.empty ()) + nm.append (suffix); + + return octave_env::make_absolute (load_path::find_file (nm)); +} + +// See if there is an function file in the path. If so, return the +// full path to the file. + +std::string +fcn_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') + retval = load_path::find_fcn_file (name.substr (0, len-2)); + else + { + std::string fname = name; + size_t pos = name.find_first_of (Vfilemarker); + if (pos != std::string::npos) + fname = name.substr (0, pos); + + retval = load_path::find_fcn_file (fname); + } + } + + return retval; +} + +// See if there is a directory called "name" in the path and if it +// contains a Contents.m file return the full path to this file. + +std::string +contents_file_in_path (const std::string& dir) +{ + std::string retval; + + if (dir.length () > 0) + { + std::string tcontents = file_ops::concat (load_path::find_dir (dir), + std::string ("Contents.m")); + + file_stat fs (tcontents); + + if (fs.exists ()) + retval = octave_env::make_absolute (tcontents); + } + + return retval; +} + +// See if there is a .oct file in the path. If so, return the +// full path to the file. + +std::string +oct_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' + && name[len - 2] == 'c' && name[len - 1] == 't') + retval = load_path::find_oct_file (name.substr (0, len-4)); + else + retval = load_path::find_oct_file (name); + } + + return retval; +} + +// See if there is a .mex file in the path. If so, return the +// full path to the file. + +std::string +mex_file_in_path (const std::string& name) +{ + std::string retval; + + int len = name.length (); + + if (len > 0) + { + if (octave_env::absolute_pathname (name)) + { + file_stat fs (name); + + if (fs.exists ()) + retval = name; + } + else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' + && name[len - 2] == 'e' && name[len - 1] == 'x') + retval = load_path::find_mex_file (name.substr (0, len-4)); + else + retval = load_path::find_mex_file (name); + } + + return retval; +} + +// Replace backslash escapes in a string with the real values. + +std::string +do_string_escapes (const std::string& s) +{ + std::string retval; + + size_t i = 0; + size_t j = 0; + size_t len = s.length (); + + retval.resize (len); + + while (j < len) + { + if (s[j] == '\\' && j+1 < len) + { + switch (s[++j]) + { + case '0': + retval[i] = '\0'; + break; + + case 'a': + retval[i] = '\a'; + break; + + case 'b': // backspace + retval[i] = '\b'; + break; + + case 'f': // formfeed + retval[i] = '\f'; + break; + + case 'n': // newline + retval[i] = '\n'; + break; + + case 'r': // carriage return + retval[i] = '\r'; + break; + + case 't': // horizontal tab + retval[i] = '\t'; + break; + + case 'v': // vertical tab + retval[i] = '\v'; + break; + + case '\\': // backslash + retval[i] = '\\'; + break; + + case '\'': // quote + retval[i] = '\''; + break; + + case '"': // double quote + retval[i] = '"'; + break; + + default: + warning ("unrecognized escape sequence `\\%c' --\ + converting to `%c'", s[j], s[j]); + retval[i] = s[j]; + break; + } + } + else + { + retval[i] = s[j]; + } + + i++; + j++; + } + + retval.resize (i); + + return retval; +} + +DEFUN (do_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ +Convert special characters in @var{string} to their escaped forms.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = do_string_escapes (args(0).string_value ()); + else + error ("do_string_escapes: STRING argument must be of type string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") +%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) +%!assert ("foo\nbar", ["foo", char(10), "bar"]) + +%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), +%! char ([7, 8, 12, 10, 13, 9, 11])) +%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) + +%!error do_string_escapes () +%!error do_string_escapes ("foo", "bar") +*/ + +const char * +undo_string_escape (char c) +{ + if (! c) + return ""; + + switch (c) + { + case '\0': + return "\\0"; + + case '\a': + return "\\a"; + + case '\b': // backspace + return "\\b"; + + case '\f': // formfeed + return "\\f"; + + case '\n': // newline + return "\\n"; + + case '\r': // carriage return + return "\\r"; + + case '\t': // horizontal tab + return "\\t"; + + case '\v': // vertical tab + return "\\v"; + + case '\\': // backslash + return "\\\\"; + + case '"': // double quote + return "\\\""; + + default: + { + static char retval[2]; + retval[0] = c; + retval[1] = '\0'; + return retval; + } + } +} + +std::string +undo_string_escapes (const std::string& s) +{ + std::string retval; + + for (size_t i = 0; i < s.length (); i++) + retval.append (undo_string_escape (s[i])); + + return retval; +} + +DEFUN (undo_string_escapes, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ +Convert special characters in strings back to their escaped forms. For\n\ +example, the expression\n\ +\n\ +@example\n\ +bell = \"\\a\";\n\ +@end example\n\ +\n\ +@noindent\n\ +assigns the value of the alert character (control-g, ASCII code 7) to\n\ +the string variable @code{bell}. If this string is printed, the\n\ +system will ring the terminal bell (if it is possible). This is\n\ +normally the desired outcome. However, sometimes it is useful to be\n\ +able to print the original representation of the string, with the\n\ +special characters replaced by their escape sequences. For example,\n\ +\n\ +@example\n\ +@group\n\ +octave:13> undo_string_escapes (bell)\n\ +ans = \\a\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +replaces the unprintable alert character with its printable\n\ +representation.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + retval = undo_string_escapes (args(0).string_value ()); + else + error ("undo_string_escapes: S argument must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') +%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") +%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") + +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") +%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), +%! "\\a\\b\\f\\n\\r\\t\\v") + +%!error undo_string_escapes () +%!error undo_string_escapes ("foo", "bar") +*/ + +DEFUN (is_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ +Return true if @var{file} is an absolute filename.\n\ +@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::absolute_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_absolute_filename () +%!error is_absolute_filename ("foo", "bar") +*/ + +DEFUN (is_rooted_relative_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ +Return true if @var{file} is a rooted-relative filename.\n\ +@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = false; + + if (args.length () == 1) + retval = (args(0).is_string () + && octave_env::rooted_relative_pathname (args(0).string_value ())); + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error is_rooted_relative_filename () +%!error is_rooted_relative_filename ("foo", "bar") +*/ + +DEFUN (make_absolute_filename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ +Return the full name of @var{file} beginning from the root of the file\n\ +system. No check is done for the existence of @var{file}.\n\ +@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + if (args.length () == 1) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_env::make_absolute (nm); + else + error ("make_absolute_filename: FILE argument must be a file name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error make_absolute_filename () +%!error make_absolute_filename ("foo", "bar") +*/ + +DEFUN (find_dir_in_path, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ +@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ +Return the full name of the path element matching @var{dir}. The\n\ +match is performed at the end of each path element. For example, if\n\ +@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ +@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ +or @code{\"/some/dir/allfoo/bar\"}.\n\ +\n\ +The second argument is optional. If it is supplied, return a cell array\n\ +containing all name matches rather than just the first.\n\ +@end deftypefn") +{ + octave_value retval = std::string (); + + int nargin = args.length (); + + std::string dir; + + if (nargin == 1 || nargin == 2) + { + dir = args(0).string_value (); + + if (! error_state) + { + if (nargin == 1) + retval = load_path::find_dir (dir); + else if (nargin == 2) + retval = Cell (load_path::find_matching_dirs (dir)); + } + else + error ("find_dir_in_path: DIR must be a directory name"); + } + else + print_usage (); + + return retval; +} + +/* +## FIXME: We need system-dependent tests here. + +%!error find_dir_in_path () +%!error find_dir_in_path ("foo", "bar", 1) +*/ + +DEFUNX ("errno", Ferrno, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ +@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ +Return the current value of the system-dependent variable errno,\n\ +set its value to @var{val} and return the previous value, or return\n\ +the named error code given @var{name} as a character string, or -1\n\ +if @var{name} is not found.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (args(0).is_string ()) + { + std::string nm = args(0).string_value (); + + if (! error_state) + retval = octave_errno::lookup (nm); + else + error ("errno: expecting character string argument"); + } + else + { + int val = args(0).int_value (); + + if (! error_state) + retval = octave_errno::set (val); + else + error ("errno: expecting integer argument"); + } + } + else if (nargin == 0) + retval = octave_errno::get (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isnumeric (errno ())) + +%!test +%! lst = errno_list (); +%! fns = fieldnames (lst); +%! oldval = errno (fns{1}); +%! assert (isnumeric (oldval)); +%! errno (oldval); +%! newval = errno (); +%! assert (oldval, newval); + +%!error errno ("foo", 1) +*/ + +DEFUN (errno_list, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} errno_list ()\n\ +Return a structure containing the system-dependent errno values.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 0) + retval = octave_errno::list (); + else + print_usage (); + + return retval; +} + +/* +%!assert (isstruct (errno_list ())) + +%!error errno_list ("foo") +*/ + +static void +check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) +{ + if (nr < 0 || nc < 0) + { + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); + + nr = (nr < 0) ? 0 : nr; + nc = (nc < 0) ? 0 : nc; + } +} + +void +check_dimensions (dim_vector& dim, const char *warnfor) +{ + bool neg = false; + + for (int i = 0; i < dim.length (); i++) + { + if (dim(i) < 0) + { + dim(i) = 0; + neg = true; + } + } + + if (neg) + warning_with_id ("Octave:neg-dim-as-zero", + "%s: converting negative dimension to zero", warnfor); +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim) +{ + if (a.is_scalar_type ()) + { + dim.resize (2); + dim(0) = a.int_value (); + dim(1) = dim(0); + } + else + { + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.columns (); + + if (nr == 1 || nc == 1) + { + Array v = a.vector_value (); + + if (error_state) + return; + + octave_idx_type n = v.length (); + dim.resize (n); + for (octave_idx_type i = 0; i < n; i++) + dim(i) = static_cast (fix (v(i))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (dim, warn_for); // May set error_state. +} + + +void +get_dimensions (const octave_value& a, const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc) +{ + if (a.is_scalar_type ()) + { + nr = nc = a.int_value (); + } + else + { + nr = a.rows (); + nc = a.columns (); + + if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) + { + Array v = a.vector_value (); + + if (error_state) + return; + + nr = static_cast (fix (v (0))); + nc = static_cast (fix (v (1))); + } + else + error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); + } + + if (! error_state) + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) +{ + nr = a.is_empty () ? 0 : a.int_value (); + nc = b.is_empty () ? 0 : b.int_value (); + + if (error_state) + error ("%s: expecting two scalar arguments", warn_for); + else + check_dimensions (nr, nc, warn_for); // May set error_state. +} + +octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx) +{ + octave_idx_type retval; + + octave_idx_type len = idx.length (); + + if (len == 0) + retval = dims.numel (); + else + { + const dim_vector dv = dims.redim (len); + retval = 1; + for (octave_idx_type i = 0; i < len; i++) + { + octave_value idxi = idx(i); + if (idxi.is_magic_colon ()) + retval *= dv(i); + else if (idxi.is_numeric_type ()) + retval *= idxi.numel (); + else + { + idx_vector jdx = idxi.index_vector (); + if (error_state) + break; + retval *= jdx.length (dv(i)); + } + } + } + + return retval; +} + +Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + Matrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc) +{ + FloatMatrix m (nr, nc, 0.0); + + if (nr > 0 && nc > 0) + { + octave_idx_type n = std::min (nr, nc); + + for (octave_idx_type i = 0; i < n; i++) + m (i, i) = 1.0; + } + + return m; +} + +size_t +octave_format (std::ostream& os, const char *fmt, ...) +{ + size_t retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vformat (os, fmt, args); + + va_end (args); + + return retval; +} + +size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args) +{ + std::string s = octave_vasprintf (fmt, args); + + os << s; + + return s.length (); +} + +std::string +octave_vasprintf (const char *fmt, va_list args) +{ + std::string retval; + + char *result; + + int status = gnulib::vasprintf (&result, fmt, args); + + if (status >= 0) + { + retval = result; + ::free (result); + } + + return retval; +} + +std::string +octave_asprintf (const char *fmt, ...) +{ + std::string retval; + + va_list args; + va_start (args, fmt); + + retval = octave_vasprintf (fmt, args); + + va_end (args); + + return retval; +} + +void +octave_sleep (double seconds) +{ + if (seconds > 0) + { + double t; + + unsigned int usec + = static_cast (modf (seconds, &t) * 1000000); + + unsigned int sec + = (t > UINT_MAX) ? UINT_MAX : static_cast (t); + + // Versions of these functions that accept unsigned int args are + // defined in cutils.c. + octave_sleep (sec); + octave_usleep (usec); + + octave_quit (); + } +} + +DEFUN (isindex, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ +@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ +Return true if @var{ind} is a valid index. Valid indices are\n\ +either positive integers (although possibly of real data type), or logical\n\ +arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ +to be indexed. When possible the internal result is cached so that\n\ +subsequent indexing using @var{ind} will not perform the check again.\n\ +@end deftypefn") +{ + octave_value retval; + int nargin = args.length (); + octave_idx_type n = 0; + + if (nargin == 2) + n = args(1).idx_type_value (); + else if (nargin != 1) + print_usage (); + + if (! error_state) + { + unwind_protect frame; + + frame.protect_var (Vallow_noninteger_range_as_index); + Vallow_noninteger_range_as_index = false; + + frame.protect_var (error_state); + + frame.protect_var (discard_error_messages); + discard_error_messages = true; + + try + { + idx_vector idx = args(0).index_vector (); + if (! error_state) + { + if (nargin == 2) + retval = idx.extent (n) <= n; + else + retval = true; + } + else + retval = false; + } + catch (octave_execution_exception) + { + retval = false; + } + } + + return retval; +} + +/* +%!assert (isindex ([1, 2, 3])) +%!assert (isindex (1:3)) +%!assert (isindex ([1, 2, -3]), false) + +%!error isindex () +*/ + +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout) +{ + octave_value_list new_args = args, retval; + int nargin = args.length (); + OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); + OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); + OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); + + const Cell *ccells = cells; + + octave_idx_type numel = 1; + dim_vector dims (1, 1); + + for (int i = 0; i < nargin; i++) + { + octave_value arg = new_args(i); + iscell[i] = arg.is_cell (); + if (iscell[i]) + { + cells[i] = arg.cell_value (); + octave_idx_type n = ccells[i].numel (); + if (n == 1) + { + iscell[i] = false; + new_args(i) = ccells[i](0); + } + else if (numel == 1) + { + numel = n; + dims = ccells[i].dims (); + } + else if (dims != ccells[i].dims ()) + { + error ("%s: cell arguments must have matching sizes", fun_name); + break; + } + } + } + + if (! error_state) + { + for (int i = 0; i < nargout; i++) + rcells[i].clear (dims); + + for (octave_idx_type j = 0; j < numel; j++) + { + for (int i = 0; i < nargin; i++) + if (iscell[i]) + new_args(i) = ccells[i](j); + + octave_quit (); + + const octave_value_list tmp = fun (new_args, nargout); + + if (tmp.length () < nargout) + { + error ("%s: do_simple_cellfun: internal error", fun_name); + break; + } + else + { + for (int i = 0; i < nargout; i++) + rcells[i](j) = tmp(i); + } + } + } + + if (! error_state) + { + retval.resize (nargout); + for (int i = 0; i < nargout; i++) + retval(i) = rcells[i]; + } + + return retval; +} + +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args) +{ + octave_value retval; + const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); + if (tmp.length () > 0) + retval = tmp(0); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/utils.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/utils.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,130 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_utils_h) +#define octave_utils_h 1 + +#include + +#include +#include +#include + +#include "dMatrix.h" +#include "lo-utils.h" + +#include "cutils.h" + +class octave_value; +class octave_value_list; +class string_vector; + +extern OCTINTERP_API bool valid_identifier (const char *s); +extern OCTINTERP_API bool valid_identifier (const std::string& s); + +extern OCTINTERP_API bool +same_file (const std::string& f, const std::string& g); + +extern OCTINTERP_API int almost_match (const std::string& std, + const std::string& s, + int min_match_len = 1, + int case_sens = 1); + +extern OCTINTERP_API int +keyword_almost_match (const char * const *std, int *min_len, + const std::string& s, int min_toks_to_match, + int max_toks); + +extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, + octave_idx_type nc); + +extern OCTINTERP_API std::string +search_path_for_file (const std::string&, const string_vector&); + +extern OCTINTERP_API string_vector +search_path_for_all_files (const std::string&, const string_vector&); + +extern OCTINTERP_API std::string +file_in_path (const std::string&, const std::string&); + +extern OCTINTERP_API std::string contents_file_in_path (const std::string&); + +extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); +extern OCTINTERP_API std::string oct_file_in_path (const std::string&); +extern OCTINTERP_API std::string mex_file_in_path (const std::string&); + +extern OCTINTERP_API std::string do_string_escapes (const std::string& s); + +extern OCTINTERP_API const char *undo_string_escape (char c); + +extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); + +extern OCTINTERP_API void +check_dimensions (dim_vector& dim, const char *warnfor); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const char *warn_for, + dim_vector& dim); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a, const octave_value& b, + const char *warn_for, octave_idx_type& nr, + octave_idx_type& nc); + +extern OCTINTERP_API void +get_dimensions (const octave_value& a,const char *warn_for, + octave_idx_type& nr, octave_idx_type& nc); + +extern OCTINTERP_API octave_idx_type +dims_to_numel (const dim_vector& dims, const octave_value_list& idx); + +extern OCTINTERP_API Matrix +identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API FloatMatrix +float_identity_matrix (octave_idx_type nr, octave_idx_type nc); + +extern OCTINTERP_API size_t +octave_format (std::ostream& os, const char *fmt, ...); + +extern OCTINTERP_API size_t +octave_vformat (std::ostream& os, const char *fmt, va_list args); + +extern OCTINTERP_API std::string +octave_vasprintf (const char *fmt, va_list args); + +extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); + +extern OCTINTERP_API void octave_sleep (double seconds); + +extern OCTINTERP_API +octave_value_list +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args, + int nargout); + +extern OCTINTERP_API +octave_value +do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), + const char *fun_name, const octave_value_list& args); + +#endif diff -r 069c552587a0 -r 959953dba519 src/interpfcn/variables.cc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/variables.cc Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,2596 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009-2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include + +#include +#include +#include + +#include "file-stat.h" +#include "oct-env.h" +#include "file-ops.h" +#include "glob-match.h" +#include "regexp.h" +#include "str-vec.h" + +#include +#include "Cell.h" +#include "defun.h" +#include "dirfns.h" +#include "error.h" +#include "gripes.h" +#include "help.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-map.h" +#include "oct-obj.h" +#include "ov.h" +#include "ov-class.h" +#include "ov-usr-fcn.h" +#include "pager.h" +#include "parse.h" +#include "symtab.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// Defines layout for the whos/who -long command +static std::string Vwhos_line_format + = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; + +void +clear_mex_functions (void) +{ + symbol_table::clear_mex_functions (); +} + +void +clear_function (const std::string& nm) +{ + symbol_table::clear_function (nm); +} + +void +clear_variable (const std::string& nm) +{ + symbol_table::clear_variable (nm); +} + +void +clear_symbol (const std::string& nm) +{ + symbol_table::clear_symbol (nm); +} + +// Attributes of variables and functions. + +// Is this octave_value a valid function? + +octave_function * +is_valid_function (const std::string& fcn_name, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + if (! fcn_name.empty ()) + { + octave_value val = symbol_table::find_function (fcn_name); + + if (val.is_defined ()) + ans = val.function_value (true); + } + + if (! ans && warn) + error ("%s: the symbol `%s' is not valid as a function", + warn_for.c_str (), fcn_name.c_str ()); + + return ans; +} + +octave_function * +is_valid_function (const octave_value& arg, + const std::string& warn_for, bool warn) +{ + octave_function *ans = 0; + + std::string fcn_name; + + if (arg.is_string ()) + { + fcn_name = arg.string_value (); + + if (! error_state) + ans = is_valid_function (fcn_name, warn_for, warn); + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + } + else if (warn) + error ("%s: expecting function name as argument", warn_for.c_str ()); + + return ans; +} + +octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer) +{ + octave_function *retval = 0; + + retval = is_valid_function (arg, warn_for, 0); + + if (! retval) + { + std::string s = arg.string_value (); + + std::string cmd = header; + cmd.append (s); + cmd.append (trailer); + + if (! error_state) + { + int parse_status; + + eval_string (cmd, true, parse_status, 0); + + if (parse_status == 0) + { + retval = is_valid_function (fname, warn_for, 0); + + if (! retval) + { + error ("%s: `%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + return retval; + } + + warning ("%s: passing function body as a string is obsolete; please use anonymous functions", + warn_for.c_str ()); + } + else + error ("%s: `%s' is not valid as a function", + warn_for.c_str (), fname.c_str ()); + } + else + error ("%s: expecting first argument to be a string", + warn_for.c_str ()); + } + + return retval; +} + +string_vector +get_struct_elts (const std::string& text) +{ + int n = 1; + + size_t pos = 0; + + size_t len = text.length (); + + while ((pos = text.find ('.', pos)) != std::string::npos) + { + if (++pos == len) + break; + + n++; + } + + string_vector retval (n); + + pos = 0; + + for (int i = 0; i < n; i++) + { + len = text.find ('.', pos); + + if (len != std::string::npos) + len -= pos; + + retval[i] = text.substr (pos, len); + + if (len != std::string::npos) + pos += len + 1; + } + + return retval; +} + +static inline bool +is_variable (const std::string& name) +{ + bool retval = false; + + if (! name.empty ()) + { + octave_value val = symbol_table::varval (name); + + retval = val.is_defined (); + } + + return retval; +} + +string_vector +generate_struct_completions (const std::string& text, + std::string& prefix, std::string& hint) +{ + string_vector names; + + size_t pos = text.rfind ('.'); + + if (pos != std::string::npos) + { + if (pos == text.length ()) + hint = ""; + else + hint = text.substr (pos+1); + + prefix = text.substr (0, pos); + + std::string base_name = prefix; + + pos = base_name.find_first_of ("{(."); + + if (pos != std::string::npos) + base_name = base_name.substr (0, pos); + + if (is_variable (base_name)) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + octave_value tmp = eval_string (prefix, true, parse_status); + + frame.run (); + + if (tmp.is_defined () && tmp.is_map ()) + names = tmp.map_keys (); + } + } + + return names; +} + +// FIXME -- this will have to be much smarter to work +// "correctly". + +bool +looks_like_struct (const std::string& text) +{ + bool retval = (! text.empty () + && text != "." + && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos + && text.find ("..") == std::string::npos + && text.rfind ('.') != std::string::npos); + +#if 0 + symbol_record *sr = curr_sym_tab->lookup (text); + + if (sr && ! sr->is_function ()) + { + int parse_status; + + unwind_protect frame; + + frame.protect_var (discard_error_messages); + frame.protect_var (error_state); + + discard_error_messages = true; + + octave_value tmp = eval_string (text, true, parse_status); + + frame.run (); + + retval = (tmp.is_defined () && tmp.is_map ()); + } +#endif + + return retval; +} + +static octave_value +do_isglobal (const octave_value_list& args) +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin != 1) + { + print_usage (); + return retval; + } + + std::string name = args(0).string_value (); + + if (error_state) + { + error ("isglobal: NAME must be a string"); + return retval; + } + + return symbol_table::is_global (name); +} + +DEFUN (isglobal, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ +Return true if @var{name} is a globally visible variable.\n\ +For example:\n\ +\n\ +@example\n\ +@group\n\ +global x\n\ +isglobal (\"x\")\n\ + @result{} 1\n\ +@end group\n\ +@end example\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + return do_isglobal (args); +} + +static octave_value +safe_symbol_lookup (const std::string& symbol_name) +{ + octave_value retval; + + unwind_protect frame; + interpreter_try (frame); + + retval = symbol_table::find (symbol_name); + + error_state = 0; + + return retval; +} + +int +symbol_exist (const std::string& name, const std::string& type) +{ + int retval = 0; + + std::string struct_elts; + std::string symbol_name = name; + + size_t pos = name.find ('.'); + + if (pos != std::string::npos && pos > 0) + { + struct_elts = name.substr (pos+1); + symbol_name = name.substr (0, pos); + } + + // We shouldn't need to look in the global symbol table, since any + // name that is visible in the current scope will be in the local + // symbol table. + + octave_value val = safe_symbol_lookup (symbol_name); + + if (val.is_defined ()) + { + bool not_a_struct = struct_elts.empty (); + bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; + + if (! retval + && var_ok + && (type == "any" || type == "var") + && (val.is_constant () || val.is_object () + || val.is_function_handle () + || val.is_anonymous_function () + || val.is_inline_function ())) + { + retval = 1; + } + + if (! retval + && (type == "any" || type == "builtin")) + { + if (not_a_struct && val.is_builtin_function ()) + { + retval = 5; + } + } + + if (! retval + && not_a_struct + && (type == "any" || type == "file") + && (val.is_user_function () || val.is_dld_function ())) + { + octave_function *f = val.function_value (true); + std::string s = f ? f->fcn_file_name () : std::string (); + + retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); + } + } + + if (! (type == "var" || type == "builtin")) + { + if (! retval) + { + std::string file_name = lookup_autoload (name); + + if (file_name.empty ()) + file_name = load_path::find_fcn (name); + + size_t len = file_name.length (); + + if (len > 0) + { + if (type == "any" || type == "file") + { + if (len > 4 && (file_name.substr (len-4) == ".oct" + || file_name.substr (len-4) == ".mex")) + retval = 3; + else + retval = 2; + } + } + } + + if (! retval) + { + std::string file_name = file_in_path (name, ""); + + if (file_name.empty ()) + file_name = name; + + file_stat fs (file_name); + + if (fs) + { + if (type == "any" || type == "file") + retval = fs.is_dir () ? 7 : 2; + else if (type == "dir" && fs.is_dir ()) + retval = 7; + } + } + } + + return retval; +} + +#define GET_IDX(LEN) \ + static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) + +std::string +unique_symbol_name (const std::string& basename) +{ + static const std::string alpha + = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; + + static size_t len = alpha.length (); + + std::string nm = basename + alpha[GET_IDX (len)]; + + size_t pos = nm.length (); + + if (nm.substr (0, 2) == "__") + nm.append ("__"); + + while (symbol_exist (nm, "any")) + nm.insert (pos++, 1, alpha[GET_IDX (len)]); + + return nm; +} + +DEFUN (exist, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ +Return 1 if the name exists as a variable, 2 if the name is an\n\ +absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ +appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ +name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ +5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ +if the name is a function not associated with a file (entered on\n\ +the command line).\n\ +\n\ +Otherwise, return 0.\n\ +\n\ +This function also returns 2 if a regular file called @var{name}\n\ +exists in Octave's search path. If you want information about\n\ +other types of files, you should use some combination of the functions\n\ +@code{file_in_path} and @code{stat} instead.\n\ +\n\ +If the optional argument @var{type} is supplied, check only for\n\ +symbols of the specified type. Valid types are\n\ +\n\ +@table @asis\n\ +@item \"var\"\n\ +Check only for variables.\n\ +\n\ +@item \"builtin\"\n\ +Check only for built-in functions.\n\ +\n\ +@item \"file\"\n\ +Check only for files.\n\ +\n\ +@item \"dir\"\n\ +Check only for directories.\n\ +@end table\n\ +\n\ +@seealso{file_in_loadpath}\n\ +@end deftypefn") +{ + octave_value retval = false; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string name = args(0).string_value (); + + if (! error_state) + { + std::string type + = (nargin == 2) ? args(1).string_value () : std::string ("any"); + + if (! error_state) + retval = symbol_exist (name, type); + else + error ("exist: TYPE must be a string"); + } + else + error ("exist: NAME must be a string"); + } + else + print_usage (); + + return retval; +} + +/* +%!test +%! if (isunix ()) +%! assert (exist ("/tmp") == 7); +%! assert (exist ("/tmp", "file") == 7); +%! assert (exist ("/tmp", "dir") == 7); +%! assert (exist ("/bin/sh") == 2); +%! assert (exist ("/bin/sh", "file") == 2); +%! assert (exist ("/bin/sh", "dir") == 0); +%! assert (exist ("/dev/null") == 2); +%! assert (exist ("/dev/null", "file") == 2); +%! assert (exist ("/dev/null", "dir") == 0); +%! endif +*/ + +octave_value +lookup_function_handle (const std::string& nm) +{ + octave_value val = symbol_table::varval (nm); + + return val.is_function_handle () ? val : octave_value (); +} + +octave_value +get_global_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::global_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_global_value: undefined symbol `%s'", nm.c_str ()); + + return val; +} + +void +set_global_value (const std::string& nm, const octave_value& val) +{ + symbol_table::global_varref (nm) = val; +} + +octave_value +get_top_level_value (const std::string& nm, bool silent) +{ + octave_value val = symbol_table::top_level_varval (nm); + + if (val.is_undefined () && ! silent) + error ("get_top_level_value: undefined symbol `%s'", nm.c_str ()); + + return val; +} + +void +set_top_level_value (const std::string& nm, const octave_value& val) +{ + symbol_table::top_level_varref (nm) = val; +} + +// Variable values. + +static bool +wants_local_change (const octave_value_list& args, int& nargin) +{ + bool retval = false; + + if (nargin == 2) + { + if (args(1).is_string () && args(1).string_value () == "local") + { + nargin = 1; + retval = true; + } + else + { + error_with_cfn ("expecting second argument to be \"local\""); + nargin = 0; + } + } + + return retval; +} + +template +bool try_local_protect (T& var) +{ + octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); + octave_user_function *curr_usr_fcn = 0; + if (curr_usr_code && curr_usr_code->is_user_function ()) + curr_usr_fcn = dynamic_cast (curr_usr_code); + + if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) + return true; + else + return false; +} + +octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + bool bval = args(0).bool_value (); + + if (! error_state) + var = bval; + else + error ("%s: expecting arg to be a logical value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + switch (sval.length ()) + { + case 1: + var = sval[0]; + break; + + case 0: + var = '\0'; + break; + + default: + error ("%s: argument must be a single character", nm); + break; + } + } + else + error ("%s: argument must be a single character", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval, int maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + int ival = args(0).int_value (); + + if (! error_state) + { + if (ival < minval) + error ("%s: expecting arg to be greater than %d", nm, minval); + else if (ival > maxval) + error ("%s: expecting arg to be less than or equal to %d", + nm, maxval); + else + var = ival; + } + else + error ("%s: expecting arg to be an integer value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval, double maxval) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + double dval = args(0).scalar_value (); + + if (! error_state) + { + if (dval < minval) + error ("%s: expecting arg to be greater than %g", minval); + else if (dval > maxval) + error ("%s: expecting arg to be less than or equal to %g", maxval); + else + var = dval; + } + else + error ("%s: expecting arg to be a scalar value", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok) +{ + octave_value retval; + + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) + retval = var; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + if (empty_ok || ! sval.empty ()) + var = sval; + else + error ("%s: value must not be empty", nm); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices) +{ + octave_value retval; + int nchoices = 0; + while (choices[nchoices] != 0) + nchoices++; + + int nargin = args.length (); + assert (var < nchoices); + + if (nargout > 0 || nargin == 0) + retval = choices[var]; + + if (wants_local_change (args, nargin)) + { + if (! try_local_protect (var)) + warning ("\"local\" has no effect outside a function"); + } + + if (nargin == 1) + { + std::string sval = args(0).string_value (); + + if (! error_state) + { + int i = 0; + for (; i < nchoices; i++) + { + if (sval == choices[i]) + { + var = i; + break; + } + } + if (i == nchoices) + error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); + } + else + error ("%s: expecting arg to be a character string", nm); + } + else if (nargin > 1) + print_usage (); + + return retval; +} + +struct +whos_parameter +{ + char command; + char modifier; + int parameter_length; + int first_parameter_length; + int balance; + std::string text; + std::string line; +}; + +static void +print_descriptor (std::ostream& os, std::list params) +{ + // This method prints a line of information on a given symbol + std::list::iterator i = params.begin (); + std::ostringstream param_buf; + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command != 's') + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); + } + + if (param.command == 's' && param.modifier == 'c') + { + int a, b; + + if (param.modifier == 'c') + { + a = param.first_parameter_length - param.balance; + a = (a < 0 ? 0 : a); + b = param.parameter_length - a - param.text . length (); + b = (b < 0 ? 0 : b); + os << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.text + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + param_buf << std::setiosflags (std::ios::left) << std::setw (a) + << "" << std::resetiosflags (std::ios::left) << param.line + << std::setiosflags (std::ios::left) + << std::setw (b) << "" + << std::resetiosflags (std::ios::left); + } + } + else + { + os << param.text; + param_buf << param.line; + } + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + param_buf << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + param_buf << param.line; + i++; + } + } + + os << param_buf.str (); +} + +// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() +// and if val is an object, expect that dims will call size if it is +// overloaded by a user-defined method. But there are currently some +// unresolved const issues that prevent that solution from working. + +std::string +get_dims_str (const octave_value& val) +{ + octave_value tmp = val; + + Matrix sz = tmp.size (); + + dim_vector dv = dim_vector::alloc (sz.numel ()); + + for (octave_idx_type i = 0; i < dv.length (); i++) + dv(i) = sz(i); + + return dv.str (); +} + +class +symbol_info_list +{ +private: + struct symbol_info + { + symbol_info (const symbol_table::symbol_record& sr, + const std::string& expr_str = std::string (), + const octave_value& expr_val = octave_value ()) + : name (expr_str.empty () ? sr.name () : expr_str), + varval (expr_val.is_undefined () ? sr.varval () : expr_val), + is_automatic (sr.is_automatic ()), + is_complex (varval.is_complex_type ()), + is_formal (sr.is_formal ()), + is_global (sr.is_global ()), + is_persistent (sr.is_persistent ()) + { } + + void display_line (std::ostream& os, + const std::list& params) const + { + std::string dims_str = get_dims_str (varval); + + std::list::const_iterator i = params.begin (); + + while (i != params.end ()) + { + whos_parameter param = *i; + + if (param.command != '\0') + { + // Do the actual printing. + + switch (param.modifier) + { + case 'l': + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + break; + + case 'r': + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + break; + + case 'c': + if (param.command == 's') + { + int front = param.first_parameter_length + - dims_str.find ('x'); + int back = param.parameter_length + - dims_str.length () + - front; + front = (front > 0) ? front : 0; + back = (back > 0) ? back : 0; + + os << std::setiosflags (std::ios::left) + << std::setw (front) + << "" + << std::resetiosflags (std::ios::left) + << dims_str + << std::setiosflags (std::ios::left) + << std::setw (back) + << "" + << std::resetiosflags (std::ios::left); + } + else + { + os << std::setiosflags (std::ios::left) + << std::setw (param.parameter_length); + } + break; + + default: + error ("whos_line_format: modifier `%c' unknown", + param.modifier); + + os << std::setiosflags (std::ios::right) + << std::setw (param.parameter_length); + } + + switch (param.command) + { + case 'a': + { + char tmp[6]; + + tmp[0] = (is_automatic ? 'a' : ' '); + tmp[1] = (is_complex ? 'c' : ' '); + tmp[2] = (is_formal ? 'f' : ' '); + tmp[3] = (is_global ? 'g' : ' '); + tmp[4] = (is_persistent ? 'p' : ' '); + tmp[5] = 0; + + os << tmp; + } + break; + + case 'b': + os << varval.byte_size (); + break; + + case 'c': + os << varval.class_name (); + break; + + case 'e': + os << varval.capacity (); + break; + + case 'n': + os << name; + break; + + case 's': + if (param.modifier != 'c') + os << dims_str; + break; + + case 't': + os << varval.type_name (); + break; + + default: + error ("whos_line_format: command `%c' unknown", + param.command); + } + + os << std::resetiosflags (std::ios::left) + << std::resetiosflags (std::ios::right); + i++; + } + else + { + os << param.text; + i++; + } + } + } + + std::string name; + octave_value varval; + bool is_automatic; + bool is_complex; + bool is_formal; + bool is_global; + bool is_persistent; + }; + +public: + symbol_info_list (void) : lst () { } + + symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } + + symbol_info_list& operator = (const symbol_info_list& sil) + { + if (this != &sil) + lst = sil.lst; + + return *this; + } + + ~symbol_info_list (void) { } + + void append (const symbol_table::symbol_record& sr) + { + lst.push_back (symbol_info (sr)); + } + + void append (const symbol_table::symbol_record& sr, + const std::string& expr_str, + const octave_value& expr_val) + { + lst.push_back (symbol_info (sr, expr_str, expr_val)); + } + + size_t size (void) const { return lst.size (); } + + bool empty (void) const { return lst.empty (); } + + octave_map + map_value (const std::string& caller_function_name, int nesting_level) const + { + size_t len = lst.size (); + + Cell name_info (len, 1); + Cell size_info (len, 1); + Cell bytes_info (len, 1); + Cell class_info (len, 1); + Cell global_info (len, 1); + Cell sparse_info (len, 1); + Cell complex_info (len, 1); + Cell nesting_info (len, 1); + Cell persistent_info (len, 1); + + std::list::const_iterator p = lst.begin (); + + for (size_t j = 0; j < len; j++) + { + const symbol_info& si = *p++; + + octave_scalar_map ni; + + ni.assign ("function", caller_function_name); + ni.assign ("level", nesting_level); + + name_info(j) = si.name; + global_info(j) = si.is_global; + persistent_info(j) = si.is_persistent; + + octave_value val = si.varval; + + size_info(j) = val.size (); + bytes_info(j) = val.byte_size (); + class_info(j) = val.class_name (); + sparse_info(j) = val.is_sparse_type (); + complex_info(j) = val.is_complex_type (); + nesting_info(j) = ni; + } + + octave_map info; + + info.assign ("name", name_info); + info.assign ("size", size_info); + info.assign ("bytes", bytes_info); + info.assign ("class", class_info); + info.assign ("global", global_info); + info.assign ("sparse", sparse_info); + info.assign ("complex", complex_info); + info.assign ("nesting", nesting_info); + info.assign ("persistent", persistent_info); + + return info; + } + + void display (std::ostream& os) + { + if (! lst.empty ()) + { + size_t bytes = 0; + size_t elements = 0; + + std::list params = parse_whos_line_format (); + + print_descriptor (os, params); + + octave_stdout << "\n"; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + p->display_line (os, params); + + octave_value val = p->varval; + + elements += val.capacity (); + bytes += val.byte_size (); + } + + os << "\nTotal is " << elements + << (elements == 1 ? " element" : " elements") + << " using " << bytes << (bytes == 1 ? " byte" : " bytes") + << "\n"; + } + } + + // Parse the string whos_line_format, and return a parameter list, + // containing all information needed to print the given + // attributtes of the symbols. + std::list parse_whos_line_format (void) + { + int idx; + size_t format_len = Vwhos_line_format.length (); + char garbage; + std::list params; + + size_t bytes1; + int elements1; + + std::string param_string = "abcenst"; + Array param_length (dim_vector (param_string.length (), 1)); + Array param_names (dim_vector (param_string.length (), 1)); + size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; + + pos_a = param_string.find ('a'); // Attributes + pos_b = param_string.find ('b'); // Bytes + pos_c = param_string.find ('c'); // Class + pos_e = param_string.find ('e'); // Elements + pos_n = param_string.find ('n'); // Name + pos_s = param_string.find ('s'); // Size + pos_t = param_string.find ('t'); // Type + + param_names(pos_a) = "Attr"; + param_names(pos_b) = "Bytes"; + param_names(pos_c) = "Class"; + param_names(pos_e) = "Elements"; + param_names(pos_n) = "Name"; + param_names(pos_s) = "Size"; + param_names(pos_t) = "Type"; + + for (size_t i = 0; i < param_string.length (); i++) + param_length(i) = param_names(i).length (); + + // The attribute column needs size 5. + param_length(pos_a) = 5; + + // Calculating necessary spacing for name column, + // bytes column, elements column and class column + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + std::stringstream ss1, ss2; + std::string str; + + str = p->name; + param_length(pos_n) = ((str.length () + > static_cast (param_length(pos_n))) + ? str.length () : param_length(pos_n)); + + octave_value val = p->varval; + + str = val.type_name (); + param_length(pos_t) = ((str.length () + > static_cast (param_length(pos_t))) + ? str.length () : param_length(pos_t)); + + elements1 = val.capacity (); + ss1 << elements1; + str = ss1.str (); + param_length(pos_e) = ((str.length () + > static_cast (param_length(pos_e))) + ? str.length () : param_length(pos_e)); + + bytes1 = val.byte_size (); + ss2 << bytes1; + str = ss2.str (); + param_length(pos_b) = ((str.length () + > static_cast (param_length(pos_b))) + ? str.length () : param_length (pos_b)); + } + + idx = 0; + while (static_cast (idx) < format_len) + { + whos_parameter param; + param.command = '\0'; + + if (Vwhos_line_format[idx] == '%') + { + bool error_encountered = false; + param.modifier = 'r'; + param.parameter_length = 0; + + int a = 0, b = -1, balance = 1; + unsigned int items; + size_t pos; + std::string cmd; + + // Parse one command from whos_line_format + cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = cmd.find (';'); + if (pos != std::string::npos) + cmd = cmd.substr (0, pos+1); + else + error ("parameter without ; in whos_line_format"); + + idx += cmd.length (); + + // FIXME -- use iostream functions instead of sscanf! + + if (cmd.find_first_of ("crl") != 1) + items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", + &garbage, ¶m.command, &a, &b, &balance); + else + items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", + &garbage, ¶m.modifier, ¶m.command, + &a, &b, &balance) - 1; + + if (items < 2) + { + error ("whos_line_format: parameter structure without command in whos_line_format"); + error_encountered = true; + } + + // Insert data into parameter + param.first_parameter_length = 0; + pos = param_string.find (param.command); + if (pos != std::string::npos) + { + param.parameter_length = param_length(pos); + param.text = param_names(pos); + param.line.assign (param_names(pos).length (), '='); + + param.parameter_length = (a > param.parameter_length + ? a : param.parameter_length); + if (param.command == 's' && param.modifier == 'c' && b > 0) + param.first_parameter_length = b; + } + else + { + error ("whos_line_format: '%c' is not a command", + param.command); + error_encountered = true; + } + + if (param.command == 's') + { + // Have to calculate space needed for printing + // matrix dimensions Space needed for Size column is + // hard to determine in prior, because it depends on + // dimensions to be shown. That is why it is + // recalculated for each Size-command int first, + // rest = 0, total; + int rest = 0; + int first = param.first_parameter_length; + int total = param.parameter_length; + + for (std::list::const_iterator p = lst.begin (); + p != lst.end (); p++) + { + octave_value val = p->varval; + std::string dims_str = get_dims_str (val); + int first1 = dims_str.find ('x'); + int total1 = dims_str.length (); + int rest1 = total1 - first1; + rest = (rest1 > rest ? rest1 : rest); + first = (first1 > first ? first1 : first); + total = (total1 > total ? total1 : total); + } + + if (param.modifier == 'c') + { + if (first < balance) + first += balance - first; + if (rest + balance < param.parameter_length) + rest += param.parameter_length - rest - balance; + + param.parameter_length = first + rest; + param.first_parameter_length = first; + param.balance = balance; + } + else + { + param.parameter_length = total; + param.first_parameter_length = 0; + } + } + else if (param.modifier == 'c') + { + error ("whos_line_format: modifier 'c' not available for command '%c'", + param.command); + error_encountered = true; + } + + // What happens if whos_line_format contains negative numbers + // at param_length positions? + param.balance = (b < 0 ? 0 : param.balance); + param.first_parameter_length = (b < 0 ? 0 : + param.first_parameter_length); + param.parameter_length = (a < 0 + ? 0 + : (param.parameter_length + < param_length(pos_s) + ? param_length(pos_s) + : param.parameter_length)); + + // Parameter will not be pushed into parameter list if ... + if (! error_encountered) + params.push_back (param); + } + else + { + // Text string, to be printed as it is ... + std::string text; + size_t pos; + text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); + pos = text.find ('%'); + if (pos != std::string::npos) + text = text.substr (0, pos); + + // Push parameter into list ... + idx += text.length (); + param.text=text; + param.line.assign (text.length (), ' '); + params.push_back (param); + } + } + + return params; + } + +private: + std::list lst; + +}; + +static octave_value +do_who (int argc, const string_vector& argv, bool return_list, + bool verbose = false, std::string msg = std::string ()) +{ + octave_value retval; + + std::string my_name = argv[0]; + + bool global_only = false; + bool have_regexp = false; + + int i; + for (i = 1; i < argc; i++) + { + if (argv[i] == "-file") + { + // FIXME. This is an inefficient manner to implement this as the + // variables are loaded in to a temporary context and then treated. + // It would be better to refecat symbol_info_list to not store the + // symbol records and then use it in load-save.cc (do_load) to + // implement this option there so that the variables are never + // stored at all. + if (i == argc - 1) + error ("whos: -file argument must be followed by a file name"); + else + { + std::string nm = argv[i + 1]; + + unwind_protect frame; + + // Set up temporary scope. + + symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); + frame.add_fcn (symbol_table::erase_scope, tmp_scope); + + symbol_table::set_scope (tmp_scope); + + octave_call_stack::push (tmp_scope, 0); + frame.add_fcn (octave_call_stack::pop); + + frame.add_fcn (symbol_table::clear_variables); + + feval ("load", octave_value (nm), 0); + + if (! error_state) + { + std::string newmsg = std::string ("Variables in the file ") + + nm + ":\n\n"; + + retval = do_who (i, argv, return_list, verbose, newmsg); + } + } + + return retval; + } + else if (argv[i] == "-regexp") + have_regexp = true; + else if (argv[i] == "global") + global_only = true; + else if (argv[i][0] == '-') + warning ("%s: unrecognized option `%s'", my_name.c_str (), + argv[i].c_str ()); + else + break; + } + + int npats = argc - i; + string_vector pats; + if (npats > 0) + { + pats.resize (npats); + for (int j = 0; j < npats; j++) + pats[j] = argv[i+j]; + } + else + { + pats.resize (++npats); + pats[0] = "*"; + } + + symbol_info_list symbol_stats; + std::list symbol_names; + + for (int j = 0; j < npats; j++) + { + std::string pat = pats[j]; + + if (have_regexp) + { + std::list tmp = global_only + ? symbol_table::regexp_global_variables (pat) + : symbol_table::regexp_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + else + { + size_t pos = pat.find_first_of (".({"); + + if (pos != std::string::npos && pos > 0) + { + if (verbose) + { + // NOTE: we can only display information for + // expressions based on global values if the variable is + // global in the current scope because we currently have + // no way of looking up the base value in the global + // scope and then evaluating the arguments in the + // current scope. + + std::string base_name = pat.substr (0, pos); + + if (symbol_table::is_variable (base_name)) + { + symbol_table::symbol_record sr + = symbol_table::find_symbol (base_name); + + if (! global_only || sr.is_global ()) + { + int parse_status; + + octave_value expr_val + = eval_string (pat, true, parse_status); + + if (! error_state) + symbol_stats.append (sr, pat, expr_val); + else + return retval; + } + } + } + } + else + { + std::list tmp = global_only + ? symbol_table::glob_global_variables (pat) + : symbol_table::glob_variables (pat); + + for (std::list::const_iterator p = tmp.begin (); + p != tmp.end (); p++) + { + if (p->is_variable ()) + { + if (verbose) + symbol_stats.append (*p); + else + symbol_names.push_back (p->name ()); + } + } + } + } + } + + if (return_list) + { + if (verbose) + { + std::string caller_function_name; + octave_function *caller = octave_call_stack::caller (); + if (caller) + caller_function_name = caller->name (); + + retval = symbol_stats.map_value (caller_function_name, 1); + } + else + retval = Cell (string_vector (symbol_names)); + } + else if (! (symbol_stats.empty () && symbol_names.empty ())) + { + if (msg.length () == 0) + if (global_only) + octave_stdout << "Global variables:\n\n"; + else + octave_stdout << "Variables in the current scope:\n\n"; + else + octave_stdout << msg; + + if (verbose) + symbol_stats.display (octave_stdout); + else + { + string_vector names (symbol_names); + + names.list_in_columns (octave_stdout); + } + + octave_stdout << "\n"; + } + + return retval; +} + +DEFUN (who, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} who\n\ +@deftypefnx {Command} {} who pattern @dots{}\n\ +@deftypefnx {Command} {} who option pattern @dots{}\n\ +@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ +List currently defined variables matching the given patterns. Valid\n\ +pattern syntax is the same as described for the @code{clear} command.\n\ +If no patterns are supplied, all variables are listed.\n\ +By default, only variables visible in the local scope are displayed.\n\ +\n\ +The following are valid options but may not be combined.\n\ +\n\ +@table @code\n\ +@item global\n\ +List variables in the global scope rather than the current scope.\n\ +\n\ +@item -regexp\n\ +The patterns are considered to be regular expressions when matching the\n\ +variables to display. The same pattern syntax accepted by\n\ +the @code{regexp} function is used.\n\ +\n\ +@item -file\n\ +The next argument is treated as a filename. All variables found within the\n\ +specified file are listed. No patterns are accepted when reading variables\n\ +from a file.\n\ +@end table\n\ +\n\ +If called as a function, return a cell array of defined variable names\n\ +matching the given patterns.\n\ +@seealso{whos, isglobal, isvarname, exist, regexp}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("who"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1); + } + else + print_usage (); + + return retval; +} + +DEFUN (whos, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Command} {} whos\n\ +@deftypefnx {Command} {} whos pattern @dots{}\n\ +@deftypefnx {Command} {} whos option pattern @dots{}\n\ +@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ +Provide detailed information on currently defined variables matching the\n\ +given patterns. Options and pattern syntax are the same as for the\n\ +@code{who} command. Extended information about each variable is\n\ +summarized in a table with the following default entries.\n\ +\n\ +@table @asis\n\ +@item Attr\n\ +Attributes of the listed variable. Possible attributes are:\n\ +\n\ +@table @asis\n\ +@item blank\n\ +Variable in local scope\n\ +\n\ +@item @code{a}\n\ +Automatic variable. An automatic variable is one created by the\n\ +interpreter, for example @code{argn}.\n\ +\n\ +@item @code{c}\n\ +Variable of complex type.\n\ +\n\ +@item @code{f}\n\ +Formal parameter (function argument).\n\ +\n\ +@item @code{g}\n\ +Variable with global scope.\n\ +\n\ +@item @code{p}\n\ +Persistent variable.\n\ +@end table\n\ +\n\ +@item Name\n\ +The name of the variable.\n\ +\n\ +@item Size\n\ +The logical size of the variable. A scalar is 1x1, a vector is\n\ +@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ +\n\ +@item Bytes\n\ +The amount of memory currently used to store the variable.\n\ +\n\ +@item Class\n\ +The class of the variable. Examples include double, single, char, uint16,\n\ +cell, and struct.\n\ +@end table\n\ +\n\ +The table can be customized to display more or less information through\n\ +the function @code{whos_line_format}.\n\ +\n\ +If @code{whos} is called as a function, return a struct array of defined\n\ +variable names matching the given patterns. Fields in the structure\n\ +describing each variable are: name, size, bytes, class, global, sparse,\n\ +complex, nesting, persistent.\n\ +@seealso{who, whos_line_format}\n\ +@end deftypefn") +{ + octave_value retval; + + if (nargout < 2) + { + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("whos"); + + if (! error_state) + retval = do_who (argc, argv, nargout == 1, true); + } + else + print_usage (); + + return retval; +} + +// Defining variables. + +void +bind_ans (const octave_value& val, bool print) +{ + static std::string ans = "ans"; + + if (val.is_defined ()) + { + if (val.is_cs_list ()) + { + octave_value_list lst = val.list_value (); + + for (octave_idx_type i = 0; i < lst.length (); i++) + bind_ans (lst(i), print); + } + else + { + symbol_table::varref (ans) = val; + + if (print) + val.print_with_name (octave_stdout, ans); + } + } +} + +void +bind_internal_variable (const std::string& fname, const octave_value& val) +{ + octave_value_list args; + + args(0) = val; + + feval (fname, args, 0); +} + +void +mlock (void) +{ + octave_function *fcn = octave_call_stack::current (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); +} + +void +munlock (const std::string& nm) +{ + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + fcn->unlock (); + } +} + +bool +mislocked (const std::string& nm) +{ + bool retval = false; + + octave_value val = symbol_table::find_function (nm); + + if (val.is_defined ()) + { + octave_function *fcn = val.function_value (); + + if (fcn) + retval = fcn->islocked (); + } + + return retval; +} + +DEFUN (mlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mlock ()\n\ +Lock the current function into memory so that it can't be cleared.\n\ +@seealso{munlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->lock (); + else + error ("mlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +DEFUN (munlock, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} munlock ()\n\ +@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ +Unlock the named function @var{fcn}. If no function is named\n\ +then unlock the current function.\n\ +@seealso{mlock, mislocked, persistent}\n\ +@end deftypefn") +{ + octave_value_list retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + munlock (name); + else + error ("munlock: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + fcn->unlock (); + else + error ("munlock: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + + +DEFUN (mislocked, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mislocked ()\n\ +@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ +Return true if the named function @var{fcn} is locked. If no function is\n\ +named then return true if the current function is locked.\n\ +@seealso{mlock, munlock, persistent}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = mislocked (name); + else + error ("mislocked: FCN must be a string"); + } + else if (args.length () == 0) + { + octave_function *fcn = octave_call_stack::caller (); + + if (fcn) + retval = fcn->islocked (); + else + error ("mislocked: invalid use outside a function"); + } + else + print_usage (); + + return retval; +} + +// Deleting names from the symbol tables. + +static inline bool +name_matches_any_pattern (const std::string& nm, const string_vector& argv, + int argc, int idx, bool have_regexp = false) +{ + bool retval = false; + + for (int k = idx; k < argc; k++) + { + std::string patstr = argv[k]; + if (! patstr.empty ()) + { + if (have_regexp) + { + if (is_regexp_match (patstr, nm)) + { + retval = true; + break; + } + } + else + { + glob_match pattern (patstr); + + if (pattern.match (nm)) + { + retval = true; + break; + } + } + } + } + + return retval; +} + +static inline void +maybe_warn_exclusive (bool exclusive) +{ + if (exclusive) + warning ("clear: ignoring --exclusive option"); +} + +static void +do_clear_functions (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_functions (); + else + { + if (exclusive) + { + string_vector fcns = symbol_table::user_function_names (); + + int fcount = fcns.length (); + + for (int i = 0; i < fcount; i++) + { + std::string nm = fcns[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_function (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_function_pattern (argv[idx++]); + } + } +} + +static void +do_clear_globals (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + symbol_table::clear_global (gvars[i]); + } + else + { + if (exclusive) + { + string_vector gvars = symbol_table::global_variable_names (); + + int gcount = gvars.length (); + + for (int i = 0; i < gcount; i++) + { + std::string nm = gvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx)) + symbol_table::clear_global (nm); + } + } + else + { + while (idx < argc) + symbol_table::clear_global_pattern (argv[idx++]); + } + } +} + +static void +do_clear_variables (const string_vector& argv, int argc, int idx, + bool exclusive = false, bool have_regexp = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + string_vector lvars = symbol_table::variable_names (); + + int lcount = lvars.length (); + + for (int i = 0; i < lcount; i++) + { + std::string nm = lvars[i]; + + if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) + symbol_table::clear_variable (nm); + } + } + else + { + if (have_regexp) + while (idx < argc) + symbol_table::clear_variable_regexp (argv[idx++]); + else + while (idx < argc) + symbol_table::clear_variable_pattern (argv[idx++]); + } + } +} + +static void +do_clear_symbols (const string_vector& argv, int argc, int idx, + bool exclusive = false) +{ + if (idx == argc) + symbol_table::clear_variables (); + else + { + if (exclusive) + { + // FIXME -- is this really what we want, or do we + // somehow want to only clear the functions that are not + // shadowed by local variables? It seems that would be a + // bit harder to do. + + do_clear_variables (argv, argc, idx, exclusive); + do_clear_functions (argv, argc, idx, exclusive); + } + else + { + while (idx < argc) + symbol_table::clear_symbol_pattern (argv[idx++]); + } + } +} + +static void +do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) +{ + // This is supposed to be mostly Matlab compatible. + + for (; idx < argc; idx++) + { + if (argv[idx] == "all" + && ! symbol_table::is_local_variable ("all")) + { + symbol_table::clear_all (); + } + else if (argv[idx] == "functions" + && ! symbol_table::is_local_variable ("functions")) + { + do_clear_functions (argv, argc, ++idx); + } + else if (argv[idx] == "global" + && ! symbol_table::is_local_variable ("global")) + { + do_clear_globals (argv, argc, ++idx); + } + else if (argv[idx] == "variables" + && ! symbol_table::is_local_variable ("variables")) + { + symbol_table::clear_variables (); + } + else if (argv[idx] == "classes" + && ! symbol_table::is_local_variable ("classes")) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + symbol_table::clear_symbol_pattern (argv[idx]); + } + } +} + +#define CLEAR_OPTION_ERROR(cond) \ + do \ + { \ + if (cond) \ + { \ + print_usage (); \ + return retval; \ + } \ + } \ + while (0) + +DEFUN (clear, args, , + "-*- texinfo -*-\n\ +@deftypefn {Command} {} clear [options] pattern @dots{}\n\ +Delete the names matching the given patterns from the symbol table. The\n\ +pattern may contain the following special characters:\n\ +\n\ +@table @code\n\ +@item ?\n\ +Match any single character.\n\ +\n\ +@item *\n\ +Match zero or more characters.\n\ +\n\ +@item [ @var{list} ]\n\ +Match the list of characters specified by @var{list}. If the first\n\ +character is @code{!} or @code{^}, match all characters except those\n\ +specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ +match all lowercase and uppercase alphabetic characters.\n\ +@end table\n\ +\n\ +For example, the command\n\ +\n\ +@example\n\ +clear foo b*r\n\ +@end example\n\ +\n\ +@noindent\n\ +clears the name @code{foo} and all names that begin with the letter\n\ +@code{b} and end with the letter @code{r}.\n\ +\n\ +If @code{clear} is called without any arguments, all user-defined\n\ +variables (local and global) are cleared from the symbol table. If\n\ +@code{clear} is called with at least one argument, only the visible\n\ +names matching the arguments are cleared. For example, suppose you have\n\ +defined a function @code{foo}, and then hidden it by performing the\n\ +assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ +will clear the variable definition and restore the definition of\n\ +@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ +clear the function definition.\n\ +\n\ +The following options are available in both long and short form\n\ +\n\ +@table @code\n\ +@item -all, -a\n\ +Clears all local and global user-defined variables and all functions\n\ +from the symbol table.\n\ +\n\ +@item -exclusive, -x\n\ +Clears the variables that don't match the following pattern.\n\ +\n\ +@item -functions, -f\n\ +Clears the function names and the built-in symbols names.\n\ +\n\ +@item -global, -g\n\ +Clears the global symbol names.\n\ +\n\ +@item -variables, -v\n\ +Clears the local variable names.\n\ +\n\ +@item -classes, -c\n\ +Clears the class structure table and clears all objects.\n\ +\n\ +@item -regexp, -r\n\ +The arguments are treated as regular expressions as any variables that\n\ +match will be cleared.\n\ +@end table\n\ +\n\ +With the exception of @code{exclusive}, all long options can be used\n\ +without the dash as well.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("clear"); + + if (! error_state) + { + if (argc == 1) + { + do_clear_globals (argv, argc, 1); + do_clear_variables (argv, argc, 1); + } + else + { + int idx = 0; + + bool clear_all = false; + bool clear_functions = false; + bool clear_globals = false; + bool clear_variables = false; + bool clear_objects = false; + bool exclusive = false; + bool have_regexp = false; + bool have_dash_option = false; + + while (++idx < argc) + { + if (argv[idx] == "-all" || argv[idx] == "-a") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_all = true; + } + else if (argv[idx] == "-exclusive" || argv[idx] == "-x") + { + have_dash_option = true; + exclusive = true; + } + else if (argv[idx] == "-functions" || argv[idx] == "-f") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_functions = true; + } + else if (argv[idx] == "-global" || argv[idx] == "-g") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_globals = true; + } + else if (argv[idx] == "-variables" || argv[idx] == "-v") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_variables = true; + } + else if (argv[idx] == "-classes" || argv[idx] == "-c") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + clear_objects = true; + } + else if (argv[idx] == "-regexp" || argv[idx] == "-r") + { + CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); + + have_dash_option = true; + have_regexp = true; + } + else + break; + } + + if (idx <= argc) + { + if (! have_dash_option) + { + do_matlab_compatible_clear (argv, argc, idx); + } + else + { + if (clear_all) + { + maybe_warn_exclusive (exclusive); + + if (++idx < argc) + warning + ("clear: ignoring extra arguments after -all"); + + symbol_table::clear_all (); + } + else if (have_regexp) + { + do_clear_variables (argv, argc, idx, exclusive, true); + } + else if (clear_functions) + { + do_clear_functions (argv, argc, idx, exclusive); + } + else if (clear_globals) + { + do_clear_globals (argv, argc, idx, exclusive); + } + else if (clear_variables) + { + do_clear_variables (argv, argc, idx, exclusive); + } + else if (clear_objects) + { + symbol_table::clear_objects (); + octave_class::clear_exemplar_map (); + } + else + { + do_clear_symbols (argv, argc, idx, exclusive); + } + } + } + } + } + + return retval; +} + +DEFUN (whos_line_format, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ +Query or set the format string used by the command @code{whos}.\n\ +\n\ +A full format string is:\n\ +@c Set example in small font to prevent overfull line\n\ +\n\ +@smallexample\n\ +%[modifier][:width[:left-min[:balance]]];\n\ +@end smallexample\n\ +\n\ +The following command sequences are available:\n\ +\n\ +@table @code\n\ +@item %a\n\ +Prints attributes of variables (g=global, p=persistent,\n\ +f=formal parameter, a=automatic variable).\n\ +\n\ +@item %b\n\ +Prints number of bytes occupied by variables.\n\ +\n\ +@item %c\n\ +Prints class names of variables.\n\ +\n\ +@item %e\n\ +Prints elements held by variables.\n\ +\n\ +@item %n\n\ +Prints variable names.\n\ +\n\ +@item %s\n\ +Prints dimensions of variables.\n\ +\n\ +@item %t\n\ +Prints type names of variables.\n\ +@end table\n\ +\n\ +Every command may also have an alignment modifier:\n\ +\n\ +@table @code\n\ +@item l\n\ +Left alignment.\n\ +\n\ +@item r\n\ +Right alignment (default).\n\ +\n\ +@item c\n\ +Column-aligned (only applicable to command %s).\n\ +@end table\n\ +\n\ +The @code{width} parameter is a positive integer specifying the minimum\n\ +number of columns used for printing. No maximum is needed as the field will\n\ +auto-expand as required.\n\ +\n\ +The parameters @code{left-min} and @code{balance} are only available when the\n\ +column-aligned modifier is used with the command @samp{%s}.\n\ +@code{balance} specifies the column number within the field width which will\n\ +be aligned between entries. Numbering starts from 0 which indicates the\n\ +leftmost column. @code{left-min} specifies the minimum field width to the\n\ +left of the specified balance column.\n\ +\n\ +The default format is\n\ +@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@seealso{whos}\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (whos_line_format); +} + +static std::string Vmissing_function_hook = "unimplemented"; + +DEFUN (missing_function_hook, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ +@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ +@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ +Query or set the internal variable that specifies the function to call when\n\ +an unknown identifier is requested.\n\ +\n\ +When called from inside a function with the \"local\" option, the variable is\n\ +changed locally for the function and any subroutines it calls. The original\n\ +variable value is restored when exiting the function.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (missing_function_hook); +} + +void maybe_missing_function_hook (const std::string& name) +{ + // Don't do this if we're handling errors. + if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) + { + // Ensure auto-restoration. + unwind_protect frame; + frame.protect_var (Vmissing_function_hook); + + // Clear the variable prior to calling the function. + const std::string func_name = Vmissing_function_hook; + Vmissing_function_hook.clear (); + + // Call. + feval (func_name, octave_value (name)); + } +} + +DEFUN (__varval__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + { + std::string name = args(0).string_value (); + + if (! error_state) + retval = symbol_table::varval (args(0).string_value ()); + else + error ("__varval__: expecting argument to be variable name"); + } + else + print_usage (); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/interpfcn/variables.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/interpfcn/variables.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,147 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_variables_h) +#define octave_variables_h 1 + +class octave_function; +class octave_user_function; + +class tree_identifier; +class octave_value; +class octave_value_list; +class octave_builtin; +class string_vector; + +#include +#include + +#include + +#include "ov.h" +#include "ov-builtin.h" +#include "symtab.h" + +extern OCTINTERP_API void clear_mex_functions (void); + +extern OCTINTERP_API octave_function * +is_valid_function (const octave_value&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +is_valid_function (const std::string&, const std::string& = std::string (), + bool warn = false); + +extern OCTINTERP_API octave_function * +extract_function (const octave_value& arg, const std::string& warn_for, + const std::string& fname, const std::string& header, + const std::string& trailer); + +extern OCTINTERP_API string_vector +get_struct_elts (const std::string& text); + +extern OCTINTERP_API string_vector +generate_struct_completions (const std::string& text, std::string& prefix, + std::string& hint); + +extern OCTINTERP_API bool +looks_like_struct (const std::string& text); + +extern OCTINTERP_API int +symbol_exist (const std::string& name, const std::string& type = "any"); + +extern OCTINTERP_API std::string +unique_symbol_name (const std::string& basename); + +extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); + +extern OCTINTERP_API octave_value +get_global_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_global_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +get_top_level_value (const std::string& nm, bool silent = false); + +extern OCTINTERP_API void +set_top_level_value (const std::string& nm, const octave_value& val); + +extern OCTINTERP_API octave_value +set_internal_variable (bool& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (char& var, const octave_value_list& args, + int nargout, const char *nm); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, + int minval = INT_MIN, int maxval = INT_MAX); + +extern OCTINTERP_API octave_value +set_internal_variable (double& var, const octave_value_list& args, + int nargout, const char *nm, + double minval = DBL_MIN, double maxval = DBL_MAX); + +extern OCTINTERP_API octave_value +set_internal_variable (std::string& var, const octave_value_list& args, + int nargout, const char *nm, bool empty_ok = true); + +extern OCTINTERP_API octave_value +set_internal_variable (int& var, const octave_value_list& args, + int nargout, const char *nm, const char **choices); + +#define SET_INTERNAL_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM) + +#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ + set_internal_variable (V ## NM, args, nargout, #NM, false) + +#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ + set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) + +// in the following, CHOICES must be a C string array terminated by null. +#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ + set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) + +extern OCTINTERP_API std::string builtin_string_variable (const std::string&); +extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); +extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); + +extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); + +extern OCTINTERP_API void +bind_internal_variable (const std::string& fname, const octave_value& val); + +extern OCTINTERP_API void mlock (void); +extern OCTINTERP_API void munlock (const std::string&); +extern OCTINTERP_API bool mislocked (const std::string&); + +extern OCTINTERP_API void clear_function (const std::string& nm); +extern OCTINTERP_API void clear_variable (const std::string& nm); +extern OCTINTERP_API void clear_symbol (const std::string& nm); + +extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); + +#endif diff -r 069c552587a0 -r 959953dba519 src/jit-ir.cc --- a/src/jit-ir.cc Tue Jul 31 09:54:19 2012 -0400 +++ b/src/jit-ir.cc Fri Aug 03 14:35:44 2012 -0400 @@ -599,6 +599,22 @@ } // -------------------- jit_magic_end -------------------- +jit_magic_end::jit_magic_end (const std::vector& full_context) +{ + // for now we only support end in 1 dimensional indexing + resize_arguments (full_context.size ()); + + size_t i; + std::vector::const_iterator iter; + for (iter = full_context.begin (), i = 0; iter != full_context.end (); ++iter, + ++i) + { + if (iter->count != 1) + throw jit_fail_exception ("end is only supported in linear contexts"); + stash_argument (i, iter->value); + } +} + const jit_function& jit_magic_end::overload () const { diff -r 069c552587a0 -r 959953dba519 src/jit-ir.h --- a/src/jit-ir.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/jit-ir.h Fri Aug 03 14:35:44 2012 -0400 @@ -1074,6 +1074,10 @@ #undef JIT_CALL_CONST + jit_call (const jit_operation& aoperation, + const std::vector& args) + : jit_instruction (args), moperation (aoperation) + {} const jit_operation& operation (void) const { return moperation; } @@ -1151,9 +1155,23 @@ jit_magic_end : public jit_instruction { public: - jit_magic_end (const std::vector& context) - : jit_instruction (context) - {} + class + context + { + public: + context (void) : value (0), index (0), count (0) + {} + + context (jit_value *avalue, size_t aindex, size_t acount) + : value (avalue), index (aindex), count (acount) + {} + + jit_value *value; + size_t index; + size_t count; + }; + + jit_magic_end (const std::vector& full_context); const jit_function& overload () const; diff -r 069c552587a0 -r 959953dba519 src/jit-typeinfo.cc --- a/src/jit-typeinfo.cc Tue Jul 31 09:54:19 2012 -0400 +++ b/src/jit-typeinfo.cc Fri Aug 03 14:35:44 2012 -0400 @@ -243,6 +243,57 @@ *ret = *mat; } +static void +make_indices (double *indices, octave_idx_type idx_count, + Array& result) +{ + result.resize (dim_vector (1, idx_count)); + for (octave_idx_type i = 0; i < idx_count; ++i) + result(i) = idx_vector (indices[i]); +} + +extern "C" double +octave_jit_paren_scalar (jit_matrix *mat, double *indicies, + octave_idx_type idx_count) +{ + // FIXME: Replace this with a more optimal version + try + { + Array idx; + make_indices (indicies, idx_count, idx); + + Array ret = mat->array->index (idx); + return ret.xelem (0); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + return 0; + } +} + +extern "C" void +octave_jit_paren_scalar_subsasgn (jit_matrix *ret, jit_matrix *mat, + double *indices, octave_idx_type idx_count, + double value) +{ + // FIXME: Replace this with a more optimal version + try + { + Array idx; + make_indices (indices, idx_count, idx); + + Matrix temp (1, 1); + temp.xelem(0) = value; + mat->array->assign (idx, temp); + ret->update (mat->array); + } + catch (const octave_execution_exception&) + { + gripe_library_execution_error (); + } +} + extern "C" void octave_jit_paren_subsasgn_matrix_range (jit_matrix *result, jit_matrix *mat, jit_range *index, double value) @@ -657,6 +708,16 @@ } // -------------------- jit_operation -------------------- +jit_operation::~jit_operation (void) +{ + for (generated_map::iterator iter = generated.begin (); + iter != generated.end (); ++iter) + { + delete iter->first; + delete iter->second; + } +} + void jit_operation::add_overload (const jit_function& func, const std::vector& args) @@ -691,23 +752,26 @@ const jit_function& jit_operation::overload (const std::vector& types) const { - // FIXME: We should search for the next best overload on failure static jit_function null_overload; - if (types.size () >= overloads.size ()) - return null_overload; - for (size_t i =0; i < types.size (); ++i) if (! types[i]) return null_overload; + if (types.size () >= overloads.size ()) + return do_generate (types); + const Array& over = overloads[types.size ()]; dim_vector dv (over.dims ()); Array idx = to_idx (types); for (octave_idx_type i = 0; i < dv.length (); ++i) if (idx(i) >= dv(i)) - return null_overload; + return do_generate (types); - return over(idx); + const jit_function& ret = over(idx); + if (! ret.valid ()) + return do_generate (types); + + return ret; } Array @@ -731,6 +795,175 @@ return idx; } +const jit_function& +jit_operation::do_generate (const signature_vec& types) const +{ + static jit_function null_overload; + generated_map::const_iterator find = generated.find (&types); + if (find != generated.end ()) + { + if (find->second) + return *find->second; + else + return null_overload; + } + + jit_function *ret = generate (types); + generated[new signature_vec (types)] = ret; + return ret ? *ret : null_overload; +} + +jit_function * +jit_operation::generate (const signature_vec& types) const +{ + return 0; +} + +bool +jit_operation::signature_cmp +::operator() (const signature_vec *lhs, const signature_vec *rhs) +{ + const signature_vec& l = *lhs; + const signature_vec& r = *rhs; + + if (l.size () < r.size ()) + return true; + else if (l.size () > r.size ()) + return false; + + for (size_t i = 0; i < l.size (); ++i) + { + if (l[i]->type_id () < r[i]->type_id ()) + return true; + else if (l[i]->type_id () > r[i]->type_id ()) + return false; + } + + return false; +} + +// -------------------- jit_index_operation -------------------- +jit_function * +jit_index_operation::generate (const signature_vec& types) const +{ + if (types.size () > 2 && types[0] == jit_typeinfo::get_matrix ()) + { + // indexing a matrix with scalars + jit_type *scalar = jit_typeinfo::get_scalar (); + for (size_t i = 1; i < types.size (); ++i) + if (types[i] != scalar) + return 0; + + return generate_matrix (types); + } + + return 0; +} + +llvm::Value * +jit_index_operation::create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const +{ + size_t n = end_idx - start_idx; + llvm::Type *scalar_t = jit_typeinfo::get_scalar_llvm (); + llvm::ArrayType *array_t = llvm::ArrayType::get (scalar_t, n); + llvm::Value *array = llvm::UndefValue::get (array_t); + for (size_t i = start_idx; i < end_idx; ++i) + { + llvm::Value *idx = fn.argument (builder, i); + array = builder.CreateInsertValue (array, idx, i - start_idx); + } + + llvm::Value *array_mem = builder.CreateAlloca (array_t); + builder.CreateStore (array, array_mem); + return builder.CreateBitCast (array_mem, scalar_t->getPointerTo ()); +} + +// -------------------- jit_paren_subsref -------------------- +jit_function * +jit_paren_subsref::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsref_matrix_scalar" << (types.size () - 1); + + jit_type *scalar = jit_typeinfo::get_scalar (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), scalar, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size ()); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 1); + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsref::do_initialize (void) +{ + std::vector types (3); + types[0] = jit_typeinfo::get_matrix (); + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + + jit_type *scalar = jit_typeinfo::get_scalar (); + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", scalar, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar); + paren_scalar.mark_can_error (); +} + +// -------------------- jit_paren_subsasgn -------------------- +jit_function * +jit_paren_subsasgn::generate_matrix (const signature_vec& types) const +{ + std::stringstream ss; + ss << "jit_paren_subsasgn_matrix_scalar" << (types.size () - 2); + + jit_type *matrix = jit_typeinfo::get_matrix (); + jit_function *fn = new jit_function (module, jit_convention::internal, + ss.str (), matrix, types); + fn->mark_can_error (); + llvm::BasicBlock *body = fn->new_block (); + llvm::IRBuilder<> builder (body); + + llvm::Value *array = create_arg_array (builder, *fn, 1, types.size () - 1); + jit_type *index = jit_typeinfo::get_index (); + llvm::Value *nelem = llvm::ConstantInt::get (index->to_llvm (), + types.size () - 2); + + llvm::Value *mat = fn->argument (builder, 0); + llvm::Value *value = fn->argument (builder, types.size () - 1); + llvm::Value *ret = paren_scalar.call (builder, mat, array, nelem, value); + fn->do_return (builder, ret); + return fn; +} + +void +jit_paren_subsasgn::do_initialize (void) +{ + if (paren_scalar.valid ()) + return; + + jit_type *matrix = jit_typeinfo::get_matrix (); + std::vector types (4); + types[0] = matrix; + types[1] = jit_typeinfo::get_scalar_ptr (); + types[2] = jit_typeinfo::get_index (); + types[3] = jit_typeinfo::get_scalar (); + + paren_scalar = jit_function (module, jit_convention::external, + "octave_jit_paren_scalar", matrix, types); + paren_scalar.add_mapping (engine, &octave_jit_paren_scalar_subsasgn); + paren_scalar.mark_can_error (); +} + // -------------------- jit_typeinfo -------------------- void jit_typeinfo::initialize (llvm::Module *m, llvm::ExecutionEngine *e) @@ -784,6 +1017,7 @@ matrix = new_type ("matrix", any, matrix_t); complex = new_type ("complex", any, complex_t); scalar = new_type ("scalar", complex, scalar_t); + scalar_ptr = new_type ("scalar_ptr", 0, scalar_t->getPointerTo ()); range = new_type ("range", any, range_t); string = new_type ("string", any, string_t); boolean = new_type ("bool", any, bool_t); @@ -813,6 +1047,9 @@ if (sizeof (void *) == 4) complex->mark_sret (); + paren_subsref_fn.initialize (module, engine); + paren_subsasgn_fn.initialize (module, engine); + // bind global variables lerror_state = new llvm::GlobalVariable (*module, bool_t, false, llvm::GlobalValue::ExternalLinkage, diff -r 069c552587a0 -r 959953dba519 src/jit-typeinfo.h --- a/src/jit-typeinfo.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/jit-typeinfo.h Fri Aug 03 14:35:44 2012 -0400 @@ -314,17 +314,22 @@ jit_operation { public: + // type signature vector + typedef std::vector signature_vec; + + virtual ~jit_operation (void); + void add_overload (const jit_function& func) { add_overload (func, func.arguments ()); } void add_overload (const jit_function& func, - const std::vector& args); + const signature_vec& args); - const jit_function& overload (const std::vector& types) const; + const jit_function& overload (const signature_vec& types) const; - jit_type *result (const std::vector& types) const + jit_type *result (const signature_vec& types) const { const jit_function& temp = overload (types); return temp.result (); @@ -346,14 +351,79 @@ const std::string& name (void) const { return mname; } void stash_name (const std::string& aname) { mname = aname; } +protected: + virtual jit_function *generate (const signature_vec& types) const; private: - Array to_idx (const std::vector& types) const; + Array to_idx (const signature_vec& types) const; + + const jit_function& do_generate (const signature_vec& types) const; + + struct signature_cmp + { + bool operator() (const signature_vec *lhs, const signature_vec *rhs); + }; + + typedef std::map + generated_map; + + mutable generated_map generated; std::vector > overloads; std::string mname; }; +class +jit_index_operation : public jit_operation +{ +public: + jit_index_operation (void) : module (0), engine (0) {} + + void initialize (llvm::Module *amodule, llvm::ExecutionEngine *aengine) + { + module = amodule; + engine = aengine; + do_initialize (); + } +protected: + virtual jit_function *generate (const signature_vec& types) const; + + virtual jit_function *generate_matrix (const signature_vec& types) const = 0; + + virtual void do_initialize (void) = 0; + + // helper functions + // [start_idx, end_idx). + llvm::Value *create_arg_array (llvm::IRBuilderD& builder, + const jit_function &fn, size_t start_idx, + size_t end_idx) const; + + llvm::Module *module; + llvm::ExecutionEngine *engine; +}; + +class +jit_paren_subsref : public jit_index_operation +{ +protected: + virtual jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + +class +jit_paren_subsasgn : public jit_index_operation +{ +protected: + jit_function *generate_matrix (const signature_vec& types) const; + + virtual void do_initialize (void); +private: + jit_function paren_scalar; +}; + // A singleton class which handles the construction of jit_types and // jit_operations. class @@ -376,6 +446,8 @@ static llvm::Type *get_scalar_llvm (void) { return instance->scalar->to_llvm (); } + static jit_type *get_scalar_ptr (void) { return instance->scalar_ptr; } + static jit_type *get_range (void) { return instance->range; } static jit_type *get_string (void) { return instance->string; } @@ -643,6 +715,7 @@ jit_type *any; jit_type *matrix; jit_type *scalar; + jit_type *scalar_ptr; // a fake type for interfacing with C++ jit_type *range; jit_type *string; jit_type *boolean; @@ -663,8 +736,8 @@ jit_operation for_index_fn; jit_operation logically_true_fn; jit_operation make_range_fn; - jit_operation paren_subsref_fn; - jit_operation paren_subsasgn_fn; + jit_paren_subsref paren_subsref_fn; + jit_paren_subsasgn paren_subsasgn_fn; jit_operation end_fn; // type id -> cast function TO that type diff -r 069c552587a0 -r 959953dba519 src/lex.h --- a/src/lex.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,208 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_lex_h) -#define octave_lex_h 1 - -#include -#include - -// FIXME -- these input buffer things should be members of a -// parser input stream class. - -typedef struct yy_buffer_state *YY_BUFFER_STATE; - -// Associate a buffer with a new file to read. -extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); - -// Report the current buffer. -extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); - -// Connect to new buffer buffer. -extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); - -// Delete a buffer. -extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); - -extern OCTINTERP_API void clear_all_buffers (void); - -extern OCTINTERP_API void cleanup_parser (void); - -// Is the given string a keyword? -extern bool is_keyword (const std::string& s); - -extern void prep_lexer_for_script_file (void); -extern void prep_lexer_for_function_file (void); -extern void prep_lexer_for_classdef_file (void); - -// For communication between the lexer and parser. - -class -lexical_feedback -{ -public: - - lexical_feedback (void) - - : bracketflag (0), braceflag (0), looping (0), - convert_spaces_to_comma (true), at_beginning_of_statement (true), - defining_func (0), looking_at_function_handle (0), - looking_at_anon_fcn_args (true), - looking_at_return_list (false), looking_at_parameter_list (false), - looking_at_decl_list (false), looking_at_initializer_expression (false), - looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), - looking_for_object_index (false), do_comma_insert (false), - looking_at_indirect_ref (false), parsed_function_name (), - parsing_class_method (false), maybe_classdef_get_set_method (false), - parsing_classdef (false), parsing_classdef_get_method (false), - parsing_classdef_set_method (false), quote_is_transpose (false), - pending_local_variables () - - { - init (); - } - - ~lexical_feedback (void) { } - - void init (void); - - // Square bracket level count. - int bracketflag; - - // Curly brace level count. - int braceflag; - - // TRUE means we're in the middle of defining a loop. - int looping; - - // TRUE means that we should convert spaces to a comma inside a - // matrix definition. - bool convert_spaces_to_comma; - - // TRUE means we are at the beginning of a statement, where a - // command name is possible. - bool at_beginning_of_statement; - - // Nonzero means we're in the middle of defining a function. - int defining_func; - - // Nonzero means we are parsing a function handle. - int looking_at_function_handle; - - // TRUE means we are parsing an anonymous function argument list. - bool looking_at_anon_fcn_args; - - // TRUE means we're parsing the return list for a function. - bool looking_at_return_list; - - // TRUE means we're parsing the parameter list for a function. - bool looking_at_parameter_list; - - // TRUE means we're parsing a declaration list (global or - // persistent). - bool looking_at_decl_list; - - // TRUE means we are looking at the initializer expression for a - // parameter list element. - bool looking_at_initializer_expression; - - // TRUE means we're parsing a matrix or the left hand side of - // multi-value assignment statement. - bool looking_at_matrix_or_assign_lhs; - - // If the front of the list is TRUE, the closest paren, brace, or - // bracket nesting is an index for an object. - std::list looking_at_object_index; - - // Object index not possible until we've seen something. - bool looking_for_object_index; - - // GAG. Stupid kludge so that [[1,2][3,4]] will work. - bool do_comma_insert; - - // TRUE means we're looking at an indirect reference to a - // structure element. - bool looking_at_indirect_ref; - - // If the top of the stack is TRUE, then we've already seen the name - // of the current function. Should only matter if - // current_function_level > 0 - std::stack parsed_function_name; - - // TRUE means we are parsing a class method in function or classdef file. - bool parsing_class_method; - - // TRUE means we are parsing a class method declaration line in a - // classdef file and can accept a property get or set method name. - // For example, "get.PropertyName" is recognized as a function name. - bool maybe_classdef_get_set_method; - - // TRUE means we are parsing a classdef file - bool parsing_classdef; - - // TRUE means we are parsing a classdef get.method. - bool parsing_classdef_get_method; - - // TRUE means we are parsing a classdef set.method. - bool parsing_classdef_set_method; - - // Return transpose or start a string? - bool quote_is_transpose; - - // Set of identifiers that might be local variable names. - std::set pending_local_variables; - -private: - - lexical_feedback (const lexical_feedback&); - - lexical_feedback& operator = (const lexical_feedback&); -}; - -class -stream_reader -{ -public: - virtual int getc (void) = 0; - virtual int ungetc (int c) = 0; - -protected: - stream_reader (void) { } - ~stream_reader (void) { } - -private: - - // No copying! - stream_reader (const stream_reader&); - stream_reader& operator = (const stream_reader&); -}; - -extern std::string -grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); - -// TRUE means that we have encountered EOF on the input stream. -extern bool parser_end_of_input; - -// Flags that need to be shared between the lexer and parser. -extern lexical_feedback lexer_flags; - -#endif diff -r 069c552587a0 -r 959953dba519 src/lex.ll --- a/src/lex.ll Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3849 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -%option prefix = "octave_" - -%top { -#ifdef HAVE_CONFIG_H -#include -#endif - -} - -%s COMMAND_START -%s MATRIX_START - -%x SCRIPT_FILE_BEGIN -%x FUNCTION_FILE_BEGIN -%x CLASSDEF_FILE_BEGIN - -%{ - -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "quit.h" -#include "lo-mappers.h" - -// These would be alphabetical, but y.tab.h must be included before -// oct-gperf.h and y.tab.h must be included after token.h and the tree -// class declarations. We can't include y.tab.h in oct-gperf.h -// because it may not be protected to allow it to be included multiple -// times. - -#include "Cell.h" -#include "comment-list.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "ov.h" -#include "parse.h" -#include "parse-private.h" -#include "pt-all.h" -#include "symtab.h" -#include "token.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" -#include -#include - -#if defined (GNULIB_NAMESPACE) -// Calls to the following functions appear in the generated output from -// flex without the namespace tag. Redefine them so we will use them -// via the gnulib namespace. -#define fprintf GNULIB_NAMESPACE::fprintf -#define fwrite GNULIB_NAMESPACE::fwrite -#define isatty GNULIB_NAMESPACE::isatty -#define malloc GNULIB_NAMESPACE::malloc -#define realloc GNULIB_NAMESPACE::realloc -#endif - -#if ! (defined (FLEX_SCANNER) \ - && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ - && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) -#error lex.l requires flex version 2.5.4 or later -#endif - -#define yylval octave_lval - -// Arrange to get input via readline. - -#ifdef YY_INPUT -#undef YY_INPUT -#endif -#define YY_INPUT(buf, result, max_size) \ - if ((result = octave_read (buf, max_size)) < 0) \ - YY_FATAL_ERROR ("octave_read () in flex scanner failed"); - -// Try to avoid crashing out completely on fatal scanner errors. -// The call to yy_fatal_error should never happen, but it avoids a -// `static function defined but not used' warning from gcc. - -#ifdef YY_FATAL_ERROR -#undef YY_FATAL_ERROR -#endif -#define YY_FATAL_ERROR(msg) \ - do \ - { \ - error (msg); \ - OCTAVE_QUIT; \ - yy_fatal_error (msg); \ - } \ - while (0) - -#define DISPLAY_TOK_AND_RETURN(tok) \ - do \ - { \ - int tok_val = tok; \ - if (Vdisplay_tokens) \ - display_token (tok_val); \ - if (lexer_debug_flag) \ - { \ - std::cerr << "R: "; \ - display_token (tok_val); \ - std::cerr << std::endl; \ - } \ - return tok_val; \ - } \ - while (0) - -#define COUNT_TOK_AND_RETURN(tok) \ - do \ - { \ - Vtoken_count++; \ - DISPLAY_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_RETURN(tok) \ - do \ - { \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = false; \ - lexer_flags.convert_spaces_to_comma = true; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define TOK_PUSH_AND_RETURN(name, tok) \ - do \ - { \ - yylval.tok_val = new token (name, input_line_number, \ - current_input_column); \ - token_stack.push (yylval.tok_val); \ - TOK_RETURN (tok); \ - } \ - while (0) - -#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - yylval.tok_val = new token (input_line_number, current_input_column); \ - token_stack.push (yylval.tok_val); \ - current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = qit; \ - lexer_flags.convert_spaces_to_comma = convert; \ - lexer_flags.looking_for_object_index = false; \ - lexer_flags.at_beginning_of_statement = bos; \ - COUNT_TOK_AND_RETURN (tok); \ - } \ - while (0) - -#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ - } \ - while (0) - -#define BIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ - } \ - while (0) - -#define XBIN_OP_RETURN(tok, convert, bos) \ - do \ - { \ - gripe_matlab_incompatible_operator (yytext); \ - BIN_OP_RETURN (tok, convert, bos); \ - } \ - while (0) - -#define LEXER_DEBUG(pattern) \ - do \ - { \ - if (lexer_debug_flag) \ - lexer_debug (pattern, yytext); \ - } \ - while (0) - -// TRUE means that we have encountered EOF on the input stream. -bool parser_end_of_input = false; - -// Flags that need to be shared between the lexer and parser. -lexical_feedback lexer_flags; - -// Stack to hold tokens so that we can delete them when the parser is -// reset and avoid growing forever just because we are stashing some -// information. This has to appear before lex.h is included, because -// one of the macros defined there uses token_stack. -// -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::stack token_stack; - -// Did eat_whitespace() eat a space or tab, or a newline, or both? - -typedef int yum_yum; - -const yum_yum ATE_NOTHING = 0; -const yum_yum ATE_SPACE_OR_TAB = 1; -const yum_yum ATE_NEWLINE = 2; - -// Is the closest nesting level a square bracket, squiggly brace or a paren? - -class bracket_brace_paren_nesting_level -{ -public: - - bracket_brace_paren_nesting_level (void) : context () { } - - ~bracket_brace_paren_nesting_level (void) { } - - void bracket (void) { context.push (BRACKET); } - bool is_bracket (void) - { return ! context.empty () && context.top () == BRACKET; } - - void brace (void) { context.push (BRACE); } - bool is_brace (void) - { return ! context.empty () && context.top () == BRACE; } - - void paren (void) { context.push (PAREN); } - bool is_paren (void) - { return ! context.empty () && context.top () == PAREN; } - - bool is_bracket_or_brace (void) - { return (! context.empty () - && (context.top () == BRACKET || context.top () == BRACE)); } - - bool none (void) { return context.empty (); } - - void remove (void) { if (! context.empty ()) context.pop (); } - - void clear (void) { while (! context.empty ()) context.pop (); } - -private: - - std::stack context; - - static const int BRACKET; - static const int BRACE; - static const int PAREN; - - bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); - - bracket_brace_paren_nesting_level& - operator = (const bracket_brace_paren_nesting_level&); -}; - -const int bracket_brace_paren_nesting_level::BRACKET = 1; -const int bracket_brace_paren_nesting_level::BRACE = 2; -const int bracket_brace_paren_nesting_level::PAREN = 3; - -static bracket_brace_paren_nesting_level nesting_level; - -static bool Vdisplay_tokens = false; - -static unsigned int Vtoken_count = 0; - -// The start state that was in effect when the beginning of a block -// comment was noticed. -static int block_comment_nesting_level = 0; - -// Internal variable for lexer debugging state. -static bool lexer_debug_flag = false; - -// Forward declarations for functions defined at the bottom of this -// file. - -static int text_yyinput (void); -static void xunput (char c, char *buf); -static void fixup_column_count (char *s); -static void do_comma_insert_check (void); -static int is_keyword_token (const std::string& s); -static int process_comment (bool start_in_block, bool& eof); -static bool match_any (char c, const char *s); -static bool next_token_is_sep_op (void); -static bool next_token_is_bin_op (bool spc_prev); -static bool next_token_is_postfix_unary_op (bool spc_prev); -static std::string strip_trailing_whitespace (char *s); -static void handle_number (void); -static int handle_string (char delim); -static int handle_close_bracket (bool spc_gobbled, int bracket_type); -static int handle_superclass_identifier (void); -static int handle_meta_identifier (void); -static int handle_identifier (void); -static bool have_continuation (bool trailing_comments_ok = true); -static bool have_ellipsis_continuation (bool trailing_comments_ok = true); -static void scan_for_comments (const char *); -static yum_yum eat_whitespace (void); -static yum_yum eat_continuation (void); -static void maybe_warn_separator_insert (char sep); -static void gripe_single_quote_string (void); -static void gripe_matlab_incompatible (const std::string& msg); -static void maybe_gripe_matlab_incompatible_comment (char c); -static void gripe_matlab_incompatible_continuation (void); -static void gripe_matlab_incompatible_operator (const std::string& op); -static void display_token (int tok); -static void lexer_debug (const char *pattern, const char *text); - -%} - -D [0-9] -S [ \t] -NL ((\n)|(\r)|(\r\n)) -SNL ({S}|{NL}) -EL (\.\.\.) -BS (\\) -CONT ({EL}|{BS}) -Im [iIjJ] -CCHAR [#%] -COMMENT ({CCHAR}.*{NL}) -SNLCMT ({SNL}|{COMMENT}) -NOT ((\~)|(\!)) -POW ((\*\*)|(\^)) -EPOW (\.{POW}) -IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) -EXPON ([DdEe][+-]?{D}+) -NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) -%% - -%{ -// Make script and function files start with a bogus token. This makes -// the parser go down a special path. -%} - -. { - LEXER_DEBUG ("."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (SCRIPT_FILE); - } - -. { - LEXER_DEBUG ("."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (FUNCTION_FILE); - } - -. { - LEXER_DEBUG ("."); - - BEGIN (INITIAL); - xunput (yytext[0], yytext); - COUNT_TOK_AND_RETURN (CLASSDEF_FILE); - } - -%{ -// Help and other command-style functions. -%} - -{NL} { - LEXER_DEBUG ("{NL}"); - - BEGIN (INITIAL); - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - COUNT_TOK_AND_RETURN ('\n'); - } - -[\;\,] { - LEXER_DEBUG ("[\\;\\,]"); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = true; - - BEGIN (INITIAL); - - if (strcmp (yytext, ",") == 0) - TOK_RETURN (','); - else - TOK_RETURN (';'); - } - -[\"\'] { - LEXER_DEBUG ("[\\\"\\']"); - - lexer_flags.at_beginning_of_statement = false; - - current_input_column++; - int tok = handle_string (yytext[0]); - - COUNT_TOK_AND_RETURN (tok); - } - -[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { - LEXER_DEBUG ("[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); - - std::string tok = strip_trailing_whitespace (yytext); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_PUSH_AND_RETURN (tok, SQ_STRING); - } - -%{ -// For this and the next two rules, we're looking at ']', and we -// need to know if the next token is `=' or `=='. -// -// It would have been so much easier if the delimiters were simply -// different for the expression on the left hand side of the equals -// operator. -// -// It's also a pain in the ass to decide whether to insert a comma -// after seeing a ']' character... - -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*\]{S}* { - LEXER_DEBUG ("{SNLCMT}*\\]{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, ']'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*\}{S}* { - LEXER_DEBUG ("{SNLCMT}*\\}{S}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - int c = yytext[yyleng-1]; - int cont_is_spc = eat_continuation (); - bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - int tok_to_return = handle_close_bracket (spc_gobbled, '}'); - - if (spc_gobbled) - xunput (' ', yytext); - - COUNT_TOK_AND_RETURN (tok_to_return); - } - -%{ -// Commas are element separators in matrix constants. If we don't -// check for continuations here we can end up inserting too many -// commas. -%} - -{S}*\,{S}* { - LEXER_DEBUG ("{S}*\\,{S}*"); - - current_input_column += yyleng; - - int tmp = eat_continuation (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (! lexer_flags.looking_at_object_index.front ()) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - } - - COUNT_TOK_AND_RETURN (','); - } - -%{ -// In some cases, spaces in matrix constants can turn into commas. -// If commas are required, spaces are not important in matrix -// constants so we just eat them. If we don't check for continuations -// here we can end up inserting too many commas. -%} - -{S}+ { - LEXER_DEBUG ("{S}+"); - - current_input_column += yyleng; - - lexer_flags.at_beginning_of_statement = false; - - int tmp = eat_continuation (); - - if (! lexer_flags.looking_at_object_index.front ()) - { - bool bin_op = next_token_is_bin_op (true); - bool postfix_un_op = next_token_is_postfix_unary_op (true); - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op) - && nesting_level.is_bracket_or_brace () - && lexer_flags.convert_spaces_to_comma) - { - if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) - { - maybe_warn_separator_insert (';'); - - xunput (';', yytext); - } - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - - maybe_warn_separator_insert (','); - - COUNT_TOK_AND_RETURN (','); - } - } - } - -%{ -// Semicolons are handled as row seprators in matrix constants. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -{SNLCMT}*;{SNLCMT}* { - LEXER_DEBUG ("{SNLCMT}*;{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN (';'); - } - -%{ -// In some cases, new lines can also become row separators. If we -// don't eat whitespace here we can end up inserting too many -// semicolons. - -// FIXME -- we need to handle block comments here. -%} - -{S}*{COMMENT}{SNLCMT}* | -{S}*{NL}{SNLCMT}* { - LEXER_DEBUG ("{S}*{COMMENT}{SNLCMT}*|{S}*{NL}{SNLCMT}*"); - - scan_for_comments (yytext); - fixup_column_count (yytext); - eat_whitespace (); - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = false; - - if (nesting_level.none ()) - return LEXICAL_ERROR; - - if (! lexer_flags.looking_at_object_index.front () - && nesting_level.is_bracket_or_brace ()) - { - maybe_warn_separator_insert (';'); - - COUNT_TOK_AND_RETURN (';'); - } - } - -\[{S}* { - LEXER_DEBUG ("\\[{S}*"); - - nesting_level.bracket (); - - lexer_flags.looking_at_object_index.push_front (false); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.defining_func - && ! lexer_flags.parsed_function_name.top ()) - lexer_flags.looking_at_return_list = true; - else - lexer_flags.looking_at_matrix_or_assign_lhs = true; - - promptflag--; - eat_whitespace (); - - lexer_flags.bracketflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('['); - } - -\] { - LEXER_DEBUG ("\\]"); - - nesting_level.remove (); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN (']'); - } - -%{ -// Imaginary numbers. -%} - -{NUMBER}{Im} { - LEXER_DEBUG ("{NUMBER}{Im}"); - - handle_number (); - COUNT_TOK_AND_RETURN (IMAG_NUM); - } - -%{ -// Real numbers. Don't grab the `.' part of a dot operator as part of -// the constant. -%} - -{D}+/\.[\*/\\^\'] | -{NUMBER} { - LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); - handle_number (); - COUNT_TOK_AND_RETURN (NUM); - } - -%{ -// Eat whitespace. Whitespace inside matrix constants is handled by -// the start state code above. -%} - -{S}* { - current_input_column += yyleng; - } - -%{ -// Continuation lines. Allow comments after continuations. -%} - -{CONT}{S}*{NL} | -{CONT}{S}*{COMMENT} { - LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); - - if (yytext[0] == '\\') - gripe_matlab_incompatible_continuation (); - scan_for_comments (yytext); - promptflag--; - input_line_number++; - current_input_column = 1; - } - -%{ -// End of file. -%} - -<> { - LEXER_DEBUG ("<>"); - - if (block_comment_nesting_level != 0) - { - warning ("block comment open at end of input"); - - if ((reading_fcn_file || reading_script_file || reading_classdef_file) - && ! curr_fcn_file_name.empty ()) - warning ("near line %d of file `%s.m'", - input_line_number, curr_fcn_file_name.c_str ()); - } - - TOK_RETURN (END_OF_INPUT); - } - -%{ -// Identifiers. Truncate the token at the first space or tab but -// don't write directly on yytext. -%} - -{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}{S}*"); - - int id_tok = handle_identifier (); - - if (id_tok >= 0) - COUNT_TOK_AND_RETURN (id_tok); - } - -%{ -// Superclass method identifiers. -%} - -{IDENT}@{IDENT}{S}* | -{IDENT}@{IDENT}.{IDENT}{S}* { - LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); - - int id_tok = handle_superclass_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (id_tok); - } - } - -%{ -// Metaclass query -%} - -\?{IDENT}{S}* | -\?{IDENT}\.{IDENT}{S}* { - LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); - - int id_tok = handle_meta_identifier (); - - if (id_tok >= 0) - { - lexer_flags.looking_for_object_index = true; - - COUNT_TOK_AND_RETURN (id_tok); - } - } - -%{ -// Function handles and superclass references -%} - -"@" { - LEXER_DEBUG ("@"); - - current_input_column++; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = false; - lexer_flags.looking_at_function_handle++; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - COUNT_TOK_AND_RETURN ('@'); - - } - -%{ -// A new line character. New line characters inside matrix constants -// are handled by the start state code above. If closest -// nesting is inside parentheses, don't return a row separator. -%} - -{NL} { - LEXER_DEBUG ("{NL}"); - - input_line_number++; - current_input_column = 1; - - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - - if (nesting_level.none ()) - { - lexer_flags.at_beginning_of_statement = true; - COUNT_TOK_AND_RETURN ('\n'); - } - else if (nesting_level.is_paren ()) - { - lexer_flags.at_beginning_of_statement = false; - gripe_matlab_incompatible ("bare newline inside parentheses"); - } - else if (nesting_level.is_bracket_or_brace ()) - return LEXICAL_ERROR; - } - -%{ -// Single quote can either be the beginning of a string or a transpose -// operator. -%} - -"'" { - LEXER_DEBUG ("'"); - - current_input_column++; - lexer_flags.convert_spaces_to_comma = true; - - if (lexer_flags.quote_is_transpose) - { - do_comma_insert_check (); - COUNT_TOK_AND_RETURN (QUOTE); - } - else - { - int tok = handle_string ('\''); - COUNT_TOK_AND_RETURN (tok); - } - } - -%{ -// Double quotes always begin strings. -%} - -\" { - LEXER_DEBUG ("\""); - - current_input_column++; - int tok = handle_string ('"'); - - COUNT_TOK_AND_RETURN (tok); -} - -%{ -// Gobble comments. -%} - -{CCHAR} { - LEXER_DEBUG ("{CCHAR}"); - - lexer_flags.looking_for_object_index = false; - - xunput (yytext[0], yytext); - - bool eof = false; - int tok = process_comment (false, eof); - - if (eof) - TOK_RETURN (END_OF_INPUT); - else if (tok > 0) - COUNT_TOK_AND_RETURN (tok); - } - -%{ -// Block comments. -%} - -^{S}*{CCHAR}\{{S}*{NL} { - LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); - - lexer_flags.looking_for_object_index = false; - - input_line_number++; - current_input_column = 1; - block_comment_nesting_level++; - promptflag--; - - bool eof = false; - process_comment (true, eof); - } - -%{ -// Other operators. -%} - -":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } - -".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } -".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } -".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } -"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } -".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } -".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } -".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } -".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } -"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } -"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } -"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } -"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } -"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } -"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } -">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } -"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } -"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } -"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } -">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } -"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } -"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } -"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } -"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } -"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } -";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } -"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } -"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } -"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } -"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } -"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } -"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } -"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } -">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } - -{NOT} { - LEXER_DEBUG ("{NOT}"); - - if (yytext[0] == '~') - BIN_OP_RETURN (EXPR_NOT, false, false); - else - XBIN_OP_RETURN (EXPR_NOT, false, false); - } - -"(" { - LEXER_DEBUG ("("); - - // If we are looking for an object index, then push TRUE for - // looking_at_object_index. Otherwise, just push whatever state - // is current (so that we can pop it off the stack when we find - // the matching close paren). - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - lexer_flags.looking_at_indirect_ref = false; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.paren (); - promptflag--; - - TOK_RETURN ('('); - } - -")" { - LEXER_DEBUG (")"); - - nesting_level.remove (); - current_input_column++; - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma - = (nesting_level.is_bracket_or_brace () - && ! lexer_flags.looking_at_anon_fcn_args); - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - if (lexer_flags.looking_at_anon_fcn_args) - lexer_flags.looking_at_anon_fcn_args = false; - - do_comma_insert_check (); - - COUNT_TOK_AND_RETURN (')'); - } - -"." { - LEXER_DEBUG ("."); - - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - TOK_RETURN ('.'); - } - -"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } -"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } -"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } -".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } -".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } -".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } -"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } -".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } -{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } -{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } -"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } -"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } -"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } -">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } - -\{{S}* { - LEXER_DEBUG ("\\{{S}*"); - - nesting_level.brace (); - - lexer_flags.looking_at_object_index.push_front - (lexer_flags.looking_for_object_index); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - promptflag--; - eat_whitespace (); - - lexer_flags.braceflag++; - BEGIN (MATRIX_START); - COUNT_TOK_AND_RETURN ('{'); - } - -"}" { - LEXER_DEBUG ("}"); - - lexer_flags.looking_at_object_index.pop_front (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - nesting_level.remove (); - - TOK_RETURN ('}'); - } - -%{ -// Unrecognized input is a lexical error. -%} - -. { - LEXER_DEBUG ("."); - - xunput (yytext[0], yytext); - - int c = text_yyinput (); - - if (c != EOF) - { - current_input_column++; - - error ("invalid character `%s' (ASCII %d) near line %d, column %d", - undo_string_escape (static_cast (c)), c, - input_line_number, current_input_column); - - return LEXICAL_ERROR; - } - else - TOK_RETURN (END_OF_INPUT); - } - -%% - -// GAG. -// -// If we're reading a matrix and the next character is '[', make sure -// that we insert a comma ahead of it. - -void -do_comma_insert_check (void) -{ - int spc_gobbled = eat_continuation (); - - int c = text_yyinput (); - - xunput (c, yytext); - - if (spc_gobbled) - xunput (' ', yytext); - - lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () - && lexer_flags.bracketflag && c == '['); -} - -// Fix things up for errors or interrupts. The parser is never called -// recursively, so it is always safe to reinitialize its state before -// doing any parsing. - -void -reset_parser (void) -{ - // Start off on the right foot. - BEGIN (INITIAL); - - parser_end_of_input = false; - - parser_symtab_context.clear (); - - // We do want a prompt by default. - promptflag = 1; - - // We are not in a block comment. - block_comment_nesting_level = 0; - - // Error may have occurred inside some brackets, braces, or parentheses. - nesting_level.clear (); - - // Clear out the stack of token info used to track line and column - // numbers. - while (! token_stack.empty ()) - { - delete token_stack.top (); - token_stack.pop (); - } - - // Can be reset by defining a function. - if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) - { - current_input_column = 1; - input_line_number = command_editor::current_command_number (); - } - - // Only ask for input from stdin if we are expecting interactive - // input. - - if (! quitting_gracefully - && (interactive || forced_interactive) - && ! (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file)) - yyrestart (stdin); - - // Clear the buffer for help text. - while (! help_buf.empty ()) - help_buf.pop (); - - // Reset other flags. - lexer_flags.init (); -} - -static void -display_character (char c) -{ - if (isgraph (c)) - std::cerr << c; - else - switch (c) - { - case 0: - std::cerr << "NUL"; - break; - - case 1: - std::cerr << "SOH"; - break; - - case 2: - std::cerr << "STX"; - break; - - case 3: - std::cerr << "ETX"; - break; - - case 4: - std::cerr << "EOT"; - break; - - case 5: - std::cerr << "ENQ"; - break; - - case 6: - std::cerr << "ACK"; - break; - - case 7: - std::cerr << "\\a"; - break; - - case 8: - std::cerr << "\\b"; - break; - - case 9: - std::cerr << "\\t"; - break; - - case 10: - std::cerr << "\\n"; - break; - - case 11: - std::cerr << "\\v"; - break; - - case 12: - std::cerr << "\\f"; - break; - - case 13: - std::cerr << "\\r"; - break; - - case 14: - std::cerr << "SO"; - break; - - case 15: - std::cerr << "SI"; - break; - - case 16: - std::cerr << "DLE"; - break; - - case 17: - std::cerr << "DC1"; - break; - - case 18: - std::cerr << "DC2"; - break; - - case 19: - std::cerr << "DC3"; - break; - - case 20: - std::cerr << "DC4"; - break; - - case 21: - std::cerr << "NAK"; - break; - - case 22: - std::cerr << "SYN"; - break; - - case 23: - std::cerr << "ETB"; - break; - - case 24: - std::cerr << "CAN"; - break; - - case 25: - std::cerr << "EM"; - break; - - case 26: - std::cerr << "SUB"; - break; - - case 27: - std::cerr << "ESC"; - break; - - case 28: - std::cerr << "FS"; - break; - - case 29: - std::cerr << "GS"; - break; - - case 30: - std::cerr << "RS"; - break; - - case 31: - std::cerr << "US"; - break; - - case 32: - std::cerr << "SPACE"; - break; - - case 127: - std::cerr << "DEL"; - break; - } -} - -static int -text_yyinput (void) -{ - int c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - // Convert CRLF into just LF and single CR into LF. - - if (c == '\r') - { - c = yyinput (); - - if (lexer_debug_flag) - { - std::cerr << "I: "; - display_character (c); - std::cerr << std::endl; - } - - if (c != '\n') - { - xunput (c, yytext); - c = '\n'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -static void -xunput (char c, char *buf) -{ - if (lexer_debug_flag) - { - std::cerr << "U: "; - display_character (c); - std::cerr << std::endl; - } - - if (c == '\n') - input_line_number--; - - yyunput (c, buf); -} - -// If we read some newlines, we need figure out what column we're -// really looking at. - -static void -fixup_column_count (char *s) -{ - char c; - while ((c = *s++) != '\0') - { - if (c == '\n') - { - input_line_number++; - current_input_column = 1; - } - else - current_input_column++; - } -} - -// Include these so that we don't have to link to libfl.a. - -int -yywrap (void) -{ - return 1; -} - -// Tell us all what the current buffer is. - -YY_BUFFER_STATE -current_buffer (void) -{ - return YY_CURRENT_BUFFER; -} - -// Create a new buffer. - -YY_BUFFER_STATE -create_buffer (FILE *f) -{ - return yy_create_buffer (f, YY_BUF_SIZE); -} - -// Start reading a new buffer. - -void -switch_to_buffer (YY_BUFFER_STATE buf) -{ - yy_switch_to_buffer (buf); -} - -// Delete a buffer. - -void -delete_buffer (YY_BUFFER_STATE buf) -{ - yy_delete_buffer (buf); - - // Prevent invalid yyin from being used by yyrestart. - if (! current_buffer ()) - yyin = 0; -} - -// Delete all buffers from the stack. -void -clear_all_buffers (void) -{ - while (current_buffer ()) - octave_pop_buffer_state (); -} - -void -cleanup_parser (void) -{ - reset_parser (); - - clear_all_buffers (); -} - -// Restore a buffer (for unwind-prot). - -void -restore_input_buffer (void *buf) -{ - switch_to_buffer (static_cast (buf)); -} - -// Delete a buffer (for unwind-prot). - -void -delete_input_buffer (void *buf) -{ - delete_buffer (static_cast (buf)); -} - -static bool -inside_any_object_index (void) -{ - bool retval = false; - - for (std::list::const_iterator i = lexer_flags.looking_at_object_index.begin (); - i != lexer_flags.looking_at_object_index.end (); i++) - { - if (*i) - { - retval = true; - break; - } - } - - return retval; -} - -// Handle keywords. Return -1 if the keyword should be ignored. - -static int -is_keyword_token (const std::string& s) -{ - int l = input_line_number; - int c = current_input_column; - - int len = s.length (); - - const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); - - if (kw) - { - yylval.tok_val = 0; - - switch (kw->kw_id) - { - case break_kw: - case catch_kw: - case continue_kw: - case else_kw: - case otherwise_kw: - case return_kw: - case unwind_protect_cleanup_kw: - lexer_flags.at_beginning_of_statement = true; - break; - - case static_kw: - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", - input_line_number, - curr_fcn_file_full_name.c_str ()); - else - warning_with_id ("Octave:deprecated-keyword", - "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", - input_line_number); - // fall through ... - - case persistent_kw: - break; - - case case_kw: - case elseif_kw: - case global_kw: - case until_kw: - break; - - case end_kw: - if (inside_any_object_index () - || (! reading_classdef_file - && (lexer_flags.defining_func - && ! (lexer_flags.looking_at_return_list - || lexer_flags.parsed_function_name.top ())))) - return 0; - - yylval.tok_val = new token (token::simple_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_try_catch_kw: - yylval.tok_val = new token (token::try_catch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case end_unwind_protect_kw: - yylval.tok_val = new token (token::unwind_protect_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfor_kw: - yylval.tok_val = new token (token::for_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endfunction_kw: - yylval.tok_val = new token (token::function_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endif_kw: - yylval.tok_val = new token (token::if_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endparfor_kw: - yylval.tok_val = new token (token::parfor_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endswitch_kw: - yylval.tok_val = new token (token::switch_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endwhile_kw: - yylval.tok_val = new token (token::while_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endclassdef_kw: - yylval.tok_val = new token (token::classdef_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endenumeration_kw: - yylval.tok_val = new token (token::enumeration_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endevents_kw: - yylval.tok_val = new token (token::events_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endmethods_kw: - yylval.tok_val = new token (token::methods_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - case endproperties_kw: - yylval.tok_val = new token (token::properties_end, l, c); - lexer_flags.at_beginning_of_statement = true; - break; - - - case for_kw: - case parfor_kw: - case while_kw: - promptflag--; - lexer_flags.looping++; - break; - - case do_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - lexer_flags.looping++; - break; - - case try_kw: - case unwind_protect_kw: - lexer_flags.at_beginning_of_statement = true; - promptflag--; - break; - - case if_kw: - case switch_kw: - promptflag--; - break; - - case get_kw: - case set_kw: - // 'get' and 'set' are keywords in classdef method - // declarations. - if (! lexer_flags.maybe_classdef_get_set_method) - return 0; - break; - - case enumeration_kw: - case events_kw: - case methods_kw: - case properties_kw: - // 'properties', 'methods' and 'events' are keywords for - // classdef blocks. - if (! lexer_flags.parsing_classdef) - return 0; - // fall through ... - - case classdef_kw: - // 'classdef' is always a keyword. - promptflag--; - break; - - case function_kw: - promptflag--; - - lexer_flags.defining_func++; - lexer_flags.parsed_function_name.push (false); - - if (! (reading_fcn_file || reading_script_file - || reading_classdef_file)) - input_line_number = 1; - break; - - case magic_file_kw: - { - if ((reading_fcn_file || reading_script_file - || reading_classdef_file) - && ! curr_fcn_file_full_name.empty ()) - yylval.tok_val = new token (curr_fcn_file_full_name, l, c); - else - yylval.tok_val = new token ("stdin", l, c); - } - break; - - case magic_line_kw: - yylval.tok_val = new token (static_cast (l), "", l, c); - break; - - default: - panic_impossible (); - } - - if (! yylval.tok_val) - yylval.tok_val = new token (l, c); - - token_stack.push (yylval.tok_val); - - return kw->tok; - } - - return 0; -} - -static bool -is_variable (const std::string& name) -{ - return (symbol_table::is_variable (name) - || (lexer_flags.pending_local_variables.find (name) - != lexer_flags.pending_local_variables.end ())); -} - -static std::string -grab_block_comment (stream_reader& reader, bool& eof) -{ - std::string buf; - - bool at_bol = true; - bool look_for_marker = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (look_for_marker) - { - at_bol = false; - look_for_marker = false; - - if (c == '{' || c == '}') - { - std::string tmp_buf (1, static_cast (c)); - - int type = c; - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - if (type == '{') - { - block_comment_nesting_level++; - promptflag--; - } - else - { - block_comment_nesting_level--; - promptflag++; - - if (block_comment_nesting_level == 0) - { - buf += grab_comment_block (reader, true, eof); - - return buf; - } - } - } - break; - - default: - at_bol = false; - tmp_buf += static_cast (c); - buf += tmp_buf; - done = true; - break; - } - } - } - } - - if (at_bol && (c == '%' || c == '#')) - { - if (c == '#' && ! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - - at_bol = false; - look_for_marker = true; - } - else - { - buf += static_cast (c); - - if (c == '\n') - { - current_input_column = 0; - at_bol = true; - } - } - } - - if (c == EOF) - eof = true; - - return buf; -} - -std::string -grab_comment_block (stream_reader& reader, bool at_bol, - bool& eof) -{ - std::string buf; - - // TRUE means we are at the beginning of a comment block. - bool begin_comment = false; - - // TRUE means we are currently reading a comment block. - bool in_comment = false; - - bool warned_incompatible = false; - - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - current_input_column++; - - if (begin_comment) - { - if (c == '%' || c == '#') - { - at_bol = false; - continue; - } - else if (at_bol && c == '{') - { - std::string tmp_buf (1, static_cast (c)); - - bool done = false; - - while ((c = reader.getc ()) != EOF && ! done) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - tmp_buf += static_cast (c); - break; - - case '\n': - { - current_input_column = 0; - at_bol = true; - done = true; - - block_comment_nesting_level++; - promptflag--; - - buf += grab_block_comment (reader, eof); - - in_comment = false; - - if (eof) - goto done; - } - break; - - default: - at_bol = false; - tmp_buf += static_cast (c); - buf += tmp_buf; - done = true; - break; - } - } - } - else - { - at_bol = false; - begin_comment = false; - } - } - - if (in_comment) - { - buf += static_cast (c); - - if (c == '\n') - { - at_bol = true; - current_input_column = 0; - in_comment = false; - - // FIXME -- bailing out here prevents things like - // - // octave> # comment - // octave> x = 1 - // - // from failing at the command line, while still - // allowing blocks of comments to be grabbed properly - // for function doc strings. But only the first line of - // a mult-line doc string will be picked up for - // functions defined on the command line. We need a - // better way of collecting these comments... - if (! (reading_fcn_file || reading_script_file)) - goto done; - } - } - else - { - switch (c) - { - case ' ': - case '\t': - break; - - case '#': - if (! warned_incompatible) - { - warned_incompatible = true; - maybe_gripe_matlab_incompatible_comment (c); - } - // fall through... - - case '%': - in_comment = true; - begin_comment = true; - break; - - default: - current_input_column--; - reader.ungetc (c); - goto done; - } - } - } - - done: - - if (c == EOF) - eof = true; - - return buf; -} - -class -flex_stream_reader : public stream_reader -{ -public: - flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } - - int getc (void) { return ::text_yyinput (); } - int ungetc (int c) { ::xunput (c, buf); return 0; } - -private: - - // No copying! - - flex_stream_reader (const flex_stream_reader&); - - flex_stream_reader& operator = (const flex_stream_reader&); - - char *buf; -}; - -static int -process_comment (bool start_in_block, bool& eof) -{ - eof = false; - - std::string help_txt; - - if (! help_buf.empty ()) - help_txt = help_buf.top (); - - flex_stream_reader flex_reader (yytext); - - // process_comment is only supposed to be called when we are not - // initially looking at a block comment. - - std::string txt = start_in_block - ? grab_block_comment (flex_reader, eof) - : grab_comment_block (flex_reader, false, eof); - - if (lexer_debug_flag) - std::cerr << "C: " << txt << std::endl; - - if (help_txt.empty () && nesting_level.none ()) - { - if (! help_buf.empty ()) - help_buf.pop (); - - help_buf.push (txt); - } - - octave_comment_buffer::append (txt); - - current_input_column = 1; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.at_beginning_of_statement = true; - - if (YY_START == COMMAND_START) - BEGIN (INITIAL); - - if (nesting_level.none ()) - return '\n'; - else if (nesting_level.is_bracket_or_brace ()) - return ';'; - else - return 0; -} - -// Return 1 if the given character matches any character in the given -// string. - -static bool -match_any (char c, const char *s) -{ - char tmp; - while ((tmp = *s++) != '\0') - { - if (c == tmp) - return true; - } - return false; -} - -// Given information about the spacing surrounding an operator, -// return 1 if it looks like it should be treated as a binary -// operator. For example, -// -// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary -// -// [ 1 +2 ] ==> unary - -static bool -looks_like_bin_op (bool spc_prev, int next_char) -{ - bool spc_next = (next_char == ' ' || next_char == '\t'); - - return ((spc_prev && spc_next) || ! spc_prev); -} - -// Recognize separators. If the separator is a CRLF pair, it is -// replaced by a single LF. - -static bool -next_token_is_sep_op (void) -{ - bool retval = false; - - int c = text_yyinput (); - - retval = match_any (c, ",;\n]"); - - xunput (c, yytext); - - return retval; -} - -// Try to determine if the next token should be treated as a postfix -// unary operator. This is ugly, but it seems to do the right thing. - -static bool -next_token_is_postfix_unary_op (bool spc_prev) -{ - bool un_op = false; - - int c0 = text_yyinput (); - - if (c0 == '\'' && ! spc_prev) - { - un_op = true; - } - else if (c0 == '.') - { - int c1 = text_yyinput (); - un_op = (c1 == '\''); - xunput (c1, yytext); - } - else if (c0 == '+') - { - int c1 = text_yyinput (); - un_op = (c1 == '+'); - xunput (c1, yytext); - } - else if (c0 == '-') - { - int c1 = text_yyinput (); - un_op = (c1 == '-'); - xunput (c1, yytext); - } - - xunput (c0, yytext); - - return un_op; -} - -// Try to determine if the next token should be treated as a binary -// operator. -// -// This kluge exists because whitespace is not always ignored inside -// the square brackets that are used to create matrix objects (though -// spacing only really matters in the cases that can be interpreted -// either as binary ops or prefix unary ops: currently just +, -). -// -// Note that a line continuation directly following a + or - operator -// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be -// parsed as a binary operator. - -static bool -next_token_is_bin_op (bool spc_prev) -{ - bool bin_op = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '=': - // Binary ops, spacing doesn't matter. - bin_op = true; - break; - - default: - // Could be either, spacing matters. - bin_op = looks_like_bin_op (spc_prev, c1); - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - // Always a binary op (may also include /=, \=, and ^=). - bin_op = true; - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - // Always a binary op (may also include .+=, .-=, ./=, ...). - bin_op = true; - else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') - // A structure element reference is a binary op. - bin_op = true; - - xunput (c1, yytext); - } - break; - - // = == & && | || * ** - case '=': - case '&': - case '|': - case '*': - // Always a binary op (may also include ==, &&, ||, **). - bin_op = true; - break; - - // < <= <> > >= - case '<': - case '>': - // Always a binary op (may also include <=, <>, >=). - bin_op = true; - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - bin_op = true; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return bin_op; -} - -// Used to delete trailing white space from tokens. - -static std::string -strip_trailing_whitespace (char *s) -{ - std::string retval = s; - - size_t pos = retval.find_first_of (" \t"); - - if (pos != std::string::npos) - retval.resize (pos); - - return retval; -} - -// FIXME -- we need to handle block comments here. - -static void -scan_for_comments (const char *text) -{ - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int len = strlen (text); - int i = 0; - - while (i < len) - { - char c = text[i++]; - - switch (c) - { - case '%': - case '#': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - break; - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - break; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); -} - -// Discard whitespace, including comments and continuations. -// -// Return value is logical OR of the following values: -// -// ATE_NOTHING : no spaces to eat -// ATE_SPACE_OR_TAB : space or tab in input -// ATE_NEWLINE : bare new line in input - -// FIXME -- we need to handle block comments here. - -static yum_yum -eat_whitespace (void) -{ - yum_yum retval = ATE_NOTHING; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - retval |= ATE_SPACE_OR_TAB; - break; - - case '\n': - retval |= ATE_NEWLINE; - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - comment_buf.resize (0); - in_comment = false; - beginning_of_comment = false; - } - current_input_column = 0; - break; - - case '#': - case '%': - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - break; - - case '.': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - { - if (have_ellipsis_continuation ()) - break; - else - goto done; - } - - case '\\': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - { - if (have_continuation ()) - break; - else - goto done; - } - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - break; - } - else - goto done; - } - } - - if (! comment_buf.empty ()) - octave_comment_buffer::append (comment_buf); - - done: - xunput (c, yytext); - current_input_column--; - return retval; -} - -static inline bool -looks_like_hex (const char *s, int len) -{ - return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); -} - -static void -handle_number (void) -{ - double value = 0.0; - int nread = 0; - - if (looks_like_hex (yytext, strlen (yytext))) - { - unsigned long ival; - - nread = sscanf (yytext, "%lx", &ival); - - value = static_cast (ival); - } - else - { - char *tmp = strsave (yytext); - - char *idx = strpbrk (tmp, "Dd"); - - if (idx) - *idx = 'e'; - - nread = sscanf (tmp, "%lf", &value); - - delete [] tmp; - } - - // If yytext doesn't contain a valid number, we are in deep doo doo. - - assert (nread == 1); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - lexer_flags.at_beginning_of_statement = false; - - yylval.tok_val = new token (value, yytext, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - - do_comma_insert_check (); -} - -// We have seen a backslash and need to find out if it should be -// treated as a continuation character. If so, this eats it, up to -// and including the new line character. -// -// Match whitespace only, followed by a comment character or newline. -// Once a comment character is found, discard all input until newline. -// If non-whitespace characters are found before comment -// characters, return 0. Otherwise, return 1. - -// FIXME -- we need to handle block comments here. - -static bool -have_continuation (bool trailing_comments_ok) -{ - std::ostringstream buf; - - std::string comment_buf; - - bool in_comment = false; - bool beginning_of_comment = false; - - int c = 0; - - while ((c = text_yyinput ()) != EOF) - { - buf << static_cast (c); - - switch (c) - { - case ' ': - case '\t': - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - break; - - case '%': - case '#': - if (trailing_comments_ok) - { - if (in_comment) - { - if (! beginning_of_comment) - comment_buf += static_cast (c); - } - else - { - maybe_gripe_matlab_incompatible_comment (c); - in_comment = true; - beginning_of_comment = true; - } - } - else - goto cleanup; - break; - - case '\n': - if (in_comment) - { - comment_buf += static_cast (c); - octave_comment_buffer::append (comment_buf); - } - current_input_column = 0; - promptflag--; - gripe_matlab_incompatible_continuation (); - return true; - - default: - if (in_comment) - { - comment_buf += static_cast (c); - beginning_of_comment = false; - } - else - goto cleanup; - break; - } - } - - xunput (c, yytext); - return false; - -cleanup: - - std::string s = buf.str (); - - int len = s.length (); - while (len--) - xunput (s[len], yytext); - - return false; -} - -// We have seen a `.' and need to see if it is the start of a -// continuation. If so, this eats it, up to and including the new -// line character. - -static bool -have_ellipsis_continuation (bool trailing_comments_ok) -{ - char c1 = text_yyinput (); - if (c1 == '.') - { - char c2 = text_yyinput (); - if (c2 == '.' && have_continuation (trailing_comments_ok)) - return true; - else - { - xunput (c2, yytext); - xunput (c1, yytext); - } - } - else - xunput (c1, yytext); - - return false; -} - -// See if we have a continuation line. If so, eat it and the leading -// whitespace on the next line. -// -// Return value is the same as described for eat_whitespace(). - -static yum_yum -eat_continuation (void) -{ - int retval = ATE_NOTHING; - - int c = text_yyinput (); - - if ((c == '.' && have_ellipsis_continuation ()) - || (c == '\\' && have_continuation ())) - retval = eat_whitespace (); - else - xunput (c, yytext); - - return retval; -} - -static int -handle_string (char delim) -{ - std::ostringstream buf; - - int bos_line = input_line_number; - int bos_col = current_input_column; - - int c; - int escape_pending = 0; - - while ((c = text_yyinput ()) != EOF) - { - current_input_column++; - - if (c == '\\') - { - if (delim == '\'' || escape_pending) - { - buf << static_cast (c); - escape_pending = 0; - } - else - { - if (have_continuation (false)) - escape_pending = 0; - else - { - buf << static_cast (c); - escape_pending = 1; - } - } - continue; - } - else if (c == '.') - { - if (delim == '\'' || ! have_ellipsis_continuation (false)) - buf << static_cast (c); - } - else if (c == '\n') - { - error ("unterminated string constant"); - break; - } - else if (c == delim) - { - if (escape_pending) - buf << static_cast (c); - else - { - c = text_yyinput (); - if (c == delim) - { - buf << static_cast (c); - } - else - { - std::string s; - xunput (c, yytext); - - if (delim == '\'') - s = buf.str (); - else - s = do_string_escapes (buf.str ()); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - yylval.tok_val = new token (s, bos_line, bos_col); - token_stack.push (yylval.tok_val); - - if (delim == '"') - gripe_matlab_incompatible ("\" used as string delimiter"); - else if (delim == '\'') - gripe_single_quote_string (); - - lexer_flags.looking_for_object_index = true; - lexer_flags.at_beginning_of_statement = false; - - return delim == '"' ? DQ_STRING : SQ_STRING; - } - } - } - else - { - buf << static_cast (c); - } - - escape_pending = 0; - } - - return LEXICAL_ERROR; -} - -static bool -next_token_is_assign_op (void) -{ - bool retval = false; - - int c0 = text_yyinput (); - - switch (c0) - { - case '=': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 != '=') - retval = true; - } - break; - - case '+': - case '-': - case '*': - case '/': - case '\\': - case '&': - case '|': - { - int c1 = text_yyinput (); - xunput (c1, yytext); - if (c1 == '=') - retval = true; - } - break; - - case '.': - { - int c1 = text_yyinput (); - if (match_any (c1, "+-*/\\")) - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '>': - { - int c1 = text_yyinput (); - if (c1 == '>') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - case '<': - { - int c1 = text_yyinput (); - if (c1 == '<') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - if (c2 == '=') - retval = true; - } - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static bool -next_token_is_index_op (void) -{ - int c = text_yyinput (); - xunput (c, yytext); - return c == '(' || c == '{'; -} - -static int -handle_close_bracket (bool spc_gobbled, int bracket_type) -{ - int retval = bracket_type; - - if (! nesting_level.none ()) - { - nesting_level.remove (); - - if (bracket_type == ']') - lexer_flags.bracketflag--; - else if (bracket_type == '}') - lexer_flags.braceflag--; - else - panic_impossible (); - } - - if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) - BEGIN (INITIAL); - - if (bracket_type == ']' - && next_token_is_assign_op () - && ! lexer_flags.looking_at_return_list) - { - retval = CLOSE_BRACE; - } - else if ((lexer_flags.bracketflag || lexer_flags.braceflag) - && lexer_flags.convert_spaces_to_comma - && (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ()))) - { - bool index_op = next_token_is_index_op (); - - // Don't insert comma if we are looking at something like - // - // [x{i}{j}] or [x{i}(j)] - // - // but do if we are looking at - // - // [x{i} {j}] or [x{i} (j)] - - if (spc_gobbled || ! (bracket_type == '}' && index_op)) - { - bool bin_op = next_token_is_bin_op (spc_gobbled); - - bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - bool sep_op = next_token_is_sep_op (); - - if (! (postfix_un_op || bin_op || sep_op)) - { - maybe_warn_separator_insert (','); - - xunput (',', yytext); - return retval; - } - } - } - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - - return retval; -} - -static void -maybe_unput_comma (int spc_gobbled) -{ - if (nesting_level.is_bracket () - || (nesting_level.is_brace () - && ! lexer_flags.looking_at_object_index.front ())) - { - int bin_op = next_token_is_bin_op (spc_gobbled); - - int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); - - int c1 = text_yyinput (); - int c2 = text_yyinput (); - - xunput (c2, yytext); - xunput (c1, yytext); - - int sep_op = next_token_is_sep_op (); - - int dot_op = (c1 == '.' - && (isalpha (c2) || isspace (c2) || c2 == '_')); - - if (postfix_un_op || bin_op || sep_op || dot_op) - return; - - int index_op = (c1 == '(' || c1 == '{'); - - // If there is no space before the indexing op, we don't insert - // a comma. - - if (index_op && ! spc_gobbled) - return; - - maybe_warn_separator_insert (','); - - xunput (',', yytext); - } -} - -static bool -next_token_can_follow_bin_op (void) -{ - std::stack buf; - - int c = EOF; - - // Skip whitespace in current statement on current line - while (true) - { - c = text_yyinput (); - - buf.push (c); - - if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) - break; - } - - // Restore input. - while (! buf.empty ()) - { - xunput (buf.top (), yytext); - - buf.pop (); - } - - return (isalnum (c) || match_any (c, "!\"'(-[_{~")); -} - -static bool -can_be_command (const std::string& tok) -{ - // Don't allow these names to be treated as commands to avoid - // surprises when parsing things like "NaN ^2". - - return ! (tok == "e" - || tok == "I" || tok == "i" - || tok == "J" || tok == "j" - || tok == "Inf" || tok == "inf" - || tok == "NaN" || tok == "nan"); -} - -static bool -looks_like_command_arg (void) -{ - bool retval = true; - - int c0 = text_yyinput (); - - switch (c0) - { - // = == - case '=': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else - retval = false; - - xunput (c1, yytext); - } - break; - - case '(': - case '{': - // Indexing. - retval = false; - break; - - case '\n': - // EOL. - break; - - case '\'': - case '"': - // Beginning of a character string. - break; - - // + - ++ -- += -= - case '+': - case '-': - { - int c1 = text_yyinput (); - - switch (c1) - { - case '\n': - // EOL. - case '+': - case '-': - // Unary ops, spacing doesn't matter. - break; - - case '\t': - case ' ': - { - if (next_token_can_follow_bin_op ()) - retval = false; - } - break; - - case '=': - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - break; - } - - xunput (c1, yytext); - } - break; - - case ':': - case '/': - case '\\': - case '^': - { - int c1 = text_yyinput (); - - if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // .+ .- ./ .\ .^ .* .** - case '.': - { - int c1 = text_yyinput (); - - if (match_any (c1, "+-/\\^*")) - { - int c2 = text_yyinput (); - - if (c2 == '=') - { - int c3 = text_yyinput (); - - if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c3, yytext); - } - else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") - && (! isdigit (c1) && c1 != ' ' && c1 != '\t' - && c1 != '.')) - { - // Structure reference. FIXME -- is this a complete check? - - retval = false; - } - - xunput (c1, yytext); - } - break; - - // & && | || * ** - case '&': - case '|': - case '*': - { - int c1 = text_yyinput (); - - if (c1 == c0) - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // < <= > >= - case '<': - case '>': - { - int c1 = text_yyinput (); - - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - // ~= != - case '~': - case '!': - { - int c1 = text_yyinput (); - - // ~ and ! can be unary ops, so require following =. - if (c1 == '=') - { - int c2 = text_yyinput (); - - if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c2, yytext); - } - else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') - && next_token_can_follow_bin_op ()) - retval = false; - - xunput (c1, yytext); - } - break; - - default: - break; - } - - xunput (c0, yytext); - - return retval; -} - -static int -handle_superclass_identifier (void) -{ - int c = yytext[yyleng-1]; - - std::string meth = strip_trailing_whitespace (yytext); - - int cont_is_spc = eat_continuation (); - - int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - - size_t pos = meth.find ("@"); - std::string cls = meth.substr (pos + 1); - meth = meth.substr (0, pos); - - std::string pkg; - pos = cls.find ("."); - if (pos != std::string::npos) - { - pkg = cls.substr (0, pos); - cls = cls.substr (pos + 1); - } - - int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) - || is_keyword_token (pkg)); - if (kw_token) - { - error ("method, class, and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val = new token (meth, pkg, cls, input_line_number, - current_input_column); - token_stack.push (yylval.tok_val); - - do_comma_insert_check (); - maybe_unput_comma (spc_gobbled); - current_input_column += yyleng; - - return SUPERCLASSREF; -} - -static int -handle_meta_identifier (void) -{ - int c = yytext[yyleng-1]; - - std::string cls = strip_trailing_whitespace (yytext).substr (1); - - int cont_is_spc = eat_continuation (); - - int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - - std::string pkg; - size_t pos = cls.find ("."); - if (pos != std::string::npos) - { - pkg = cls.substr (0, pos); - cls = cls.substr (pos + 1); - } - - int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); - if (kw_token) - { - error ("class and package names may not be keywords"); - return LEXICAL_ERROR; - } - - yylval.tok_val = new token (pkg, cls, input_line_number, - current_input_column); - token_stack.push (yylval.tok_val); - - do_comma_insert_check (); - maybe_unput_comma (spc_gobbled); - current_input_column += yyleng; - - return METAQUERY; -} - -// Figure out exactly what kind of token to return when we have seen -// an identifier. Handles keywords. Return -1 if the identifier -// should be ignored. - -static int -handle_identifier (void) -{ - bool at_bos = lexer_flags.at_beginning_of_statement; - - std::string tok = strip_trailing_whitespace (yytext); - - int c = yytext[yyleng-1]; - - int cont_is_spc = eat_continuation (); - - int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); - - // If we are expecting a structure element, avoid recognizing - // keywords and other special names and return STRUCT_ELT, which is - // a string that is also a valid identifier. But first, we have to - // decide whether to insert a comma. - - if (lexer_flags.looking_at_indirect_ref) - { - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - current_input_column += yyleng; - - return STRUCT_ELT; - } - - lexer_flags.at_beginning_of_statement = false; - - // The is_keyword_token may reset - // lexer_flags.at_beginning_of_statement. For example, if it sees - // an else token, then the next token is at the beginning of a - // statement. - - int kw_token = is_keyword_token (tok); - - // If we found a keyword token, then the beginning_of_statement flag - // is already set. Otherwise, we won't be at the beginning of a - // statement. - - if (lexer_flags.looking_at_function_handle) - { - if (kw_token) - { - error ("function handles may not refer to keywords"); - - return LEXICAL_ERROR; - } - else - { - yylval.tok_val = new token (tok, input_line_number, - current_input_column); - - token_stack.push (yylval.tok_val); - - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = true; - - return FCN_HANDLE; - } - } - - // If we have a regular keyword, return it. - // Keywords can be followed by identifiers. - - if (kw_token) - { - if (kw_token >= 0) - { - current_input_column += yyleng; - lexer_flags.quote_is_transpose = false; - lexer_flags.convert_spaces_to_comma = true; - lexer_flags.looking_for_object_index = false; - } - - return kw_token; - } - - // See if we have a plot keyword (title, using, with, or clear). - - int c1 = text_yyinput (); - - bool next_tok_is_eq = false; - if (c1 == '=') - { - int c2 = text_yyinput (); - xunput (c2, yytext); - - if (c2 != '=') - next_tok_is_eq = true; - } - - xunput (c1, yytext); - - // Kluge alert. - // - // If we are looking at a text style function, set up to gobble its - // arguments. - // - // If the following token is `=', or if we are parsing a function - // return list or function parameter list, or if we are looking at - // something like [ab,cd] = foo (), force the symbol to be inserted - // as a variable in the current symbol table. - - if (! is_variable (tok)) - { - if (at_bos && spc_gobbled && can_be_command (tok) - && looks_like_command_arg ()) - { - BEGIN (COMMAND_START); - } - else if (next_tok_is_eq - || lexer_flags.looking_at_decl_list - || lexer_flags.looking_at_return_list - || (lexer_flags.looking_at_parameter_list - && ! lexer_flags.looking_at_initializer_expression)) - { - symbol_table::force_variable (tok); - } - else if (lexer_flags.looking_at_matrix_or_assign_lhs) - { - lexer_flags.pending_local_variables.insert (tok); - } - } - - // Find the token in the symbol table. Beware the magic - // transformation of the end keyword... - - if (tok == "end") - tok = "__end__"; - - yylval.tok_val = new token (&(symbol_table::insert (tok)), - input_line_number, current_input_column); - - token_stack.push (yylval.tok_val); - - // After seeing an identifer, it is ok to convert spaces to a comma - // (if needed). - - lexer_flags.convert_spaces_to_comma = true; - - if (! (next_tok_is_eq || YY_START == COMMAND_START)) - { - lexer_flags.quote_is_transpose = true; - - do_comma_insert_check (); - - maybe_unput_comma (spc_gobbled); - } - - current_input_column += yyleng; - - if (tok != "__end__") - lexer_flags.looking_for_object_index = true; - - return NAME; -} - -void -lexical_feedback::init (void) -{ - // Not initially defining a matrix list. - bracketflag = 0; - - // Not initially defining a cell array list. - braceflag = 0; - - // Not initially inside a loop or if statement. - looping = 0; - - // Not initially defining a function. - defining_func = 0; - - // Not parsing an object index. - while (! parsed_function_name.empty ()) - parsed_function_name.pop (); - - parsing_class_method = false; - - // Not initially defining a class with classdef. - maybe_classdef_get_set_method = false; - parsing_classdef = false; - parsing_classdef_get_method = false; - parsing_classdef_set_method = false; - - // Not initiallly looking at a function handle. - looking_at_function_handle = 0; - - // Not initiallly looking at an anonymous function argument list. - looking_at_anon_fcn_args = 0; - - // Not parsing a function return, parameter, or declaration list. - looking_at_return_list = false; - looking_at_parameter_list = false; - looking_at_decl_list = false; - - // Not looking at an argument list initializer expression. - looking_at_initializer_expression = false; - - // Not parsing a matrix or the left hand side of multi-value - // assignment statement. - looking_at_matrix_or_assign_lhs = false; - - // Not parsing an object index. - while (! looking_at_object_index.empty ()) - looking_at_object_index.pop_front (); - - looking_at_object_index.push_front (false); - - // Object index not possible until we've seen something. - looking_for_object_index = false; - - // Yes, we are at the beginning of a statement. - at_beginning_of_statement = true; - - // No need to do comma insert or convert spaces to comma at - // beginning of input. - convert_spaces_to_comma = true; - do_comma_insert = false; - - // Not initially looking at indirect references. - looking_at_indirect_ref = false; - - // Quote marks strings intially. - quote_is_transpose = false; - - // Set of identifiers that might be local variable names is empty. - pending_local_variables.clear (); -} - -bool -is_keyword (const std::string& s) -{ - // Parsing function names like "set.property_name" inside - // classdef-style class definitions is simplified by handling the - // "set" and "get" portions of the names using the same mechanism as - // is used for keywords. However, they are not really keywords in - // the language, so omit them from the list of possible keywords. - - return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 - && ! (s == "set" || s == "get")); -} - -DEFUN (iskeyword, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} iskeyword ()\n\ -@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ -Return true if @var{name} is an Octave keyword. If @var{name}\n\ -is omitted, return a list of keywords.\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("iskeyword"); - - if (error_state) - return retval; - - if (argc == 1) - { - // Neither set and get are keywords. See the note in the - // is_keyword function for additional details. - - string_vector lst (TOTAL_KEYWORDS); - - int j = 0; - - for (int i = 0; i < TOTAL_KEYWORDS; i++) - { - std::string tmp = wordlist[i].name; - - if (! (tmp == "set" || tmp == "get")) - lst[j++] = tmp; - } - - lst.resize (j); - - retval = Cell (lst.sort ()); - } - else if (argc == 2) - { - retval = is_keyword (argv[1]); - } - else - print_usage (); - - return retval; -} - -/* - -%!assert (iskeyword ("for")) -%!assert (iskeyword ("fort"), false) -%!assert (iskeyword ("fft"), false) - -*/ - -void -prep_lexer_for_script_file (void) -{ - BEGIN (SCRIPT_FILE_BEGIN); -} - -void -prep_lexer_for_function_file (void) -{ - BEGIN (FUNCTION_FILE_BEGIN); -} - -void -prep_lexer_for_classdef_file (void) -{ - BEGIN (CLASSDEF_FILE_BEGIN); -} - -static void -maybe_warn_separator_insert (char sep) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d", - sep, input_line_number); - else - warning_with_id ("Octave:separator-insert", - "potential auto-insertion of `%c' near line %d of file %s", - sep, input_line_number, nm.c_str ()); -} - -static void -gripe_single_quote_string (void) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d", - input_line_number); - else - warning_with_id ("Octave:single-quote-string", - "single quote delimited string near line %d of file %s", - input_line_number, nm.c_str ()); -} - -static void -gripe_matlab_incompatible (const std::string& msg) -{ - std::string nm = curr_fcn_file_full_name; - - if (nm.empty ()) - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s", - msg.c_str ()); - else - warning_with_id ("Octave:matlab-incompatible", - "potential Matlab compatibility problem: %s near line %d offile %s", - msg.c_str (), input_line_number, nm.c_str ()); -} - -static void -maybe_gripe_matlab_incompatible_comment (char c) -{ - if (c == '#') - gripe_matlab_incompatible ("# used as comment character"); -} - -static void -gripe_matlab_incompatible_continuation (void) -{ - gripe_matlab_incompatible ("\\ used as line continuation marker"); -} - -static void -gripe_matlab_incompatible_operator (const std::string& op) -{ - std::string t = op; - int n = t.length (); - if (t[n-1] == '\n') - t.resize (n-1); - gripe_matlab_incompatible (t + " used as operator"); -} - -static void -display_token (int tok) -{ - switch (tok) - { - case '=': std::cerr << "'='\n"; break; - case ':': std::cerr << "':'\n"; break; - case '-': std::cerr << "'-'\n"; break; - case '+': std::cerr << "'+'\n"; break; - case '*': std::cerr << "'*'\n"; break; - case '/': std::cerr << "'/'\n"; break; - case ADD_EQ: std::cerr << "ADD_EQ\n"; break; - case SUB_EQ: std::cerr << "SUB_EQ\n"; break; - case MUL_EQ: std::cerr << "MUL_EQ\n"; break; - case DIV_EQ: std::cerr << "DIV_EQ\n"; break; - case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; - case POW_EQ: std::cerr << "POW_EQ\n"; break; - case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; - case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; - case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; - case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; - case AND_EQ: std::cerr << "AND_EQ\n"; break; - case OR_EQ: std::cerr << "OR_EQ\n"; break; - case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; - case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; - case LSHIFT: std::cerr << "LSHIFT\n"; break; - case RSHIFT: std::cerr << "RSHIFT\n"; break; - case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; - case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; - case EXPR_AND: std::cerr << "EXPR_AND\n"; break; - case EXPR_OR: std::cerr << "EXPR_OR\n"; break; - case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; - case EXPR_LT: std::cerr << "EXPR_LT\n"; break; - case EXPR_LE: std::cerr << "EXPR_LE\n"; break; - case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; - case EXPR_NE: std::cerr << "EXPR_NE\n"; break; - case EXPR_GE: std::cerr << "EXPR_GE\n"; break; - case EXPR_GT: std::cerr << "EXPR_GT\n"; break; - case LEFTDIV: std::cerr << "LEFTDIV\n"; break; - case EMUL: std::cerr << "EMUL\n"; break; - case EDIV: std::cerr << "EDIV\n"; break; - case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; - case EPLUS: std::cerr << "EPLUS\n"; break; - case EMINUS: std::cerr << "EMINUS\n"; break; - case QUOTE: std::cerr << "QUOTE\n"; break; - case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; - case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; - case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; - case POW: std::cerr << "POW\n"; break; - case EPOW: std::cerr << "EPOW\n"; break; - - case NUM: - case IMAG_NUM: - std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") - << " [" << yylval.tok_val->number () << "]\n"; - break; - - case STRUCT_ELT: - std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; - - case NAME: - { - symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); - std::cerr << "NAME"; - if (sr) - std::cerr << " [" << sr->name () << "]"; - std::cerr << "\n"; - } - break; - - case END: std::cerr << "END\n"; break; - - case DQ_STRING: - case SQ_STRING: - std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") - << " [" << yylval.tok_val->text () << "]\n"; - break; - - case FOR: std::cerr << "FOR\n"; break; - case WHILE: std::cerr << "WHILE\n"; break; - case DO: std::cerr << "DO\n"; break; - case UNTIL: std::cerr << "UNTIL\n"; break; - case IF: std::cerr << "IF\n"; break; - case ELSEIF: std::cerr << "ELSEIF\n"; break; - case ELSE: std::cerr << "ELSE\n"; break; - case SWITCH: std::cerr << "SWITCH\n"; break; - case CASE: std::cerr << "CASE\n"; break; - case OTHERWISE: std::cerr << "OTHERWISE\n"; break; - case BREAK: std::cerr << "BREAK\n"; break; - case CONTINUE: std::cerr << "CONTINUE\n"; break; - case FUNC_RET: std::cerr << "FUNC_RET\n"; break; - case UNWIND: std::cerr << "UNWIND\n"; break; - case CLEANUP: std::cerr << "CLEANUP\n"; break; - case TRY: std::cerr << "TRY\n"; break; - case CATCH: std::cerr << "CATCH\n"; break; - case GLOBAL: std::cerr << "GLOBAL\n"; break; - case PERSISTENT: std::cerr << "PERSISTENT\n"; break; - case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; - case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; - case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; - case FCN: std::cerr << "FCN\n"; break; - case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; - case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; - case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; - case CLASSDEF_FILE: std::cerr << "CLASSDEF_FILE\n"; break; - case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; - case METAQUERY: std::cerr << "METAQUERY\n"; break; - case GET: std::cerr << "GET\n"; break; - case SET: std::cerr << "SET\n"; break; - case PROPERTIES: std::cerr << "PROPERTIES\n"; break; - case METHODS: std::cerr << "METHODS\n"; break; - case EVENTS: std::cerr << "EVENTS\n"; break; - case CLASSDEF: std::cerr << "CLASSDEF\n"; break; - case '\n': std::cerr << "\\n\n"; break; - case '\r': std::cerr << "\\r\n"; break; - case '\t': std::cerr << "TAB\n"; break; - default: - { - if (tok < 256) - std::cerr << static_cast (tok) << "\n"; - else - std::cerr << "UNKNOWN(" << tok << ")\n"; - } - break; - } -} - -static void -display_state (void) -{ - std::cerr << "S: "; - - switch (YY_START) - { - case INITIAL: - std::cerr << "INITIAL" << std::endl; - break; - - case COMMAND_START: - std::cerr << "COMMAND_START" << std::endl; - break; - - case MATRIX_START: - std::cerr << "MATRIX_START" << std::endl; - break; - - case SCRIPT_FILE_BEGIN: - std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; - break; - - case FUNCTION_FILE_BEGIN: - std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; - break; - - case CLASSDEF_FILE_BEGIN: - std::cerr << "CLASSDEF_FILE_BEGIN" << std::endl; - break; - - default: - std::cerr << "UNKNOWN START STATE!" << std::endl; - break; - } -} - -static void -lexer_debug (const char *pattern, const char *text) -{ - std::cerr << std::endl; - - display_state (); - - std::cerr << "P: " << pattern << std::endl; - std::cerr << "T: " << text << std::endl; -} - -DEFUN (__display_tokens__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ -Query or set the internal variable that determines whether Octave's\n\ -lexer displays tokens as they are read.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (display_tokens); -} - -DEFUN (__token_count__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __token_count__ ()\n\ -Number of language tokens processed since Octave startup.\n\ -@end deftypefn") -{ - return octave_value (Vtoken_count); -} - -DEFUN (__lexer_debug_flag__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - retval = set_internal_variable (lexer_debug_flag, args, nargout, - "__lexer_debug_flag__"); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/link-deps.mk --- a/src/link-deps.mk Tue Jul 31 09:54:19 2012 -0400 +++ b/src/link-deps.mk Fri Aug 03 14:35:44 2012 -0400 @@ -3,7 +3,7 @@ if AMCOND_ENABLE_DYNAMIC_LINKING LIBOCTINTERP_LINK_DEPS = else - LIBOCTINTERP_LINK_DEPS = $(DLD_FUNCTIONS_LIBS) + LIBOCTINTERP_LINK_DEPS = $(DLDFCN_LIBS) endif LIBOCTINTERP_LINK_DEPS += \ diff -r 069c552587a0 -r 959953dba519 src/load-path.cc --- a/src/load-path.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2327 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "input.h" -#include "load-path.h" -#include "pager.h" -#include "parse.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" - -load_path *load_path::instance = 0; -load_path::hook_fcn_ptr load_path::add_hook = execute_pkg_add; -load_path::hook_fcn_ptr load_path::remove_hook = execute_pkg_del; -std::string load_path::command_line_path; -std::string load_path::sys_path; -load_path::abs_dir_cache_type load_path::abs_dir_cache; - -void -load_path::dir_info::update (void) -{ - file_stat fs (dir_name); - - if (fs) - { - if (is_relative) - { - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - abs_dir_cache_iterator p = abs_dir_cache.find (abs_name); - - if (p != abs_dir_cache.end ()) - { - // The directory is in the cache of all directories - // we have visited (indexed by its absolute name). - // If it is out of date, initialize it. Otherwise, - // copy the info from the cache. By doing that, we - // avoid unnecessary calls to stat that can slow - // things down tremendously for large directories. - - const dir_info& di = p->second; - - if (fs.mtime () + fs.time_resolution () > di.dir_time_last_checked) - initialize (); - else - *this = di; - } - else - { - // We haven't seen this directory before. - - initialize (); - } - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are, but - // don't treat it as an error. - - error_state = 0; - } - } - else if (fs.mtime () + fs.time_resolution () > dir_time_last_checked) - initialize (); - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::initialize (void) -{ - is_relative = ! octave_env::absolute_pathname (dir_name); - - dir_time_last_checked = octave_time (static_cast (0)); - - file_stat fs (dir_name); - - if (fs) - { - method_file_map.clear (); - - dir_mtime = fs.mtime (); - dir_time_last_checked = octave_time (); - - get_file_list (dir_name); - - try - { - std::string abs_name = octave_env::make_absolute (dir_name); - - // FIXME -- nothing is ever removed from this cache of - // directory information, so there could be some resource - // problems. Perhaps it should be pruned from time to time. - - abs_dir_cache[abs_name] = *this; - } - catch (octave_execution_exception) - { - // Skip updating if we don't know where we are. - } - } - else - { - std::string msg = fs.error (); - warning ("load_path: %s: %s", dir_name.c_str (), msg.c_str ()); - } -} - -void -load_path::dir_info::get_file_list (const std::string& d) -{ - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - all_files.resize (len); - fcn_files.resize (len); - - octave_idx_type all_files_count = 0; - octave_idx_type fcn_files_count = 0; - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string full_name = file_ops::concat (d, fname); - - file_stat fs (full_name); - - if (fs) - { - if (fs.is_dir ()) - { - if (fname == "private") - get_private_file_map (full_name); - else if (fname[0] == '@') - get_method_file_map (full_name, fname.substr (1)); - } - else - { - all_files[all_files_count++] = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - std::string ext = fname.substr (pos); - - if (ext == ".m" || ext == ".oct" || ext == ".mex") - { - std::string base = fname.substr (0, pos); - - if (valid_identifier (base)) - fcn_files[fcn_files_count++] = fname; - } - } - } - } - } - - all_files.resize (all_files_count); - fcn_files.resize (fcn_files_count); - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } -} - -load_path::dir_info::fcn_file_map_type -get_fcn_files (const std::string& d) -{ - load_path::dir_info::fcn_file_map_type retval; - - dir_entry dir (d); - - if (dir) - { - string_vector flist = dir.read (); - - octave_idx_type len = flist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = flist[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - - if (valid_identifier (base)) - { - int t = 0; - - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - retval[base] |= t; - } - } - } - } - else - { - std::string msg = dir.error (); - warning ("load_path: %s: %s", d.c_str (), msg.c_str ()); - } - - return retval; -} - -void -load_path::dir_info::get_private_file_map (const std::string& d) -{ - private_file_map = get_fcn_files (d); -} - -void -load_path::dir_info::get_method_file_map (const std::string& d, - const std::string& class_name) -{ - method_file_map[class_name].method_file_map = get_fcn_files (d); - - std::string pd = file_ops::concat (d, "private"); - - file_stat fs (pd); - - if (fs && fs.is_dir ()) - method_file_map[class_name].private_file_map = get_fcn_files (pd); -} - -bool -load_path::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new load_path (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create load path object!"); - - retval = false; - } - - return retval; -} - -// FIXME -- maybe we should also maintain a map to speed up this -// method of access. - -load_path::const_dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) const -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - const_dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -load_path::dir_info_list_iterator -load_path::find_dir_info (const std::string& dir_arg) -{ - std::string dir = file_ops::tilde_expand (dir_arg); - - dir_info_list_iterator retval = dir_info_list.begin (); - - while (retval != dir_info_list.end ()) - { - if (retval->dir_name == dir) - break; - - retval++; - } - - return retval; -} - -bool -load_path::contains (const std::string& dir) const -{ - return find_dir_info (dir) != dir_info_list.end (); -} - -void -load_path::move_fcn_map (const std::string& dir_name, - const string_vector& fcn_files, bool at_end) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } -} - -void -load_path::move_method_map (const std::string& dir_name, bool at_end) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info fi = *p; - - file_info_list.erase (p); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - - break; - } - } - } - } - } -} - -void -load_path::move (dir_info_list_iterator i, bool at_end) -{ - if (dir_info_list.size () > 1) - { - dir_info di = *i; - - dir_info_list.erase (i); - - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - std::string dir_name = di.dir_name; - - move_fcn_map (dir_name, di.fcn_files, at_end); - - // No need to move elements of private function map. - - move_method_map (dir_name, at_end); - } -} - -static void -maybe_add_path_elts (std::string& path, const std::string& dir) -{ - std::string tpath = genpath (dir); - - if (! tpath.empty ()) - { - if (path.empty ()) - path = tpath; - else - path += dir_path::path_sep_str () + tpath; - } -} - -void -load_path::do_initialize (bool set_initial_path) -{ - sys_path = ""; - - if (set_initial_path) - { - maybe_add_path_elts (sys_path, Vlocal_ver_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_oct_file_dir); - maybe_add_path_elts (sys_path, Vlocal_ver_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_api_fcn_file_dir); - maybe_add_path_elts (sys_path, Vlocal_fcn_file_dir); - maybe_add_path_elts (sys_path, Voct_file_dir); - maybe_add_path_elts (sys_path, Vfcn_file_dir); - } - - std::string tpath = load_path::command_line_path; - - if (tpath.empty ()) - tpath = octave_env::getenv ("OCTAVE_PATH"); - - std::string xpath; - - if (! tpath.empty ()) - { - xpath = tpath; - - if (! sys_path.empty ()) - xpath += dir_path::path_sep_str () + sys_path; - } - else - xpath = sys_path; - - do_set (xpath, false, true); -} - -void -load_path::do_clear (void) -{ - dir_info_list.clear (); - fcn_map.clear (); - private_fcn_map.clear (); - method_map.clear (); -} - -static std::list -split_path (const std::string& p) -{ - std::list retval; - - size_t beg = 0; - size_t end = p.find (dir_path::path_sep_char ()); - - size_t len = p.length (); - - while (end != std::string::npos) - { - std::string elt = p.substr (beg, end-beg); - - if (! elt.empty ()) - retval.push_back (elt); - - beg = end + 1; - - if (beg == len) - break; - - end = p.find (dir_path::path_sep_char (), beg); - } - - std::string elt = p.substr (beg); - - if (! elt.empty ()) - retval.push_back (elt); - - return retval; -} - -void -load_path::do_set (const std::string& p, bool warn, bool is_init) -{ - // Use a list when we need to preserve order. - std::list elts = split_path (p); - - // Use a set when we need to search and order is not important. - std::set elts_set (elts.begin (), elts.end ()); - - if (is_init) - init_dirs = elts_set; - else - { - for (std::set::const_iterator it = init_dirs.begin (); - it != init_dirs.end (); it++) - { - if (elts_set.find (*it) == elts_set.end ()) - { - warning_with_id ("Octave:remove-init-dir", - "default load path altered. Some built-in functions may not be found. Try restoredefaultpath() to recover it."); - break; - } - } - } - - // Temporarily disable add hook. - - unwind_protect frame; - frame.protect_var (add_hook); - - add_hook = 0; - - do_clear (); - - for (std::list::const_iterator i = elts.begin (); - i != elts.end (); i++) - do_append (*i, warn); - - // Restore add hook and execute for all newly added directories. - frame.run_top (); - - for (dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - if (add_hook) - add_hook (i->dir_name); - } - - // Always prepend current directory. - do_prepend (".", warn); -} - -void -load_path::do_append (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, true, warn); -} - -void -load_path::do_prepend (const std::string& dir, bool warn) -{ - if (! dir.empty ()) - do_add (dir, false, warn); -} - -// Strip trailing directory separators. - -static std::string -strip_trailing_separators (const std::string& dir_arg) -{ - std::string dir = dir_arg; - - size_t k = dir.length (); - - while (k > 1 && file_ops::is_dir_sep (dir[k-1])) - k--; - - if (k < dir.length ()) - dir.resize (k); - - return dir; -} - -void -load_path::do_add (const std::string& dir_arg, bool at_end, bool warn) -{ - size_t len = dir_arg.length (); - - if (len > 1 && dir_arg.substr (len-2) == "//") - warning_with_id ("Octave:recursive-path-search", - "trailing `//' is no longer special in search path elements"); - - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - move (i, at_end); - else - { - file_stat fs (dir); - - if (fs) - { - if (fs.is_dir ()) - { - dir_info di (dir); - - if (! error_state) - { - if (at_end) - dir_info_list.push_back (di); - else - dir_info_list.push_front (di); - - add_to_fcn_map (di, at_end); - - add_to_private_fcn_map (di); - - add_to_method_map (di, at_end); - - if (add_hook) - add_hook (dir); - } - } - else if (warn) - warning ("addpath: %s: not a directory", dir_arg.c_str ()); - } - else if (warn) - { - std::string msg = fs.error (); - warning ("addpath: %s: %s", dir_arg.c_str (), msg.c_str ()); - } - } - - // FIXME -- is there a better way to do this? - - i = find_dir_info ("."); - - if (i != dir_info_list.end ()) - move (i, false); -} - -void -load_path::remove_fcn_map (const std::string& dir, - const string_vector& fcn_files) -{ - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type k = 0; k < len; k++) - { - std::string fname = fcn_files[k]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == dir) - { - file_info_list.erase (p); - - if (file_info_list.empty ()) - fcn_map.erase (fname); - - break; - } - } - } -} - -void -load_path::remove_private_fcn_map (const std::string& dir) -{ - private_fcn_map_iterator p = private_fcn_map.find (dir); - - if (p != private_fcn_map.end ()) - private_fcn_map.erase (p); -} - -void -load_path::remove_method_map (const std::string& dir) -{ - for (method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - std::string class_name = i->first; - - fcn_map_type& fm = i->second; - - std::string full_dir_name = file_ops::concat (dir, "@" + class_name); - - for (fcn_map_iterator q = fm.begin (); q != fm.end (); q++) - { - file_info_list_type& file_info_list = q->second; - - if (file_info_list.size () == 1) - continue; - else - { - for (file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - if (p->dir_name == full_dir_name) - { - file_info_list.erase (p); - - // FIXME -- if there are no other elements, we - // should remove this element of fm but calling - // erase here would invalidate the iterator q. - - break; - } - } - } - } - } -} - -bool -load_path::do_remove (const std::string& dir_arg) -{ - bool retval = false; - - if (! dir_arg.empty ()) - { - if (dir_arg == ".") - { - warning ("rmpath: can't remove \".\" from path"); - - // Avoid additional warnings. - retval = true; - } - else - { - std::string dir = file_ops::tilde_expand (dir_arg); - - dir = strip_trailing_separators (dir); - - dir_info_list_iterator i = find_dir_info (dir); - - if (i != dir_info_list.end ()) - { - retval = true; - - if (remove_hook) - remove_hook (dir); - - string_vector fcn_files = i->fcn_files; - - dir_info_list.erase (i); - - remove_fcn_map (dir, fcn_files); - - remove_private_fcn_map (dir); - - remove_method_map (dir); - } - } - } - - return retval; -} - -void -load_path::do_update (void) const -{ - // I don't see a better way to do this because we need to - // preserve the correct directory ordering for new files that - // have appeared. - - fcn_map.clear (); - - private_fcn_map.clear (); - - method_map.clear (); - - for (dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - dir_info& di = *p; - - di.update (); - - add_to_fcn_map (di, true); - - add_to_private_fcn_map (di); - - add_to_method_map (di, true); - } -} - -bool -load_path::check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who) -{ - bool retval = false; - - if (type == load_path::OCT_FILE) - { - if ((type & possible_types) == load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - } - else if (type == load_path::M_FILE) - { - if ((type & possible_types) == load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == load_path::MEX_FILE) - { - if ((type & possible_types) == load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else if (type == (load_path::OCT_FILE | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - } - else if (type == (load_path::M_FILE | load_path::OCT_FILE - | load_path::MEX_FILE)) - { - if (possible_types & load_path::OCT_FILE) - { - fname += ".oct"; - retval = true; - } - else if (possible_types & load_path::MEX_FILE) - { - fname += ".mex"; - retval = true; - } - else if (possible_types & load_path::M_FILE) - { - fname += ".m"; - retval = true; - } - } - else - error ("%s: %s: invalid type code = %d", who, fcn.c_str (), type); - - return retval; -} - -std::string -load_path::do_find_fcn (const std::string& fcn, std::string& dir_name, - int type) const -{ - std::string retval; - - // update (); - - if (fcn.length () > 0 && fcn[0] == '@') - { - size_t pos = fcn.find ('/'); - - if (pos != std::string::npos) - { - std::string class_name = fcn.substr (1, pos-1); - std::string meth = fcn.substr (pos+1); - - retval = do_find_method (class_name, meth, dir_name); - } - else - retval = std::string (); - } - else - { - dir_name = std::string (); - - const_fcn_map_iterator p = fcn_map.find (fcn); - - if (p != fcn_map.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, fcn); - - if (check_file_type (retval, type, fi.types, - fcn, "load_path::do_find_fcn")) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::string -load_path::do_find_private_fcn (const std::string& dir, - const std::string& fcn, int type) const -{ - std::string retval; - - // update (); - - const_private_fcn_map_iterator q = private_fcn_map.find (dir); - - if (q != private_fcn_map.end ()) - { - const dir_info::fcn_file_map_type& m = q->second; - - dir_info::const_fcn_file_map_iterator p = m.find (fcn); - - if (p != m.end ()) - { - std::string fname - = file_ops::concat (file_ops::concat (dir, "private"), fcn); - - if (check_file_type (fname, type, p->second, fcn, - "load_path::find_private_fcn")) - retval = fname; - } - } - - return retval; -} - -std::string -load_path::do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, int type) const -{ - std::string retval; - - // update (); - - dir_name = std::string (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - const_fcn_map_iterator p = m.find (meth); - - if (p != m.end ()) - { - const file_info_list_type& file_info_list = p->second; - - for (const_file_info_list_iterator i = file_info_list.begin (); - i != file_info_list.end (); - i++) - { - const file_info& fi = *i; - - retval = file_ops::concat (fi.dir_name, meth); - - bool found = check_file_type (retval, type, fi.types, - meth, "load_path::do_find_method"); - - if (found) - { - dir_name = fi.dir_name; - break; - } - else - retval = std::string (); - } - } - } - - return retval; -} - -std::list -load_path::do_methods (const std::string& class_name) const -{ - std::list retval; - - // update (); - - const_method_map_iterator q = method_map.find (class_name); - - if (q != method_map.end ()) - { - const fcn_map_type& m = q->second; - - for (const_fcn_map_iterator p = m.begin (); p != m.end (); p++) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; -} - -std::list -load_path::do_overloads (const std::string& meth) const -{ - std::list retval; - - // update (); - - for (const_method_map_iterator q = method_map.begin (); - q != method_map.end (); q++) - { - const fcn_map_type& m = q->second; - - if (m.find (meth) != m.end ()) - retval.push_back (q->first); - } - - return retval; -} - -std::string -load_path::do_find_file (const std::string& file) const -{ - std::string retval; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - if (all_files[i] == file) - return file_ops::concat (p->dir_name, file); - } - } - } - - return retval; -} - -std::string -load_path::do_find_dir (const std::string& dir) const -{ - std::string retval; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - return dir; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - return p->dir_name; - } - } - } - - return retval; -} - -string_vector -load_path::do_find_matching_dirs (const std::string& dir) const -{ - std::list retlist; - - if (dir.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos - && (octave_env::absolute_pathname (dir) - || octave_env::rooted_relative_pathname (dir))) - { - file_stat fs (dir); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (dir); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string dname = octave_env::make_absolute (p->dir_name); - - size_t dname_len = dname.length (); - - if (dname.substr (dname_len - 1) == file_ops::dir_sep_str ()) - { - dname = dname.substr (0, dname_len - 1); - dname_len--; - } - - size_t dir_len = dir.length (); - - if (dname_len >= dir_len - && file_ops::is_dir_sep (dname[dname_len - dir_len - 1]) - && dir.compare (dname.substr (dname_len - dir_len)) == 0) - { - file_stat fs (p->dir_name); - - if (fs.exists () && fs.is_dir ()) - retlist.push_back (p->dir_name); - } - } - } - - return retlist; -} - -std::string -load_path::do_find_first_of (const string_vector& flist) const -{ - std::string retval; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - return file; - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - return tfile; - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - { - dir_name = p->dir_name; - file_name = rel_flist[j]; - - goto done; - } - } - } - } - - done: - - if (! dir_name.empty ()) - retval = file_ops::concat (dir_name, file_name); - - return retval; -} - -string_vector -load_path::do_find_all_first_of (const string_vector& flist) const -{ - std::list retlist; - - std::string dir_name; - std::string file_name; - - octave_idx_type flen = flist.length (); - octave_idx_type rel_flen = 0; - - string_vector rel_flist (flen); - - for (octave_idx_type i = 0; i < flen; i++) - { - std::string file = flist[i]; - - if (file.find_first_of (file_ops::dir_sep_chars ()) != std::string::npos) - { - if (octave_env::absolute_pathname (file) - || octave_env::rooted_relative_pathname (file)) - { - file_stat fs (file); - - if (fs.exists ()) - retlist.push_back (file); - } - else - { - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - std::string tfile = file_ops::concat (p->dir_name, file); - - file_stat fs (tfile); - - if (fs.exists ()) - retlist.push_back (tfile); - } - } - } - else - rel_flist[rel_flen++] = file; - } - - rel_flist.resize (rel_flen); - - for (const_dir_info_list_iterator p = dir_info_list.begin (); - p != dir_info_list.end (); - p++) - { - string_vector all_files = p->all_files; - - octave_idx_type len = all_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - for (octave_idx_type j = 0; j < rel_flen; j++) - { - if (all_files[i] == rel_flist[j]) - retlist.push_back - (file_ops::concat (p->dir_name, rel_flist[j])); - } - } - } - - return retlist; -} - -string_vector -load_path::do_dirs (void) const -{ - size_t len = dir_info_list.size (); - - string_vector retval (len); - - octave_idx_type k = 0; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval[k++] = i->dir_name; - - return retval; -} - -std::list -load_path::do_dir_list (void) const -{ - std::list retval; - - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - retval.push_back (i->dir_name); - - return retval; -} - -string_vector -load_path::do_files (const std::string& dir, bool omit_exts) const -{ - string_vector retval; - - const_dir_info_list_iterator p = find_dir_info (dir); - - if (p != dir_info_list.end ()) - retval = p->fcn_files; - - if (omit_exts) - { - octave_idx_type len = retval.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = retval[i]; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - retval[i] = fname.substr (0, pos); - } - } - - return retval; -} - -string_vector -load_path::do_fcn_names (void) const -{ - size_t len = fcn_map.size (); - - string_vector retval (len); - - octave_idx_type count = 0; - - for (const_fcn_map_iterator p = fcn_map.begin (); - p != fcn_map.end (); - p++) - retval[count++] = p->first; - - return retval; -} - -std::string -load_path::do_path (void) const -{ - std::string xpath; - - string_vector xdirs = load_path::dirs (); - - octave_idx_type len = xdirs.length (); - - if (len > 0) - xpath = xdirs[0]; - - for (octave_idx_type i = 1; i < len; i++) - xpath += dir_path::path_sep_str () + xdirs[i]; - - return xpath; -} - -void -print_types (std::ostream& os, int types) -{ - bool printed_type = false; - - if (types & load_path::OCT_FILE) - { - os << "oct"; - printed_type = true; - } - - if (types & load_path::MEX_FILE) - { - if (printed_type) - os << "|"; - os << "mex"; - printed_type = true; - } - - if (types & load_path::M_FILE) - { - if (printed_type) - os << "|"; - os << "m"; - printed_type = true; - } -} - -void -print_fcn_list (std::ostream& os, - const load_path::dir_info::fcn_file_map_type& lst) -{ - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - os << " " << p->first << " ("; - - print_types (os, p->second); - - os << ")\n"; - } -} - -string_vector -get_file_list (const load_path::dir_info::fcn_file_map_type& lst) -{ - octave_idx_type n = lst.size (); - - string_vector retval (n); - - octave_idx_type count = 0; - - for (load_path::dir_info::const_fcn_file_map_iterator p = lst.begin (); - p != lst.end (); - p++) - { - std::string nm = p->first; - - int types = p->second; - - if (types & load_path::OCT_FILE) - nm += ".oct"; - else if (types & load_path::MEX_FILE) - nm += ".mex"; - else - nm += ".m"; - - retval[count++] = nm; - } - - return retval; -} - -void -load_path::do_display (std::ostream& os) const -{ - for (const_dir_info_list_iterator i = dir_info_list.begin (); - i != dir_info_list.end (); - i++) - { - string_vector fcn_files = i->fcn_files; - - if (! fcn_files.empty ()) - { - os << "\n*** function files in " << i->dir_name << ":\n\n"; - - fcn_files.list_in_columns (os); - } - - const dir_info::method_file_map_type& method_file_map - = i->method_file_map; - - if (! method_file_map.empty ()) - { - for (dir_info::const_method_file_map_iterator p = method_file_map.begin (); - p != method_file_map.end (); - p++) - { - os << "\n*** methods in " << i->dir_name - << "/@" << p->first << ":\n\n"; - - const dir_info::class_info& ci = p->second; - - string_vector method_files = get_file_list (ci.method_file_map); - - method_files.list_in_columns (os); - } - } - } - - for (const_private_fcn_map_iterator i = private_fcn_map.begin (); - i != private_fcn_map.end (); i++) - { - os << "\n*** private functions in " - << file_ops::concat (i->first, "private") << ":\n\n"; - - print_fcn_list (os, i->second); - } - -#if defined (DEBUG_LOAD_PATH) - - for (const_fcn_map_iterator i = fcn_map.begin (); - i != fcn_map.end (); - i++) - { - os << i->first << ":\n"; - - const file_info_list_type& file_info_list = i->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - - for (const_method_map_iterator i = method_map.begin (); - i != method_map.end (); - i++) - { - os << "CLASS " << i->first << ":\n"; - - const fcn_map_type& fm = i->second; - - for (const_fcn_map_iterator q = fm.begin (); - q != fm.end (); - q++) - { - os << " " << q->first << ":\n"; - - const file_info_list_type& file_info_list = q->second; - - for (const_file_info_list_iterator p = file_info_list.begin (); - p != file_info_list.end (); - p++) - { - os << " " << p->dir_name << " ("; - - print_types (os, p->types); - - os << ")\n"; - } - } - } - - os << "\n"; - -#endif -} - -// True if a path is contained in a path list separated by path_sep_char -static bool -in_path_list (const std::string& path_list, const std::string& path) -{ - size_t ps = path.size (), pls = path_list.size (), pos = path_list.find (path); - char psc = dir_path::path_sep_char (); - while (pos != std::string::npos) - { - if ((pos == 0 || path_list[pos-1] == psc) - && (pos + ps == pls || path_list[pos + ps] == psc)) - return true; - else - pos = path_list.find (path, pos + 1); - } - - return false; -} - -void -load_path::add_to_fcn_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - string_vector fcn_files = di.fcn_files; - - octave_idx_type len = fcn_files.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string fname = fcn_files[i]; - - std::string ext; - std::string base = fname; - - size_t pos = fname.rfind ('.'); - - if (pos != std::string::npos) - { - base = fname.substr (0, pos); - ext = fname.substr (pos); - } - - file_info_list_type& file_info_list = fcn_map[base]; - - file_info_list_iterator p = file_info_list.begin (); - - while (p != file_info_list.end ()) - { - if (p->dir_name == dir_name) - break; - - p++; - } - - int t = 0; - if (ext == ".m") - t = load_path::M_FILE; - else if (ext == ".oct") - t = load_path::OCT_FILE; - else if (ext == ".mex") - t = load_path::MEX_FILE; - - if (p == file_info_list.end ()) - { - file_info fi (dir_name, t); - - if (at_end) - file_info_list.push_back (fi); - else - { - // Warn if a built-in or library function is being shadowed. - - if (! file_info_list.empty ()) - { - file_info& old = file_info_list.front (); - - // FIXME -- do we need to be more careful about the - // way we look for old.dir_name in sys_path to avoid - // partial matches? - - // Don't warn about Contents.m files since we expect - // more than one to exist in the load path. - - if (fname != "Contents.m" - && sys_path.find (old.dir_name) != std::string::npos - && in_path_list (sys_path, old.dir_name)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - - warning_with_id ("Octave:shadowed-function", - "function %s shadows a core library function", - fcn_path.c_str ()); - } - } - else if (symbol_table::is_built_in_function_name (base)) - { - std::string fcn_path = file_ops::concat (dir_name, fname); - warning_with_id ("Octave:shadowed-function", - "function %s shadows a built-in function", - fcn_path.c_str ()); - } - - file_info_list.push_front (fi); - } - } - else - { - file_info& fi = *p; - - fi.types |= t; - } - } -} - -void -load_path::add_to_private_fcn_map (const dir_info& di) const -{ - dir_info::fcn_file_map_type private_file_map = di.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[di.dir_name] = private_file_map; -} - -void -load_path::add_to_method_map (const dir_info& di, bool at_end) const -{ - std::string dir_name = di.dir_name; - - // - dir_info::method_file_map_type method_file_map = di.method_file_map; - - for (dir_info::const_method_file_map_iterator q = method_file_map.begin (); - q != method_file_map.end (); - q++) - { - std::string class_name = q->first; - - fcn_map_type& fm = method_map[class_name]; - - std::string full_dir_name - = file_ops::concat (dir_name, "@" + class_name); - - const dir_info::class_info& ci = q->second; - - // - const dir_info::fcn_file_map_type& m = ci.method_file_map; - - for (dir_info::const_fcn_file_map_iterator p = m.begin (); - p != m.end (); - p++) - { - std::string base = p->first; - - int types = p->second; - - file_info_list_type& file_info_list = fm[base]; - - file_info_list_iterator p2 = file_info_list.begin (); - - while (p2 != file_info_list.end ()) - { - if (p2->dir_name == full_dir_name) - break; - - p2++; - } - - if (p2 == file_info_list.end ()) - { - file_info fi (full_dir_name, types); - - if (at_end) - file_info_list.push_back (fi); - else - file_info_list.push_front (fi); - } - else - { - // FIXME -- is this possible? - - file_info& fi = *p2; - - fi.types = types; - } - } - - // - dir_info::fcn_file_map_type private_file_map = ci.private_file_map; - - if (! private_file_map.empty ()) - private_fcn_map[full_dir_name] = private_file_map; - } -} - -std::string -genpath (const std::string& dirname, const string_vector& skip) -{ - std::string retval; - - dir_entry dir (dirname); - - if (dir) - { - retval = dirname; - - string_vector dirlist = dir.read (); - - octave_idx_type len = dirlist.length (); - - for (octave_idx_type i = 0; i < len; i++) - { - std::string elt = dirlist[i]; - - bool skip_p = (elt == "." || elt == ".." || elt[0] == '@'); - - if (! skip_p) - { - for (octave_idx_type j = 0; j < skip.length (); j++) - { - skip_p = (elt == skip[j]); - if (skip_p) - break; - } - - if (! skip_p) - { - std::string nm = file_ops::concat (dirname, elt); - - file_stat fs (nm); - - if (fs && fs.is_dir ()) - retval += dir_path::path_sep_str () + genpath (nm, skip); - } - } - } - } - - return retval; -} - -static void -execute_pkg_add_or_del (const std::string& dir, - const std::string& script_file) -{ - if (! octave_interpreter_ready) - return; - - unwind_protect frame; - - frame.protect_var (input_from_startup_file); - - input_from_startup_file = true; - - std::string file = file_ops::concat (dir, script_file); - - file_stat fs (file); - - if (fs.exists ()) - source_file (file, "base"); -} - -void -execute_pkg_add (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_ADD"); -} - -void -execute_pkg_del (const std::string& dir) -{ - execute_pkg_add_or_del (dir, "PKG_DEL"); -} - -DEFUN (genpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} genpath (@var{dir})\n\ -@deftypefnx {Built-in Function} {} genpath (@var{dir}, @var{skip}, @dots{})\n\ -Return a path constructed from @var{dir} and all its subdirectories.\n\ -If additional string parameters are given, the resulting path will\n\ -exclude directories with those names.\n\ -@end deftypefn") -{ - octave_value retval; - - octave_idx_type nargin = args.length (); - - if (nargin == 1) - { - std::string dirname = args(0).string_value (); - - if (! error_state) - retval = genpath (dirname); - else - error ("genpath: DIR must be a character string"); - } - else if (nargin > 1) - { - std::string dirname = args(0).string_value (); - - string_vector skip (nargin - 1); - - for (octave_idx_type i = 1; i < nargin; i++) - { - skip[i-1] = args(i).string_value (); - - if (error_state) - break; - } - - if (! error_state) - retval = genpath (dirname, skip); - else - error ("genpath: all arguments must be character strings"); - } - else - print_usage (); - - return retval; -} - -static void -rehash_internal (void) -{ - load_path::update (); - - // FIXME -- maybe we should rename this variable since it is being - // used for more than keeping track of the prompt time. - - // This will force updated functions to be found. - Vlast_prompt_time.stamp (); -} - -DEFUN (rehash, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rehash ()\n\ -Reinitialize Octave's load path directory cache.\n\ -@end deftypefn") -{ - octave_value_list retval; - - rehash_internal (); - - return retval; -} - -DEFUN (command_line_path, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} command_line_path (@dots{})\n\ -Return the command line path variable.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - return octave_value (load_path::get_command_line_path ()); -} - -DEFUN (restoredefaultpath, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} restoredefaultpath (@dots{})\n\ -Restore Octave's path to its initial state at startup.\n\ -\n\ -@seealso{path, addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - load_path::initialize (true); - - return octave_value (load_path::system_path ()); -} - -// Return Octave's original default list of directories in which to -// search for function files. This corresponds to the path that -// exists prior to running the system's octaverc file or the user's -// ~/.octaverc file - -DEFUN (__pathorig__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} __pathorig__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - return octave_value (load_path::system_path ()); -} - -DEFUN (path, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} path (@dots{})\n\ -Modify or display Octave's load path.\n\ -\n\ -If @var{nargin} and @var{nargout} are zero, display the elements of\n\ -Octave's load path in an easy to read format.\n\ -\n\ -If @var{nargin} is zero and nargout is greater than zero, return the\n\ -current load path.\n\ -\n\ -If @var{nargin} is greater than zero, concatenate the arguments,\n\ -separating them with @code{pathsep}. Set the internal search path\n\ -to the result and return it.\n\ -\n\ -No checks are made for duplicate elements.\n\ -@seealso{addpath, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("path"); - - if (! error_state) - { - if (argc > 1) - { - std::string path = argv[1]; - - for (int i = 2; i < argc; i++) - path += dir_path::path_sep_str () + argv[i]; - - load_path::set (path, true); - - rehash_internal (); - } - - if (nargout > 0) - retval = load_path::path (); - else if (argc == 1 && nargout == 0) - { - octave_stdout << "\nOctave's search path contains the following directories:\n\n"; - - string_vector dirs = load_path::dirs (); - - dirs.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - - return retval; -} - -DEFUN (addpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} addpath (@var{dir1}, @dots{})\n\ -@deftypefnx {Built-in Function} {} addpath (@var{dir1}, @dots{}, @var{option})\n\ -Add @var{dir1}, @dots{} to the current function search path. If\n\ -@var{option} is \"-begin\" or 0 (the default), prepend the\n\ -directory name to the current path. If @var{option} is \"-end\"\n\ -or 1, append the directory name to the current path.\n\ -Directories added to the path must exist.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -addpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, rmpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - octave_value retval; - - // Originally written by Bill Denney and Etienne Grossman. Heavily - // modified and translated to C++ by jwe. - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool append = false; - - octave_value option_arg = args(nargin-1); - - if (option_arg.is_string ()) - { - std::string option = option_arg.string_value (); - - if (option == "-end") - { - append = true; - nargin--; - } - else if (option == "-begin") - nargin--; - } - else if (option_arg.is_numeric_type ()) - { - int val = option_arg.int_value (); - - if (! error_state) - { - if (val == 0) - nargin--; - else if (val == 1) - { - append = true; - nargin--; - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - else - { - error ("addpath: expecting final argument to be 1 or 0"); - return retval; - } - } - - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - if (! append) - std::reverse (dir_elts.begin (), dir_elts.end ()); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (append) - load_path::append (dir, true); - else - load_path::prepend (dir, true); - - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} - -DEFUN (rmpath, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rmpath (@var{dir1}, @dots{})\n\ -Remove @var{dir1}, @dots{} from the current function search path.\n\ -\n\ -In addition to accepting individual directory arguments, lists of\n\ -directory names separated by @code{pathsep} are also accepted. For example:\n\ -\n\ -@example\n\ -rmpath (\"dir1:/dir2:~/dir3\")\n\ -@end example\n\ -@seealso{path, addpath, genpath, pathdef, savepath, pathsep}\n\ -@end deftypefn") -{ - // Originally by Etienne Grossmann. Heavily modified and translated - // to C++ by jwe. - - octave_value retval; - - if (nargout > 0) - retval = load_path::path (); - - int nargin = args.length (); - - if (nargin > 0) - { - bool need_to_update = false; - - for (int i = 0; i < nargin; i++) - { - std::string arg = args(i).string_value (); - - if (! error_state) - { - std::list dir_elts = split_path (arg); - - for (std::list::const_iterator p = dir_elts.begin (); - p != dir_elts.end (); - p++) - { - std::string dir = *p; - - //dir = regexprep (dir_elts{j}, '//+', "/"); - //dir = regexprep (dir, '/$', ""); - - if (! load_path::remove (dir)) - warning ("rmpath: %s: not found", dir.c_str ()); - else - need_to_update = true; - } - } - else - error ("addpath: all arguments must be character strings"); - } - - if (need_to_update) - rehash_internal (); - } - else - print_usage (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/load-path.h --- a/src/load-path.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,566 +0,0 @@ -/* - -Copyright (C) 2006-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_load_path_h) -#define octave_load_path_h 1 - -#include -#include -#include -#include - -#include "pathsearch.h" -#include "str-vec.h" - -class -OCTINTERP_API -load_path -{ -protected: - - load_path (void) - : dir_info_list (), fcn_map (), private_fcn_map (), method_map (), - init_dirs () { } - -public: - - typedef void (*hook_fcn_ptr) (const std::string& dir); - - ~load_path (void) { } - - static void initialize (bool set_initial_path = false) - { - if (instance_ok ()) - instance->do_initialize (set_initial_path); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void set (const std::string& p, bool warn = false) - { - if (instance_ok ()) - instance->do_set (p, warn); - } - - static void append (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_append (dir, warn); - } - - static void prepend (const std::string& dir, bool warn = false) - { - if (instance_ok ()) - instance->do_prepend (dir, warn); - } - - static bool remove (const std::string& dir) - { - return instance_ok () ? instance->do_remove (dir) : false; - } - - static void update (void) - { - if (instance_ok ()) - instance->do_update (); - } - - static std::string find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name) - { - return instance_ok () - ? instance->do_find_method (class_name, meth, dir_name) : std::string (); - } - - static std::string find_method (const std::string& class_name, - const std::string& meth) - { - std::string dir_name; - return find_method (class_name, meth, dir_name); - } - - static std::list methods (const std::string& class_name) - { - return instance_ok () - ? instance->do_methods (class_name) : std::list (); - } - - static std::list overloads (const std::string& meth) - { - return instance_ok () - ? instance->do_overloads (meth) : std::list (); - } - - static std::string find_fcn (const std::string& fcn, std::string& dir_name) - { - return instance_ok () - ? instance->do_find_fcn (fcn, dir_name) : std::string (); - } - - static std::string find_fcn (const std::string& fcn) - { - std::string dir_name; - return find_fcn (fcn, dir_name); - } - - static std::string find_private_fcn (const std::string& dir, - const std::string& fcn) - { - return instance_ok () - ? instance->do_find_private_fcn (dir, fcn) : std::string (); - } - - static std::string find_fcn_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, M_FILE) : std::string (); - } - - static std::string find_oct_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, OCT_FILE) : std::string (); - } - - static std::string find_mex_file (const std::string& fcn) - { - std::string dir_name; - - return instance_ok () ? - instance->do_find_fcn (fcn, dir_name, MEX_FILE) : std::string (); - } - - static std::string find_file (const std::string& file) - { - return instance_ok () - ? instance->do_find_file (file) : std::string (); - } - - static std::string find_dir (const std::string& dir) - { - return instance_ok () - ? instance->do_find_dir (dir) : std::string (); - } - - static string_vector find_matching_dirs (const std::string& dir) - { - return instance_ok () - ? instance->do_find_matching_dirs (dir) : string_vector (); - } - - static std::string find_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_first_of (files) : std::string (); - } - - static string_vector find_all_first_of (const string_vector& files) - { - return instance_ok () ? - instance->do_find_all_first_of (files) : string_vector (); - } - - static string_vector dirs (void) - { - return instance_ok () ? instance->do_dirs () : string_vector (); - } - - static std::list dir_list (void) - { - return instance_ok () - ? instance->do_dir_list () : std::list (); - } - - static string_vector files (const std::string& dir, bool omit_exts = false) - { - return instance_ok () - ? instance->do_files (dir, omit_exts) : string_vector (); - } - - static string_vector fcn_names (void) - { - return instance_ok () ? instance->do_fcn_names () : string_vector (); - } - - static std::string path (void) - { - return instance_ok () ? instance->do_path () : std::string (); - } - - static void display (std::ostream& os) - { - if (instance_ok ()) - instance->do_display (os); - } - - static void set_add_hook (hook_fcn_ptr f) { add_hook = f; } - - static void set_remove_hook (hook_fcn_ptr f) { remove_hook = f; } - - static void set_command_line_path (const std::string& p) - { - if (command_line_path.empty ()) - command_line_path = p; - else - command_line_path += dir_path::path_sep_str () + p; - } - - static std::string get_command_line_path (void) - { - return instance_ok () ? instance->do_get_command_line_path () : std::string (); - } - - static std::string system_path (void) - { - return instance_ok () ? instance->do_system_path () : std::string (); - } - -private: - - static const int M_FILE = 1; - static const int OCT_FILE = 2; - static const int MEX_FILE = 4; - - class dir_info - { - public: - - // - typedef std::map fcn_file_map_type; - - typedef fcn_file_map_type::const_iterator const_fcn_file_map_iterator; - typedef fcn_file_map_type::iterator fcn_file_map_iterator; - - struct class_info - { - class_info (void) : method_file_map (), private_file_map () { } - - class_info (const class_info& ci) - : method_file_map (ci.method_file_map), - private_file_map (ci.private_file_map) { } - - class_info& operator = (const class_info& ci) - { - if (this != &ci) - { - method_file_map = ci.method_file_map; - private_file_map = ci.private_file_map; - } - return *this; - } - - ~class_info (void) { } - - fcn_file_map_type method_file_map; - fcn_file_map_type private_file_map; - }; - - // - typedef std::map method_file_map_type; - - typedef method_file_map_type::const_iterator const_method_file_map_iterator; - typedef method_file_map_type::iterator method_file_map_iterator; - - // This default constructor is only provided so we can create a - // std::map of dir_info objects. You should not use this - // constructor for any other purpose. - dir_info (void) - : dir_name (), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { } - - dir_info (const std::string& d) - : dir_name (d), abs_dir_name (), is_relative (false), - dir_mtime (), dir_time_last_checked (), - all_files (), fcn_files (), private_file_map (), method_file_map () - { - initialize (); - } - - dir_info (const dir_info& di) - : dir_name (di.dir_name), abs_dir_name (di.abs_dir_name), - is_relative (di.is_relative), - dir_mtime (di.dir_mtime), - dir_time_last_checked (di.dir_time_last_checked), - all_files (di.all_files), fcn_files (di.fcn_files), - private_file_map (di.private_file_map), - method_file_map (di.method_file_map) { } - - ~dir_info (void) { } - - dir_info& operator = (const dir_info& di) - { - if (&di != this) - { - dir_name = di.dir_name; - abs_dir_name = di.abs_dir_name; - is_relative = di.is_relative; - dir_mtime = di.dir_mtime; - dir_time_last_checked = di.dir_time_last_checked; - all_files = di.all_files; - fcn_files = di.fcn_files; - private_file_map = di.private_file_map; - method_file_map = di.method_file_map; - } - - return *this; - } - - void update (void); - - std::string dir_name; - std::string abs_dir_name; - bool is_relative; - octave_time dir_mtime; - octave_time dir_time_last_checked; - string_vector all_files; - string_vector fcn_files; - fcn_file_map_type private_file_map; - method_file_map_type method_file_map; - - private: - - void initialize (void); - - void get_file_list (const std::string& d); - - void get_private_file_map (const std::string& d); - - void get_method_file_map (const std::string& d, - const std::string& class_name); - - friend fcn_file_map_type get_fcn_files (const std::string& d); - }; - - class file_info - { - public: - - file_info (const std::string& d, int t) : dir_name (d), types (t) { } - - file_info (const file_info& fi) - : dir_name (fi.dir_name), types (fi.types) { } - - ~file_info (void) { } - - file_info& operator = (const file_info& fi) - { - if (&fi != this) - { - dir_name = fi.dir_name; - types = fi.types; - } - - return *this; - } - - std::string dir_name; - int types; - }; - - // We maintain two ways of looking at the same information. - // - // First, a list of directories and the set of "public" files and - // private files (those found in the special "private" subdirectory) - // in each directory. - // - // Second, a map from file names (the union of all "public" files for all - // directories, but without filename extensions) to a list of - // corresponding information (directory name and file types). This - // way, we can quickly find shadowed file names and look up all - // overloaded functions (in the "@" directories used to implement - // classes). - - typedef std::list dir_info_list_type; - - typedef dir_info_list_type::const_iterator const_dir_info_list_iterator; - typedef dir_info_list_type::iterator dir_info_list_iterator; - - typedef std::map abs_dir_cache_type; - - typedef abs_dir_cache_type::const_iterator const_abs_dir_cache_iterator; - typedef abs_dir_cache_type::iterator abs_dir_cache_iterator; - - typedef std::list file_info_list_type; - - typedef file_info_list_type::const_iterator const_file_info_list_iterator; - typedef file_info_list_type::iterator file_info_list_iterator; - - // - typedef std::map fcn_map_type; - - typedef fcn_map_type::const_iterator const_fcn_map_iterator; - typedef fcn_map_type::iterator fcn_map_iterator; - - // > - typedef std::map private_fcn_map_type; - - typedef private_fcn_map_type::const_iterator const_private_fcn_map_iterator; - typedef private_fcn_map_type::iterator private_fcn_map_iterator; - - // > - typedef std::map method_map_type; - - typedef method_map_type::const_iterator const_method_map_iterator; - typedef method_map_type::iterator method_map_iterator; - - mutable dir_info_list_type dir_info_list; - - mutable fcn_map_type fcn_map; - - mutable private_fcn_map_type private_fcn_map; - - mutable method_map_type method_map; - - mutable std::set init_dirs; - - static load_path *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - static hook_fcn_ptr add_hook; - - static hook_fcn_ptr remove_hook; - - static std::string command_line_path; - - static std::string sys_path; - - static abs_dir_cache_type abs_dir_cache; - - static bool instance_ok (void); - - const_dir_info_list_iterator find_dir_info (const std::string& dir) const; - dir_info_list_iterator find_dir_info (const std::string& dir); - - bool contains (const std::string& dir) const; - - void move_fcn_map (const std::string& dir, - const string_vector& fcn_files, bool at_end); - - void move_method_map (const std::string& dir, bool at_end); - - void move (std::list::iterator i, bool at_end); - - void do_initialize (bool set_initial_path); - - void do_clear (void); - - void do_set (const std::string& p, bool warn, bool is_init = false); - - void do_append (const std::string& dir, bool warn); - - void do_prepend (const std::string& dir, bool warn); - - void do_add (const std::string& dir, bool at_end, bool warn); - - void remove_fcn_map (const std::string& dir, const string_vector& fcn_files); - - void remove_private_fcn_map (const std::string& dir); - - void remove_method_map (const std::string& dir); - - bool do_remove (const std::string& dir); - - void do_update (void) const; - - static bool - check_file_type (std::string& fname, int type, int possible_types, - const std::string& fcn, const char *who); - - std::string do_find_fcn (const std::string& fcn, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_private_fcn (const std::string& dir, - const std::string& fcn, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::string do_find_method (const std::string& class_name, - const std::string& meth, - std::string& dir_name, - int type = M_FILE | OCT_FILE | MEX_FILE) const; - - std::list do_methods (const std::string& class_name) const; - - std::list do_overloads (const std::string& meth) const; - - std::string do_find_file (const std::string& file) const; - - std::string do_find_dir (const std::string& dir) const; - - string_vector do_find_matching_dirs (const std::string& dir) const; - - std::string do_find_first_of (const string_vector& files) const; - - string_vector do_find_all_first_of (const string_vector& files) const; - - string_vector do_dirs (void) const; - - std::list do_dir_list (void) const; - - string_vector do_files (const std::string& dir, bool omit_exts) const; - - string_vector do_fcn_names (void) const; - - std::string do_path (void) const; - - friend void print_types (std::ostream& os, int types); - - friend string_vector get_file_list (const dir_info::fcn_file_map_type& lst); - - friend void - print_fcn_list (std::ostream& os, const dir_info::fcn_file_map_type& lst); - - void do_display (std::ostream& os) const; - - std::string do_system_path (void) const { return sys_path; } - - std::string do_get_command_line_path (void) const { return command_line_path; } - - void add_to_fcn_map (const dir_info& di, bool at_end) const; - - void add_to_private_fcn_map (const dir_info& di) const; - - void add_to_method_map (const dir_info& di, bool at_end) const; - - friend dir_info::fcn_file_map_type get_fcn_files (const std::string& d); -}; - -extern std::string -genpath (const std::string& dir, const string_vector& skip = "private"); - -extern void execute_pkg_add (const std::string& dir); -extern void execute_pkg_del (const std::string& dir); - -#endif diff -r 069c552587a0 -r 959953dba519 src/load-save.cc --- a/src/load-save.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1872 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -// Author: John W. Eaton. -// HDF5 support by Steven G. Johnson -// Matlab v5 support by James R. Van Zandt - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include "strftime.h" - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "file-stat.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" -#include "oct-locbuf.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-path.h" -#include "load-save.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "symtab.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -#include "ls-hdf5.h" -#include "ls-mat-ascii.h" -#include "ls-mat4.h" -#include "ls-mat5.h" -#include "ls-oct-ascii.h" -#include "ls-oct-binary.h" - -// Remove gnulib definitions, if any. -#ifdef close -#undef close -#endif -#ifdef open -#undef open -#endif - -#ifdef HAVE_ZLIB -#include "zfstream.h" -#endif - -// Write octave-workspace file if Octave crashes or is killed by a signal. -static bool Vcrash_dumps_octave_core = true; - -// The maximum amount of memory (in kilobytes) that we will attempt to -// write to the Octave core file. -static double Voctave_core_file_limit = -1.0; - -// The name of the Octave core file. -static std::string Voctave_core_file_name = "octave-workspace"; - -// The default output format. May be one of "binary", "text", -// "mat-binary", or "hdf5". -static std::string Vdefault_save_options = "-text"; - -// The output format for Octave core files. -static std::string Voctave_core_file_options = "-binary"; - -static std::string -default_save_header_format (void) -{ - return - std::string ("# Created by Octave " OCTAVE_VERSION - ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format string for the comment line at the top of text-format -// save files. Passed to strftime. Should begin with `#' and contain -// no newline characters. -static std::string Vsave_header_format_string = default_save_header_format (); - -static void -gripe_file_open (const std::string& fcn, const std::string& file) -{ - if (fcn == "load") - error ("%s: unable to open input file `%s'", fcn.c_str (), file.c_str ()); - else if (fcn == "save") - error ("%s: unable to open output file `%s'", fcn.c_str (), file.c_str ()); - else - error ("%s: unable to open file `%s'", fcn.c_str (), file.c_str ()); -} - -// Install a variable with name NAME and the value VAL in the -// symbol table. If GLOBAL is TRUE, make the variable global. - -static void -install_loaded_variable (const std::string& name, - const octave_value& val, - bool global, const std::string& /*doc*/) -{ - if (global) - { - symbol_table::symbol_record& sr = symbol_table::insert (name); - sr.clear (); - sr.mark_global (); - sr.varref () = val; - } - else - symbol_table::varref (name) = val; -} - -// Return TRUE if NAME matches one of the given globbing PATTERNS. - -static bool -matches_patterns (const string_vector& patterns, int pat_idx, - int num_pat, const std::string& name) -{ - for (int i = pat_idx; i < num_pat; i++) - { - glob_match pattern (patterns[i]); - - if (pattern.match (name)) - return true; - } - - return false; -} - -int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, bool quiet) -{ - const int magic_len = 10; - char magic[magic_len+1]; - is.read (magic, magic_len); - magic[magic_len] = '\0'; - - if (strncmp (magic, "Octave-1-L", magic_len) == 0) - swap = oct_mach_info::words_big_endian (); - else if (strncmp (magic, "Octave-1-B", magic_len) == 0) - swap = ! oct_mach_info::words_big_endian (); - else - { - if (! quiet) - error ("load: unable to read read binary file"); - return -1; - } - - char tmp = 0; - is.read (&tmp, 1); - - flt_fmt = mopt_digit_to_float_format (tmp); - - if (flt_fmt == oct_mach_info::flt_fmt_unknown) - { - if (! quiet) - error ("load: unrecognized binary format!"); - - return -1; - } - - return 0; -} - -#ifdef HAVE_ZLIB -static bool -check_gzip_magic (const std::string& fname) -{ - bool retval = false; - std::ifstream file (fname.c_str ()); - OCTAVE_LOCAL_BUFFER (unsigned char, magic, 2); - - if (file.read (reinterpret_cast (magic), 2) && magic[0] == 0x1f && - magic[1] == 0x8b) - retval = true; - - file.close (); - return retval; -} -#endif - -static load_save_format -get_file_format (std::istream& file, const std::string& filename) -{ - load_save_format retval = LS_UNKNOWN; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (read_binary_file_header (file, swap, flt_fmt, true) == 0) - retval = LS_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - int32_t mopt, nr, nc, imag, len; - - int err = read_mat_file_header (file, swap, mopt, nr, nc, imag, len, 1); - - if (! err) - retval = LS_MAT_BINARY; - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - err = read_mat5_binary_file_header (file, swap, true, filename); - - if (! err) - { - file.clear (); - file.seekg (0, std::ios::beg); - retval = LS_MAT5_BINARY; - } - else - { - file.clear (); - file.seekg (0, std::ios::beg); - - std::string tmp = extract_keyword (file, "name"); - - if (! tmp.empty ()) - retval = LS_ASCII; - } - } - } - - return retval; -} - -static load_save_format -get_file_format (const std::string& fname, const std::string& orig_fname, - bool &use_zlib) -{ - load_save_format retval = LS_UNKNOWN; - -#ifdef HAVE_HDF5 - // check this before we open the file - if (H5Fis_hdf5 (fname.c_str ()) > 0) - return LS_HDF5; -#endif /* HAVE_HDF5 */ - - std::ifstream file (fname.c_str ()); - use_zlib = false; - - if (file) - { - retval = get_file_format (file, orig_fname); - file.close (); - -#ifdef HAVE_ZLIB - if (retval == LS_UNKNOWN && check_gzip_magic (fname)) - { - gzifstream gzfile (fname.c_str ()); - use_zlib = true; - - if (gzfile) - { - retval = get_file_format (gzfile, orig_fname); - gzfile.close (); - } - } -#endif - - if (retval == LS_UNKNOWN) - { - // Try reading the file as numbers only, determining the - // number of rows and columns from the data. We don't - // even bother to check to see if the first item in the - // file is a number, so that get_complete_line() can - // skip any comments that might appear at the top of the - // file. - - retval = LS_MAT_ASCII; - } - } - else - gripe_file_open ("load", orig_fname); - - return retval; -} - -octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout) -{ - octave_value retval; - - octave_scalar_map retstruct; - - std::ostringstream output_buf; - std::list symbol_names; - - octave_idx_type count = 0; - - for (;;) - { - bool global = false; - octave_value tc; - - std::string name; - std::string doc; - - switch (format.type) - { - case LS_ASCII: - name = read_ascii_data (stream, orig_fname, global, tc, count); - break; - - case LS_BINARY: - name = read_binary_data (stream, swap, flt_fmt, orig_fname, - global, tc, doc); - break; - - case LS_MAT_ASCII: - name = read_mat_ascii_data (stream, orig_fname, tc); - break; - - case LS_MAT_BINARY: - name = read_mat_binary_data (stream, orig_fname, tc); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - name = read_hdf5_data (stream, orig_fname, global, tc, doc); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - name = read_mat5_binary_element (stream, orig_fname, swap, - global, tc); - break; - - default: - gripe_unrecognized_data_fmt ("load"); - break; - } - - if (error_state || stream.eof () || name.empty ()) - break; - else if (! error_state && ! name.empty ()) - { - if (tc.is_defined ()) - { - if (format == LS_MAT_ASCII && argv_idx < argc) - warning ("load: loaded ASCII file `%s' -- ignoring extra args", - orig_fname.c_str ()); - - if (format == LS_MAT_ASCII - || argv_idx == argc - || matches_patterns (argv, argv_idx, argc, name)) - { - count++; - if (list_only) - { - if (verbose) - { - if (count == 1) - output_buf - << "type rows cols name\n" - << "==== ==== ==== ====\n"; - - output_buf - << std::setiosflags (std::ios::left) - << std::setw (16) << tc.type_name () . c_str () - << std::setiosflags (std::ios::right) - << std::setw (7) << tc.rows () - << std::setw (7) << tc.columns () - << " " << name << "\n"; - } - else - symbol_names.push_back (name); - } - else - { - if (nargout == 1) - { - if (format == LS_MAT_ASCII) - retval = tc; - else - retstruct.assign (name, tc); - } - else - install_loaded_variable (name, tc, global, doc); - } - } - - // Only attempt to read one item from a headless text file. - - if (format == LS_MAT_ASCII) - break; - } - else - error ("load: unable to load variable `%s'", name.c_str ()); - } - else - { - if (count == 0) - error ("load: are you sure `%s' is an Octave data file?", - orig_fname.c_str ()); - - break; - } - } - - if (list_only && count) - { - if (verbose) - { - std::string msg = output_buf.str (); - - if (nargout > 0) - retval = msg; - else - octave_stdout << msg; - } - else - { - if (nargout > 0) - retval = Cell (string_vector (symbol_names)); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - - octave_stdout << "\n"; - } - } - } - else if (retstruct.nfields () != 0) - retval = retstruct; - - return retval; -} - -std::string -find_file_to_load (const std::string& name, const std::string& orig_name) -{ - std::string fname = name; - - if (! (octave_env::absolute_pathname (fname) - || octave_env::rooted_relative_pathname (fname))) - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - std::string tmp - = octave_env::make_absolute (load_path::find_file (fname)); - - if (! tmp.empty ()) - { - warning_with_id ("Octave:load-file-in-path", - "load: file found in load path"); - fname = tmp; - } - } - } - - size_t dot_pos = fname.rfind ("."); - size_t sep_pos = fname.find_last_of (file_ops::dir_sep_chars ()); - - if (dot_pos == std::string::npos - || (sep_pos != std::string::npos && dot_pos < sep_pos)) - { - // Either no '.' in name or no '.' appears after last directory - // separator. - - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - fname = find_file_to_load (fname + ".mat", orig_name); - } - else - { - file_stat fs (fname); - - if (! (fs.exists () && fs.is_reg ())) - { - fname = ""; - - error ("load: unable to find file %s", orig_name.c_str ()); - } - } - - return fname; -} - - -DEFUN (load, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} load file\n\ -@deftypefnx {Command} {} load options file\n\ -@deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ -@deftypefnx {Command} {} load file options\n\ -@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ -@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ -Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ -@var{file}. If no variables are specified then all variables found in the\n\ -file will be loaded. As with @code{save}, the list of variables to extract\n\ -can be full names or use a pattern syntax. The format of the file is\n\ -automatically detected but may be overridden by supplying the appropriate\n\ -option.\n\ -\n\ -If load is invoked using the functional form\n\ -\n\ -@example\n\ -load (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -If a variable that is not marked as global is loaded from a file when a\n\ -global symbol with the same name already exists, it is loaded in the\n\ -global symbol table. Also, if a variable is marked as global in a file\n\ -and a local symbol exists, the local symbol is moved to the global\n\ -symbol table and given the value from the file.\n\ -\n\ -If invoked with a single output argument, Octave returns data instead\n\ -of inserting variables in the symbol table. If the data file contains\n\ -only numbers (TAB- or space-delimited columns), a matrix of values is\n\ -returned. Otherwise, @code{load} returns a structure with members\n\ - corresponding to the names of the variables in the file.\n\ -\n\ -The @code{load} command can read data stored in Octave's text and\n\ -binary formats, and @sc{matlab}'s binary format. If compiled with zlib\n\ -support, it can also load gzip-compressed files. It will automatically\n\ -detect the type of file and do conversion from different floating point\n\ -formats (currently only IEEE big and little endian, though other formats\n\ -may be added in the future).\n\ -\n\ -Valid options for @code{load} are listed in the following table.\n\ -\n\ -@table @code\n\ -@item -force\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave now overwrites variables currently in memory with\n\ -those of the same name found in the file.\n\ -\n\ -@item -ascii\n\ -Force Octave to assume the file contains columns of numbers in text format\n\ -without any header or other information. Data in the file will be loaded\n\ -as a single numeric matrix with the name of the variable derived from the\n\ -name of the file.\n\ -\n\ -@item -binary\n\ -Force Octave to assume the file is in Octave's binary format.\n\ -\n\ -@item -hdf5\n\ -Force Octave to assume the file is in @sc{hdf5} format.\n\ -(@sc{hdf5} is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -Note that Octave can read @sc{hdf5} files not created by itself, but may\n\ -skip some datasets in formats that it cannot support. This format is\n\ -only available if Octave was built with a link to the @sc{hdf5} libraries.\n\ -\n\ -@item -import\n\ -This option is accepted for backward compatibility but is ignored.\n\ -Octave can now support multi-dimensional HDF data and automatically\n\ -modifies variable names if they are invalid Octave identifiers.\n\ -\n\ -@item -mat\n\ -@itemx -mat-binary\n\ -@itemx -6\n\ -@itemx -v6\n\ -@itemx -7\n\ -@itemx -v7\n\ -Force Octave to assume the file is in @sc{matlab}'s version 6 or 7 binary\n\ -format.\n\ -\n\ -@item -mat4-binary\n\ -@itemx -4\n\ -@itemx -v4\n\ -@itemx -V4\n\ -Force Octave to assume the file is in the binary format written by\n\ -@sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Force Octave to assume the file is in Octave's text format.\n\ -@end table\n\ -@seealso{save, dlmwrite, csvwrite, fwrite}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("load"); - - if (error_state) - return retval; - - int i = 1; - std::string orig_fname = ""; - - // Function called with Matlab-style ["filename", options] syntax - if (argc > 1 && ! argv[1].empty () && argv[1].at (0) != '-') - { - orig_fname = argv[1]; - i++; - } - - // It isn't necessary to have the default load format stored in a - // user preference variable since we can determine the type of file - // as we are reading. - - load_save_format format = LS_UNKNOWN; - - bool list_only = false; - bool verbose = false; - - //for (i; i < argc; i++) - for (; i < argc; i++) - { - if (argv[i] == "-force" || argv[i] == "-f") - { - // Silently ignore this - // warning ("load: -force ignored"); - } - else if (argv[i] == "-list" || argv[i] == "-l") - { - list_only = true; - } - else if (argv[i] == "-verbose" || argv[i] == "-v") - { - verbose = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" || argv[i] == "-m" - || argv[i] == "-6" || argv[i] == "-v6") - { - format = LS_MAT5_BINARY; - } - else if (argv[i] == "-7" || argv[i] == "-v7") - { - format = LS_MAT7_BINARY; - } - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("load: octave executable was not linked with HDF5 library"); - return retval; -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-import" || argv[i] == "-i") - { - warning ("load: -import ignored"); - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else - break; - } - - if (orig_fname == "") - { - if (i == argc) - { - print_usage (); - return retval; - } - else - orig_fname = argv[i]; - } - else - i--; - - oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; - - bool swap = false; - - if (orig_fname == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("load: cannot read HDF5 format from stdin"); - else -#endif /* HAVE_HDF5 */ - if (format != LS_UNKNOWN) - { - // FIXME -- if we have already seen EOF on a - // previous call, how do we fix up the state of std::cin so - // that we can get additional input? I'm afraid that we - // can't fix this using std::cin only. - - retval = do_load (std::cin, orig_fname, format, flt_fmt, - list_only, swap, verbose, argv, i, argc, - nargout); - } - else - error ("load: must specify file format if reading from stdin"); - } - else - { - std::string fname = file_ops::tilde_expand (orig_fname); - - fname = find_file_to_load (fname, orig_fname); - - if (error_state) - return retval; - - bool use_zlib = false; - - if (format == LS_UNKNOWN) - format = get_file_format (fname, orig_fname, use_zlib); - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - i++; - - hdf5_ifstream hdf5_file (fname.c_str ()); - - if (hdf5_file.file_id >= 0) - { - retval = do_load (hdf5_file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - hdf5_file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here; the "else" above has to - // go with the "if" below!!!!! - if (format != LS_UNKNOWN) - { - i++; - - // Always open in binary mode and handle various - // line-endings explicitly. - std::ios::openmode mode = std::ios::in | std::ios::binary; - -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - gripe_file_open ("load", orig_fname); - } - else -#endif - { - std::ifstream file (fname.c_str (), mode); - - if (file) - { - if (format == LS_BINARY) - { - if (read_binary_file_header (file, swap, flt_fmt) < 0) - { - if (file) file.close (); - return retval; - } - } - else if (format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - { - if (read_mat5_binary_file_header (file, swap, false, orig_fname) < 0) - { - if (file) file.close (); - return retval; - } - } - - retval = do_load (file, orig_fname, format, - flt_fmt, list_only, swap, verbose, - argv, i, argc, nargout); - - file.close (); - } - else - error ("load: unable to open input file `%s'", - orig_fname.c_str ()); - } - } - } - - return retval; -} - -// Return TRUE if PATTERN has any special globbing chars in it. - -static bool -glob_pattern_p (const std::string& pattern) -{ - int open = 0; - - int len = pattern.length (); - - for (int i = 0; i < len; i++) - { - char c = pattern[i]; - - switch (c) - { - case '?': - case '*': - return true; - - 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 true; - continue; - - case '\\': - if (i == len - 1) - return false; - - default: - continue; - } - } - - return false; -} - -static void -do_save (std::ostream& os, const octave_value& tc, - const std::string& name, const std::string& help, - bool global, load_save_format fmt, bool save_as_floats) -{ - switch (fmt.type) - { - case LS_ASCII: - save_ascii_data (os, tc, name, global, 0); - break; - - case LS_BINARY: - save_binary_data (os, tc, name, help, global, save_as_floats); - break; - - case LS_MAT_ASCII: - if (! save_mat_ascii_data (os, tc, fmt.opts & LS_MAT_ASCII_LONG ? 16 : 8, - fmt.opts & LS_MAT_ASCII_TABS)) - warning ("save: unable to save %s in ASCII format", name.c_str ()); - break; - - case LS_MAT_BINARY: - save_mat_binary_data (os, tc, name); - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: - save_hdf5_data (os, tc, name, help, global, save_as_floats); - break; -#endif /* HAVE_HDF5 */ - - case LS_MAT5_BINARY: - save_mat5_binary_element (os, tc, name, global, false, save_as_floats); - break; - - case LS_MAT7_BINARY: - save_mat5_binary_element (os, tc, name, global, true, save_as_floats); - break; - - default: - gripe_unrecognized_data_fmt ("save"); - break; - } -} - -// Save the info from SR on stream OS in the format specified by FMT. - -void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats) -{ - octave_value val = sr.varval (); - - if (val.is_defined ()) - { - std::string name = sr.name (); - std::string help; - bool global = sr.is_global (); - - do_save (os, val, name, help, global, fmt, save_as_floats); - } -} - -// save fields of a scalar structure STR matching PATTERN on stream OS -// in the format specified by FMT. - -static size_t -save_fields (std::ostream& os, const octave_scalar_map& m, - const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - glob_match pat (pattern); - - size_t saved = 0; - - for (octave_scalar_map::const_iterator p = m.begin (); p != m.end (); p++) - { - std::string empty_str; - - if (pat.match (m.key (p))) - { - do_save (os, m.contents (p), m.key (p), empty_str, - 0, fmt, save_as_floats); - - saved++; - } - } - - return saved; -} - -// Save variables with names matching PATTERN on stream OS in the -// format specified by FMT. - -static size_t -save_vars (std::ostream& os, const std::string& pattern, - load_save_format fmt, bool save_as_floats) -{ - std::list vars = symbol_table::glob (pattern); - - size_t saved = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - do_save (os, *p, fmt, save_as_floats); - - if (error_state) - break; - - saved++; - } - - return saved; -} - -static string_vector -parse_save_options (const string_vector &argv, - load_save_format &format, bool &append, - bool &save_as_floats, bool &use_zlib) -{ - string_vector retval; - int argc = argv.length (); - - bool do_double = false, do_tabs = false; - - for (int i = 0; i < argc; i++) - { - if (argv[i] == "-append") - { - append = true; - } - else if (argv[i] == "-ascii" || argv[i] == "-a") - { - format = LS_MAT_ASCII; - } - else if (argv[i] == "-double") - { - do_double = true; - } - else if (argv[i] == "-tabs") - { - do_tabs = true; - } - else if (argv[i] == "-text" || argv[i] == "-t") - { - format = LS_ASCII; - } - else if (argv[i] == "-binary" || argv[i] == "-b") - { - format = LS_BINARY; - } - else if (argv[i] == "-hdf5" || argv[i] == "-h") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } - else if (argv[i] == "-mat-binary" || argv[i] == "-mat" - || argv[i] == "-m" || argv[i] == "-6" || argv[i] == "-v6" - || argv[i] == "-V6") - { - format = LS_MAT5_BINARY; - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-mat7-binary" || argv[i] == "-7" - || argv[i] == "-v7" || argv[i] == "-V7") - { - format = LS_MAT7_BINARY; - } -#endif - else if (argv[i] == "-mat4-binary" || argv[i] == "-V4" - || argv[i] == "-v4" || argv[i] == "-4") - { - format = LS_MAT_BINARY; - } - else if (argv[i] == "-float-binary" || argv[i] == "-f") - { - format = LS_BINARY; - save_as_floats = true; - } - else if (argv[i] == "-float-hdf5") - { -#ifdef HAVE_HDF5 - format = LS_HDF5; - save_as_floats = true; -#else /* ! HAVE_HDF5 */ - error ("save: octave executable was not linked with HDF5 library"); -#endif /* ! HAVE_HDF5 */ - } -#ifdef HAVE_ZLIB - else if (argv[i] == "-zip" || argv[i] == "-z") - { - use_zlib = true; - } -#endif - else - retval.append (argv[i]); - } - - if (do_double) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_LONG; - else - warning ("save: \"-double\" option only has an effect with \"-ascii\""); - } - - if (do_tabs) - { - if (format == LS_MAT_ASCII) - format.opts |= LS_MAT_ASCII_TABS; - else - warning ("save: \"-tabs\" option only has an effect with \"-ascii\""); - } - - return retval; -} - -static string_vector -parse_save_options (const std::string &arg, load_save_format &format, - bool &append, bool &save_as_floats, - bool &use_zlib) -{ - std::istringstream is (arg); - std::string str; - string_vector argv; - - while (! is.eof ()) - { - is >> str; - argv.append (str); - } - - return parse_save_options (argv, format, append, save_as_floats, - use_zlib); -} - -void -write_header (std::ostream& os, load_save_format format) -{ - switch (format.type) - { - case LS_BINARY: - { - os << (oct_mach_info::words_big_endian () - ? "Octave-1-B" : "Octave-1-L"); - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char tmp = static_cast (float_format_to_mopt_digit (flt_fmt)); - - os.write (&tmp, 1); - } - break; - - case LS_MAT5_BINARY: - case LS_MAT7_BINARY: - { - char const * versionmagic; - int16_t number = *(reinterpret_cast("\x00\x01")); - struct tm bdt; - time_t now; - char headertext[128]; - - time (&now); - bdt = *gmtime (&now); - memset (headertext, ' ', 124); - // ISO 8601 format date - nstrftime (headertext, 124, "MATLAB 5.0 MAT-file, written by Octave " - OCTAVE_VERSION ", %Y-%m-%d %T UTC", &bdt, 1, 0); - - // The first pair of bytes give the version of the MAT file - // format. The second pair of bytes form a magic number which - // signals a MAT file. MAT file data are always written in - // native byte order. The order of the bytes in the second - // pair indicates whether the file was written by a big- or - // little-endian machine. However, the version number is - // written in the *opposite* byte order from everything else! - if (number == 1) - versionmagic = "\x01\x00\x4d\x49"; // this machine is big endian - else - versionmagic = "\x00\x01\x49\x4d"; // this machine is little endian - - memcpy (headertext+124, versionmagic, 4); - os.write (headertext, 128); - } - - break; - -#ifdef HAVE_HDF5 - case LS_HDF5: -#endif /* HAVE_HDF5 */ - case LS_ASCII: - { - octave_localtime now; - - std::string comment_string = now.strftime (Vsave_header_format_string); - - if (! comment_string.empty ()) - { -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream& hs = dynamic_cast (os); - H5Gset_comment (hs.file_id, "/", comment_string.c_str ()); - } - else -#endif /* HAVE_HDF5 */ - os << comment_string << "\n"; - } - } - break; - - default: - break; - } -} - -static void -save_vars (const string_vector& argv, int argv_idx, int argc, - std::ostream& os, load_save_format fmt, - bool save_as_floats, bool write_header_info) -{ - if (write_header_info) - write_header (os, fmt); - - if (argv_idx == argc) - { - save_vars (os, "*", fmt, save_as_floats); - } - else if (argv[argv_idx] == "-struct") - { - if (++argv_idx >= argc) - { - error ("save: missing struct name"); - return; - } - - std::string struct_name = argv[argv_idx]; - - if (! symbol_table::is_variable (struct_name)) - { - error ("save: no such variable: `%s'", struct_name.c_str ()); - return; - } - - octave_value struct_var = symbol_table::varref (struct_name); - - if (! struct_var.is_map () || struct_var.numel () != 1) - { - error ("save: `%s' is not a scalar structure", - struct_name.c_str ()); - return; - } - octave_scalar_map struct_var_map = struct_var.scalar_map_value (); - - ++argv_idx; - - if (argv_idx < argc) - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_fields (os, struct_var_map, argv[i], fmt, - save_as_floats)) - { - warning ("save: no such field `%s.%s'", - struct_name.c_str (), argv[i].c_str ()); - } - } - } - else - save_fields (os, struct_var_map, "*", fmt, save_as_floats); - } - else - { - for (int i = argv_idx; i < argc; i++) - { - if (! save_vars (os, argv[i], fmt, save_as_floats)) - warning ("save: no such variable `%s'", argv[i].c_str ()); - } - } -} - -static void -dump_octave_core (std::ostream& os, const char *fname, load_save_format fmt, - bool save_as_floats) -{ - write_header (os, fmt); - - std::list vars - = symbol_table::all_variables (symbol_table::top_scope (), 0); - - double save_mem_size = 0; - - typedef std::list::const_iterator const_vars_iterator; - - for (const_vars_iterator p = vars.begin (); p != vars.end (); p++) - { - octave_value val = p->varval (); - - if (val.is_defined ()) - { - std::string name = p->name (); - std::string help; - bool global = p->is_global (); - - double val_size = val.byte_size () / 1024; - - // FIXME -- maybe we should try to throw out the largest first... - - if (Voctave_core_file_limit < 0 - || save_mem_size + val_size < Voctave_core_file_limit) - { - save_mem_size += val_size; - - do_save (os, val, name, help, global, fmt, save_as_floats); - - if (error_state) - break; - } - } - } - - message (0, "save to `%s' complete", fname); -} - -void -dump_octave_core (void) -{ - if (Vcrash_dumps_octave_core) - { - // FIXME -- should choose better file name? - - const char *fname = Voctave_core_file_name.c_str (); - - message (0, "attempting to save variables to `%s'...", fname); - - load_save_format format = LS_BINARY; - - bool save_as_floats = false; - - bool append = false; - - bool use_zlib = false; - - parse_save_options (Voctave_core_file_options, format, append, - save_as_floats, use_zlib); - - std::ios::openmode mode = std::ios::out; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - - mode |= append ? std::ios::ate : std::ios::trunc; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - hdf5_ofstream file (fname, mode); - - if (file.file_id >= 0) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! The open brace below must - // go with the else above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - else -#endif - { - std::ofstream file (fname, mode); - - if (file) - { - dump_octave_core (file, fname, format, save_as_floats); - - file.close (); - } - else - warning ("unable to open `%s' for writing...", fname); - } - } - } -} - - -DEFUN (save, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} save file\n\ -@deftypefnx {Command} {} save options file\n\ -@deftypefnx {Command} {} save options file @var{v1} @var{v2} @dots{}\n\ -@deftypefnx {Command} {} save options file -struct @var{STRUCT} @var{f1} @var{f2} @dots{}\n\ -Save the named variables @var{v1}, @var{v2}, @dots{}, in the file\n\ -@var{file}. The special filename @samp{-} may be used to write\n\ -output to the terminal. If no variable names are listed, Octave saves\n\ -all the variables in the current scope. Otherwise, full variable names or\n\ -pattern syntax can be used to specify the variables to save.\n\ -If the @option{-struct} modifier is used, fields @var{f1} @var{f2} @dots{}\n\ -of the scalar structure @var{STRUCT} are saved as if they were variables\n\ -with corresponding names.\n\ -Valid options for the @code{save} command are listed in the following table.\n\ -Options that modify the output format override the format specified by\n\ -@code{default_save_options}.\n\ -\n\ -If save is invoked using the functional form\n\ -\n\ -@example\n\ -save (\"-option1\", @dots{}, \"file\", \"v1\", @dots{})\n\ -@end example\n\ -\n\ -@noindent\n\ -then the @var{options}, @var{file}, and variable name arguments\n\ -(@var{v1}, @dots{}) must be specified as character strings.\n\ -\n\ -@table @code\n\ -@item -append\n\ -Append to the destination instead of overwriting.\n\ -\n\ -@item -ascii\n\ -Save a single matrix in a text file without header or any other information.\n\ -\n\ -@item -binary\n\ -Save the data in Octave's binary data format.\n\ -\n\ -@item -float-binary\n\ -Save the data in Octave's binary data format but only using single\n\ -precision. Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -hdf5\n\ -Save the data in @sc{hdf5} format.\n\ -(HDF5 is a free, portable binary format developed by the National\n\ -Center for Supercomputing Applications at the University of Illinois.)\n\ -This format is only available if Octave was built with a link to the\n\ -@sc{hdf5} libraries.\n\ -\n\ -@item -float-hdf5\n\ -Save the data in @sc{hdf5} format but only using single precision.\n\ -Only use this format if you know that all the\n\ -values to be saved can be represented in single precision.\n\ -\n\ -@item -V7\n\ -@itemx -v7\n\ -@itemx -7\n\ -@itemx -mat7-binary\n\ -Save the data in @sc{matlab}'s v7 binary data format.\n\ -\n\ -@item -V6\n\ -@itemx -v6\n\ -@itemx -6\n\ -@itemx -mat\n\ -@itemx -mat-binary\n\ -Save the data in @sc{matlab}'s v6 binary data format.\n\ -\n\ -@item -V4\n\ -@itemx -v4\n\ -@itemx -4\n\ -@itemx -mat4-binary\n\ -Save the data in the binary format written by @sc{matlab} version 4.\n\ -\n\ -@item -text\n\ -Save the data in Octave's text data format. (default).\n\ -\n\ -@item -zip\n\ -@itemx -z\n\ -Use the gzip algorithm to compress the file. This works equally on files\n\ -that are compressed with gzip outside of octave, and gzip can equally be\n\ -used to convert the files for backward compatibility.\n\ -This option is only available if Octave was built with a link to the zlib\n\ -libraries.\n\ -@end table\n\ -\n\ -The list of variables to save may use wildcard patterns containing\n\ -the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @code{[a-zA-Z]} will\n\ -match all lower and uppercase alphabetic characters.\n\ -\n\ -Wildcards may also be used in the field name specifications when using\n\ -the @option{-struct} modifier (but not in the struct name itself).\n\ -\n\ -@end table\n\ -\n\ -Except when using the @sc{matlab} binary data file format or the\n\ -@samp{-ascii} format, saving global\n\ -variables also saves the global status of the variable. If the variable\n\ -is restored at a later time using @samp{load}, it will be restored as a\n\ -global variable.\n\ -\n\ -The command\n\ -\n\ -@example\n\ -save -binary data a b*\n\ -@end example\n\ -\n\ -@noindent\n\ -saves the variable @samp{a} and all variables beginning with @samp{b} to\n\ -the file @file{data} in Octave's binary format.\n\ -@seealso{load, default_save_options, save_header_format_string, dlmread, csvread, fread}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length (); - - string_vector argv = args.make_argv (); - - if (error_state) - return retval; - - // Here is where we would get the default save format if it were - // stored in a user preference variable. - - bool save_as_floats = false; - - load_save_format format = LS_ASCII; - - bool append = false; - - bool use_zlib = false; - - // get default options - parse_save_options (Vdefault_save_options, format, append, save_as_floats, - use_zlib); - - // override from command line - argv = parse_save_options (argv, format, append, save_as_floats, - use_zlib); - argc = argv.length (); - int i = 0; - - if (error_state) - return retval; - - if (i == argc) - { - print_usage (); - return retval; - } - - if (save_as_floats && format == LS_ASCII) - { - error ("save: cannot specify both -ascii and -float-binary"); - return retval; - } - - if (argv[i] == "-") - { - i++; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - error ("save: cannot write HDF5 format to stdout"); - else -#endif /* HAVE_HDF5 */ - // don't insert any commands here! the brace below must go - // with the "else" above! - { - if (append) - warning ("save: ignoring -append option for output to stdout"); - - // FIXME -- should things intended for the screen end up - // in a octave_value (string)? - - save_vars (argv, i, argc, octave_stdout, format, - save_as_floats, true); - } - } - - // Guard against things like `save a*', which are probably mistakes... - - else if (i == argc - 1 && glob_pattern_p (argv[i])) - { - print_usage (); - return retval; - } - else - { - std::string fname = file_ops::tilde_expand (argv[i]); - - i++; - - // Matlab v7 files are always compressed - if (format == LS_MAT7_BINARY) - use_zlib = false; - - std::ios::openmode mode - = append ? (std::ios::app | std::ios::ate) : std::ios::out; - - if (format == LS_BINARY -#ifdef HAVE_HDF5 - || format == LS_HDF5 -#endif - || format == LS_MAT_BINARY - || format == LS_MAT5_BINARY - || format == LS_MAT7_BINARY) - mode |= std::ios::binary; - -#ifdef HAVE_HDF5 - if (format == LS_HDF5) - { - // FIXME. It should be possible to append to HDF5 files. - if (append) - { - error ("save: appending to HDF5 files is not implemented"); - return retval; - } - - bool write_header_info = ! (append && - H5Fis_hdf5 (fname.c_str ()) > 0); - - hdf5_ofstream hdf5_file (fname.c_str (), mode); - - if (hdf5_file.file_id != -1) - { - save_vars (argv, i, argc, hdf5_file, format, - save_as_floats, write_header_info); - - hdf5_file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif /* HAVE_HDF5 */ - // don't insert any statements here! The brace below must go - // with the "else" above! - { -#ifdef HAVE_ZLIB - if (use_zlib) - { - gzofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - else -#endif - { - std::ofstream file (fname.c_str (), mode); - - if (file) - { - bool write_header_info = ! file.tellp (); - - save_vars (argv, i, argc, file, format, - save_as_floats, write_header_info); - - file.close (); - } - else - { - gripe_file_open ("save", fname); - return retval; - } - } - } - } - - return retval; -} - -DEFUN (crash_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} crash_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} crash_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} crash_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it\n\ -crashes or receives a hangup, terminate or similar signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{octave_core_file_limit, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (crash_dumps_octave_core); -} - -DEFUN (default_save_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} default_save_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} default_save_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} default_save_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the default options\n\ -for the @code{save} command, and defines the default format.\n\ -Typical values include @code{\"-ascii\"}, @code{\"-text -zip\"}.\n\ -The default value is @option{-text}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{save}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (default_save_options); -} - -DEFUN (octave_core_file_limit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_limit ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_limit (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_limit (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum amount\n\ -of memory (in kilobytes) of the top-level workspace that Octave will\n\ -attempt to save when writing data to the crash dump file (the name of\n\ -the file is specified by @var{octave_core_file_name}). If\n\ -@var{octave_core_file_options} flags specify a binary format,\n\ -then @var{octave_core_file_limit} will be approximately the maximum\n\ -size of the file. If a text file format is used, then the file could\n\ -be much larger than the limit. The default value is -1 (unlimited)\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (octave_core_file_limit); -} - -DEFUN (octave_core_file_name, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_name ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_name (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_name (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the name of the file\n\ -used for saving data from the top-level workspace if Octave aborts.\n\ -The default value is @code{\"octave-workspace\"}\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_options}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_name); -} - -DEFUN (octave_core_file_options, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} octave_core_file_options ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} octave_core_file_options (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} octave_core_file_options (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options used for\n\ -saving the workspace data if Octave aborts. The value of\n\ -@code{octave_core_file_options} should follow the same format as the\n\ -options for the @code{save} function. The default value is Octave's binary\n\ -format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{crash_dumps_octave_core, octave_core_file_name, octave_core_file_limit}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (octave_core_file_options); -} - -DEFUN (save_header_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_header_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_header_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_header_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format\n\ -string used for the comment line written at the beginning of\n\ -text-format data files saved by Octave. The format string is\n\ -passed to @code{strftime} and should begin with the character\n\ -@samp{#} and contain no newline characters. If the value of\n\ -@code{save_header_format_string} is the empty string,\n\ -the header comment is omitted from text-format data files. The\n\ -default value is\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -\"# Created by Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end smallexample\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, save}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (save_header_format_string); -} diff -r 069c552587a0 -r 959953dba519 src/load-save.h --- a/src/load-save.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,90 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_load_save_h) -#define octave_load_save_h 1 - -#include -#include - -class octave_value; - -// FIXME: maybe MAT5 and MAT7 should be options to MAT_BINARY. -// Similarly, save_as_floats may be an option for LS_BINARY, LS_HDF5 etc. -enum load_save_format_type - { - LS_ASCII, - LS_BINARY, - LS_MAT_ASCII, - LS_MAT_BINARY, - LS_MAT5_BINARY, - LS_MAT7_BINARY, -#ifdef HAVE_HDF5 - LS_HDF5, -#endif /* HAVE_HDF5 */ - LS_UNKNOWN - }; - -enum load_save_format_options -{ - // LS_MAT_ASCII options (not exclusive) - LS_MAT_ASCII_LONG = 1, - LS_MAT_ASCII_TABS = 2, - // LS_MAT_BINARY options - LS_MAT_BINARY_V5 = 1, - LS_MAT_BINARY_V7, - // zero means no option. - LS_NO_OPTION = 0 -}; - -class load_save_format -{ -public: - load_save_format (load_save_format_type t, - load_save_format_options o = LS_NO_OPTION) - : type (t), opts (o) { } - operator int (void) const - { return type; } - int type, opts; -}; - -extern void dump_octave_core (void); - -extern int -read_binary_file_header (std::istream& is, bool& swap, - oct_mach_info::float_format& flt_fmt, - bool quiet = false); - -extern octave_value -do_load (std::istream& stream, const std::string& orig_fname, - load_save_format format, oct_mach_info::float_format flt_fmt, - bool list_only, bool swap, bool verbose, - const string_vector& argv, int argv_idx, int argc, int nargout); - -extern void -do_save (std::ostream& os, const symbol_table::symbol_record& sr, - load_save_format fmt, bool save_as_floats); - -extern void -write_header (std::ostream& os, load_save_format format); - -#endif diff -r 069c552587a0 -r 959953dba519 src/ls-oct-ascii.cc --- a/src/ls-oct-ascii.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,432 +0,0 @@ -/* - -Copyright (C) 1996-2012 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 3 of the License, 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, see -. - -*/ - -// Author: John W. Eaton. - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include -#include -#include - -#include "byte-swap.h" -#include "data-conv.h" -#include "file-ops.h" -#include "glob-match.h" -#include "lo-mappers.h" -#include "mach-info.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "load-save.h" -#include "ls-ascii-helper.h" -#include "ls-oct-ascii.h" -#include "oct-obj.h" -#include "oct-map.h" -#include "ov-cell.h" -#include "pager.h" -#include "pt-exp.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" -#include "dMatrix.h" - -// The number of decimal digits to use when writing ascii data. -static int Vsave_precision = 16; - -// Functions for reading ascii data. - -// Extract a KEYWORD and its value from stream IS, returning the -// associated value in a new string. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*:[ \t]*string-value[ \t]*\n - -std::string -extract_keyword (std::istream& is, const char *keyword, const bool next_only) -{ - std::string retval; - - int ch = is.peek (); - if (next_only && ch != '%' && ch != '#') - return retval; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - std::ostringstream value; - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - retval = read_until_newline (is, false); - break; - } - else if (next_only) - break; - else - skip_until_newline (is, false); - } - } - - int len = retval.length (); - - if (len > 0) - { - while (len) - { - c = retval[len-1]; - - if (c == ' ' || c == '\t') - len--; - else - { - retval.resize (len); - break; - } - } - } - - return retval; -} - -// Extract one value (scalar, matrix, string, etc.) from stream IS and -// place it in TC, returning the name of the variable. If the value -// is tagged as global in the file, return TRUE in GLOBAL. -// -// Each type supplies its own function to load the data, and so this -// function is extensible. -// -// FILENAME is used for error messages. -// -// The data is expected to be in the following format: -// -// The input file must have a header followed by some data. -// -// All lines in the header must begin with a `#' character. -// -// The header must contain a list of keyword and value pairs with the -// keyword and value separated by a colon. -// -// Keywords must appear in the following order: -// -// # name: -// # type: -// # -// -// Where, for the built in types are: -// -// : a valid identifier -// -// : -// | global -// -// : scalar -// | complex scalar -// | matrix -// | complex matrix -// | bool -// | bool matrix -// | string -// | range -// -// : -// | -// -// : # rows: -// : # columns: -// -// : # elements: -// : # length: (once before each string) -// -// For backward compatibility the type "string array" is treated as a -// "string" type. Also "string" can have a single element with no elements -// line such that -// -// : # length: -// -// Formatted ASCII data follows the header. -// -// Example: -// -// # name: foo -// # type: matrix -// # rows: 2 -// # columns: 2 -// 2 4 -// 1 3 -// -// Example: -// -// # name: foo -// # type: string -// # elements: 5 -// # length: 4 -// this -// # length: 2 -// is -// # length: 1 -// a -// # length: 6 -// string -// # length: 5 -// array -// -// FIXME -- this format is fairly rigid, and doesn't allow for -// arbitrary comments. Someone should fix that. It does allow arbitrary -// types however. - -// Ugh. The signature of the compare method is not standard in older -// versions of the GNU libstdc++. Do this instead: - -#define SUBSTRING_COMPARE_EQ(s, pos, n, t) (s.substr (pos, n) == t) - -std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count) -{ - // Read name for this entry or break on EOF. - - std::string name = extract_keyword (is, "name"); - - if (name.empty ()) - { - if (count == 0) - error ("load: empty name keyword or no data found in file `%s'", - filename.c_str ()); - - return std::string (); - } - - if (! (name == ".nargin." || name == ".nargout." - || name == CELL_ELT_TAG || valid_identifier (name))) - { - error ("load: bogus identifier `%s' found in file `%s'", - name.c_str (), filename.c_str ()); - return std::string (); - } - - // Look for type keyword. - - std::string tag = extract_keyword (is, "type"); - - if (! tag.empty ()) - { - std::string typ; - size_t pos = tag.rfind (' '); - - if (pos != std::string::npos) - { - global = SUBSTRING_COMPARE_EQ (tag, 0, 6, "global"); - - typ = global ? tag.substr (7) : tag; - } - else - typ = tag; - - // Special case for backward compatiablity. A small bit of cruft - if (SUBSTRING_COMPARE_EQ (typ, 0, 12, "string array")) - tc = charMatrix (); - else - tc = octave_value_typeinfo::lookup_type (typ); - - if (! tc.load_ascii (is)) - error ("load: trouble reading ascii file `%s'", filename.c_str ()); - } - else - error ("load: failed to extract keyword specifying value type"); - - if (error_state) - { - error ("load: reading file %s", filename.c_str ()); - return std::string (); - } - - return name; -} - -// Save the data from TC along with the corresponding NAME, and global -// flag MARK_AS_GLOBAL on stream OS in the plain text format described -// above for load_ascii_data. If NAME is empty, the name: line is not -// generated. PRECISION specifies the number of decimal digits to print. -// -// Assumes ranges and strings cannot contain Inf or NaN values. -// -// Returns 1 for success and 0 for failure. - -// FIXME -- should probably write the help string here too. - -bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, - int precision) -{ - bool success = true; - - if (! name.empty ()) - os << "# name: " << name << "\n"; - - octave_value val = val_arg; - - if (mark_as_global) - os << "# type: global " << val.type_name () << "\n"; - else - os << "# type: " << val.type_name () << "\n"; - - if (! precision) - precision = Vsave_precision; - - long old_precision = os.precision (); - os.precision (precision); - - success = val.save_ascii (os); - - // Insert an extra pair of newline characters after the data so that - // multiple data elements may be handled separately by gnuplot (see - // the description of the index qualifier for the plot command in the - // gnuplot documentation). - os << "\n\n"; - - os.precision (old_precision); - - return (os && success); -} - -bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name) -{ - return save_ascii_data (os, t, name, false, 6); -} - -// Maybe this should be a static function in tree-plot.cc? - -// If TC is matrix, save it on stream OS in a format useful for -// making a 3-dimensional plot with gnuplot. If PARAMETRIC is -// TRUE, assume a parametric 3-dimensional plot will be generated. - -bool -save_three_d (std::ostream& os, const octave_value& tc, bool parametric) -{ - bool fail = false; - - octave_idx_type nr = tc.rows (); - octave_idx_type nc = tc.columns (); - - if (tc.is_real_matrix ()) - { - os << "# 3D data...\n" - << "# type: matrix\n" - << "# total rows: " << nr << "\n" - << "# total columns: " << nc << "\n"; - - long old_precision = os.precision (); - os.precision (6); - - if (parametric) - { - octave_idx_type extras = nc % 3; - if (extras) - warning ("ignoring last %d columns", extras); - - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc-extras; i += 3) - { - os << tmp.extract (0, i, nr-1, i+2); - if (i+3 < nc-extras) - os << "\n"; - } - } - else - { - Matrix tmp = tc.matrix_value (); - nr = tmp.rows (); - - for (octave_idx_type i = 0; i < nc; i++) - { - os << tmp.extract (0, i, nr-1, i); - if (i+1 < nc) - os << "\n"; - } - } - - os.precision (old_precision); - } - else - { - ::error ("for now, I can only save real matrices in 3D format"); - fail = true; - } - - return (os && ! fail); -} - -DEFUN (save_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} save_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} save_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} save_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the number of\n\ -digits to keep when saving data in text format.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (save_precision, -1, INT_MAX); -} diff -r 069c552587a0 -r 959953dba519 src/ls-oct-ascii.h --- a/src/ls-oct-ascii.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,189 +0,0 @@ -/* - -Copyright (C) 2003-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_ls_oct_ascii_h) -#define octave_ls_oct_ascii_h 1 - -#include - -#include -#include - -#include "str-vec.h" - -#include "ls-ascii-helper.h" - -// Flag for cell elements -#define CELL_ELT_TAG "" - -// Used when converting Inf to something that gnuplot can read. - -#ifndef OCT_RBV -#define OCT_RBV DBL_MAX / 100.0 -#endif - -extern OCTINTERP_API std::string -extract_keyword (std::istream& is, const char *keyword, - const bool next_only = false); - -extern OCTINTERP_API std::string -read_ascii_data (std::istream& is, const std::string& filename, bool& global, - octave_value& tc, octave_idx_type count); - -extern OCTINTERP_API bool -save_ascii_data (std::ostream& os, const octave_value& val_arg, - const std::string& name, bool mark_as_global, int precision); - -extern OCTINTERP_API bool -save_ascii_data_for_plotting (std::ostream& os, const octave_value& t, - const std::string& name); - -extern OCTINTERP_API bool -save_three_d (std::ostream& os, const octave_value& t, - bool parametric = false); - -// Match KEYWORD on stream IS, placing the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const char *keyword, T& value, - const bool next_only = false) -{ - bool status = false; - value = T (); - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - bool match = (tmp.compare (0, strlen (keyword), keyword) == 0); - - if (match) - { - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - break; - } - else if (next_only) - break; - } - } - return status; -} - -template -bool -extract_keyword (std::istream& is, const std::string& kw, T& value, - const bool next_only = false) -{ - return extract_keyword (is, kw.c_str (), value, next_only); -} - -// Match one of the elements in KEYWORDS on stream IS, placing the -// matched keyword in KW and the associated value in VALUE, -// returning TRUE if successful and FALSE otherwise. -// -// Input should look something like: -// -// [%#][ \t]*keyword[ \t]*int-value.*\n - -template -bool -extract_keyword (std::istream& is, const string_vector& keywords, - std::string& kw, T& value, const bool next_only = false) -{ - bool status = false; - kw = ""; - value = 0; - - char c; - while (is.get (c)) - { - if (c == '%' || c == '#') - { - std::ostringstream buf; - - while (is.get (c) && (c == ' ' || c == '\t' || c == '%' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - std::string tmp = buf.str (); - - for (int i = 0; i < keywords.length (); i++) - { - int match = (tmp == keywords[i]); - - if (match) - { - kw = keywords[i]; - - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n' && c != '\r') - is >> value; - if (is) - status = true; - skip_until_newline (is, false); - return status; - } - } - - if (next_only) - break; - } - } - return status; -} - -#endif diff -r 069c552587a0 -r 959953dba519 src/mappers.cc --- a/src/mappers.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2087 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "lo-ieee.h" -#include "lo-specfun.h" -#include "lo-mappers.h" - -#include "defun.h" -#include "error.h" -#include "variables.h" - -DEFUN (abs, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} abs (@var{z})\n\ -Compute the magnitude of @var{z}, defined as\n\ -@tex\n\ -$|z| = \\sqrt{x^2 + y^2}$.\n\ -@end tex\n\ -@ifnottex\n\ -|@var{z}| = @code{sqrt (x^2 + y^2)}.\n\ -@end ifnottex\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -abs (3 + 4i)\n\ - @result{} 5\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).abs (); - else - print_usage (); - - return retval; -} - -/* -%!assert (abs (1), 1) -%!assert (abs (-3.5), 3.5) -%!assert (abs (3+4i), 5) -%!assert (abs (3-4i), 5) -%!assert (abs ([1.1, 3i; 3+4i, -3-4i]), [1.1, 3; 5, 5]) - -%!assert (abs (single (1)), single (1)) -%!assert (abs (single (-3.5)), single (3.5)) -%!assert (abs (single (3+4i)), single (5)) -%!assert (abs (single (3-4i)), single (5)) -%!assert (abs (single ([1.1, 3i; 3+4i, -3-4i])), single ([1.1, 3; 5, 5])) - -%!error abs () -%!error abs (1, 2) -*/ - -DEFUN (acos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acos (@var{x})\n\ -Compute the inverse cosine in radians for each element of @var{x}.\n\ -@seealso{cos, acosd}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! assert (acos (x), v, sqrt (eps)); - -%!test -%! x = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! v = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! assert (acos (x), v, sqrt (eps ("single"))); - -%!error acos () -%!error acos (1, 2) -*/ - -DEFUN (acosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} acosh (@var{x})\n\ -Compute the inverse hyperbolic cosine for each element of @var{x}.\n\ -@seealso{cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).acosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [1, 0, -1, 0]; -%! v = [0, pi/2*i, pi*i, pi/2*i]; -%! assert (acosh (x), v, sqrt (eps)); - -%!test -%! x = single ([1, 0, -1, 0]); -%! v = single ([0, pi/2*i, pi*i, pi/2*i]); -%! assert (acosh (x), v, sqrt (eps ("single"))); - -%!error acosh () -%!error acosh (1, 2) -*/ - -DEFUN (angle, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} angle (@var{z})\n\ -See arg.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -DEFUN (arg, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} arg (@var{z})\n\ -@deftypefnx {Mapping Function} {} angle (@var{z})\n\ -Compute the argument of @var{z}, defined as,\n\ -@tex\n\ -$\\theta = atan2 (y, x),$\n\ -@end tex\n\ -@ifnottex\n\ -@var{theta} = @code{atan2 (@var{y}, @var{x})},\n\ -@end ifnottex\n\ -in radians.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -arg (3 + 4i)\n\ - @result{} 0.92730\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).arg (); - else - print_usage (); - - return retval; -} - -/* -%!assert (arg (1), 0) -%!assert (arg (i), pi/2) -%!assert (arg (-1), pi) -%!assert (arg (-i), -pi/2) -%!assert (arg ([1, i; -1, -i]), [0, pi/2; pi, -pi/2]) - -%!assert (arg (single (1)), single (0)) -%!assert (arg (single (i)), single (pi/2)) -%!test -%! if (ismac ()) -%! ## Avoid failing for a MacOS feature -%! assert (arg (single (-1)), single (pi), 2*eps (single (1))); -%! else -%! assert (arg (single (-1)), single (pi)); -%! endif -%!assert (arg (single (-i)), single (-pi/2)) -%!assert (arg (single ([1, i; -1, -i])), single ([0, pi/2; pi, -pi/2]), 2e1*eps ("single")) - -%!error arg () -%!error arg (1, 2) -*/ - -DEFUN (asin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asin (@var{x})\n\ -Compute the inverse sine in radians for each element of @var{x}.\n\ -@seealso{sin, asind}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asin (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! v = [0, pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6, 0]; -%! assert (all (abs (asin (x) - v) < sqrt (eps))); - -%!error asin () -%!error asin (1, 2) -*/ - -DEFUN (asinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} asinh (@var{x})\n\ -Compute the inverse hyperbolic sine for each element of @var{x}.\n\ -@seealso{sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).asinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, pi/2*i, 0, -pi/2*i]; -%! x = [0, i, 0, -i]; -%! assert (asinh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/2*i, 0, -pi/2*i]); -%! x = single ([0, i, 0, -i]); -%! assert (asinh (x), v, sqrt (eps ("single"))); - -%!error asinh () -%!error asinh (1, 2) -*/ - -DEFUN (atan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atan (@var{x})\n\ -Compute the inverse tangent in radians for each element of @var{x}.\n\ -@seealso{tan, atand}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! v = [0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]; -%! x = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (atan (x), v, sqrt (eps)); - -%!test -%! v = single ([0, pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6, 0]); -%! x = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (atan (x), v, sqrt (eps ("single"))); - -%!error atan () -%!error atan (1, 2) -*/ - -DEFUN (atanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} atanh (@var{x})\n\ -Compute the inverse hyperbolic tangent for each element of @var{x}.\n\ -@seealso{tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).atanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! v = [0, 0]; -%! x = [0, 0]; -%! assert (atanh (x), v, sqrt (eps)); - -%!test -%! v = single ([0, 0]); -%! x = single ([0, 0]); -%! assert (atanh (x), v, sqrt (eps ("single"))); - -%!error atanh () -%!error atanh (1, 2) -*/ - -DEFUN (cbrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cbrt (@var{x})\n\ -Compute the real cube root of each element of @var{x}.\n\ -Unlike @code{@var{x}^(1/3)}, the result will be negative if @var{x} is\n\ -negative.\n\ -@seealso{nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cbrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (cbrt (64), 4) -%!assert (cbrt (-125), -5) -%!assert (cbrt (0), 0) -%!assert (cbrt (Inf), Inf) -%!assert (cbrt (-Inf), -Inf) -%!assert (cbrt (NaN), NaN) -%!assert (cbrt (2^300), 2^100) -%!assert (cbrt (125*2^300), 5*2^100) - -%!error cbrt () -%!error cbrt (1, 2) -*/ - -DEFUN (ceil, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ceil (@var{x})\n\ -Return the smallest integer not less than @var{x}. This is equivalent to\n\ -rounding towards positive infinity. If @var{x} is\n\ -complex, return @code{ceil (real (@var{x})) + ceil (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -ceil ([-2.7, 2.7])\n\ - @result{} -2 3\n\ -@end group\n\ -@end example\n\ -@seealso{floor, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).ceil (); - else - print_usage (); - - return retval; -} - -/* -## double precision -%!assert (ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]) - -## complex double precison -%!assert (ceil ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 2+2i, -1-i, -1-i]) - -## single precision -%!assert (ceil (single ([2, 1.1, -1.1, -1])), single ([2, 2, -1, -1])) - -## complex single precision -%!assert (ceil (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 2+2i, -1-i, -1-i])) - -%!error ceil () -%!error ceil (1, 2) -*/ - -DEFUN (conj, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} conj (@var{z})\n\ -Return the complex conjugate of @var{z}, defined as\n\ -@tex\n\ -$\\bar{z} = x - iy$.\n\ -@end tex\n\ -@ifnottex\n\ -@code{conj (@var{z})} = @var{x} - @var{i}@var{y}.\n\ -@end ifnottex\n\ -@seealso{real, imag}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).conj (); - else - print_usage (); - - return retval; -} - -/* -%!assert (conj (1), 1) -%!assert (conj (i), -i) -%!assert (conj (1+i), 1-i) -%!assert (conj (1-i), 1+i) -%!assert (conj ([-1, -i; -1+i, -1-i]), [-1, i; -1-i, -1+i]) - -%!assert (conj (single (1)), single (1)) -%!assert (conj (single (i)), single (-i)) -%!assert (conj (single (1+i)), single (1-i)) -%!assert (conj (single (1-i)), single (1+i)) -%!assert (conj (single ([-1, -i; -1+i, -1-i])), single ([-1, i; -1-i, -1+i])) - -%!error conj () -%!error conj (1, 2) -*/ - -DEFUN (cos, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cos (@var{x})\n\ -Compute the cosine for each element of @var{x} in radians.\n\ -@seealso{acos, cosd, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cos (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]; -%! assert (cos (x), v, sqrt (eps)); - -%!test -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([1, rt3/2, rt2/2, 1/2, 0, -1/2, -rt2/2, -rt3/2, -1]); -%! assert (cos (x), v, sqrt (eps ("single"))); - -%!error cos () -%!error cos (1, 2) -*/ - -DEFUN (cosh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} cosh (@var{x})\n\ -Compute the hyperbolic cosine for each element of @var{x}.\n\ -@seealso{acosh, sinh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).cosh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [1, 0, -1, 0]; -%! assert (cosh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([1, 0, -1, 0]); -%! assert (cosh (x), v, sqrt (eps ("single"))); - -%!error cosh () -%!error cosh (1, 2) -*/ - -DEFUN (erf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erf (@var{z})\n\ -Compute the error function,\n\ -@tex\n\ -$$\n\ - {\\rm erf} (z) = {2 \\over \\sqrt{\\pi}}\\int_0^z e^{-t^2} dt\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - z\n\ - 2 /\n\ -erf (z) = --------- * | e^(-t^2) dt\n\ - sqrt (pi) /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erfcx, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erf (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = [0,.5,1]; -%! v = [0, .520499877813047, .842700792949715]; -%! assert (erf (x), v, 1.e-10); -%! assert (erf (-x), -v, 1.e-10); -%! assert (erfc (x), 1-v, 1.e-10); -%! assert (erfinv (v), x, 1.e-10); - -%!test -%! a = -1i*sqrt (single (-1/(6.4187*6.4187))); -%! assert (erf (a), erf (real (a))); - -%!test -%! x = single ([0,.5,1]); -%! v = single ([0, .520499877813047, .842700792949715]); -%! assert (erf (x), v, 1.e-6); -%! assert (erf (-x), -v, 1.e-6); -%! assert (erfc (x), 1-v, 1.e-6); -%! assert (erfinv (v), x, 1.e-6); - -%!error erf () -%!error erf (1, 2) -*/ - -DEFUN (erfinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfinv (@var{x})\n\ -Compute the inverse error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erf (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erf, erfc, erfcx, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erf (erfinv ([-0.9 -0.3 0 0.4 0.8])), [-0.9 -0.3 0 0.4 0.8], eps) -%!assert (erf (erfinv (single ([-0.9 -0.3 0 0.4 0.8]))), single ([-0.9 -0.3 0 0.4 0.8]), eps ("single")) -## tail region -%!assert (erf (erfinv ([-0.999 -0.99 0.9999 0.99999])), [-0.999 -0.99 0.9999 0.99999], eps) -%!assert (erf (erfinv (single ([-0.999 -0.99 0.9999 0.99999]))), single ([-0.999 -0.99 0.9999 0.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfinv (erf ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfinv (erf (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfinv ([-1, 1, 1.1, -2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfinv (1+2i) - -%!error erfinv () -%!error erfinv (1, 2) -*/ - -DEFUN (erfcinv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcinv (@var{x})\n\ -Compute the inverse complementary error function, i.e., @var{y} such that\n\ -\n\ -@example\n\ -erfc (@var{y}) == @var{x}\n\ -@end example\n\ -@seealso{erfc, erf, erfcx, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcinv (); - else - print_usage (); - - return retval; -} - -/* -## middle region -%!assert (erfc (erfcinv ([1.9 1.3 1 0.6 0.2])), [1.9 1.3 1 0.6 0.2], eps) -%!assert (erfc (erfcinv (single ([1.9 1.3 1 0.6 0.2]))), single ([1.9 1.3 1 0.6 0.2]), eps ("single")) -## tail region -%!assert (erfc (erfcinv ([0.001 0.01 1.9999 1.99999])), [0.001 0.01 1.9999 1.99999], eps) -%!assert (erfc (erfcinv (single ([0.001 0.01 1.9999 1.99999]))), single ([0.001 0.01 1.9999 1.99999]), eps ("single")) -## backward - loss of accuracy -%!assert (erfcinv (erfc ([-3 -1 -0.4 0.7 1.3 2.8])), [-3 -1 -0.4 0.7 1.3 2.8], -1e-12) -%!assert (erfcinv (erfc (single ([-3 -1 -0.4 0.7 1.3 2.8]))), single ([-3 -1 -0.4 0.7 1.3 2.8]), -1e-4) -## exceptional -%!assert (erfcinv ([2, 0, -0.1, 2.1]), [-Inf, Inf, NaN, NaN]) -%!error erfcinv (1+2i) - -%!error erfcinv () -%!error erfcinv (1, 2) -*/ - -DEFUN (erfc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfc (@var{z})\n\ -Compute the complementary error function,\n\ -@tex\n\ -$1 - {\\rm erf} (z)$.\n\ -@end tex\n\ -@ifnottex\n\ -@w{@code{1 - erf (@var{z})}}.\n\ -@end ifnottex\n\ -@seealso{erfcinv, erfcx, erf, erfinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfc (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (erfc (a), erfc (real (a))); - -%!error erfc () -%!error erfc (1, 2) -*/ - -DEFUN (erfcx, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} erfcx (@var{z})\n\ -Compute the scaled complementary error function,\n\ -@tex\n\ -$$\n\ - e^{z^2} {\\rm erfc} (z) \\equiv e^{z^2} (1 - {\\rm erf} (z))\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -exp (z^2) * erfc (x)\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{erfc, erf, erfinv, erfcinv}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).erfcx (); - else - print_usage (); - - return retval; -} - -/* -## FIXME: Need a test for erfcx - -%!error erfcx () -%!error erfcx (1, 2) -*/ - -DEFUN (exp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} exp (@var{x})\n\ -Compute\n\ -@tex\n\ -$e^{x}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{e^x}\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the matrix\n\ -exponential, see @ref{Linear Algebra}.\n\ -@seealso{log}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).exp (); - else - print_usage (); - - return retval; -} - -/* -%!assert (exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)) -%!assert (exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)) -%!assert (exp (single ([0, 1, -1, -1000])), single ([1, e, 1/e, 0]), sqrt (eps ("single"))) -%!assert (exp (single (1+i)), single (e * (cos (1) + sin (1) * i)), sqrt (eps ("single"))) - -%!assert (exp ([Inf, -Inf, NaN]), [Inf 0 NaN]) -%!assert (exp (single ([Inf, -Inf, NaN])), single ([Inf 0 NaN])) - -%!error exp () -%!error exp (1, 2) -*/ - -DEFUN (expm1, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} expm1 (@var{x})\n\ -Compute\n\ -@tex\n\ -$ e^{x} - 1 $\n\ -@end tex\n\ -@ifnottex\n\ -@code{exp (@var{x}) - 1}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).expm1 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (expm1 (2*eps), 2*eps, 1e-29) - -%!assert (expm1 ([Inf, -Inf, NaN]), [Inf -1 NaN]) -%!assert (expm1 (single ([Inf, -Inf, NaN])), single ([Inf -1 NaN])) - -%!error expm1 () -%!error expm1 (1, 2) -*/ - -DEFUN (isfinite, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isfinite (@var{x})\n\ -@deftypefnx {Mapping Function} {} finite (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -finite values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -finite ([13, Inf, NA, NaN])\n\ - @result{} [ 1, 0, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isinf, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).finite (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!finite (Inf)) -%!assert (!finite (NaN)) -%!assert (finite (rand (1,10))) - -%!assert (!finite (single (Inf))) -%!assert (!finite (single (NaN))) -%!assert (finite (single (rand (1,10)))) - -%!error finite () -%!error finite (1, 2) -*/ - -DEFUN (fix, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} fix (@var{x})\n\ -Truncate fractional portion of @var{x} and return the integer portion. This\n\ -is equivalent to rounding towards zero. If @var{x} is complex, return\n\ -@code{fix (real (@var{x})) + fix (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -fix ([-2.7, 2.7])\n\ - @result{} -2 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).fix (); - else - print_usage (); - - return retval; -} - -/* -%!assert (fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]) -%!assert (fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]) -%!assert (fix (single ([1.1, 1, -1.1, -1])), single ([1, 1, -1, -1])) -%!assert (fix (single ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i])), single ([1+i, 1+i, -1-i, -1-i])) - -%!error fix () -%!error fix (1, 2) -*/ - -DEFUN (floor, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} floor (@var{x})\n\ -Return the largest integer not greater than @var{x}. This is equivalent to\n\ -rounding towards negative infinity. If @var{x} is\n\ -complex, return @code{floor (real (@var{x})) + floor (imag (@var{x})) * I}.\n\ -\n\ -@example\n\ -@group\n\ -floor ([-2.7, 2.7])\n\ - @result{} -3 2\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, round, fix}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).floor (); - else - print_usage (); - - return retval; -} - -/* -%!assert (floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]) -%!assert (floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]) -%!assert (floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])) -%!assert (floor (single ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i])), single ([2+2i, 1+i, -2-2i, -1-i])) - -%!error floor () -%!error floor (1, 2) -*/ - -DEFUN (gamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} gamma (@var{z})\n\ -Compute the Gamma function,\n\ -@tex\n\ -$$\n\ - \\Gamma (z) = \\int_0^\\infty t^{z-1} e^{-t} dt.\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - infinity\n\ - /\n\ -gamma (z) = | t^(z-1) exp (-t) dt.\n\ - /\n\ - t=0\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -@seealso{gammainc, lgamma}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).gamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (gamma (x), v, sqrt (eps)); - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (gamma (a), gamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (gamma (x), v, sqrt (eps ("single"))); - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 1, Inf]; -%! assert (gamma (x), v); -%! assert (gamma (single (x)), single (v)); - -%!error gamma () -%!error gamma (1, 2) -*/ - -DEFUN (imag, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} imag (@var{z})\n\ -Return the imaginary part of @var{z} as a real number.\n\ -@seealso{real, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).imag (); - else - print_usage (); - - return retval; -} - -/* -%!assert (imag (1), 0) -%!assert (imag (i), 1) -%!assert (imag (1+i), 1) -%!assert (imag ([i, 1; 1, i]), full (eye (2))) - -%!assert (imag (single (1)), single (0)) -%!assert (imag (single (i)), single (1)) -%!assert (imag (single (1+i)), single (1)) -%!assert (imag (single ([i, 1; 1, i])), full (eye (2,"single"))) - -%!error imag () -%!error imag (1, 2) -*/ - -DEFUNX ("isalnum", Fisalnum, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalnum (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters or digits and false where they are not. This is equivalent to\n\ -(@code{isalpha (@var{s}) | isdigit (@var{s})}).\n\ -@seealso{isalpha, isdigit, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalnum (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalnum (charset), result); - -%!error isalnum () -%!error isalnum (1, 2) -*/ - -DEFUNX ("isalpha", Fisalpha, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isalpha (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -letters and false where they are not. This is equivalent to\n\ -(@code{islower (@var{s}) | isupper (@var{s})}).\n\ -@seealso{isdigit, ispunct, isspace, iscntrl, isalnum, islower, isupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisalpha (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! result(toascii ("a":"z") + 1) = true; -%! assert (isalpha (charset), result); - -%!error isalpha () -%!error isalpha (1, 2) -*/ - -DEFUNX ("isascii", Fisascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isascii (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -ASCII characters (in the range 0 to 127 decimal) and false where they are\n\ -not.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisascii (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = true (1, 128); -%! assert (isascii (charset), result); - -%!error isascii () -%!error isascii (1, 2) -*/ - -DEFUNX ("iscntrl", Fiscntrl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -control characters and false where they are not.\n\ -@seealso{ispunct, isspace, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xiscntrl (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(1:32) = true; -%! result(128) = true; -%! assert (iscntrl (charset), result); - -%!error iscntrl () -%!error iscntrl (1, 2) -*/ - -DEFUNX ("isdigit", Fisdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -decimal digits (0-9) and false where they are not.\n\ -@seealso{isxdigit, isalpha, isletter, ispunct, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("0":"9") + 1) = true; -%! assert (isdigit (charset), result); - -%!error isdigit () -%!error isdigit (1, 2) -*/ - -DEFUN (isinf, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isinf (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -are infinite and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isinf ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 1, 0, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isfinite, isnan, isna}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isinf (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isinf (Inf)) -%!assert (!isinf (NaN)) -%!assert (!isinf (NA)) -%!assert (isinf (rand (1,10)), false (1,10)) -%!assert (isinf ([NaN -Inf -1 0 1 Inf NA]), [false, true, false, false, false, true, false]) - -%!assert (isinf (single (Inf))) -%!assert (!isinf (single (NaN))) -%!assert (!isinf (single (NA))) -%!assert (isinf (single (rand (1,10))), false (1,10)) -%!assert (isinf (single ([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]) - -%!error isinf () -%!error isinf (1, 2) -*/ - -DEFUNX ("isgraph", Fisgraph, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isgraph (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (but not the space character) and false where they are\n\ -not.\n\ -@seealso{isprint}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisgraph (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:127) = true; -%! assert (isgraph (charset), result); - -%!error isgraph () -%!error isgraph (1, 2) -*/ - -DEFUNX ("islower", Fislower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} islower (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -lowercase letters and false where they are not.\n\ -@seealso{isupper, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xislower (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("a":"z") + 1) = true; -%! assert (islower (charset), result); - -%!error islower () -%!error islower (1, 2) -*/ - -DEFUN (isna, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isna (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NA (missing) values and false where they are not.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -isna ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 0 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isnan, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isna (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isna (Inf)) -%!assert (!isna (NaN)) -%!assert (isna (NA)) -%!assert (isna (rand (1,10)), false (1,10)) -%!assert (isna ([NaN -Inf -1 0 1 Inf NA]), [false, false, false, false, false, false, true]) - -%!assert (!isna (single (Inf))) -%!assert (!isna (single (NaN))) -%!assert (isna (single (NA))) -%!assert (isna (single (rand (1,10))), false (1,10)) -%!assert (isna (single ([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]) - -%!error isna () -%!error isna (1, 2) -*/ - -DEFUN (isnan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isnan (@var{x})\n\ -Return a logical array which is true where the elements of @var{x} are\n\ -NaN values and false where they are not.\n\ -NA values are also considered NaN values. For example:\n\ -\n\ -@example\n\ -@group\n\ -isnan ([13, Inf, NA, NaN])\n\ - @result{} [ 0, 0, 1, 1 ]\n\ -@end group\n\ -@end example\n\ -@seealso{isna, isinf, isfinite}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).isnan (); - else - print_usage (); - - return retval; -} - -/* -%!assert (!isnan (Inf)) -%!assert (isnan (NaN)) -%!assert (isnan (NA)) -%!assert (isnan (rand (1,10)), false (1,10)) -%!assert (isnan ([NaN -Inf -1 0 1 Inf NA]), [true, false, false, false, false, false, true]) - -%!assert (!isnan (single (Inf))) -%!assert (isnan (single (NaN))) -%!assert (isnan (single (NA))) -%!assert (isnan (single (rand (1,10))), false (1,10)) -%!assert (isnan (single ([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]) - -%!error isnan () -%!error isnan (1, 2) -*/ - -DEFUNX ("isprint", Fisprint, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isprint (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -printable characters (including the space character) and false where they\n\ -are not.\n\ -@seealso{isgraph}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisprint (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(33:127) = true; -%! assert (isprint (charset), result); - -%!error isprint () -%!error isprint (1, 2) -*/ - -DEFUNX ("ispunct", Fispunct, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} ispunct (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -punctuation characters and false where they are not.\n\ -@seealso{isalpha, isdigit, isspace, iscntrl}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xispunct (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(34:48) = true; -%! result(59:65) = true; -%! result(92:97) = true; -%! result(124:127) = true; -%! assert (ispunct (charset), result); - -%!error ispunct () -%!error ispunct (1, 2) -*/ - -DEFUNX ("isspace", Fisspace, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isspace (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -whitespace characters (space, formfeed, newline, carriage return, tab, and\n\ -vertical tab) and false where they are not.\n\ -@seealso{iscntrl, ispunct, isalpha, isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisspace (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii (" \f\n\r\t\v") + 1) = true; -%! assert (isspace (charset), result); - -%!error isspace () -%!error isspace (1, 2) -*/ - -DEFUNX ("isupper", Fisupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isupper (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -uppercase letters and false where they are not.\n\ -@seealso{islower, isalpha, isletter, isalnum}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisupper (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"Z") + 1) = true; -%! assert (isupper (charset), result); - -%!error isupper () -%!error isupper (1, 2) -*/ - -DEFUNX ("isxdigit", Fisxdigit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ -Return a logical array which is true where the elements of @var{s} are\n\ -hexadecimal digits (0-9 and @nospell{a-fA-F}).\n\ -@seealso{isdigit}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xisxdigit (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! charset = char (0:127); -%! result = false (1, 128); -%! result(toascii ("A":"F") + 1) = true; -%! result(toascii ("0":"9") + 1) = true; -%! result(toascii ("a":"f") + 1) = true; -%! assert (isxdigit (charset), result); - -%!error isxdigit () -%!error isxdigit (1, 2) -*/ - -DEFUN (lgamma, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} lgamma (@var{x})\n\ -@deftypefnx {Mapping Function} {} gammaln (@var{x})\n\ -Return the natural logarithm of the gamma function of @var{x}.\n\ -@seealso{gamma, gammainc}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).lgamma (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! a = -1i*sqrt (-1/(6.4187*6.4187)); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = [.5, 1, 1.5, 2, 3, 4, 5]; -%! v = [sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]; -%! assert (lgamma (x), log (v), sqrt (eps)) - -%!test -%! a = single (-1i*sqrt (-1/(6.4187*6.4187))); -%! assert (lgamma (a), lgamma (real (a))); - -%!test -%! x = single ([.5, 1, 1.5, 2, 3, 4, 5]); -%! v = single ([sqrt(pi), 1, .5*sqrt(pi), 1, 2, 6, 24]); -%! assert (lgamma (x), log (v), sqrt (eps ("single"))) - -%!test -%! x = [-1, 0, 1, Inf]; -%! v = [Inf, Inf, 0, Inf]; -%! assert (lgamma (x), v); -%! assert (lgamma (single (x)), single (v)); - -%!error lgamma () -%!error lgamma (1,2) -*/ - -DEFUN (log, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log (@var{x})\n\ -Compute the natural logarithm,\n\ -@tex\n\ -$\\ln{(x)},$\n\ -@end tex\n\ -@ifnottex\n\ -@code{ln (@var{x})},\n\ -@end ifnottex\n\ -for each element of @var{x}. To compute the\n\ -matrix logarithm, see @ref{Linear Algebra}.\n\ -@seealso{exp, log1p, log2, log10, logspace}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log ([1, e, e^2]), [0, 1, 2], sqrt (eps)) -%!assert (log ([-0.5, -1.5, -2.5]), log ([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)) - -%!assert (log (single ([1, e, e^2])), single ([0, 1, 2]), sqrt (eps ("single"))) -%!assert (log (single ([-0.5, -1.5, -2.5])), single (log ([0.5, 1.5, 2.5]) + pi*1i), 4*eps ("single")) - -%!error log () -%!error log (1, 2) -*/ - -DEFUN (log10, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log10 (@var{x})\n\ -Compute the base-10 logarithm of each element of @var{x}.\n\ -@seealso{log, log2, logspace, exp}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log10 (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)) -%!assert (log10 (single ([0.01, 0.1, 1, 10, 100])), single ([-2, -1, 0, 1, 2]), sqrt (eps ("single"))) - -%!error log10 () -%!error log10 (1, 2) -*/ - -DEFUN (log1p, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} log1p (@var{x})\n\ -Compute\n\ -@tex\n\ -$\\ln{(1 + x)}$\n\ -@end tex\n\ -@ifnottex\n\ -@code{log (1 + @var{x})}\n\ -@end ifnottex\n\ -accurately in the neighborhood of zero.\n\ -@seealso{log, exp, expm1}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).log1p (); - else - print_usage (); - - return retval; -} - -/* -%!assert (log1p ([0, 2*eps, -2*eps]), [0, 2*eps, -2*eps], 1e-29) -%!assert (log1p (single ([0, 2*eps, -2*eps])), single ([0, 2*eps, -2*eps]), 1e-29) - -%!error log1p () -%!error log1p (1, 2) -*/ - -DEFUN (real, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} real (@var{z})\n\ -Return the real part of @var{z}.\n\ -@seealso{imag, conj}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).real (); - else - print_usage (); - - return retval; -} - -/* -%!assert (real (1), 1) -%!assert (real (i), 0) -%!assert (real (1+i), 1) -%!assert (real ([1, i; i, 1]), full (eye (2))) - -%!assert (real (single (1)), single (1)) -%!assert (real (single (i)), single (0)) -%!assert (real (single (1+i)), single (1)) -%!assert (real (single ([1, i; i, 1])), full (eye (2,"single"))) - -%!error real () -%!error real (1, 2) -*/ - -DEFUN (round, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} round (@var{x})\n\ -Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ -@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ -are two nearest integers, return the one further away from zero.\n\ -\n\ -@example\n\ -@group\n\ -round ([-2.7, 2.7])\n\ - @result{} -3 3\n\ -@end group\n\ -@end example\n\ -@seealso{ceil, floor, fix, roundb}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).round (); - else - print_usage (); - - return retval; -} - -/* -%!assert (round (1), 1) -%!assert (round (1.1), 1) -%!assert (round (5.5), 6) -%!assert (round (i), i) -%!assert (round (2.5+3.5i), 3+4i) -%!assert (round (-2.6), -3) -%!assert (round ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (round (single (1)), single (1)) -%!assert (round (single (1.1)), single (1)) -%!assert (round (single (5.5)), single (6)) -%!assert (round (single (i)), single (i)) -%!assert (round (single (2.5+3.5i)), single (3+4i)) -%!assert (round (single (-2.6)), single (-3)) -%!assert (round (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error round () -%!error round (1, 2) -*/ - -DEFUN (roundb, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} roundb (@var{x})\n\ -Return the integer nearest to @var{x}. If there are two nearest\n\ -integers, return the even one (banker's rounding). If @var{x} is complex,\n\ -return @code{roundb (real (@var{x})) + roundb (imag (@var{x})) * I}.\n\ -@seealso{round}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).roundb (); - else - print_usage (); - - return retval; -} - -/* -%!assert (roundb (1), 1) -%!assert (roundb (1.1), 1) -%!assert (roundb (1.5), 2) -%!assert (roundb (4.5), 4) -%!assert (roundb (i), i) -%!assert (roundb (2.5+3.5i), 2+4i) -%!assert (roundb (-2.6), -3) -%!assert (roundb ([1.1, -2.4; -3.7, 7.1]), [1, -2; -4, 7]) - -%!assert (roundb (single (1)), single (1)) -%!assert (roundb (single (1.1)), single (1)) -%!assert (roundb (single (1.5)), single (2)) -%!assert (roundb (single (4.5)), single (4)) -%!assert (roundb (single (i)), single (i)) -%!assert (roundb (single (2.5+3.5i)), single (2+4i)) -%!assert (roundb (single (-2.6)), single (-3)) -%!assert (roundb (single ([1.1, -2.4; -3.7, 7.1])), single ([1, -2; -4, 7])) - -%!error roundb () -%!error roundb (1, 2) -*/ - -DEFUN (sign, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sign (@var{x})\n\ -Compute the @dfn{signum} function, which is defined as\n\ -@tex\n\ -$$\n\ -{\\rm sign} (@var{x}) = \\cases{1,&$x>0$;\\cr 0,&$x=0$;\\cr -1,&$x<0$.\\cr}\n\ -$$\n\ -@end tex\n\ -@ifnottex\n\ -\n\ -@example\n\ -@group\n\ - -1, x < 0;\n\ -sign (x) = 0, x = 0;\n\ - 1, x > 0.\n\ -@end group\n\ -@end example\n\ -\n\ -@end ifnottex\n\ -\n\ -For complex arguments, @code{sign} returns @code{x ./ abs (@var{x})}.\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).signum (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sign (-2) , -1) -%!assert (sign (0), 0) -%!assert (sign (3), 1) -%!assert (sign ([1, -pi; e, 0]), [1, -1; 1, 0]) - -%!assert (sign (single (-2)) , single (-1)) -%!assert (sign (single (0)), single (0)) -%!assert (sign (single (3)), single (1)) -%!assert (sign (single ([1, -pi; e, 0])), single ([1, -1; 1, 0])) - -%!error sign () -%!error sign (1, 2) -*/ - -DEFUN (sin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sin (@var{x})\n\ -Compute the sine for each element of @var{x} in radians.\n\ -@seealso{asin, sind, sinh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sin (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]; -%! assert (sin (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, 1/2, rt2/2, rt3/2, 1, rt3/2, rt2/2, 1/2, 0]); -%! assert (sin (x), v, sqrt (eps ("single"))); - -%!error sin () -%!error sin (1, 2) -*/ - -DEFUN (sinh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sinh (@var{x})\n\ -Compute the hyperbolic sine for each element of @var{x}.\n\ -@seealso{asinh, cosh, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sinh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi/2*i, pi*i, 3*pi/2*i]; -%! v = [0, i, 0, -i]; -%! assert (sinh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/2*i, pi*i, 3*pi/2*i]); -%! v = single ([0, i, 0, -i]); -%! assert (sinh (x), v, sqrt (eps ("single"))); - -%!error sinh () -%!error sinh (1, 2) -*/ - -DEFUN (sqrt, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} sqrt (@var{x})\n\ -Compute the square root of each element of @var{x}. If @var{x} is negative,\n\ -a complex result is returned. To compute the matrix square root, see\n\ -@ref{Linear Algebra}.\n\ -@seealso{realsqrt, nthroot}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).sqrt (); - else - print_usage (); - - return retval; -} - -/* -%!assert (sqrt (4), 2) -%!assert (sqrt (-1), i) -%!assert (sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)) -%!assert (sqrt ([4, -4; i, 1-i]), [2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))], sqrt (eps)) - -%!assert (sqrt (single (4)), single (2)) -%!assert (sqrt (single (-1)), single (i)) -%!assert (sqrt (single (1+i)), single (exp (0.5 * log (1+i))), sqrt (eps ("single"))) -%!assert (sqrt (single ([4, -4; i, 1-i])), single ([2, 2i; exp(0.5 * log (i)), exp(0.5 * log (1-i))]), sqrt (eps ("single"))) - -%!error sqrt () -%!error sqrt (1, 2) -*/ - -DEFUN (tan, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tan (@var{z})\n\ -Compute the tangent for each element of @var{x} in radians.\n\ -@seealso{atan, tand, tanh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tan (); - else - print_usage (); - - return retval; -} - -/* -%!shared rt2, rt3 -%! rt2 = sqrt (2); -%! rt3 = sqrt (3); - -%!test -%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; -%! v = [0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]; -%! assert (tan (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]); -%! v = single ([0, rt3/3, 1, rt3, -rt3, -1, -rt3/3, 0]); -%! assert (tan (x), v, sqrt (eps ("single"))); - -%!error tan () -%!error tan (1, 2) -*/ - -DEFUN (tanh, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tanh (@var{x})\n\ -Compute hyperbolic tangent for each element of @var{x}.\n\ -@seealso{atanh, sinh, cosh}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).tanh (); - else - print_usage (); - - return retval; -} - -/* -%!test -%! x = [0, pi*i]; -%! v = [0, 0]; -%! assert (tanh (x), v, sqrt (eps)); - -%!test -%! x = single ([0, pi*i]); -%! v = single ([0, 0]); -%! assert (tanh (x), v, sqrt (eps ("single"))); - -%!error tanh () -%!error tanh (1, 2) -*/ - -DEFUNX ("toascii", Ftoascii, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toascii (@var{s})\n\ -Return ASCII representation of @var{s} in a matrix. For example:\n\ -\n\ -@example\n\ -@group\n\ -toascii (\"ASCII\")\n\ - @result{} [ 65, 83, 67, 73, 73 ]\n\ -@end group\n\ -\n\ -@end example\n\ -@seealso{char}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoascii (); - else - print_usage (); - - return retval; -} - -/* -%!assert (toascii (char (0:127)), 0:127) -%!assert (toascii (" ":"@"), 32:64) -%!assert (toascii ("A":"Z"), 65:90) -%!assert (toascii ("[":"`"), 91:96) -%!assert (toascii ("a":"z"), 97:122) -%!assert (toascii ("{":"~"), 123:126) - -%!error toascii () -%!error toascii (1, 2) -*/ - -DEFUNX ("tolower", Ftolower, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} tolower (@var{s})\n\ -@deftypefnx {Mapping Function} {} lower (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each uppercase\n\ -character replaced by the corresponding lowercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -tolower (\"MiXeD cAsE 123\")\n\ - @result{} \"mixed case 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{toupper}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtolower (); - else - print_usage (); - - return retval; -} - -DEFALIAS (lower, tolower); - -/* -%!assert (tolower ("OCTAVE"), "octave") -%!assert (tolower ("123OCTave!_&"), "123octave!_&") -%!assert (tolower ({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}) -%!assert (tolower (["ABC"; "DEF"]), ["abc"; "def"]) -%!assert (tolower ({["ABC"; "DEF"]}), {["abc";"def"]}) -%!assert (tolower (68), "d") -%!assert (tolower ({[68, 68; 68, 68]}), {["dd";"dd"]}) -%!test -%! a(3,3,3,3) = "D"; -%! assert (tolower (a)(3,3,3,3), "d"); - -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("A":"Z") + 1) = result (toascii ("a":"z") + 1); -%! assert (tolower (charset), result); - -%!error lower () -%!error tolower () -%!error tolower (1, 2) -*/ - -DEFUNX ("toupper", Ftoupper, args, , - "-*- texinfo -*-\n\ -@deftypefn {Mapping Function} {} toupper (@var{s})\n\ -@deftypefnx {Mapping Function} {} upper (@var{s})\n\ -Return a copy of the string or cell string @var{s}, with each lowercase\n\ -character replaced by the corresponding uppercase one; non-alphabetic\n\ -characters are left unchanged. For example:\n\ -\n\ -@example\n\ -@group\n\ -toupper (\"MiXeD cAsE 123\")\n\ - @result{} \"MIXED CASE 123\"\n\ -@end group\n\ -@end example\n\ -@seealso{tolower}\n\ -@end deftypefn") -{ - octave_value retval; - if (args.length () == 1) - retval = args(0).xtoupper (); - else - print_usage (); - - return retval; -} - -DEFALIAS (upper, toupper); - -/* -%!assert (toupper ("octave"), "OCTAVE") -%!assert (toupper ("123OCTave!_&"), "123OCTAVE!_&") -%!assert (toupper ({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}) -%!assert (toupper (["abc"; "def"]), ["ABC"; "DEF"]) -%!assert (toupper ({["abc"; "def"]}), {["ABC";"DEF"]}) -%!assert (toupper (100), "D") -%!assert (toupper ({[100, 100; 100, 100]}), {["DD";"DD"]}) -%!test -%! a(3,3,3,3) = "d"; -%! assert (toupper (a)(3,3,3,3), "D"); -%!test -%! charset = char (0:127); -%! result = charset; -%! result (toascii ("a":"z") + 1) = result (toascii ("A":"Z") + 1); -%! assert (toupper (charset), result); - -%!error toupper () -%!error upper () -%!error toupper (1, 2) -*/ - -DEFALIAS (gammaln, lgamma); - -DEFALIAS (finite, isfinite); diff -r 069c552587a0 -r 959953dba519 src/mxarray.in.h --- a/src/mxarray.in.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/mxarray.in.h Fri Aug 03 14:35:44 2012 -0400 @@ -1,3 +1,4 @@ +// DO NOT EDIT! Generated automatically from mxarray.in.h by configure /* Copyright (C) 2001-2012 Paul Kienzle diff -r 069c552587a0 -r 959953dba519 src/oct-conf.in.h --- a/src/oct-conf.in.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/oct-conf.in.h Fri Aug 03 14:35:44 2012 -0400 @@ -1,4 +1,4 @@ -// oct-conf.h.in +// DO NOT EDIT! Generated automatically from oct-conf.in.h by configure /* Copyright (C) 1996-2012 John W. Eaton diff -r 069c552587a0 -r 959953dba519 src/oct-hist.cc --- a/src/oct-hist.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,781 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -/* - -The functions listed below were adapted from similar functions from -GNU Bash, the Bourne Again SHell, copyright (C) 1987, 1989, 1991 Free -Software Foundation, Inc. - - do_history edit_history_readline - do_edit_history edit_history_add_hist - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include - -#include - -#include -#include - -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "oct-env.h" -#include "oct-time.h" -#include "str-vec.h" - -#include -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means input is coming from temporary history file. -bool input_from_tmp_history_file = false; - -static std::string -default_history_file (void) -{ - std::string file; - - std::string env_file = octave_env::getenv ("OCTAVE_HISTFILE"); - - if (! env_file.empty ()) - file = env_file; - - if (file.empty ()) - file = file_ops::concat (octave_env::get_home_directory (), - ".octave_hist"); - - return file; -} - -static int -default_history_size (void) -{ - int size = 1024; - - std::string env_size = octave_env::getenv ("OCTAVE_HISTSIZE"); - - if (! env_size.empty ()) - { - int val; - - if (sscanf (env_size.c_str (), "%d", &val) == 1) - size = val > 0 ? val : 0; - } - - return size; -} - -static std::string -default_history_timestamp_format (void) -{ - return - std::string ("# Octave " OCTAVE_VERSION ", %a %b %d %H:%M:%S %Y %Z <") - + octave_env::get_user_name () - + std::string ("@") - + octave_env::get_host_name () - + std::string (">"); -} - -// The format of the timestamp marker written to the history file when -// Octave exits. -static std::string Vhistory_timestamp_format_string - = default_history_timestamp_format (); - -// Display, save, or load history. Stolen and modified from bash. -// -// Arg of -w FILENAME means write file, arg of -r FILENAME -// means read file, arg of -q means don't number lines. Arg of N -// means only display that many items. - -static void -do_history (int argc, const string_vector& argv) -{ - int numbered_output = 1; - - unwind_protect frame; - - frame.add_fcn (command_history::set_file, command_history::file ()); - - int i; - for (i = 1; i < argc; i++) - { - std::string option = argv[i]; - - if (option == "-r" || option == "-w" || option == "-a" - || option == "-n") - { - if (i < argc - 1) - command_history::set_file (argv[i+1]); - - if (option == "-a") - // Append `new' lines to file. - command_history::append (); - - else if (option == "-w") - // Write entire history. - command_history::write (); - - else if (option == "-r") - // Read entire file. - command_history::read (); - - else if (option == "-n") - // Read `new' history from file. - command_history::read_range (); - - else - panic_impossible (); - - return; - } - else if (argv[i] == "-q") - numbered_output = 0; - else if (argv[i] == "--") - { - i++; - break; - } - else - break; - } - - int limit = -1; - - if (i < argc) - { - if (sscanf (argv[i].c_str (), "%d", &limit) != 1) - { - if (argv[i][0] == '-') - error ("history: unrecognized option `%s'", argv[i].c_str ()); - else - error ("history: bad non-numeric arg `%s'", argv[i].c_str ()); - - return; - } - - if (limit < 0) - limit = -limit; - } - - string_vector hlist = command_history::list (limit, numbered_output); - - int len = hlist.length (); - - for (i = 0; i < len; i++) - octave_stdout << hlist[i] << "\n"; -} - -// Read the edited history lines from STREAM and return them -// one at a time. This can read unlimited length lines. The -// caller should free the storage. - -static char * -edit_history_readline (std::fstream& stream) -{ - char c; - int line_len = 128; - int lindex = 0; - char *line = new char [line_len]; - line[0] = '\0'; - - while (stream.get (c)) - { - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [line_len += 128]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - if (c == '\n') - { - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; - } - else - line[lindex++] = c; - } - - if (! lindex) - { - delete [] line; - return 0; - } - - if (lindex + 2 >= line_len) - { - char *tmp_line = new char [lindex+3]; - strcpy (tmp_line, line); - delete [] line; - line = tmp_line; - } - - // Finish with newline if none in file. - - line[lindex++] = '\n'; - line[lindex++] = '\0'; - return line; -} - -// Use `command' to replace the last entry in the history list, which, -// by this time, is `run_history blah...'. The intent is that the -// new command becomes the history entry, and that `fc' should never -// appear in the history list. This way you can do `run_history' to -// your heart's content. - -static void -edit_history_repl_hist (const std::string& command) -{ - if (! command.empty ()) - { - string_vector hlist = command_history::list (); - - int len = hlist.length (); - - if (len > 0) - { - int i = len - 1; - - std::string histent = command_history::get_entry (i); - - if (! histent.empty ()) - { - std::string cmd = command; - - int cmd_len = cmd.length (); - - if (cmd[cmd_len - 1] == '\n') - cmd.resize (cmd_len - 1); - - if (! cmd.empty ()) - command_history::replace_entry (i, cmd); - } - } - } -} - -static void -edit_history_add_hist (const std::string& line) -{ - if (! line.empty ()) - { - std::string tmp = line; - - int len = tmp.length (); - - if (len > 0 && tmp[len-1] == '\n') - tmp.resize (len - 1); - - if (! tmp.empty ()) - command_history::add (tmp); - } -} - -static std::string -mk_tmp_hist_file (int argc, const string_vector& argv, - int insert_curr, const char *warn_for) -{ - std::string retval; - - string_vector hlist = command_history::list (); - - int hist_count = hlist.length (); - - // The current command line is already part of the history list by - // the time we get to this point. Delete it from the list. - - hist_count -= 2; - - if (! insert_curr) - command_history::remove (hist_count); - - hist_count--; - - // If no numbers have been specified, the default is to edit the - // last command in the history list. - - int hist_end = hist_count; - int hist_beg = hist_count; - int reverse = 0; - - // Process options. - - int usage_error = 0; - if (argc == 3) - { - if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1 - || sscanf (argv[2].c_str (), "%d", &hist_end) != 1) - usage_error = 1; - else - { - hist_beg--; - hist_end--; - } - } - else if (argc == 2) - { - if (sscanf (argv[1].c_str (), "%d", &hist_beg) != 1) - usage_error = 1; - else - { - hist_beg--; - hist_end = hist_beg; - } - } - - if (hist_beg < 0 || hist_end < 0 || hist_beg > hist_count - || hist_end > hist_count) - { - error ("%s: history specification out of range", warn_for); - return retval; - } - - if (usage_error) - { - usage ("%s [first] [last]", warn_for); - return retval; - } - - if (hist_end < hist_beg) - { - int t = hist_end; - hist_end = hist_beg; - hist_beg = t; - reverse = 1; - } - - std::string name = octave_tempnam ("", "oct-"); - - std::fstream file (name.c_str (), std::ios::out); - - if (! file) - { - error ("%s: couldn't open temporary file `%s'", warn_for, - name.c_str ()); - return retval; - } - - if (reverse) - { - for (int i = hist_end; i >= hist_beg; i--) - file << hlist[i] << "\n"; - } - else - { - for (int i = hist_beg; i <= hist_end; i++) - file << hlist[i] << "\n"; - } - - file.close (); - - return name; -} - -static void -unlink_cleanup (const char *file) -{ - gnulib::unlink (file); -} - -static void -do_edit_history (int argc, const string_vector& argv) -{ - std::string name = mk_tmp_hist_file (argc, argv, 0, "edit_history"); - - if (name.empty ()) - return; - - // Call up our favorite editor on the file of commands. - - std::string cmd = VEDITOR; - cmd.append (" \""); - cmd.append (name); - cmd.append ("\""); - - // Ignore interrupts while we are off editing commands. Should we - // maybe avoid using system()? - - volatile octave_interrupt_handler old_interrupt_handler - = octave_ignore_interrupts (); - - system (cmd.c_str ()); - - octave_set_interrupt_handler (old_interrupt_handler); - - // Write the commands to the history file since source_file - // disables command line history while it executes. - - std::fstream file (name.c_str (), std::ios::in); - - char *line; - int first = 1; - while ((line = edit_history_readline (file)) != 0) - { - // Skip blank lines. - - if (line[0] == '\n') - { - delete [] line; - continue; - } - - if (first) - { - first = 0; - edit_history_repl_hist (line); - } - else - edit_history_add_hist (line); - } - - file.close (); - - // Turn on command echo, so the output from this will make better - // sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -static void -do_run_history (int argc, const string_vector& argv) -{ - std::string name = mk_tmp_hist_file (argc, argv, 1, "run_history"); - - if (name.empty ()) - return; - - // Turn on command echo so the output from this will make better - // sense. - - unwind_protect frame; - - frame.add_fcn (unlink_cleanup, name.c_str ()); - frame.protect_var (Vecho_executing_commands); - frame.protect_var (input_from_tmp_history_file); - - Vecho_executing_commands = ECHO_CMD_LINE; - input_from_tmp_history_file = true; - - source_file (name); -} - -void -initialize_history (bool read_history_file) -{ - command_history::initialize (read_history_file, - default_history_file (), - default_history_size (), - octave_env::getenv ("OCTAVE_HISTCONTROL")); -} - -void -octave_history_write_timestamp (void) -{ - octave_localtime now; - - std::string timestamp = now.strftime (Vhistory_timestamp_format_string); - - if (! timestamp.empty ()) - command_history::add (timestamp); -} - -DEFUN (edit_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} edit_history [@var{first}] [@var{last}]\n\ -If invoked with no arguments, @code{edit_history} allows you to edit the\n\ -history list using the editor named by the variable @w{@env{EDITOR}}. The\n\ -commands to be edited are first copied to a temporary file. When you\n\ -exit the editor, Octave executes the commands that remain in the file.\n\ -It is often more convenient to use @code{edit_history} to define functions\n\ -rather than attempting to enter them directly on the command line.\n\ -By default, the block of commands is executed as soon as you exit the\n\ -editor. To avoid executing any commands, simply delete all the lines\n\ -from the buffer before exiting the editor.\n\ -\n\ -The @code{edit_history} command takes two optional arguments specifying\n\ -the history numbers of first and last commands to edit. For example,\n\ -the command\n\ -\n\ -@example\n\ -edit_history 13\n\ -@end example\n\ -\n\ -@noindent\n\ -extracts all the commands from the 13th through the last in the history\n\ -list. The command\n\ -\n\ -@example\n\ -edit_history 13 169\n\ -@end example\n\ -\n\ -@noindent\n\ -only extracts commands 13 through 169. Specifying a larger number for\n\ -the first command than the last command reverses the list of commands\n\ -before placing them in the buffer to be edited. If both arguments are\n\ -omitted, the previous command in the history list is used.\n\ -@seealso{run_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("edit_history"); - - if (error_state) - return retval; - - do_edit_history (argc, argv); - - return retval; -} - -DEFUN (history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} history options\n\ -If invoked with no arguments, @code{history} displays a list of commands\n\ -that you have executed. Valid options are:\n\ -\n\ -@table @code\n\ -@item -w @var{file}\n\ -Write the current history to the file @var{file}. If the name is\n\ -omitted, use the default history file (normally @file{~/.octave_hist}).\n\ -\n\ -@item -r @var{file}\n\ -Read the file @var{file}, appending its contents to the current\n\ -history list. If the name is omitted, use the default history file\n\ -(normally @file{~/.octave_hist}).\n\ -\n\ -@item @var{n}\n\ -Display only the most recent @var{n} lines of history.\n\ -\n\ -@item -q\n\ -Don't number the displayed lines of history. This is useful for cutting\n\ -and pasting commands using the X Window System.\n\ -@end table\n\ -\n\ -For example, to display the five most recent commands that you have\n\ -typed without displaying line numbers, use the command\n\ -@kbd{history -q 5}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("history"); - - if (error_state) - return retval; - - do_history (argc, argv); - - return retval; -} - -DEFUN (run_history, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} run_history [@var{first}] [@var{last}]\n\ -Similar to @code{edit_history}, except that the editor is not invoked,\n\ -and the commands are simply executed as they appear in the history list.\n\ -@seealso{edit_history}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("run_history"); - - if (error_state) - return retval; - - do_run_history (argc, argv); - - return retval; -} - -DEFUN (history_control, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_control ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_control (@var{new_val})\n\ -Query or set the internal variable that specifies how commands are saved\n\ -to the history list. The default value is an empty character string,\n\ -but may be overridden by the environment variable\n\ -@w{@env{OCTAVE_HISTCONTROL}}.\n\ -\n\ -The value of @code{history_control} is a colon-separated list of values\n\ -controlling how commands are saved on the history list. If the list\n\ -of values includes @code{ignorespace}, lines which begin with a space\n\ -character are not saved in the history list. A value of @code{ignoredups}\n\ -causes lines matching the previous history entry to not be saved.\n\ -A value of @code{ignoreboth} is shorthand for @code{ignorespace} and\n\ -@code{ignoredups}. A value of @code{erasedups} causes all previous lines\n\ -matching the current line to be removed from the history list before that\n\ -line is saved. Any value not in the above list is ignored. If\n\ -@code{history_control} is the empty string, all commands are saved on\n\ -the history list, subject to the value of @code{saving_history}.\n\ -@seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ -@end deftypefn") -{ - std::string old_history_control = command_history::histcontrol (); - - std::string tmp = old_history_control; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_control"); - - if (tmp != old_history_control) - command_history::process_histcontrol (tmp); - - return retval; -} - -DEFUN (history_size, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_size ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_size (@var{new_val})\n\ -Query or set the internal variable that specifies how many entries\n\ -to store in the history file. The default value is @code{1024},\n\ -but may be overridden by the environment variable @w{@env{OCTAVE_HISTSIZE}}.\n\ -@seealso{history_file, history_timestamp_format_string, saving_history}\n\ -@end deftypefn") -{ - int old_history_size = command_history::size (); - - int tmp = old_history_size; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_size", -1, INT_MAX); - - if (tmp != old_history_size) - command_history::set_size (tmp); - - return retval; -} - -DEFUN (history_file, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_file ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_file (@var{new_val})\n\ -Query or set the internal variable that specifies the name of the\n\ -file used to store command history. The default value is\n\ -@file{~/.octave_hist}, but may be overridden by the environment\n\ -variable @w{@env{OCTAVE_HISTFILE}}.\n\ -@seealso{history_size, saving_history, history_timestamp_format_string}\n\ -@end deftypefn") -{ - std::string old_history_file = command_history::file (); - - std::string tmp = old_history_file; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "history_file"); - - if (tmp != old_history_file) - command_history::set_file (tmp); - - return retval; -} - -DEFUN (history_timestamp_format_string, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} history_timestamp_format_string ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} history_timestamp_format_string (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} history_timestamp_format_string (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the format string\n\ -for the comment line that is written to the history file when Octave\n\ -exits. The format string is passed to @code{strftime}. The default\n\ -value is\n\ -\n\ -@example\n\ -\"# Octave VERSION, %a %b %d %H:%M:%S %Y %Z \"\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{strftime, history_file, history_size, saving_history}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (history_timestamp_format_string); -} - -DEFUN (saving_history, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} saving_history ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} saving_history (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} saving_history (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether commands entered\n\ -on the command line are saved in the history file.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ -@end deftypefn") -{ - bool old_saving_history = ! command_history::ignoring_entries (); - - bool tmp = old_saving_history; - - octave_value retval = set_internal_variable (tmp, args, nargout, - "saving_history"); - - if (tmp != old_saving_history) - command_history::ignore_entries (! tmp); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/oct-hist.h --- a/src/oct-hist.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_octave_hist_h) -#define octave_octave_hist_h 1 - -#include - -#include "cmd-hist.h" - -extern void initialize_history (bool read_history_file = false); - -// Write timestamp to history file. -extern void octave_history_write_timestamp (void); - -// TRUE means input is coming from temporary history file. -extern bool input_from_tmp_history_file; - -#endif diff -r 069c552587a0 -r 959953dba519 src/oct-parse.yy --- a/src/oct-parse.yy Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5027 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 David Grundberg -Copyright (C) 2009-2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -// Parser for Octave. - -// C decarations. - -%{ -#define YYDEBUG 1 - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include - -#include "Cell.h" -#include "Matrix.h" -#include "cmd-edit.h" -#include "cmd-hist.h" -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "quit.h" - -#include "comment-list.h" -#include "defaults.h" -#include "defun.h" -#include "dirfns.h" -#include "dynamic-ld.h" -#include "error.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-hist.h" -#include "oct-map.h" -#include "ov-classdef.h" -#include "ov-fcn-handle.h" -#include "ov-usr-fcn.h" -#include "ov-null-mat.h" -#include "toplev.h" -#include "pager.h" -#include "parse.h" -#include "parse-private.h" -#include "pt-all.h" -#include "pt-eval.h" -#include "pt-funcall.h" -#include "symtab.h" -#include "token.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -#if defined (GNULIB_NAMESPACE) -// Calls to the following functions appear in the generated output from -// Bison without the namespace tag. Redefine them so we will use them -// via the gnulib namespace. -#define fclose GNULIB_NAMESPACE::fclose -#define fprintf GNULIB_NAMESPACE::fprintf -#define malloc GNULIB_NAMESPACE::malloc -#endif - -// The current input line number. -int input_line_number = 1; - -// The column of the current token. -int current_input_column = 1; - -// Buffer for help text snagged from function files. -std::stack help_buf; - -// Buffer for comments appearing before a function statement. -static std::string fcn_comment_header; - -// TRUE means we are using readline. -// (--no-line-editing) -bool line_editing = true; - -// TRUE means we printed messages about reading startup files. -bool reading_startup_message_printed = false; - -// TRUE means input is coming from startup file. -bool input_from_startup_file = false; - -// = 0 currently outside any function. -// = 1 inside the primary function or a subfunction. -// > 1 means we are looking at a function definition that seems to be -// inside a function. Note that the function still might not be a -// nested function. -static int current_function_depth = 0; - -// A stack holding the nested function scopes being parsed. -// We don't use std::stack, because we want the clear method. Also, we -// must access one from the top -static std::vector function_scopes; - -// Maximum function depth detected. Just here to determine whether -// we have nested functions or just implicitly ended subfunctions. -static int max_function_depth = 0; - -// FALSE if we are still at the primary function. Subfunctions can -// only be declared inside function files. -static int parsing_subfunctions = false; - -// Have we found an explicit end to a function? -static bool endfunction_found = false; - -// Keep track of symbol table information when parsing functions. -symtab_context parser_symtab_context; - -// Name of the current class when we are parsing class methods or -// constructors. -std::string current_class_name; - -// TRUE means we are in the process of autoloading a function. -static bool autoloading = false; - -// TRUE means the current function file was found in a relative path -// element. -static bool fcn_file_from_relative_lookup = false; - -// Pointer to the primary user function or user script function. -static octave_function *primary_fcn_ptr = 0; - -// Scope where we install all subfunctions and nested functions. Only -// used while reading function files. -static symbol_table::scope_id primary_fcn_scope; - -// Pointer to the classdef object we just parsed, if any. -static tree_classdef *classdef_object = 0; - -// List of autoloads (function -> file mapping). -static std::map autoload_map; - -// Forward declarations for some functions defined at the bottom of -// the file. - -// Generic error messages. -static void -yyerror (const char *s); - -// Error mesages for mismatched end tokens. -static void -end_error (const char *type, token::end_tok_type ettype, int l, int c); - -// Check to see that end tokens are properly matched. -static bool -end_token_ok (token *tok, token::end_tok_type expected); - -// Maybe print a warning if an assignment expression is used as the -// test in a logical expression. -static void -maybe_warn_assign_as_truth_value (tree_expression *expr); - -// Maybe print a warning about switch labels that aren't constants. -static void -maybe_warn_variable_switch_label (tree_expression *expr); - -// Finish building a range. -static tree_expression * -finish_colon_expression (tree_colon_expression *e); - -// Build a constant. -static tree_constant * -make_constant (int op, token *tok_val); - -// Build a function handle. -static tree_fcn_handle * -make_fcn_handle (token *tok_val); - -// Build an anonymous function handle. -static tree_anon_fcn_handle * -make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); - -// Build a binary expression. -static tree_expression * -make_binary_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a boolean expression. -static tree_expression * -make_boolean_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2); - -// Build a prefix expression. -static tree_expression * -make_prefix_op (int op, tree_expression *op1, token *tok_val); - -// Build a postfix expression. -static tree_expression * -make_postfix_op (int op, tree_expression *op1, token *tok_val); - -// Build an unwind-protect command. -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a try-catch command. -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc); - -// Build a while command. -static tree_command * -make_while_command (token *while_tok, tree_expression *expr, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc); - -// Build a do-until command. -static tree_command * -make_do_until_command (token *until_tok, tree_statement_list *body, - tree_expression *expr, octave_comment_list *lc); - -// Build a for command. -static tree_command * -make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_expression *maxproc, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc); - -// Build a break command. -static tree_command * -make_break_command (token *break_tok); - -// Build a continue command. -static tree_command * -make_continue_command (token *continue_tok); - -// Build a return command. -static tree_command * -make_return_command (token *return_tok); - -// Start an if command. -static tree_if_command_list * -start_if_command (tree_expression *expr, tree_statement_list *list); - -// Finish an if command. -static tree_if_command * -finish_if_command (token *if_tok, tree_if_command_list *list, - token *end_tok, octave_comment_list *lc); - -// Build an elseif clause. -static tree_if_clause * -make_elseif_clause (token *elseif_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Finish a switch command. -static tree_switch_command * -finish_switch_command (token *switch_tok, tree_expression *expr, - tree_switch_case_list *list, token *end_tok, - octave_comment_list *lc); - -// Build a switch case. -static tree_switch_case * -make_switch_case (token *case_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc); - -// Build an assignment to a variable. -static tree_expression * -make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, - tree_expression *rhs); - -// Define a script. -static void -make_script (tree_statement_list *cmds, tree_statement *end_script); - -// Begin defining a function. -static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body, - tree_statement *end_function); - -// Create a no-op statement for end_function. -static tree_statement * -make_end (const std::string& type, int l, int c); - -// Do most of the work for defining a function. -static octave_user_function * -frob_function (const std::string& fname, octave_user_function *fcn); - -// Finish defining a function. -static tree_function_def * -finish_function (tree_parameter_list *ret_list, - octave_user_function *fcn, octave_comment_list *lc); - -// Reset state after parsing function. -static void -recover_from_parsing_function (void); - -// Make an index expression. -static tree_index_expression * -make_index_expression (tree_expression *expr, - tree_argument_list *args, char type); - -// Make an indirect reference expression. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, const std::string&); - -// Make an indirect reference expression with dynamic field name. -static tree_index_expression * -make_indirect_ref (tree_expression *expr, tree_expression *field); - -// Make a declaration command. -static tree_decl_command * -make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); - -// Validate argument list forming a matrix or cell row. -static tree_argument_list * -validate_matrix_row (tree_argument_list *row); - -// Finish building a matrix list. -static tree_expression * -finish_matrix (tree_matrix *m); - -// Finish building a cell list. -static tree_expression * -finish_cell (tree_cell *c); - -// Maybe print a warning. Duh. -static void -maybe_warn_missing_semi (tree_statement_list *); - -// Set the print flag for a statement based on the separator type. -static tree_statement_list * -set_stmt_print_flag (tree_statement_list *, char, bool); - -// Create a statement list. -static tree_statement_list *make_statement_list (tree_statement *stmt); - -// Append a statement to an existing statement list. -static tree_statement_list * -append_statement_list (tree_statement_list *list, char sep, - tree_statement *stmt, bool warn_missing_semi); - -static tree_funcall * -make_superclass_ref (const std::string& method_nm, - const std::string& package_nm, - const std::string& class_nm, - int l, int c); - -static tree_funcall * -make_meta_class_query (const std::string& package_nm, - const std::string& class_nm, - int l, int c); - -static tree_classdef * -make_classdef (token *tok_val, tree_classdef_attribute_list *a, - tree_identifier *id, tree_classdef_superclass_list *sc, - tree_classdef_body *body, token *end_tok, - octave_comment_list *lc); - -static tree_classdef_properties_block * -make_classdef_properties_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_property_list *plist, - token *end_tok, octave_comment_list *lc); - -static tree_classdef_methods_block * -make_classdef_methods_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_methods_list *mlist, - token *end_tok, octave_comment_list *lc); - -static tree_classdef_events_block * -make_classdef_events_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_events_list *elist, - token *end_tok, octave_comment_list *lc); - -static tree_classdef_enum_block * -make_classdef_enum_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_enum_list *elist, - token *end_tok, octave_comment_list *lc); - -// Finish building a statement. -template -static tree_statement * -make_statement (T *arg) -{ - octave_comment_list *comment = octave_comment_buffer::get_comment (); - - return new tree_statement (arg, comment); -} - -#define ABORT_PARSE \ - do \ - { \ - global_command = 0; \ - yyerrok; \ - if (! parser_symtab_context.empty ()) \ - parser_symtab_context.pop (); \ - if ((interactive || forced_interactive) \ - && ! get_input_from_eval_string) \ - YYACCEPT; \ - else \ - YYABORT; \ - } \ - while (0) - -%} - -// Bison declarations. - -// Don't add spaces around the = here; it causes some versions of -// bison to fail to properly recognize the directive. - -%name-prefix="octave_" - -%union -{ - // The type of the basic tokens returned by the lexer. - token *tok_val; - - // Comment strings that we need to deal with mid-rule. - octave_comment_list *comment_type; - - // Types for the nonterminals we generate. - char sep_type; - token *tok_type; - tree *tree_type; - tree_matrix *tree_matrix_type; - tree_cell *tree_cell_type; - tree_expression *tree_expression_type; - tree_constant *tree_constant_type; - tree_fcn_handle *tree_fcn_handle_type; - tree_funcall *tree_funcall_type; - tree_function_def *tree_function_def_type; - tree_anon_fcn_handle *tree_anon_fcn_handle_type; - tree_identifier *tree_identifier_type; - tree_index_expression *tree_index_expression_type; - tree_colon_expression *tree_colon_expression_type; - tree_argument_list *tree_argument_list_type; - tree_parameter_list *tree_parameter_list_type; - tree_command *tree_command_type; - tree_if_command *tree_if_command_type; - tree_if_clause *tree_if_clause_type; - tree_if_command_list *tree_if_command_list_type; - tree_switch_command *tree_switch_command_type; - tree_switch_case *tree_switch_case_type; - tree_switch_case_list *tree_switch_case_list_type; - tree_decl_elt *tree_decl_elt_type; - tree_decl_init_list *tree_decl_init_list_type; - tree_decl_command *tree_decl_command_type; - tree_statement *tree_statement_type; - tree_statement_list *tree_statement_list_type; - octave_user_function *octave_user_function_type; - - tree_classdef *tree_classdef_type; - tree_classdef_attribute* tree_classdef_attribute_type; - tree_classdef_attribute_list* tree_classdef_attribute_list_type; - tree_classdef_superclass* tree_classdef_superclass_type; - tree_classdef_superclass_list* tree_classdef_superclass_list_type; - tree_classdef_body* tree_classdef_body_type; - tree_classdef_property* tree_classdef_property_type; - tree_classdef_property_list* tree_classdef_property_list_type; - tree_classdef_properties_block* tree_classdef_properties_block_type; - tree_classdef_methods_list* tree_classdef_methods_list_type; - tree_classdef_methods_block* tree_classdef_methods_block_type; - tree_classdef_event* tree_classdef_event_type; - tree_classdef_events_list* tree_classdef_events_list_type; - tree_classdef_events_block* tree_classdef_events_block_type; - tree_classdef_enum* tree_classdef_enum_type; - tree_classdef_enum_list* tree_classdef_enum_list_type; - tree_classdef_enum_block* tree_classdef_enum_block_type; -} - -// Tokens with line and column information. -%token '=' ':' '-' '+' '*' '/' -%token ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ -%token EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ -%token LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT -%token EXPR_AND_AND EXPR_OR_OR -%token EXPR_AND EXPR_OR EXPR_NOT -%token EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT -%token LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS -%token QUOTE TRANSPOSE -%token PLUS_PLUS MINUS_MINUS POW EPOW -%token NUM IMAG_NUM -%token STRUCT_ELT -%token NAME -%token END -%token DQ_STRING SQ_STRING -%token FOR PARFOR WHILE DO UNTIL -%token IF ELSEIF ELSE -%token SWITCH CASE OTHERWISE -%token BREAK CONTINUE FUNC_RET -%token UNWIND CLEANUP -%token TRY CATCH -%token GLOBAL PERSISTENT -%token FCN_HANDLE -%token CLASSDEF -%token PROPERTIES METHODS EVENTS ENUMERATION -%token METAQUERY -%token SUPERCLASSREF -%token GET SET - -// Other tokens. -%token END_OF_INPUT LEXICAL_ERROR -%token FCN SCRIPT_FILE CLASSDEF_FILE FUNCTION_FILE -// %token VARARGIN VARARGOUT -%token CLOSE_BRACE - -// Nonterminals we construct. -%type stash_comment function_beg -%type classdef_beg -%type sep_no_nl opt_sep_no_nl sep opt_sep opt_comma -%type input -%type string constant magic_colon -%type anon_fcn_handle -%type fcn_handle -%type matrix_rows matrix_rows1 -%type cell_rows cell_rows1 -%type matrix cell -%type primary_expr oper_expr -%type simple_expr colon_expr assign_expr expression -%type identifier fcn_name magic_tilde -%type superclass_identifier meta_identifier -%type function1 function2 -%type word_list_cmd -%type colon_expr1 -%type arg_list word_list assign_lhs -%type cell_or_matrix_row -%type param_list param_list1 param_list2 -%type return_list return_list1 -%type command select_command loop_command -%type jump_command except_command -%type function -%type classdef -%type script_file classdef_file -%type function_file function_list -%type if_command -%type elseif_clause else_clause -%type if_cmd_list1 if_cmd_list -%type switch_command -%type switch_case default_case -%type case_list1 case_list -%type decl2 -%type decl1 -%type declaration -%type statement function_end -%type simple_list simple_list1 list list1 -%type opt_list input1 - -%type attr -%type attr_list opt_attr_list -%type superclass -%type superclass_list opt_superclass_list -%type class_body -%type class_property -%type property_list -%type properties_block -%type methods_list -%type methods_block -%type class_event -%type events_list -%type events_block -%type class_enum -%type enum_list -%type enum_block - -// Precedence and associativity. -%right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ -%left EXPR_OR_OR -%left EXPR_AND_AND -%left EXPR_OR -%left EXPR_AND -%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT -%left LSHIFT RSHIFT -%left ':' -%left '-' '+' EPLUS EMINUS -%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV -%right UNARY EXPR_NOT -%left POW EPOW QUOTE TRANSPOSE -%right PLUS_PLUS MINUS_MINUS -%left '(' '.' '{' - -// Where to start. -%start input - -%% - -// ============================== -// Statements and statement lists -// ============================== - -input : input1 - { - global_command = $1; - promptflag = 1; - YYACCEPT; - } - | function_file - { YYACCEPT; } - | classdef_file - { YYACCEPT; } - | simple_list parse_error - { ABORT_PARSE; } - | parse_error - { ABORT_PARSE; } - ; - -input1 : '\n' - { $$ = 0; } - | END_OF_INPUT - { - parser_end_of_input = 1; - $$ = 0; - } - | simple_list - { $$ = $1; } - | simple_list '\n' - { $$ = $1; } - | simple_list END_OF_INPUT - { $$ = $1; } - ; - -simple_list : simple_list1 opt_sep_no_nl - { $$ = set_stmt_print_flag ($1, $2, false); } - ; - -simple_list1 : statement - { $$ = make_statement_list ($1); } - | simple_list1 sep_no_nl statement - { $$ = append_statement_list ($1, $2, $3, false); } - ; - -opt_list : // empty - { $$ = new tree_statement_list (); } - | list - { $$ = $1; } - ; - -list : list1 opt_sep - { $$ = set_stmt_print_flag ($1, $2, true); } - ; - -list1 : statement - { $$ = make_statement_list ($1); } - | list1 sep statement - { $$ = append_statement_list ($1, $2, $3, true); } - ; - -statement : expression - { $$ = make_statement ($1); } - | command - { $$ = make_statement ($1); } - | word_list_cmd - { $$ = make_statement ($1); } - ; - -// ================= -// Word-list command -// ================= - -// These are not really like expressions since they can't appear on -// the RHS of an assignment. But they are also not like commands (IF, -// WHILE, etc. - -word_list_cmd : identifier word_list - { $$ = make_index_expression ($1, $2, '('); } - ; - -word_list : string - { $$ = new tree_argument_list ($1); } - | word_list string - { - $1->append ($2); - $$ = $1; - } - ; - -// =========== -// Expressions -// =========== - -identifier : NAME - { - symbol_table::symbol_record *sr = $1->sym_rec (); - $$ = new tree_identifier (*sr, $1->line (), $1->column ()); - } - ; - -superclass_identifier - : SUPERCLASSREF - { - std::string method_nm = $1->superclass_method_name (); - std::string package_nm = $1->superclass_package_name (); - std::string class_nm = $1->superclass_class_name (); - - $$ = make_superclass_ref (method_nm, package_nm, class_nm, - $1->line (), $1->column ()); - } - ; - -meta_identifier : METAQUERY - { - std::string package_nm = $1->meta_package_name (); - std::string class_nm = $1->meta_class_name (); - - $$ = make_meta_class_query (package_nm, class_nm, - $1->line (), $1->column ()); - } - ; - -string : DQ_STRING - { $$ = make_constant (DQ_STRING, $1); } - | SQ_STRING - { $$ = make_constant (SQ_STRING, $1); } - ; - -constant : NUM - { $$ = make_constant (NUM, $1); } - | IMAG_NUM - { $$ = make_constant (IMAG_NUM, $1); } - | string - { $$ = $1; } - ; - -matrix : '[' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ';' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' ',' ']' - { - $$ = new tree_constant (octave_null_matrix::instance); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - | '[' matrix_rows ']' - { - $$ = finish_matrix ($2); - lexer_flags.looking_at_matrix_or_assign_lhs = false; - lexer_flags.pending_local_variables.clear (); - } - ; - -matrix_rows : matrix_rows1 - { $$ = $1; } - | matrix_rows1 ';' // Ignore trailing semicolon. - { $$ = $1; } - ; - -matrix_rows1 : cell_or_matrix_row - { $$ = new tree_matrix ($1); } - | matrix_rows1 ';' cell_or_matrix_row - { - $1->append ($3); - $$ = $1; - } - ; - -cell : '{' '}' - { $$ = new tree_constant (octave_value (Cell ())); } - | '{' ';' '}' - { $$ = new tree_constant (octave_value (Cell ())); } - | '{' cell_rows '}' - { $$ = finish_cell ($2); } - ; - -cell_rows : cell_rows1 - { $$ = $1; } - | cell_rows1 ';' // Ignore trailing semicolon. - { $$ = $1; } - ; - -cell_rows1 : cell_or_matrix_row - { $$ = new tree_cell ($1); } - | cell_rows1 ';' cell_or_matrix_row - { - $1->append ($3); - $$ = $1; - } - ; - -cell_or_matrix_row - : arg_list - { $$ = validate_matrix_row ($1); } - | arg_list ',' // Ignore trailing comma. - { $$ = validate_matrix_row ($1); } - ; - -fcn_handle : '@' FCN_HANDLE - { - $$ = make_fcn_handle ($2); - lexer_flags.looking_at_function_handle--; - } - ; - -anon_fcn_handle : '@' param_list statement - { - lexer_flags.quote_is_transpose = false; - $$ = make_anon_fcn_handle ($2, $3); - } - ; - -primary_expr : identifier - { $$ = $1; } - | constant - { $$ = $1; } - | fcn_handle - { $$ = $1; } - | matrix - { $$ = $1; } - | cell - { $$ = $1; } - | meta_identifier - { $$ = $1; } - | superclass_identifier - { $$ = $1; } - | '(' expression ')' - { $$ = $2->mark_in_parens (); } - ; - -magic_colon : ':' - { - octave_value tmp (octave_value::magic_colon_t); - $$ = new tree_constant (tmp); - } - ; - -magic_tilde : EXPR_NOT - { - $$ = new tree_black_hole (); - } - ; - -arg_list : expression - { $$ = new tree_argument_list ($1); } - | magic_colon - { $$ = new tree_argument_list ($1); } - | magic_tilde - { $$ = new tree_argument_list ($1); } - | arg_list ',' magic_colon - { - $1->append ($3); - $$ = $1; - } - | arg_list ',' magic_tilde - { - $1->append ($3); - $$ = $1; - } - | arg_list ',' expression - { - $1->append ($3); - $$ = $1; - } - ; - -indirect_ref_op : '.' - { lexer_flags.looking_at_indirect_ref = true; } - ; - -oper_expr : primary_expr - { $$ = $1; } - | oper_expr PLUS_PLUS - { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } - | oper_expr MINUS_MINUS - { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } - | oper_expr '(' ')' - { $$ = make_index_expression ($1, 0, '('); } - | oper_expr '(' arg_list ')' - { $$ = make_index_expression ($1, $3, '('); } - | oper_expr '{' '}' - { $$ = make_index_expression ($1, 0, '{'); } - | oper_expr '{' arg_list '}' - { $$ = make_index_expression ($1, $3, '{'); } - | oper_expr QUOTE - { $$ = make_postfix_op (QUOTE, $1, $2); } - | oper_expr TRANSPOSE - { $$ = make_postfix_op (TRANSPOSE, $1, $2); } - | oper_expr indirect_ref_op STRUCT_ELT - { $$ = make_indirect_ref ($1, $3->text ()); } - | oper_expr indirect_ref_op '(' expression ')' - { $$ = make_indirect_ref ($1, $4); } - | PLUS_PLUS oper_expr %prec UNARY - { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } - | MINUS_MINUS oper_expr %prec UNARY - { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } - | EXPR_NOT oper_expr %prec UNARY - { $$ = make_prefix_op (EXPR_NOT, $2, $1); } - | '+' oper_expr %prec UNARY - { $$ = make_prefix_op ('+', $2, $1); } - | '-' oper_expr %prec UNARY - { $$ = make_prefix_op ('-', $2, $1); } - | oper_expr POW oper_expr - { $$ = make_binary_op (POW, $1, $2, $3); } - | oper_expr EPOW oper_expr - { $$ = make_binary_op (EPOW, $1, $2, $3); } - | oper_expr '+' oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr '-' oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr '*' oper_expr - { $$ = make_binary_op ('*', $1, $2, $3); } - | oper_expr '/' oper_expr - { $$ = make_binary_op ('/', $1, $2, $3); } - | oper_expr EPLUS oper_expr - { $$ = make_binary_op ('+', $1, $2, $3); } - | oper_expr EMINUS oper_expr - { $$ = make_binary_op ('-', $1, $2, $3); } - | oper_expr EMUL oper_expr - { $$ = make_binary_op (EMUL, $1, $2, $3); } - | oper_expr EDIV oper_expr - { $$ = make_binary_op (EDIV, $1, $2, $3); } - | oper_expr LEFTDIV oper_expr - { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } - | oper_expr ELEFTDIV oper_expr - { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } - ; - -colon_expr : colon_expr1 - { $$ = finish_colon_expression ($1); } - ; - -colon_expr1 : oper_expr - { $$ = new tree_colon_expression ($1); } - | colon_expr1 ':' oper_expr - { - if (! ($$ = $1->append ($3))) - ABORT_PARSE; - } - ; - -simple_expr : colon_expr - { $$ = $1; } - | simple_expr LSHIFT simple_expr - { $$ = make_binary_op (LSHIFT, $1, $2, $3); } - | simple_expr RSHIFT simple_expr - { $$ = make_binary_op (RSHIFT, $1, $2, $3); } - | simple_expr EXPR_LT simple_expr - { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } - | simple_expr EXPR_LE simple_expr - { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } - | simple_expr EXPR_EQ simple_expr - { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } - | simple_expr EXPR_GE simple_expr - { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } - | simple_expr EXPR_GT simple_expr - { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } - | simple_expr EXPR_NE simple_expr - { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } - | simple_expr EXPR_AND simple_expr - { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } - | simple_expr EXPR_OR simple_expr - { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } - | simple_expr EXPR_AND_AND simple_expr - { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } - | simple_expr EXPR_OR_OR simple_expr - { $$ = make_boolean_op (EXPR_OR_OR, $1, $2, $3); } - ; - -// Arrange for the lexer to return CLOSE_BRACE for `]' by looking ahead -// one token for an assignment op. - -assign_lhs : simple_expr - { - $$ = new tree_argument_list ($1); - $$->mark_as_simple_assign_lhs (); - } - | '[' arg_list opt_comma CLOSE_BRACE - { - $$ = $2; - lexer_flags.looking_at_matrix_or_assign_lhs = false; - for (std::set::const_iterator p = lexer_flags.pending_local_variables.begin (); - p != lexer_flags.pending_local_variables.end (); - p++) - { - symbol_table::force_variable (*p); - } - lexer_flags.pending_local_variables.clear (); - } - ; - -assign_expr : assign_lhs '=' expression - { $$ = make_assign_op ('=', $1, $2, $3); } - | assign_lhs ADD_EQ expression - { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } - | assign_lhs SUB_EQ expression - { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } - | assign_lhs MUL_EQ expression - { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } - | assign_lhs DIV_EQ expression - { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } - | assign_lhs LEFTDIV_EQ expression - { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } - | assign_lhs POW_EQ expression - { $$ = make_assign_op (POW_EQ, $1, $2, $3); } - | assign_lhs LSHIFT_EQ expression - { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } - | assign_lhs RSHIFT_EQ expression - { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } - | assign_lhs EMUL_EQ expression - { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } - | assign_lhs EDIV_EQ expression - { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } - | assign_lhs ELEFTDIV_EQ expression - { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } - | assign_lhs EPOW_EQ expression - { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } - | assign_lhs AND_EQ expression - { $$ = make_assign_op (AND_EQ, $1, $2, $3); } - | assign_lhs OR_EQ expression - { $$ = make_assign_op (OR_EQ, $1, $2, $3); } - ; - -expression : simple_expr - { $$ = $1; } - | assign_expr - { $$ = $1; } - | anon_fcn_handle - { $$ = $1; } - ; - -// ================================================ -// Commands, declarations, and function definitions -// ================================================ - -command : declaration - { $$ = $1; } - | select_command - { $$ = $1; } - | loop_command - { $$ = $1; } - | jump_command - { $$ = $1; } - | except_command - { $$ = $1; } - | function - { $$ = $1; } - | script_file - { $$ = $1; } - ; - -// ===================== -// Declaration statemnts -// ===================== - -parsing_decl_list - : // empty - { lexer_flags.looking_at_decl_list = true; } - -declaration : GLOBAL parsing_decl_list decl1 - { - $$ = make_decl_command (GLOBAL, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - | PERSISTENT parsing_decl_list decl1 - { - $$ = make_decl_command (PERSISTENT, $1, $3); - lexer_flags.looking_at_decl_list = false; - } - ; - -decl1 : decl2 - { $$ = new tree_decl_init_list ($1); } - | decl1 decl2 - { - $1->append ($2); - $$ = $1; - } - ; - -decl_param_init : // empty - { lexer_flags.looking_at_initializer_expression = true; } - -decl2 : identifier - { $$ = new tree_decl_elt ($1); } - | identifier '=' decl_param_init expression - { - lexer_flags.looking_at_initializer_expression = false; - $$ = new tree_decl_elt ($1, $4); - } - | magic_tilde - { - $$ = new tree_decl_elt ($1); - } - ; - -// ==================== -// Selection statements -// ==================== - -select_command : if_command - { $$ = $1; } - | switch_command - { $$ = $1; } - ; - -// ============ -// If statement -// ============ - -if_command : IF stash_comment if_cmd_list END - { - if (! ($$ = finish_if_command ($1, $3, $4, $2))) - ABORT_PARSE; - } - ; - -if_cmd_list : if_cmd_list1 - { $$ = $1; } - | if_cmd_list1 else_clause - { - $1->append ($2); - $$ = $1; - } - ; - -if_cmd_list1 : expression opt_sep opt_list - { - $1->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - $$ = start_if_command ($1, $3); - } - | if_cmd_list1 elseif_clause - { - $1->append ($2); - $$ = $1; - } - ; - -elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list - { - $4->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - $$ = make_elseif_clause ($1, $4, $6, $2); - } - ; - -else_clause : ELSE stash_comment opt_sep opt_list - { $$ = new tree_if_clause ($4, $2); } - ; - -// ================ -// Switch statement -// ================ - -switch_command : SWITCH stash_comment expression opt_sep case_list END - { - if (! ($$ = finish_switch_command ($1, $3, $5, $6, $2))) - ABORT_PARSE; - } - ; - -case_list : // empty - { $$ = new tree_switch_case_list (); } - | default_case - { $$ = new tree_switch_case_list ($1); } - | case_list1 - { $$ = $1; } - | case_list1 default_case - { - $1->append ($2); - $$ = $1; - } - ; - -case_list1 : switch_case - { $$ = new tree_switch_case_list ($1); } - | case_list1 switch_case - { - $1->append ($2); - $$ = $1; - } - ; - -switch_case : CASE stash_comment opt_sep expression opt_sep opt_list - { $$ = make_switch_case ($1, $4, $6, $2); } - ; - -default_case : OTHERWISE stash_comment opt_sep opt_list - { - $$ = new tree_switch_case ($4, $2); - } - ; - -// ======= -// Looping -// ======= - -loop_command : WHILE stash_comment expression opt_sep opt_list END - { - $3->mark_braindead_shortcircuit (curr_fcn_file_full_name); - - if (! ($$ = make_while_command ($1, $3, $5, $6, $2))) - ABORT_PARSE; - } - | DO stash_comment opt_sep opt_list UNTIL expression - { - if (! ($$ = make_do_until_command ($5, $4, $6, $2))) - ABORT_PARSE; - } - | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END - { - if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, - $7, $8, $2))) - ABORT_PARSE; - } - | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END - { - if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, - $9, $10, $2))) - ABORT_PARSE; - } - | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END - { - if (! ($$ = make_for_command (PARFOR, $1, $3, $5, - 0, $7, $8, $2))) - ABORT_PARSE; - } - | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END - { - if (! ($$ = make_for_command (PARFOR, $1, $4, $6, - $8, $11, $12, $2))) - ABORT_PARSE; - } - ; - -// ======= -// Jumping -// ======= - -jump_command : BREAK - { - if (! ($$ = make_break_command ($1))) - ABORT_PARSE; - } - | CONTINUE - { - if (! ($$ = make_continue_command ($1))) - ABORT_PARSE; - } - | FUNC_RET - { - if (! ($$ = make_return_command ($1))) - ABORT_PARSE; - } - ; - -// ========== -// Exceptions -// ========== - -except_command : UNWIND stash_comment opt_sep opt_list CLEANUP - stash_comment opt_sep opt_list END - { - if (! ($$ = make_unwind_command ($1, $4, $8, $9, $2, $6))) - ABORT_PARSE; - } - | TRY stash_comment opt_sep opt_list CATCH - stash_comment opt_sep opt_list END - { - if (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) - ABORT_PARSE; - } - | TRY stash_comment opt_sep opt_list END - { - if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) - ABORT_PARSE; - } - ; - -// =========================================== -// Some `subroutines' for function definitions -// =========================================== - -push_fcn_symtab : // empty - { - current_function_depth++; - - if (max_function_depth < current_function_depth) - max_function_depth = current_function_depth; - - parser_symtab_context.push (); - - symbol_table::set_scope (symbol_table::alloc_scope ()); - - function_scopes.push_back (symbol_table::current_scope ()); - - if (! reading_script_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_scope = symbol_table::current_scope (); - - if (reading_script_file && current_function_depth > 1) - yyerror ("nested functions not implemented in this context"); - } - ; - -// =========================== -// List of function parameters -// =========================== - -param_list_beg : '(' - { - lexer_flags.looking_at_parameter_list = true; - - if (lexer_flags.looking_at_function_handle) - { - parser_symtab_context.push (); - symbol_table::set_scope (symbol_table::alloc_scope ()); - lexer_flags.looking_at_function_handle--; - lexer_flags.looking_at_anon_fcn_args = true; - } - } - ; - -param_list_end : ')' - { - lexer_flags.looking_at_parameter_list = false; - lexer_flags.looking_for_object_index = false; - } - ; - -param_list : param_list_beg param_list1 param_list_end - { - lexer_flags.quote_is_transpose = false; - $$ = $2; - } - | param_list_beg error - { - yyerror ("invalid parameter list"); - $$ = 0; - ABORT_PARSE; - } - ; - -param_list1 : // empty - { $$ = 0; } - | param_list2 - { - $1->mark_as_formal_parameters (); - if ($1->validate (tree_parameter_list::in)) - $$ = $1; - else - ABORT_PARSE; - } - ; - -param_list2 : decl2 - { $$ = new tree_parameter_list ($1); } - | param_list2 ',' decl2 - { - $1->append ($3); - $$ = $1; - } - ; - -// =================================== -// List of function return value names -// =================================== - -return_list : '[' ']' - { - lexer_flags.looking_at_return_list = false; - $$ = new tree_parameter_list (); - } - | return_list1 - { - lexer_flags.looking_at_return_list = false; - if ($1->validate (tree_parameter_list::out)) - $$ = $1; - else - ABORT_PARSE; - } - | '[' return_list1 ']' - { - lexer_flags.looking_at_return_list = false; - if ($2->validate (tree_parameter_list::out)) - $$ = $2; - else - ABORT_PARSE; - } - ; - -return_list1 : identifier - { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } - | return_list1 ',' identifier - { - $1->append (new tree_decl_elt ($3)); - $$ = $1; - } - ; - -// =========== -// Script file -// =========== - -script_file : SCRIPT_FILE opt_list END_OF_INPUT - { - tree_statement *end_of_script - = make_end ("endscript", input_line_number, - current_input_column); - - make_script ($2, end_of_script); - - $$ = 0; - } - ; - -// ============= -// Function file -// ============= - -function_file : FUNCTION_FILE function_list opt_sep END_OF_INPUT - { $$ = 0; } - ; - -function_list : function - | function_list sep function - ; - -// =================== -// Function definition -// =================== - -function_beg : push_fcn_symtab FCN stash_comment - { - $$ = $3; - - if (reading_classdef_file || lexer_flags.parsing_classdef) - lexer_flags.maybe_classdef_get_set_method = true; - } - ; - -function : function_beg function1 - { - $$ = finish_function (0, $2, $1); - recover_from_parsing_function (); - } - | function_beg return_list '=' function1 - { - $$ = finish_function ($2, $4, $1); - recover_from_parsing_function (); - } - ; - -fcn_name : identifier - { - std::string id_name = $1->name (); - - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - - $$ = $1; - } - | GET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - lexer_flags.parsing_classdef_get_method = true; - $$ = $3; - } - | SET '.' identifier - { - lexer_flags.parsed_function_name.top () = true; - lexer_flags.maybe_classdef_get_set_method = false; - lexer_flags.parsing_classdef_set_method = true; - $$ = $3; - } - ; - -function1 : fcn_name function2 - { - std::string fname = $1->name (); - - delete $1; - - if (! ($$ = frob_function (fname, $2))) - ABORT_PARSE; - } - ; - -function2 : param_list opt_sep opt_list function_end - { $$ = start_function ($1, $3, $4); } - | opt_sep opt_list function_end - { $$ = start_function (0, $2, $3); } - ; - -function_end : END - { - endfunction_found = true; - if (end_token_ok ($1, token::function_end)) - $$ = make_end ("endfunction", $1->line (), $1->column ()); - else - ABORT_PARSE; - } - | END_OF_INPUT - { -// A lot of tests are based on the assumption that this is OK -// if (reading_script_file) -// { -// yyerror ("function body open at end of script"); -// YYABORT; -// } - - if (endfunction_found) - { - yyerror ("inconsistent function endings -- " - "if one function is explicitly ended, " - "so must all the others"); - YYABORT; - } - - if (! (reading_fcn_file || reading_script_file - || get_input_from_eval_string)) - { - yyerror ("function body open at end of input"); - YYABORT; - } - - if (reading_classdef_file) - { - yyerror ("classdef body open at end of input"); - YYABORT; - } - - $$ = make_end ("endfunction", input_line_number, - current_input_column); - } - ; - -// ============= -// Classdef file -// ============= - -classdef_file : CLASSDEF_FILE classdef opt_sep END_OF_INPUT - { - classdef_object = $2; - $$ = 0; - } - ; - -// ======== -// Classdef -// ======== - -classdef_beg : CLASSDEF - { - if (! reading_classdef_file) - { - yyerror ("classdef must appear inside a file containing only a class definition"); - YYABORT; - } - - lexer_flags.parsing_classdef = true; - $$ = $1; - } - ; - -classdef : classdef_beg stash_comment opt_attr_list identifier opt_superclass_list opt_sep class_body opt_sep END - { - lexer_flags.parsing_classdef = false; - $$ = make_classdef ($1, $3, $4, $5, $7, $9, $2); - } - ; - -opt_attr_list : // empty - { $$ = 0; } - | '(' attr_list ')' - { $$ = $2; } - ; - -attr_list : attr - { $$ = new tree_classdef_attribute_list ($1); } - | attr_list ',' attr - { - $1->append ($3); - $$ = $1; - } - ; - -attr : identifier - { $$ = new tree_classdef_attribute ($1); } - | identifier '=' decl_param_init expression - { - lexer_flags.looking_at_initializer_expression = false; - $$ = new tree_classdef_attribute ($1, $4); - } - | EXPR_NOT identifier - { $$ = new tree_classdef_attribute ($2, false); } - ; - -opt_superclass_list - : // empty - { $$ = 0; } - | superclass_list - { $$ = $1; } - ; - -superclass_list : EXPR_LT superclass - { $$ = new tree_classdef_superclass_list ($2); } - | superclass_list EXPR_AND superclass - { - $1->append ($3); - $$ = $1; - } - ; - -superclass : identifier - { $$ = new tree_classdef_superclass ($1); } - | identifier '.' identifier - { $$ = new tree_classdef_superclass ($3, $1); } - ; - -class_body : properties_block - { $$ = new tree_classdef_body ($1); } - | methods_block - { $$ = new tree_classdef_body ($1); } - | events_block - { $$ = new tree_classdef_body ($1); } - | enum_block - { $$ = new tree_classdef_body ($1); } - | class_body opt_sep properties_block - { - $1->append ($3); - $$ = $1; - } - | class_body opt_sep methods_block - { - $1->append ($3); - $$ = $1; - } - | class_body opt_sep events_block - { - $1->append ($3); - $$ = $1; - } - | class_body opt_sep enum_block - { - $1->append ($3); - $$ = $1; - } - ; - -properties_block - : PROPERTIES stash_comment opt_attr_list opt_sep property_list opt_sep END - { - if (! ($$ = make_classdef_properties_block ($1, $3, $5, $7, $2))) - ABORT_PARSE; - } - ; - -property_list - : class_property - { $$ = new tree_classdef_property_list ($1); } - | property_list opt_sep class_property - { - $1->append ($3); - $$ = $1; - } - ; - -class_property : identifier - { $$ = new tree_classdef_property ($1); } - | identifier '=' decl_param_init expression ';' - { - lexer_flags.looking_at_initializer_expression = false; - $$ = new tree_classdef_property ($1, $4); - } - ; - -methods_block : METHODS stash_comment opt_attr_list opt_sep methods_list opt_sep END - { - if (! ($$ = make_classdef_methods_block ($1, $3, $5, $7, $2))) - ABORT_PARSE; - } - ; - -methods_list : function - { - octave_value fcn; - if ($1) - fcn = $1->function (); - delete $1; - $$ = new tree_classdef_methods_list (fcn); - } - | methods_list opt_sep function - { - octave_value fcn; - if ($3) - fcn = $3->function (); - delete $3; - - $1->append (fcn); - $$ = $1; - } - ; - -events_block : EVENTS stash_comment opt_attr_list opt_sep events_list opt_sep END - { - if (! ($$ = make_classdef_events_block ($1, $3, $5, $7, $2))) - ABORT_PARSE; - } - ; - -events_list : class_event - { $$ = new tree_classdef_events_list ($1); } - | events_list opt_sep class_event - { - $1->append ($3); - $$ = $1; - } - ; - -class_event : identifier - { $$ = new tree_classdef_event ($1); } - ; - -enum_block : ENUMERATION stash_comment opt_attr_list opt_sep enum_list opt_sep END - { - if (! ($$ = make_classdef_enum_block ($1, $3, $5, $7, $2))) - ABORT_PARSE; - } - ; - -enum_list : class_enum - { $$ = new tree_classdef_enum_list ($1); } - | enum_list opt_sep class_enum - { - $1->append ($3); - $$ = $1; - } - ; - -class_enum : identifier '(' expression ')' - { $$ = new tree_classdef_enum ($1, $3); } - ; - -// ============= -// Miscellaneous -// ============= - -stash_comment : // empty - { $$ = octave_comment_buffer::get_comment (); } - ; - -parse_error : LEXICAL_ERROR - { yyerror ("parse error"); } - | error - ; - -sep_no_nl : ',' - { $$ = ','; } - | ';' - { $$ = ';'; } - | sep_no_nl ',' - { $$ = $1; } - | sep_no_nl ';' - { $$ = $1; } - ; - -opt_sep_no_nl : // empty - { $$ = 0; } - | sep_no_nl - { $$ = $1; } - ; - -sep : ',' - { $$ = ','; } - | ';' - { $$ = ';'; } - | '\n' - { $$ = '\n'; } - | sep ',' - { $$ = $1; } - | sep ';' - { $$ = $1; } - | sep '\n' - { $$ = $1; } - ; - -opt_sep : // empty - { $$ = 0; } - | sep - { $$ = $1; } - ; - -opt_comma : // empty - { $$ = 0; } - | ',' - { $$ = ','; } - ; - -%% - -// Generic error messages. - -static void -yyerror (const char *s) -{ - int err_col = current_input_column - 1; - - std::ostringstream output_buf; - - if (reading_fcn_file || reading_script_file || reading_classdef_file) - output_buf << "parse error near line " << input_line_number - << " of file " << curr_fcn_file_full_name; - else - output_buf << "parse error:"; - - if (s && strcmp (s, "parse error") != 0) - output_buf << "\n\n " << s; - - output_buf << "\n\n"; - - if (! current_input_line.empty ()) - { - size_t len = current_input_line.length (); - - if (current_input_line[len-1] == '\n') - current_input_line.resize (len-1); - - // Print the line, maybe with a pointer near the error token. - - output_buf << ">>> " << current_input_line << "\n"; - - if (err_col == 0) - err_col = len; - - for (int i = 0; i < err_col + 3; i++) - output_buf << " "; - - output_buf << "^"; - } - - output_buf << "\n"; - - std::string msg = output_buf.str (); - - parse_error ("%s", msg.c_str ()); -} - -// Error mesages for mismatched end tokens. - -static void -end_error (const char *type, token::end_tok_type ettype, int l, int c) -{ - static const char *fmt - = "`%s' command matched by `%s' near line %d column %d"; - - switch (ettype) - { - case token::simple_end: - error (fmt, type, "end", l, c); - break; - - case token::for_end: - error (fmt, type, "endfor", l, c); - break; - - case token::function_end: - error (fmt, type, "endfunction", l, c); - break; - - case token::classdef_end: - error (fmt, type, "endclassdef", l, c); - break; - - case token::if_end: - error (fmt, type, "endif", l, c); - break; - - case token::switch_end: - error (fmt, type, "endswitch", l, c); - break; - - case token::while_end: - error (fmt, type, "endwhile", l, c); - break; - - case token::try_catch_end: - error (fmt, type, "end_try_catch", l, c); - break; - - case token::unwind_protect_end: - error (fmt, type, "end_unwind_protect", l, c); - break; - - default: - panic_impossible (); - break; - } -} - -// Check to see that end tokens are properly matched. - -static bool -end_token_ok (token *tok, token::end_tok_type expected) -{ - bool retval = true; - - token::end_tok_type ettype = tok->ettype (); - - if (ettype != expected && ettype != token::simple_end) - { - retval = false; - - yyerror ("parse error"); - - int l = tok->line (); - int c = tok->column (); - - switch (expected) - { - case token::classdef_end: - end_error ("classdef", ettype, l, c); - break; - - case token::for_end: - end_error ("for", ettype, l, c); - break; - - case token::enumeration_end: - end_error ("enumeration", ettype, l, c); - break; - - case token::function_end: - end_error ("function", ettype, l, c); - break; - - case token::if_end: - end_error ("if", ettype, l, c); - break; - - case token::parfor_end: - end_error ("parfor", ettype, l, c); - break; - - case token::try_catch_end: - end_error ("try", ettype, l, c); - break; - - case token::switch_end: - end_error ("switch", ettype, l, c); - break; - - case token::unwind_protect_end: - end_error ("unwind_protect", ettype, l, c); - break; - - case token::while_end: - end_error ("while", ettype, l, c); - break; - - default: - panic_impossible (); - break; - } - } - - return retval; -} - -// Maybe print a warning if an assignment expression is used as the -// test in a logical expression. - -static void -maybe_warn_assign_as_truth_value (tree_expression *expr) -{ - if (expr->is_assignment_expression () - && expr->paren_count () < 2) - { - if (curr_fcn_file_full_name.empty ()) - warning_with_id - ("Octave:assign-as-truth-value", - "suggest parenthesis around assignment used as truth value"); - else - warning_with_id - ("Octave:assign-as-truth-value", - "suggest parenthesis around assignment used as truth value near line %d, column %d in file `%s'", - expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); - } -} - -// Maybe print a warning about switch labels that aren't constants. - -static void -maybe_warn_variable_switch_label (tree_expression *expr) -{ - if (! expr->is_constant ()) - { - if (curr_fcn_file_full_name.empty ()) - warning_with_id ("Octave:variable-switch-label", - "variable switch label"); - else - warning_with_id - ("Octave:variable-switch-label", - "variable switch label near line %d, column %d in file `%s'", - expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); - } -} - -static tree_expression * -fold (tree_binary_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *op1 = e->lhs (); - tree_expression *op2 = e->rhs (); - - if (op1->is_constant () && op2->is_constant ()) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, op1->line (), op1->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - - return retval; -} - -static tree_expression * -fold (tree_unary_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *op = e->operand (); - - if (op->is_constant ()) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, op->line (), op->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - - return retval; -} - -// Finish building a range. - -static tree_expression * -finish_colon_expression (tree_colon_expression *e) -{ - tree_expression *retval = e; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - tree_expression *base = e->base (); - tree_expression *limit = e->limit (); - tree_expression *incr = e->increment (); - - if (base) - { - if (limit) - { - if (base->is_constant () && limit->is_constant () - && (! incr || (incr && incr->is_constant ()))) - { - octave_value tmp = e->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, base->line (), base->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - e->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete e; - - retval = tc_retval; - } - } - } - else - { - e->preserve_base (); - delete e; - - // FIXME -- need to attempt constant folding here - // too (we need a generic way to do that). - retval = base; - } - } - - return retval; -} - -// Make a constant. - -static tree_constant * -make_constant (int op, token *tok_val) -{ - int l = tok_val->line (); - int c = tok_val->column (); - - tree_constant *retval = 0; - - switch (op) - { - case NUM: - { - octave_value tmp (tok_val->number ()); - retval = new tree_constant (tmp, l, c); - retval->stash_original_text (tok_val->text_rep ()); - } - break; - - case IMAG_NUM: - { - octave_value tmp (Complex (0.0, tok_val->number ())); - retval = new tree_constant (tmp, l, c); - retval->stash_original_text (tok_val->text_rep ()); - } - break; - - case DQ_STRING: - case SQ_STRING: - { - std::string txt = tok_val->text (); - - char delim = op == DQ_STRING ? '"' : '\''; - octave_value tmp (txt, delim); - - if (txt.empty ()) - { - if (op == DQ_STRING) - tmp = octave_null_str::instance; - else - tmp = octave_null_sq_str::instance; - } - - retval = new tree_constant (tmp, l, c); - - if (op == DQ_STRING) - txt = undo_string_escapes (txt); - - // FIXME -- maybe this should also be handled by - // tok_val->text_rep () for character strings? - retval->stash_original_text (delim + txt + delim); - } - break; - - default: - panic_impossible (); - break; - } - - return retval; -} - -// Make a function handle. - -static tree_fcn_handle * -make_fcn_handle (token *tok_val) -{ - int l = tok_val->line (); - int c = tok_val->column (); - - tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); - - return retval; -} - -// Make an anonymous function handle. - -static tree_anon_fcn_handle * -make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) -{ - // FIXME -- need to get these from the location of the @ symbol. - int l = input_line_number; - int c = current_input_column; - - tree_parameter_list *ret_list = 0; - - symbol_table::scope_id fcn_scope = symbol_table::current_scope (); - - if (parser_symtab_context.empty ()) - panic_impossible (); - - parser_symtab_context.pop (); - - stmt->set_print_flag (false); - - tree_statement_list *body = new tree_statement_list (stmt); - - body->mark_as_anon_function_body (); - - tree_anon_fcn_handle *retval - = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); - // FIXME: Stash the filename. This does not work and produces - // errors when executed. - //retval->stash_file_name (curr_fcn_file_name); - - return retval; -} - -// Build a binary expression. - -static tree_expression * -make_binary_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2) -{ - octave_value::binary_op t = octave_value::unknown_binary_op; - - switch (op) - { - case POW: - t = octave_value::op_pow; - break; - - case EPOW: - t = octave_value::op_el_pow; - break; - - case '+': - t = octave_value::op_add; - break; - - case '-': - t = octave_value::op_sub; - break; - - case '*': - t = octave_value::op_mul; - break; - - case '/': - t = octave_value::op_div; - break; - - case EMUL: - t = octave_value::op_el_mul; - break; - - case EDIV: - t = octave_value::op_el_div; - break; - - case LEFTDIV: - t = octave_value::op_ldiv; - break; - - case ELEFTDIV: - t = octave_value::op_el_ldiv; - break; - - case LSHIFT: - t = octave_value::op_lshift; - break; - - case RSHIFT: - t = octave_value::op_rshift; - break; - - case EXPR_LT: - t = octave_value::op_lt; - break; - - case EXPR_LE: - t = octave_value::op_le; - break; - - case EXPR_EQ: - t = octave_value::op_eq; - break; - - case EXPR_GE: - t = octave_value::op_ge; - break; - - case EXPR_GT: - t = octave_value::op_gt; - break; - - case EXPR_NE: - t = octave_value::op_ne; - break; - - case EXPR_AND: - t = octave_value::op_el_and; - break; - - case EXPR_OR: - t = octave_value::op_el_or; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_binary_expression *e - = maybe_compound_binary_expression (op1, op2, l, c, t); - - return fold (e); -} - -// Build a boolean expression. - -static tree_expression * -make_boolean_op (int op, tree_expression *op1, token *tok_val, - tree_expression *op2) -{ - tree_boolean_expression::type t; - - switch (op) - { - case EXPR_AND_AND: - t = tree_boolean_expression::bool_and; - break; - - case EXPR_OR_OR: - t = tree_boolean_expression::bool_or; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_boolean_expression *e - = new tree_boolean_expression (op1, op2, l, c, t); - - return fold (e); -} - -// Build a prefix expression. - -static tree_expression * -make_prefix_op (int op, tree_expression *op1, token *tok_val) -{ - octave_value::unary_op t = octave_value::unknown_unary_op; - - switch (op) - { - case EXPR_NOT: - t = octave_value::op_not; - break; - - case '+': - t = octave_value::op_uplus; - break; - - case '-': - t = octave_value::op_uminus; - break; - - case PLUS_PLUS: - t = octave_value::op_incr; - break; - - case MINUS_MINUS: - t = octave_value::op_decr; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_prefix_expression *e - = new tree_prefix_expression (op1, l, c, t); - - return fold (e); -} - -// Build a postfix expression. - -static tree_expression * -make_postfix_op (int op, tree_expression *op1, token *tok_val) -{ - octave_value::unary_op t = octave_value::unknown_unary_op; - - switch (op) - { - case QUOTE: - t = octave_value::op_hermitian; - break; - - case TRANSPOSE: - t = octave_value::op_transpose; - break; - - case PLUS_PLUS: - t = octave_value::op_incr; - break; - - case MINUS_MINUS: - t = octave_value::op_decr; - break; - - default: - panic_impossible (); - break; - } - - int l = tok_val->line (); - int c = tok_val->column (); - - tree_postfix_expression *e - = new tree_postfix_expression (op1, l, c, t); - - return fold (e); -} - -// Build an unwind-protect command. - -static tree_command * -make_unwind_command (token *unwind_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc) -{ - tree_command *retval = 0; - - if (end_token_ok (end_tok, token::unwind_protect_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = unwind_tok->line (); - int c = unwind_tok->column (); - - retval = new tree_unwind_protect_command (body, cleanup, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a try-catch command. - -static tree_command * -make_try_command (token *try_tok, tree_statement_list *body, - tree_statement_list *cleanup, token *end_tok, - octave_comment_list *lc, octave_comment_list *mc) -{ - tree_command *retval = 0; - - if (end_token_ok (end_tok, token::try_catch_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = try_tok->line (); - int c = try_tok->column (); - - retval = new tree_try_catch_command (body, cleanup, - lc, mc, tc, l, c); - } - - return retval; -} - -// Build a while command. - -static tree_command * -make_while_command (token *while_tok, tree_expression *expr, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc) -{ - tree_command *retval = 0; - - maybe_warn_assign_as_truth_value (expr); - - if (end_token_ok (end_tok, token::while_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = while_tok->line (); - int c = while_tok->column (); - - retval = new tree_while_command (expr, body, lc, tc, l, c); - } - - return retval; -} - -// Build a do-until command. - -static tree_command * -make_do_until_command (token *until_tok, tree_statement_list *body, - tree_expression *expr, octave_comment_list *lc) -{ - tree_command *retval = 0; - - maybe_warn_assign_as_truth_value (expr); - - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = until_tok->line (); - int c = until_tok->column (); - - retval = new tree_do_until_command (expr, body, lc, tc, l, c); - - return retval; -} - -// Build a for command. - -static tree_command * -make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_expression *maxproc, - tree_statement_list *body, token *end_tok, - octave_comment_list *lc) -{ - tree_command *retval = 0; - - bool parfor = tok_id == PARFOR; - - if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - lexer_flags.looping--; - - int l = for_tok->line (); - int c = for_tok->column (); - - if (lhs->length () == 1) - { - tree_expression *tmp = lhs->remove_front (); - - retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, - body, lc, tc, l, c); - - delete lhs; - } - else - { - if (parfor) - yyerror ("invalid syntax for parfor statement"); - else - retval = new tree_complex_for_command (lhs, expr, body, - lc, tc, l, c); - } - } - - return retval; -} - -// Build a break command. - -static tree_command * -make_break_command (token *break_tok) -{ - tree_command *retval = 0; - - int l = break_tok->line (); - int c = break_tok->column (); - - retval = new tree_break_command (l, c); - - return retval; -} - -// Build a continue command. - -static tree_command * -make_continue_command (token *continue_tok) -{ - tree_command *retval = 0; - - int l = continue_tok->line (); - int c = continue_tok->column (); - - retval = new tree_continue_command (l, c); - - return retval; -} - -// Build a return command. - -static tree_command * -make_return_command (token *return_tok) -{ - tree_command *retval = 0; - - int l = return_tok->line (); - int c = return_tok->column (); - - retval = new tree_return_command (l, c); - - return retval; -} - -// Start an if command. - -static tree_if_command_list * -start_if_command (tree_expression *expr, tree_statement_list *list) -{ - maybe_warn_assign_as_truth_value (expr); - - tree_if_clause *t = new tree_if_clause (expr, list); - - return new tree_if_command_list (t); -} - -// Finish an if command. - -static tree_if_command * -finish_if_command (token *if_tok, tree_if_command_list *list, - token *end_tok, octave_comment_list *lc) -{ - tree_if_command *retval = 0; - - if (end_token_ok (end_tok, token::if_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = if_tok->line (); - int c = if_tok->column (); - - if (list && ! list->empty ()) - { - tree_if_clause *elt = list->front (); - - if (elt) - { - elt->line (l); - elt->column (c); - } - } - - retval = new tree_if_command (list, lc, tc, l, c); - } - - return retval; -} - -// Build an elseif clause. - -static tree_if_clause * -make_elseif_clause (token *elseif_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc) -{ - maybe_warn_assign_as_truth_value (expr); - - int l = elseif_tok->line (); - int c = elseif_tok->column (); - - return new tree_if_clause (expr, list, lc, l, c); -} - -// Finish a switch command. - -static tree_switch_command * -finish_switch_command (token *switch_tok, tree_expression *expr, - tree_switch_case_list *list, token *end_tok, - octave_comment_list *lc) -{ - tree_switch_command *retval = 0; - - if (end_token_ok (end_tok, token::switch_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = switch_tok->line (); - int c = switch_tok->column (); - - if (list && ! list->empty ()) - { - tree_switch_case *elt = list->front (); - - if (elt) - { - elt->line (l); - elt->column (c); - } - } - - retval = new tree_switch_command (expr, list, lc, tc, l, c); - } - - return retval; -} - -// Build a switch case. - -static tree_switch_case * -make_switch_case (token *case_tok, tree_expression *expr, - tree_statement_list *list, octave_comment_list *lc) -{ - maybe_warn_variable_switch_label (expr); - - int l = case_tok->line (); - int c = case_tok->column (); - - return new tree_switch_case (expr, list, lc, l, c); -} - -// Build an assignment to a variable. - -static tree_expression * -make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, - tree_expression *rhs) -{ - tree_expression *retval = 0; - - octave_value::assign_op t = octave_value::unknown_assign_op; - - switch (op) - { - case '=': - t = octave_value::op_asn_eq; - break; - - case ADD_EQ: - t = octave_value::op_add_eq; - break; - - case SUB_EQ: - t = octave_value::op_sub_eq; - break; - - case MUL_EQ: - t = octave_value::op_mul_eq; - break; - - case DIV_EQ: - t = octave_value::op_div_eq; - break; - - case LEFTDIV_EQ: - t = octave_value::op_ldiv_eq; - break; - - case POW_EQ: - t = octave_value::op_pow_eq; - break; - - case LSHIFT_EQ: - t = octave_value::op_lshift_eq; - break; - - case RSHIFT_EQ: - t = octave_value::op_rshift_eq; - break; - - case EMUL_EQ: - t = octave_value::op_el_mul_eq; - break; - - case EDIV_EQ: - t = octave_value::op_el_div_eq; - break; - - case ELEFTDIV_EQ: - t = octave_value::op_el_ldiv_eq; - break; - - case EPOW_EQ: - t = octave_value::op_el_pow_eq; - break; - - case AND_EQ: - t = octave_value::op_el_and_eq; - break; - - case OR_EQ: - t = octave_value::op_el_or_eq; - break; - - default: - panic_impossible (); - break; - } - - int l = eq_tok->line (); - int c = eq_tok->column (); - - if (lhs->is_simple_assign_lhs ()) - { - tree_expression *tmp = lhs->remove_front (); - - retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); - - delete lhs; - } - else if (t == octave_value::op_asn_eq) - return new tree_multi_assignment (lhs, rhs, false, l, c); - else - yyerror ("computed multiple assignment not allowed"); - - return retval; -} - -// Define a script. - -static void -make_script (tree_statement_list *cmds, tree_statement *end_script) -{ - std::string doc_string; - - if (! help_buf.empty ()) - { - doc_string = help_buf.top (); - help_buf.pop (); - } - - if (! cmds) - cmds = new tree_statement_list (); - - cmds->append (end_script); - - octave_user_script *script - = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, - cmds, doc_string); - - octave_time now; - - script->stash_fcn_file_time (now); - - primary_fcn_ptr = script; - - // Unmark any symbols that may have been tagged as local variables - // while parsing (for example, by force_local_variable in lex.l). - - symbol_table::unmark_forced_variables (); -} - -// Begin defining a function. - -static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body, - tree_statement *end_fcn_stmt) -{ - // We'll fill in the return list later. - - if (! body) - body = new tree_statement_list (); - - body->append (end_fcn_stmt); - - octave_user_function *fcn - = new octave_user_function (symbol_table::current_scope (), - param_list, 0, body); - - if (fcn) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - fcn->stash_trailing_comment (tc); - } - - return fcn; -} - -static tree_statement * -make_end (const std::string& type, int l, int c) -{ - return make_statement (new tree_no_op_command (type, l, c)); -} - -// Do most of the work for defining a function. - -static octave_user_function * -frob_function (const std::string& fname, octave_user_function *fcn) -{ - std::string id_name = fname; - - // If input is coming from a file, issue a warning if the name of - // the file does not match the name of the function stated in the - // file. Matlab doesn't provide a diagnostic (it ignores the stated - // name). - if (! autoloading && reading_fcn_file - && current_function_depth == 1 && ! parsing_subfunctions) - { - // FIXME -- should curr_fcn_file_name already be - // preprocessed when we get here? It seems to only be a - // problem with relative file names. - - std::string nm = curr_fcn_file_name; - - size_t pos = nm.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - nm = curr_fcn_file_name.substr (pos+1); - - if (nm != id_name) - { - warning_with_id - ("Octave:function-name-clash", - "function name `%s' does not agree with function file name `%s'", - id_name.c_str (), curr_fcn_file_full_name.c_str ()); - - id_name = nm; - } - } - - if (reading_fcn_file || reading_classdef_file || autoloading) - { - octave_time now; - - fcn->stash_fcn_file_name (curr_fcn_file_full_name); - fcn->stash_fcn_file_time (now); - fcn->mark_as_system_fcn_file (); - - if (fcn_file_from_relative_lookup) - fcn->mark_relative (); - - if (current_function_depth > 1 || parsing_subfunctions) - { - fcn->stash_parent_fcn_name (curr_fcn_file_name); - - if (current_function_depth > 1) - fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); - else - fcn->stash_parent_fcn_scope (primary_fcn_scope); - } - - if (lexer_flags.parsing_class_method) - { - if (current_class_name == id_name) - fcn->mark_as_class_constructor (); - else - fcn->mark_as_class_method (); - - fcn->stash_dispatch_class (current_class_name); - } - - std::string nm = fcn->fcn_file_name (); - - file_stat fs (nm); - - if (fs && fs.is_newer (now)) - warning_with_id ("Octave:future-time-stamp", - "time stamp for `%s' is in the future", nm.c_str ()); - } - else if (! (input_from_tmp_history_file || input_from_startup_file) - && reading_script_file - && curr_fcn_file_name == id_name) - { - warning ("function `%s' defined within script file `%s'", - id_name.c_str (), curr_fcn_file_full_name.c_str ()); - } - - fcn->stash_function_name (id_name); - fcn->stash_fcn_location (input_line_number, current_input_column); - - if (! help_buf.empty () && current_function_depth == 1 - && ! parsing_subfunctions) - { - fcn->document (help_buf.top ()); - - help_buf.pop (); - } - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - primary_fcn_ptr = fcn; - - return fcn; -} - -static tree_function_def * -finish_function (tree_parameter_list *ret_list, - octave_user_function *fcn, octave_comment_list *lc) -{ - tree_function_def *retval = 0; - - if (ret_list) - ret_list->mark_as_formal_parameters (); - - if (fcn) - { - std::string nm = fcn->name (); - std::string file = fcn->fcn_file_name (); - - std::string tmp = nm; - if (! file.empty ()) - tmp += ": " + file; - - symbol_table::cache_name (fcn->scope (), tmp); - - if (lc) - fcn->stash_leading_comment (lc); - - fcn->define_ret_list (ret_list); - - if (current_function_depth > 1 || parsing_subfunctions) - { - fcn->mark_as_subfunction (); - - if (endfunction_found && function_scopes.size () > 1) - { - symbol_table::scope_id pscope - = function_scopes[function_scopes.size ()-2]; - - symbol_table::install_nestfunction (nm, octave_value (fcn), - pscope); - } - else - symbol_table::install_subfunction (nm, octave_value (fcn), - primary_fcn_scope); - } - - if (current_function_depth == 1 && fcn) - symbol_table::update_nest (fcn->scope ()); - - if (! reading_fcn_file && current_function_depth == 1) - { - // We are either reading a script file or defining a function - // at the command line, so this definition creates a - // tree_function object that is placed in the parse tree. - // Otherwise, it is just inserted in the symbol table, - // either as a subfunction or nested function (see above), - // or as the primary function for the file, via - // primary_fcn_ptr (see also load_fcn_from_file,, - // parse_fcn_file, and - // symbol_table::fcn_info::fcn_info_rep::find_user_function). - - retval = new tree_function_def (fcn); - } - - // Unmark any symbols that may have been tagged as local - // variables while parsing (for example, by force_local_variable - // in lex.l). - - symbol_table::unmark_forced_variables (fcn->scope ()); - } - - return retval; -} - -static void -recover_from_parsing_function (void) -{ - if (parser_symtab_context.empty ()) - panic_impossible (); - - parser_symtab_context.pop (); - - if (reading_fcn_file && current_function_depth == 1 - && ! parsing_subfunctions) - parsing_subfunctions = true; - - current_function_depth--; - function_scopes.pop_back (); - - lexer_flags.defining_func--; - lexer_flags.parsed_function_name.pop (); - lexer_flags.looking_at_return_list = false; - lexer_flags.looking_at_parameter_list = false; -} - -// Make an index expression. - -static tree_index_expression * -make_index_expression (tree_expression *expr, tree_argument_list *args, - char type) -{ - tree_index_expression *retval = 0; - - if (args && args->has_magic_tilde ()) - { - yyerror ("invalid use of empty argument (~) in index expression"); - return retval; - } - - int l = expr->line (); - int c = expr->column (); - - expr->mark_postfix_indexed (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (args, type); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, args, l, c, type); - - return retval; -} - -// Make an indirect reference expression. - -static tree_index_expression * -make_indirect_ref (tree_expression *expr, const std::string& elt) -{ - tree_index_expression *retval = 0; - - int l = expr->line (); - int c = expr->column (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (elt); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, elt, l, c); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make an indirect reference expression with dynamic field name. - -static tree_index_expression * -make_indirect_ref (tree_expression *expr, tree_expression *elt) -{ - tree_index_expression *retval = 0; - - int l = expr->line (); - int c = expr->column (); - - if (expr->is_index_expression ()) - { - tree_index_expression *tmp = static_cast (expr); - - tmp->append (elt); - - retval = tmp; - } - else - retval = new tree_index_expression (expr, elt, l, c); - - lexer_flags.looking_at_indirect_ref = false; - - return retval; -} - -// Make a declaration command. - -static tree_decl_command * -make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst) -{ - tree_decl_command *retval = 0; - - int l = tok_val->line (); - int c = tok_val->column (); - - switch (tok) - { - case GLOBAL: - retval = new tree_global_command (lst, l, c); - break; - - case PERSISTENT: - if (current_function_depth > 0) - retval = new tree_persistent_command (lst, l, c); - else - { - if (reading_script_file) - warning ("ignoring persistent declaration near line %d of file `%s'", - l, curr_fcn_file_full_name.c_str ()); - else - warning ("ignoring persistent declaration near line %d", l); - } - break; - - default: - panic_impossible (); - break; - } - - return retval; -} - -static tree_argument_list * -validate_matrix_row (tree_argument_list *row) -{ - if (row && row->has_magic_tilde ()) - yyerror ("invalid use of tilde (~) in matrix expression"); - return row; -} - -// Finish building a matrix list. - -static tree_expression * -finish_matrix (tree_matrix *m) -{ - tree_expression *retval = m; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - if (m->all_elements_are_constant ()) - { - octave_value tmp = m->rvalue1 (); - - if (! (error_state || warning_state)) - { - tree_constant *tc_retval - = new tree_constant (tmp, m->line (), m->column ()); - - std::ostringstream buf; - - tree_print_code tpc (buf); - - m->accept (tpc); - - tc_retval->stash_original_text (buf.str ()); - - delete m; - - retval = tc_retval; - } - } - - return retval; -} - -// Finish building a cell list. - -static tree_expression * -finish_cell (tree_cell *c) -{ - return finish_matrix (c); -} - -static void -maybe_warn_missing_semi (tree_statement_list *t) -{ - if (current_function_depth > 0) - { - tree_statement *tmp = t->back (); - - if (tmp->is_expression ()) - warning_with_id - ("Octave:missing-semicolon", - "missing semicolon near line %d, column %d in file `%s'", - tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); - } -} - -static tree_statement_list * -set_stmt_print_flag (tree_statement_list *list, char sep, - bool warn_missing_semi) -{ - tree_statement *tmp = list->back (); - - switch (sep) - { - case ';': - tmp->set_print_flag (false); - break; - - case 0: - case ',': - case '\n': - tmp->set_print_flag (true); - if (warn_missing_semi) - maybe_warn_missing_semi (list); - break; - - default: - warning ("unrecognized separator type!"); - break; - } - - // Even if a statement is null, we add it to the list then remove it - // here so that the print flag is applied to the correct statement. - - if (tmp->is_null_statement ()) - { - list->pop_back (); - delete tmp; - } - - return list; -} - -static tree_statement_list * -make_statement_list (tree_statement *stmt) -{ - return new tree_statement_list (stmt); -} - -static tree_statement_list * -append_statement_list (tree_statement_list *list, char sep, - tree_statement *stmt, bool warn_missing_semi) -{ - set_stmt_print_flag (list, sep, warn_missing_semi); - - list->append (stmt); - - return list; -} - -static tree_funcall * -make_superclass_ref (const std::string& method_nm, - const std::string& package_nm, - const std::string& class_nm, - int l, int c) -{ - octave_value_list args; - - args(2) = class_nm; - args(1) = package_nm; - args(0) = method_nm; - - octave_value fcn - = symbol_table::find_built_in_function ("__superclass_reference__"); - - return new tree_funcall (fcn, args); -} - -static tree_funcall * -make_meta_class_query (const std::string& package_nm, - const std::string& class_nm, - int l, int c) -{ - octave_value_list args; - - args(1) = class_nm; - args(0) = package_nm; - - octave_value fcn - = symbol_table::find_built_in_function ("__meta_class_query__"); - - return new tree_funcall (fcn, args); -} - -// A CLASSDEF block defines a class that has a constructor and other -// methods, but it is not an executable command. Parsing the block -// makes some changes in the symbol table (inserting the constructor -// and methods, and adding to the list of known objects) and creates -// a parse tree containing meta information about the class. - -static tree_classdef * -make_classdef (token *tok_val, tree_classdef_attribute_list *a, - tree_identifier *id, tree_classdef_superclass_list *sc, - tree_classdef_body *body, token *end_tok, - octave_comment_list *lc) -{ - tree_classdef *retval = 0; - - if (end_token_ok (end_tok, token::classdef_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = tok_val->line (); - int c = tok_val->column (); - - retval = new tree_classdef (a, id, sc, body, lc, tc, l, c); - } - - return retval; -} - -static tree_classdef_properties_block * -make_classdef_properties_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_property_list *plist, - token *end_tok, octave_comment_list *lc) -{ - tree_classdef_properties_block *retval = 0; - - if (end_token_ok (end_tok, token::properties_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = tok_val->line (); - int c = tok_val->column (); - - retval = new tree_classdef_properties_block (a, plist, lc, tc, l, c); - } - - return retval; -} - -static tree_classdef_methods_block * -make_classdef_methods_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_methods_list *mlist, - token *end_tok, octave_comment_list *lc) -{ - tree_classdef_methods_block *retval = 0; - - if (end_token_ok (end_tok, token::methods_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = tok_val->line (); - int c = tok_val->column (); - - retval = new tree_classdef_methods_block (a, mlist, lc, tc, l, c); - } - - return retval; -} - -static tree_classdef_events_block * -make_classdef_events_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_events_list *elist, - token *end_tok, octave_comment_list *lc) -{ - tree_classdef_events_block *retval = 0; - - if (end_token_ok (end_tok, token::events_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = tok_val->line (); - int c = tok_val->column (); - - retval = new tree_classdef_events_block (a, elist, lc, tc, l, c); - } - - return retval; -} - -static tree_classdef_enum_block * -make_classdef_enum_block (token *tok_val, - tree_classdef_attribute_list *a, - tree_classdef_enum_list *elist, - token *end_tok, octave_comment_list *lc) -{ - tree_classdef_enum_block *retval = 0; - - if (end_token_ok (end_tok, token::enumeration_end)) - { - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - int l = tok_val->line (); - int c = tok_val->column (); - - retval = new tree_classdef_enum_block (a, elist, lc, tc, l, c); - } - - return retval; -} - -static void -safe_fclose (FILE *f) -{ - // FIXME -- comments at the end of an input file are - // discarded (otherwise, they would be appended to the next - // statement, possibly from the command line or another file, which - // can be quite confusing). - - octave_comment_list *tc = octave_comment_buffer::get_comment (); - - delete tc; - - if (f) - fclose (static_cast (f)); -} - -static bool -looks_like_copyright (const std::string& s) -{ - bool retval = false; - - if (! s.empty ()) - { - size_t offset = s.find_first_not_of (" \t"); - - retval = (s.substr (offset, 9) == "Copyright" || s.substr (offset, 6) == "Author"); - } - - return retval; -} - -static int -text_getc (FILE *f) -{ - int c = gnulib::getc (f); - - // Convert CRLF into just LF and single CR into LF. - - if (c == '\r') - { - c = gnulib::getc (f); - - if (c != '\n') - { - ungetc (c, f); - c = '\n'; - } - } - - if (c == '\n') - input_line_number++; - - return c; -} - -class -stdio_stream_reader : public stream_reader -{ -public: - stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } - - int getc (void) { return ::text_getc (f); } - int ungetc (int c) - { - if (c == '\n') - input_line_number--; - - return ::ungetc (c, f); - } - -private: - FILE *f; - - // No copying! - - stdio_stream_reader (const stdio_stream_reader&); - - stdio_stream_reader & operator = (const stdio_stream_reader&); -}; - -static bool -skip_white_space (stream_reader& reader) -{ - int c = 0; - - while ((c = reader.getc ()) != EOF) - { - switch (c) - { - case ' ': - case '\t': - current_input_column++; - break; - - case '\n': - current_input_column = 1; - break; - - default: - reader.ungetc (c); - goto done; - } - } - - done: - - return (c == EOF); -} - -static bool -looking_at_classdef_keyword (FILE *ffile) -{ - bool status = false; - - long pos = gnulib::ftell (ffile); - - char buf [10]; - gnulib::fgets (buf, 10, ffile); - size_t len = strlen (buf); - if (len > 8 && strncmp (buf, "classdef", 8) == 0 - && ! (isalnum (buf[8]) || buf[8] == '_')) - status = true; - - gnulib::fseek (ffile, pos, SEEK_SET); - - return status; - } - -static std::string -gobble_leading_white_space (FILE *ffile, bool& eof) -{ - std::string help_txt; - - eof = false; - - // TRUE means we have already cached the help text. - bool have_help_text = false; - - std::string txt; - - stdio_stream_reader stdio_reader (ffile); - - while (true) - { - eof = skip_white_space (stdio_reader); - - if (eof) - break; - - txt = grab_comment_block (stdio_reader, true, eof); - - if (txt.empty ()) - break; - - if (! (have_help_text || looks_like_copyright (txt))) - { - help_txt = txt; - have_help_text = true; - } - - octave_comment_buffer::append (txt); - - if (eof) - break; - } - - return help_txt; -} - -static bool -looking_at_function_keyword (FILE *ffile) -{ - bool status = false; - - long pos = gnulib::ftell (ffile); - - char buf [10]; - gnulib::fgets (buf, 10, ffile); - size_t len = strlen (buf); - if (len > 8 && strncmp (buf, "function", 8) == 0 - && ! (isalnum (buf[8]) || buf[8] == '_')) - status = true; - - gnulib::fseek (ffile, pos, SEEK_SET); - - return status; -} - -static octave_function * -parse_fcn_file (const std::string& ff, const std::string& dispatch_type, - bool force_script = false, bool require_file = true, - const std::string& warn_for = std::string ()) -{ - unwind_protect frame; - - octave_function *fcn_ptr = 0; - - // Open function file and parse. - - FILE *in_stream = command_editor::get_input_stream (); - - frame.add_fcn (command_editor::set_input_stream, in_stream); - - frame.protect_var (ff_instream); - - frame.protect_var (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (reading_fcn_file); - frame.protect_var (line_editing); - frame.protect_var (current_class_name); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - - input_line_number = 1; - current_input_column = 1; - reading_fcn_file = true; - line_editing = false; - current_class_name = dispatch_type; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = false; - - frame.add_fcn (command_history::ignore_entries, - command_history::ignoring_entries ()); - - command_history::ignore_entries (); - - FILE *ffile = get_input_from_file (ff, 0); - - frame.add_fcn (safe_fclose, ffile); - - if (ffile) - { - bool eof; - - std::string help_txt = gobble_leading_white_space (ffile, eof); - - if (! help_txt.empty ()) - help_buf.push (help_txt); - - if (! eof) - { - std::string file_type; - - frame.protect_var (get_input_from_eval_string); - frame.protect_var (parser_end_of_input); - frame.protect_var (reading_fcn_file); - frame.protect_var (reading_script_file); - frame.protect_var (reading_classdef_file); - frame.protect_var (Vecho_executing_commands); - - - get_input_from_eval_string = false; - parser_end_of_input = false; - - if (! force_script && looking_at_function_keyword (ffile)) - { - file_type = "function"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = false; - reading_fcn_file = true; - reading_script_file = false; - } - else if (! force_script && looking_at_classdef_keyword (ffile)) - { - file_type = "classdef"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = true; - reading_fcn_file = false; - reading_script_file = false; - } - else - { - file_type = "script"; - - Vecho_executing_commands = ECHO_OFF; - - reading_classdef_file = false; - reading_fcn_file = false; - reading_script_file = true; - } - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (ffile); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - frame.protect_var (primary_fcn_ptr); - primary_fcn_ptr = 0; - - frame.protect_var (classdef_object); - classdef_object = 0; - - reset_parser (); - - // Do this with an unwind-protect cleanup function so that - // the forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - if (! help_txt.empty ()) - help_buf.push (help_txt); - - if (reading_script_file) - prep_lexer_for_script_file (); - else if (reading_classdef_file) - prep_lexer_for_classdef_file (); - else - prep_lexer_for_function_file (); - - lexer_flags.parsing_class_method = ! dispatch_type.empty (); - - frame.protect_var (global_command); - - global_command = 0; - - int status = yyparse (); - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - frame.add_fcn (cleanup_statement_list, &global_command); - - fcn_ptr = primary_fcn_ptr; - - if (status == 0) - { - if (reading_classdef_file && classdef_object) - { - // Convert parse tree for classdef object to - // meta.class info (and stash it in the symbol - // table?). Return pointer to constructor? - - octave_value meta_class = classdef_object->make_meta_class (); - } - } - else - { - error ("parse error while reading %s file %s", - file_type.c_str(), ff.c_str ()); - } - } - else - { - tree_statement *end_of_script - = make_end ("endscript", input_line_number, current_input_column); - - make_script (0, end_of_script); - - fcn_ptr = primary_fcn_ptr; - } - } - else if (require_file) - error ("no such file, `%s'", ff.c_str ()); - else if (! warn_for.empty ()) - error ("%s: unable to open file `%s'", warn_for.c_str (), ff.c_str ()); - - return fcn_ptr; -} - -std::string -get_help_from_file (const std::string& nm, bool& symbol_found, - std::string& file) -{ - std::string retval; - - file = fcn_file_in_path (nm); - - if (! file.empty ()) - { - symbol_found = true; - - FILE *fptr = gnulib::fopen (file.c_str (), "r"); - - if (fptr) - { - unwind_protect frame; - frame.add_fcn (safe_fclose, fptr); - - bool eof; - retval = gobble_leading_white_space (fptr, eof); - - if (retval.empty ()) - { - octave_function *fcn = parse_fcn_file (file, ""); - - if (fcn) - { - retval = fcn->doc_string (); - - delete fcn; - } - } - } - } - - return retval; -} - -std::string -get_help_from_file (const std::string& nm, bool& symbol_found) -{ - std::string file; - return get_help_from_file (nm, symbol_found, file); -} - -std::string -lookup_autoload (const std::string& nm) -{ - std::string retval; - - typedef std::map::const_iterator am_iter; - - am_iter p = autoload_map.find (nm); - - if (p != autoload_map.end ()) - retval = load_path::find_file (p->second); - - return retval; -} - -string_vector -autoloaded_functions (void) -{ - string_vector names (autoload_map.size ()); - - octave_idx_type i = 0; - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - names[i++] = p->first; - - return names; -} - -string_vector -reverse_lookup_autoload (const std::string& nm) -{ - string_vector names; - - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - if (nm == p->second) - names.append (p->first); - - return names; -} - -octave_function * -load_fcn_from_file (const std::string& file_name, const std::string& dir_name, - const std::string& dispatch_type, - const std::string& fcn_name, bool autoload) -{ - octave_function *retval = 0; - - unwind_protect frame; - - std::string nm = file_name; - - size_t nm_len = nm.length (); - - std::string file; - - frame.protect_var (fcn_file_from_relative_lookup); - - fcn_file_from_relative_lookup = false; - - file = nm; - - if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") - || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") - || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) - { - nm = octave_env::base_pathname (file); - nm = nm.substr (0, nm.find_last_of ('.')); - - size_t pos = nm.find_last_of (file_ops::dir_sep_str ()); - if (pos != std::string::npos) - nm = nm.substr (pos+1); - } - - if (autoload) - { - frame.protect_var (autoloading); - autoloading = true; - } - - fcn_file_from_relative_lookup = ! octave_env::absolute_pathname (file); - - file = octave_env::make_absolute (file); - - int len = file.length (); - - if (len > 4 && file.substr (len-4, len-1) == ".oct") - { - if (autoload && ! fcn_name.empty ()) - nm = fcn_name; - - retval = octave_dynamic_loader::load_oct (nm, file, fcn_file_from_relative_lookup); - } - else if (len > 4 && file.substr (len-4, len-1) == ".mex") - { - // Temporarily load m-file version of mex-file, if it exists, - // to get the help-string to use. - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = nm; - curr_fcn_file_full_name = file.substr (0, len - 2); - - octave_function *tmpfcn = parse_fcn_file (file.substr (0, len - 2), - dispatch_type, autoloading, - false); - - retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_relative_lookup); - - if (tmpfcn) - retval->document (tmpfcn->doc_string ()); - delete tmpfcn; - } - else if (len > 2) - { - // These are needed by yyparse. - - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = nm; - curr_fcn_file_full_name = file; - - retval = parse_fcn_file (file, dispatch_type, autoloading); - } - - if (retval) - { - retval->stash_dir_name (dir_name); - - if (retval->is_user_function ()) - { - symbol_table::scope_id id = retval->scope (); - - symbol_table::stash_dir_name_for_subfunctions (id, dir_name); - } - } - - return retval; -} - -DEFUN (autoload, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ -Define @var{function} to autoload from @var{file}.\n\ -\n\ -The second argument, @var{file}, should be an absolute file name or\n\ -a file name in the same directory as the function or script from which\n\ -the autoload command was run. @var{file} should not depend on the\n\ -Octave load path.\n\ -\n\ -Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ -are evaluated when a directory is added to the Octave's load path. To\n\ -avoid having to hardcode directory names in @var{file}, if @var{file}\n\ -is in the same directory as the PKG_ADD script then\n\ -\n\ -@example\n\ -autoload (\"foo\", \"bar.oct\");\n\ -@end example\n\ -\n\ -@noindent\n\ -will load the function @code{foo} from the file @code{bar.oct}. The above\n\ -when @code{bar.oct} is not in the same directory or uses like\n\ -\n\ -@example\n\ -autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ -@end example\n\ -\n\ -@noindent\n\ -are strongly discouraged, as their behavior might be unpredictable.\n\ -\n\ -With no arguments, return a structure containing the current autoload map.\n\ -@seealso{PKG_ADD}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - { - Cell func_names (dim_vector (autoload_map.size (), 1)); - Cell file_names (dim_vector (autoload_map.size (), 1)); - - octave_idx_type i = 0; - typedef std::map::const_iterator am_iter; - for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) - { - func_names(i) = p->first; - file_names(i) = p->second; - - i++; - } - - octave_map m; - - m.assign ("function", func_names); - m.assign ("file", file_names); - - retval = m; - } - else if (nargin == 2) - { - string_vector argv = args.make_argv ("autoload"); - - if (! error_state) - { - std::string nm = argv[2]; - - if (! octave_env::absolute_pathname (nm)) - { - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - bool found = false; - - if (fcn) - { - std::string fname = fcn->fcn_file_name (); - - if (! fname.empty ()) - { - fname = octave_env::make_absolute (fname); - fname = fname.substr (0, fname.find_last_of (file_ops::dir_sep_str ()) + 1); - - file_stat fs (fname + nm); - - if (fs.exists ()) - { - nm = fname + nm; - found = true; - } - } - } - if (! found) - warning_with_id ("Octave:autoload-relative-file-name", - "autoload: `%s' is not an absolute file name", - nm.c_str ()); - } - autoload_map[argv[1]] = nm; - } - } - else - print_usage (); - - return retval; -} - -void -source_file (const std::string& file_name, const std::string& context, - bool verbose, bool require_file, const std::string& warn_for) -{ - // Map from absolute name of script file to recursion level. We - // use a map instead of simply placing a limit on recursion in the - // source_file function so that two mutually recursive scripts - // written as - // - // foo1.m: - // ------ - // foo2 - // - // foo2.m: - // ------ - // foo1 - // - // and called with - // - // foo1 - // - // (for example) will behave the same if they are written as - // - // foo1.m: - // ------ - // source ("foo2.m") - // - // foo2.m: - // ------ - // source ("foo1.m") - // - // and called with - // - // source ("foo1.m") - // - // (for example). - - static std::map source_call_depth; - - std::string file_full_name = file_ops::tilde_expand (file_name); - - file_full_name = octave_env::make_absolute (file_full_name); - - unwind_protect frame; - - frame.protect_var (curr_fcn_file_name); - frame.protect_var (curr_fcn_file_full_name); - - curr_fcn_file_name = file_name; - curr_fcn_file_full_name = file_full_name; - - if (source_call_depth.find (file_full_name) == source_call_depth.end ()) - source_call_depth[file_full_name] = -1; - - frame.protect_var (source_call_depth[file_full_name]); - - source_call_depth[file_full_name]++; - - if (source_call_depth[file_full_name] >= Vmax_recursion_depth) - { - error ("max_recursion_depth exceeded"); - return; - } - - if (! context.empty ()) - { - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("source: context must be \"caller\" or \"base\""); - - if (! error_state) - frame.add_fcn (octave_call_stack::pop); - } - - if (! error_state) - { - octave_function *fcn = parse_fcn_file (file_full_name, "", true, - require_file, warn_for); - - if (! error_state) - { - if (fcn && fcn->is_user_script ()) - { - octave_value_list args; - - if (verbose) - { - std::cout << "executing commands from " << file_full_name << " ... "; - reading_startup_message_printed = true; - std::cout.flush (); - } - - fcn->do_multi_index_op (0, args); - - if (verbose) - std::cout << "done." << std::endl; - - delete fcn; - } - } - else - error ("source: error sourcing file `%s'", - file_full_name.c_str ()); - } -} - -DEFUN (mfilename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mfilename ()\n\ -@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ -@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ -Return the name of the currently executing file. At the top-level,\n\ -return the empty string. Given the argument @code{\"fullpath\"},\n\ -include the directory part of the file name, but not the extension.\n\ -Given the argument @code{\"fullpathext\"}, include the directory part\n\ -of the file name and the extension.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 1) - { - print_usage (); - return retval; - } - - std::string arg; - - if (nargin == 1) - { - arg = args(0).string_value (); - - if (error_state) - { - error ("mfilename: expecting argument to be a character string"); - return retval; - } - } - - std::string fname; - - octave_user_code *fcn = octave_call_stack::caller_user_code (); - - if (fcn) - { - fname = fcn->fcn_file_name (); - - if (fname.empty ()) - fname = fcn->name (); - } - - if (arg == "fullpathext") - retval = fname; - else - { - size_t dpos = fname.rfind (file_ops::dir_sep_char ()); - size_t epos = fname.rfind ('.'); - - if (epos <= dpos) - epos = std::string::npos; - - fname = (epos != std::string::npos) ? fname.substr (0, epos) : fname; - - if (arg == "fullpath") - retval = fname; - else - retval = (dpos != std::string::npos) ? fname.substr (dpos+1) : fname; - } - - return retval; -} - - -DEFUN (source, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} source (@var{file})\n\ -Parse and execute the contents of @var{file}. This is equivalent to\n\ -executing commands from a script file, but without requiring the file to\n\ -be named @file{@var{file}.m}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string file_name = args(0).string_value (); - - if (! error_state) - { - std::string context; - - if (nargin == 2) - context = args(1).string_value (); - - if (! error_state) - source_file (file_name, context); - else - error ("source: expecting context to be character string"); - } - else - error ("source: expecting file name as argument"); - } - else - print_usage (); - - return retval; -} - -// Evaluate an Octave function (built-in or interpreted) and return -// the list of result values. NAME is the name of the function to -// call. ARGS are the arguments to the function. NARGOUT is the -// number of output arguments expected. - -octave_value_list -feval (const std::string& name, const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - octave_value fcn = symbol_table::find_function (name, args); - - if (fcn.is_defined ()) - retval = fcn.do_multi_index_op (nargout, args); - else - { - maybe_missing_function_hook (name); - if (! error_state) - error ("feval: function `%s' not found", name.c_str ()); - } - - return retval; -} - -octave_value_list -feval (octave_function *fcn, const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - if (fcn) - retval = fcn->do_multi_index_op (nargout, args); - - return retval; -} - -static octave_value_list -get_feval_args (const octave_value_list& args) -{ - return args.slice (1, args.length () - 1, true); -} - - -// Evaluate an Octave function (built-in or interpreted) and return -// the list of result values. The first element of ARGS should be a -// string containing the name of the function to call, then the rest -// are the actual arguments to the function. NARGOUT is the number of -// output arguments expected. - -octave_value_list -feval (const octave_value_list& args, int nargout) -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - octave_value f_arg = args(0); - - if (f_arg.is_string ()) - { - std::string name = f_arg.string_value (); - - if (! error_state) - { - octave_value_list tmp_args = get_feval_args (args); - - retval = feval (name, tmp_args, nargout); - } - } - else if (f_arg.is_function_handle () - || f_arg.is_anonymous_function () - || f_arg.is_inline_function ()) - { - const octave_value_list tmp_args = get_feval_args (args); - - retval = f_arg.do_multi_index_op (nargout, tmp_args); - } - else - error ("feval: first argument must be a string, inline function or a function handle"); - } - - return retval; -} - -DEFUN (feval, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ -Evaluate the function named @var{name}. Any arguments after the first\n\ -are passed on to the named function. For example,\n\ -\n\ -@example\n\ -@group\n\ -feval (\"acos\", -1)\n\ - @result{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -calls the function @code{acos} with the argument @samp{-1}.\n\ -\n\ -The function @code{feval} can also be used with function handles of\n\ -any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ -the only way to call user-supplied functions in strings, but\n\ -function handles are now preferred due to the cleaner syntax they\n\ -offer. For example,\n\ -\n\ -@example\n\ -@group\n\ -@var{f} = @@exp;\n\ -feval (@var{f}, 1)\n\ - @result{} 2.7183\n\ -@var{f} (1)\n\ - @result{} 2.7183\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -are equivalent ways to call the function referred to by @var{f}. If it\n\ -cannot be predicted beforehand that @var{f} is a function handle or the\n\ -function name in a string, @code{feval} can be used instead.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - retval = feval (args, nargout); - else - print_usage (); - - return retval; -} - -DEFUN (builtin, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ -Call the base function @var{f} even if @var{f} is overloaded to\n\ -another function for the given type signature.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - const std::string name (args(0).string_value ()); - - if (! error_state) - { - octave_value fcn = symbol_table::builtin_find (name); - - if (fcn.is_defined ()) - retval = feval (fcn.function_value (), args.splice (0, 1), - nargout); - else - error ("builtin: lookup for symbol `%s' failed", name.c_str ()); - } - else - error ("builtin: function name (F) must be a string"); - } - else - print_usage (); - - return retval; -} - -octave_value_list -eval_string (const std::string& s, bool silent, int& parse_status, int nargout) -{ - octave_value_list retval; - - unwind_protect frame; - - frame.protect_var (input_line_number); - frame.protect_var (current_input_column); - frame.protect_var (get_input_from_eval_string); - frame.protect_var (input_from_eval_string_pending); - frame.protect_var (parser_end_of_input); - frame.protect_var (line_editing); - frame.protect_var (current_eval_string); - frame.protect_var (current_function_depth); - frame.protect_var (function_scopes); - frame.protect_var (max_function_depth); - frame.protect_var (parsing_subfunctions); - frame.protect_var (endfunction_found); - frame.protect_var (reading_fcn_file); - frame.protect_var (reading_script_file); - frame.protect_var (reading_classdef_file); - - input_line_number = 1; - current_input_column = 1; - get_input_from_eval_string = true; - input_from_eval_string_pending = true; - parser_end_of_input = false; - line_editing = false; - current_function_depth = 0; - function_scopes.clear (); - max_function_depth = 0; - parsing_subfunctions = false; - endfunction_found = false; - reading_fcn_file = false; - reading_script_file = false; - reading_classdef_file = false; - - current_eval_string = s; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (0); - - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); - - switch_to_buffer (new_buf); - - do - { - reset_parser (); - - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - parse_status = yyparse (); - - tree_statement_list *command_list = global_command; - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - if (parse_status == 0) - { - if (command_list) - { - unwind_protect inner_frame; - - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of an - // interrupt. - - inner_frame.add_fcn (cleanup_statement_list, &command_list); - - tree_statement *stmt = 0; - - if (command_list->length () == 1 - && (stmt = command_list->front ()) - && stmt->is_expression ()) - { - tree_expression *expr = stmt->expression (); - - if (silent) - expr->set_print_flag (false); - - bool do_bind_ans = false; - - if (expr->is_identifier ()) - { - tree_identifier *id - = dynamic_cast (expr); - - do_bind_ans = (! id->is_variable ()); - } - else - do_bind_ans = (! expr->is_assignment_expression ()); - - retval = expr->rvalue (nargout); - - if (do_bind_ans && ! (error_state || retval.empty ())) - bind_ans (retval(0), expr->print_result ()); - - if (nargout == 0) - retval = octave_value_list (); - } - else if (nargout == 0) - command_list->accept (*current_evaluator); - else - error ("eval: invalid use of statement list"); - - if (error_state - || tree_return_command::returning - || tree_break_command::breaking - || tree_continue_command::continuing) - break; - } - else if (parser_end_of_input) - break; - } - } - while (parse_status == 0); - - return retval; -} - -octave_value -eval_string (const std::string& s, bool silent, int& parse_status) -{ - octave_value retval; - - octave_value_list tmp = eval_string (s, silent, parse_status, 1); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; -} - -static octave_value_list -eval_string (const octave_value& arg, bool silent, int& parse_status, - int nargout) -{ - std::string s = arg.string_value (); - - if (error_state) - { - error ("eval: expecting std::string argument"); - return octave_value (-1); - } - - return eval_string (s, silent, parse_status, nargout); -} - -void -cleanup_statement_list (tree_statement_list **lst) -{ - if (*lst) - { - delete *lst; - *lst = 0; - } -} - -DEFUN (eval, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} eval (@var{try})\n\ -@deftypefnx {Built-in Function} {} eval (@var{try}, @var{catch})\n\ -Parse the string @var{try} and evaluate it as if it were an Octave\n\ -program. If that fails, evaluate the optional string @var{catch}.\n\ -The string @var{try} is evaluated in the current context,\n\ -so any results remain available after @code{eval} returns.\n\ -\n\ -The following example makes the variable @var{a} with the approximate\n\ -value 3.1416 available.\n\ -\n\ -@example\n\ -eval (\"a = acos(-1);\");\n\ -@end example\n\ -\n\ -If an error occurs during the evaluation of @var{try} the @var{catch}\n\ -string is evaluated, as the following example shows:\n\ -\n\ -@example\n\ -@group\n\ -eval ('error (\"This is a bad example\");',\n\ - 'printf (\"This error occurred:\\n%s\\n\", lasterr ());');\n\ - @print{} This error occurred:\n\ - This is a bad example\n\ -@end group\n\ -@end example\n\ -\n\ -Consider using try/catch blocks instead if you are only using @code{eval}\n\ -as an error-capturing mechanism rather than for the execution of arbitrary\n\ -code strings.\n\ -@seealso{evalin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 0) - { - unwind_protect frame; - - if (nargin > 1) - { - frame.protect_var (buffer_error_messages); - buffer_error_messages++; - } - - int parse_status = 0; - - octave_value_list tmp = eval_string (args(0), nargout > 0, - parse_status, nargout); - - if (nargin > 1 && (parse_status != 0 || error_state)) - { - error_state = 0; - - // Set up for letting the user print any messages from - // errors that occurred in the first part of this eval(). - - buffer_error_messages--; - - tmp = eval_string (args(1), nargout > 0, parse_status, nargout); - - if (nargout > 0) - retval = tmp; - } - else if (nargout > 0) - retval = tmp; - } - else - print_usage (); - - return retval; -} - -/* - -%!shared x -%! x = 1; - -%!assert (eval ("x"), 1) -%!assert (eval ("x;")) -%!assert (eval ("x;"), 1); - -%!test -%! y = eval ("x"); -%! assert (y, 1); - -%!test -%! y = eval ("x;"); -%! assert (y, 1); - -%!test -%! eval ("x = 1;") -%! assert (x,1); - -%!test -%! eval ("flipud = 2;"); -%! assert (flipud, 2); - -%!function y = __f () -%! eval ("flipud = 2;"); -%! y = flipud; -%!endfunction -%!assert (__f(), 2) - -% bug #35645 -%!test -%! [a,] = gcd (1,2); -%! [a,b,] = gcd (1, 2); - -*/ - -DEFUN (assignin, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ -Assign @var{value} to @var{varname} in context @var{context}, which\n\ -may be either @code{\"base\"} or @code{\"caller\"}.\n\ -@seealso{evalin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 3) - { - std::string context = args(0).string_value (); - - if (! error_state) - { - unwind_protect frame; - - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("assignin: CONTEXT must be \"caller\" or \"base\""); - - if (! error_state) - { - frame.add_fcn (octave_call_stack::pop); - - std::string nm = args(1).string_value (); - - if (! error_state) - { - if (valid_identifier (nm)) - symbol_table::varref (nm) = args(2); - else - error ("assignin: invalid variable name in argument VARNAME"); - } - else - error ("assignin: VARNAME must be a string"); - } - } - else - error ("assignin: CONTEXT must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (evalin, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} evalin (@var{context}, @var{try})\n\ -@deftypefnx {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ -Like @code{eval}, except that the expressions are evaluated in the\n\ -context @var{context}, which may be either @code{\"caller\"} or\n\ -@code{\"base\"}.\n\ -@seealso{eval, assignin}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin > 1) - { - std::string context = args(0).string_value (); - - if (! error_state) - { - unwind_protect frame; - - if (context == "caller") - octave_call_stack::goto_caller_frame (); - else if (context == "base") - octave_call_stack::goto_base_frame (); - else - error ("evalin: CONTEXT must be \"caller\" or \"base\""); - - if (! error_state) - { - frame.add_fcn (octave_call_stack::pop); - - if (nargin > 2) - { - frame.protect_var (buffer_error_messages); - buffer_error_messages++; - } - - int parse_status = 0; - - octave_value_list tmp = eval_string (args(1), nargout > 0, - parse_status, nargout); - - if (nargout > 0) - retval = tmp; - - if (nargin > 2 && (parse_status != 0 || error_state)) - { - error_state = 0; - - // Set up for letting the user print any messages from - // errors that occurred in the first part of this eval(). - - buffer_error_messages--; - - tmp = eval_string (args(2), nargout > 0, - parse_status, nargout); - - retval = (nargout > 0) ? tmp : octave_value_list (); - } - } - } - else - error ("evalin: CONTEXT must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (__parser_debug_flag__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{old_val} =} __parser_debug_flag__ (@var{new_val}))\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - bool debug_flag = octave_debug; - - retval = set_internal_variable (debug_flag, args, nargout, - "__parser_debug_flag__"); - - octave_debug = debug_flag; - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/pager.cc --- a/src/pager.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,715 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include "cmd-edit.h" -#include "oct-env.h" -#include "singleton-cleanup.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "oct-obj.h" -#include "pager.h" -#include "procstream.h" -#include "sighandlers.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Our actual connection to the external pager. -static oprocstream *external_pager = 0; - -// TRUE means we write to the diary file. -static bool write_to_diary_file = false; - -// The name of the current diary file. -static std::string diary_file; - -// The diary file. -static std::ofstream external_diary_file; - -static std::string -default_pager (void) -{ - std::string pager_binary = octave_env::getenv ("PAGER"); - -#ifdef OCTAVE_DEFAULT_PAGER - if (pager_binary.empty ()) - pager_binary = OCTAVE_DEFAULT_PAGER; -#endif - - return pager_binary; -} - -// The shell command to run as the pager. -static std::string VPAGER = default_pager (); - -// The options to pass to the pager. -static std::string VPAGER_FLAGS; - -// TRUE means that if output is going to the pager, it is sent as soon -// as it is available. Otherwise, it is buffered and only sent to the -// pager when it is time to print another prompt. -static bool Vpage_output_immediately = false; - -// TRUE means all output intended for the screen should be passed -// through the pager. -static bool Vpage_screen_output = true; - -static bool really_flush_to_pager = false; - -static bool flushing_output_to_pager = false; - -static void -clear_external_pager (void) -{ - if (external_pager) - { - octave_child_list::remove (external_pager->pid ()); - - delete external_pager; - external_pager = 0; - } -} - -static bool -pager_event_handler (pid_t pid, int status) -{ - bool retval = false; - - if (pid > 0) - { - if (WIFEXITED (status) || WIFSIGNALLED (status)) - { - // Avoid warning() since that will put us back in the pager, - // which would be bad news. - - std::cerr << "warning: connection to external pager lost (pid = " - << pid << ")" << std::endl; - std::cerr << "warning: flushing pending output (please wait)" - << std::endl; - - // Request removal of this PID from the list of child - // processes. - - retval = true; - } - } - - return retval; -} - -static std::string -pager_command (void) -{ - std::string cmd = VPAGER; - - if (! (cmd.empty () || VPAGER_FLAGS.empty ())) - cmd += " " + VPAGER_FLAGS; - - return cmd; -} - -static void -do_sync (const char *msg, int len, bool bypass_pager) -{ - if (msg && len > 0) - { - if (bypass_pager) - { - std::cout.write (msg, len); - std::cout.flush (); - } - else - { - if (! external_pager) - { - std::string pgr = pager_command (); - - if (! pgr.empty ()) - { - external_pager = new oprocstream (pgr.c_str ()); - - if (external_pager) - octave_child_list::insert (external_pager->pid (), - pager_event_handler); - } - } - - if (external_pager) - { - if (external_pager->good ()) - { - external_pager->write (msg, len); - - external_pager->flush (); - -#if defined (EPIPE) - if (errno == EPIPE) - external_pager->setstate (std::ios::failbit); -#endif - } - else - { - // FIXME -- omething is not right with the - // pager. If it died then we should receive a - // signal for that. If there is some other problem, - // then what? - } - } - else - { - std::cout.write (msg, len); - std::cout.flush (); - } - } - } -} - -// Assume our terminal wraps long lines. - -static bool -more_than_a_screenful (const char *s, int len) -{ - if (s) - { - int available_rows = command_editor::terminal_rows () - 2; - - int cols = command_editor::terminal_cols (); - - int count = 0; - - int chars_this_line = 0; - - for (int i = 0; i < len; i++) - { - if (*s++ == '\n') - { - count += chars_this_line / cols + 1; - chars_this_line = 0; - } - else - chars_this_line++; - } - - if (count > available_rows) - return true; - } - - return false; -} - -int -octave_pager_buf::sync (void) -{ - if (! interactive - || really_flush_to_pager - || (Vpage_screen_output && Vpage_output_immediately) - || ! Vpage_screen_output) - { - char *buf = eback (); - - int len = pptr () - buf; - - bool bypass_pager = (! interactive - || ! Vpage_screen_output - || (really_flush_to_pager - && Vpage_screen_output - && ! Vpage_output_immediately - && ! more_than_a_screenful (buf, len))); - - if (len > 0) - { - do_sync (buf, len, bypass_pager); - - flush_current_contents_to_diary (); - - seekoff (0, std::ios::beg); - } - } - - return 0; -} - -void -octave_pager_buf::flush_current_contents_to_diary (void) -{ - char *buf = eback () + diary_skip; - - size_t len = pptr () - buf; - - octave_diary.write (buf, len); - - diary_skip = 0; -} - -void -octave_pager_buf::set_diary_skip (void) -{ - diary_skip = pptr () - eback (); -} - -int -octave_diary_buf::sync (void) -{ - if (write_to_diary_file && external_diary_file) - { - char *buf = eback (); - - int len = pptr () - buf; - - if (len > 0) - external_diary_file.write (buf, len); - } - - seekoff (0, std::ios::beg); - - return 0; -} - -octave_pager_stream *octave_pager_stream::instance = 0; - -octave_pager_stream::octave_pager_stream (void) : std::ostream (0), pb (0) -{ - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -octave_pager_stream::~octave_pager_stream (void) -{ - flush (); - delete pb; -} - -std::ostream& -octave_pager_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -void -octave_pager_stream::flush_current_contents_to_diary (void) -{ - if (instance_ok ()) - instance->do_flush_current_contents_to_diary (); -} - -void -octave_pager_stream::set_diary_skip (void) -{ - if (instance_ok ()) - instance->do_set_diary_skip (); -} - -// Reinitialize the pager buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_pager_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_pager_stream::do_flush_current_contents_to_diary (void) -{ - if (pb) - pb->flush_current_contents_to_diary (); -} - -void -octave_pager_stream::do_set_diary_skip (void) -{ - if (pb) - pb->set_diary_skip (); -} - -void -octave_pager_stream::do_reset (void) -{ - delete pb; - pb = new octave_pager_buf (); - rdbuf (pb); - setf (unitbuf); -} - -bool -octave_pager_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_pager_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create pager_stream object!"); - - retval = false; - } - - return retval; -} - -octave_diary_stream *octave_diary_stream::instance = 0; - -octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) -{ - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -octave_diary_stream::~octave_diary_stream (void) -{ - flush (); - delete db; -} - -std::ostream& -octave_diary_stream::stream (void) -{ - return instance_ok () ? *instance : std::cout; -} - -// Reinitialize the diary buffer to avoid hanging on to large internal -// buffers when they might not be needed. This function should only be -// called when the pager is not in use. For example, just before -// getting command-line input. - -void -octave_diary_stream::reset (void) -{ - if (instance_ok ()) - instance->do_reset (); -} - -void -octave_diary_stream::do_reset (void) -{ - delete db; - db = new octave_diary_buf (); - rdbuf (db); - setf (unitbuf); -} - -bool -octave_diary_stream::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_diary_stream (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create diary_stream object!"); - - retval = false; - } - - return retval; -} - -void -flush_octave_stdout (void) -{ - if (! flushing_output_to_pager) - { - unwind_protect frame; - - frame.protect_var (really_flush_to_pager); - frame.protect_var (flushing_output_to_pager); - - really_flush_to_pager = true; - flushing_output_to_pager = true; - - octave_stdout.flush (); - - clear_external_pager (); - } -} - -static void -close_diary_file (void) -{ - // Try to flush the current buffer to the diary now, so that things - // like - // - // function foo () - // diary on; - // ... - // diary off; - // endfunction - // - // will do the right thing. - - octave_pager_stream::flush_current_contents_to_diary (); - - if (external_diary_file.is_open ()) - { - octave_diary.flush (); - external_diary_file.close (); - } -} - -static void -open_diary_file (void) -{ - close_diary_file (); - - // If there is pending output in the pager buf, it should not go - // into the diary file. - - octave_pager_stream::set_diary_skip (); - - external_diary_file.open (diary_file.c_str (), std::ios::app); - - if (! external_diary_file) - error ("diary: can't open diary file `%s'", diary_file.c_str ()); -} - -DEFUN (diary, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} diary options\n\ -Record a list of all commands @emph{and} the output they produce, mixed\n\ -together just as you see them on your terminal. Valid options are:\n\ -\n\ -@table @code\n\ -@item on\n\ -Start recording your session in a file called @file{diary} in your\n\ -current working directory.\n\ -\n\ -@item off\n\ -Stop recording your session in the diary file.\n\ -\n\ -@item @var{file}\n\ -Record your session in the file named @var{file}.\n\ -@end table\n\ -\n\ -With no arguments, @code{diary} toggles the current diary state.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("diary"); - - if (error_state) - return retval; - - if (diary_file.empty ()) - diary_file = "diary"; - - switch (argc) - { - case 1: - write_to_diary_file = ! write_to_diary_file; - open_diary_file (); - break; - - case 2: - { - std::string arg = argv[1]; - - if (arg == "on") - { - write_to_diary_file = true; - open_diary_file (); - } - else if (arg == "off") - { - close_diary_file (); - write_to_diary_file = false; - } - else - { - diary_file = arg; - write_to_diary_file = true; - open_diary_file (); - } - } - break; - - default: - print_usage (); - break; - } - - return retval; -} - -DEFUN (more, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} more\n\ -@deftypefnx {Command} {} more on\n\ -@deftypefnx {Command} {} more off\n\ -Turn output pagination on or off. Without an argument, @code{more}\n\ -toggles the current state.\n\ -The current state can be determined via @code{page_screen_output}.\n\ -@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("more"); - - if (error_state) - return retval; - - if (argc == 2) - { - std::string arg = argv[1]; - - if (arg == "on") - Vpage_screen_output = true; - else if (arg == "off") - Vpage_screen_output = false; - else - error ("more: unrecognized argument `%s'", arg.c_str ()); - } - else if (argc == 1) - Vpage_screen_output = ! Vpage_screen_output; - else - print_usage (); - - return retval; -} - -DEFUN (terminal_size, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} terminal_size ()\n\ -Return a two-element row vector containing the current size of the\n\ -terminal window in characters (rows and columns).\n\ -@seealso{list_in_columns}\n\ -@end deftypefn") -{ - RowVector size (2, 0.0); - - size(0) = command_editor::terminal_rows (); - size(1) = command_editor::terminal_cols (); - - return octave_value (size); -} - -DEFUN (page_output_immediately, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_output_immediately ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_output_immediately (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_output_immediately (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave sends\n\ -output to the pager as soon as it is available. Otherwise, Octave\n\ -buffers its output and waits until just before the prompt is printed to\n\ -flush it to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_output_immediately); -} - -DEFUN (page_screen_output, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} page_screen_output ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} page_screen_output (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} page_screen_output (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether output intended\n\ -for the terminal window that is longer than one page is sent through a\n\ -pager. This allows you to view one screenful at a time. Some pagers\n\ -(such as @code{less}---see @ref{Installation}) are also capable of moving\n\ -backward on the output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (page_screen_output); -} - -DEFUN (PAGER, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the program to use\n\ -to display terminal output on your system. The default value is\n\ -normally @code{\"less\"}, @code{\"more\"}, or\n\ -@code{\"pg\"}, depending on what programs are installed on your system.\n\ -@xref{Installation}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); -} - -DEFUN (PAGER_FLAGS, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} PAGER_FLAGS ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} PAGER_FLAGS (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} PAGER_FLAGS (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the options to pass\n\ -to the pager.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ -@end deftypefn") -{ - return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); -} diff -r 069c552587a0 -r 959953dba519 src/pager.h --- a/src/pager.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,150 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_pager_h) -#define octave_pager_h 1 - -#include -#include -#include - -#include - -class -OCTINTERP_API -octave_pager_buf : public std::stringbuf -{ -public: - - octave_pager_buf (void) : std::stringbuf (), diary_skip (0) { } - - void flush_current_contents_to_diary (void); - - void set_diary_skip (void); - -protected: - - int sync (void); - -private: - - size_t diary_skip; -}; - -class -OCTINTERP_API -octave_pager_stream : public std::ostream -{ -protected: - - octave_pager_stream (void); - -public: - - ~octave_pager_stream (void); - - static void flush_current_contents_to_diary (void); - - static void set_diary_skip (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_flush_current_contents_to_diary (void); - - void do_set_diary_skip (void); - - void do_reset (void); - - static octave_pager_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_pager_buf *pb; - - // No copying! - - octave_pager_stream (const octave_pager_stream&); - - octave_pager_stream& operator = (const octave_pager_stream&); -}; - -class -OCTINTERP_API -octave_diary_buf : public std::stringbuf -{ -public: - - octave_diary_buf (void) : std::stringbuf () { } - -protected: - - int sync (void); -}; - -class -OCTINTERP_API -octave_diary_stream : public std::ostream -{ -protected: - - octave_diary_stream (void); - -public: - - ~octave_diary_stream (void); - - static std::ostream& stream (void); - - static void reset (void); - -private: - - void do_reset (void); - - static octave_diary_stream *instance; - - static bool instance_ok (void); - - static void cleanup_instance (void) { delete instance; instance = 0; } - - octave_diary_buf *db; - - // No copying! - - octave_diary_stream (const octave_diary_stream&); - - octave_diary_stream& operator = (const octave_diary_stream&); -}; - -#define octave_stdout (octave_pager_stream::stream ()) - -#define octave_diary (octave_diary_stream::stream ()) - -extern OCTINTERP_API void flush_octave_stdout (void); - -#endif diff -r 069c552587a0 -r 959953dba519 src/parse-private.h --- a/src/parse-private.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -/* - -Copyright (C) 2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_parse_private_h) -#define octave_parse_private_h 1 - -#include - -#include "symtab.h" - -// Keep track of symbol table information when parsing functions. -class symtab_context -{ -private: - - class frame - { - public: - frame (symbol_table::scope_id s, symbol_table::scope_id c) - : m_scope (s), m_context (c) { } - - frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } - - frame& operator = (const frame& f) - { - if (&f != this) - { - m_scope = f.m_scope; - m_context = f.m_context; - } - - return *this; - } - - ~frame (void) { } - - symbol_table::scope_id scope (void) const { return m_scope; } - symbol_table::scope_id context (void) const { return m_context; } - - private: - - symbol_table::scope_id m_scope; - symbol_table::scope_id m_context; - }; - - std::stack frame_stack; - -public: - symtab_context (void) : frame_stack () { } - - void clear (void) - { - while (! frame_stack.empty ()) - frame_stack.pop (); - } - - bool empty (void) const { return frame_stack.empty (); } - - void pop (void) - { - frame tmp = frame_stack.top (); - - symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); - - frame_stack.pop (); - } - - void push (void) - { - frame_stack.push (frame (symbol_table::current_scope (), - symbol_table::current_context ())); - } -}; - -extern symtab_context parser_symtab_context; - -#endif diff -r 069c552587a0 -r 959953dba519 src/parse-tree/lex.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,208 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_lex_h) +#define octave_lex_h 1 + +#include +#include + +// FIXME -- these input buffer things should be members of a +// parser input stream class. + +typedef struct yy_buffer_state *YY_BUFFER_STATE; + +// Associate a buffer with a new file to read. +extern OCTINTERP_API YY_BUFFER_STATE create_buffer (FILE *f); + +// Report the current buffer. +extern OCTINTERP_API YY_BUFFER_STATE current_buffer (void); + +// Connect to new buffer buffer. +extern OCTINTERP_API void switch_to_buffer (YY_BUFFER_STATE buf); + +// Delete a buffer. +extern OCTINTERP_API void delete_buffer (YY_BUFFER_STATE buf); + +extern OCTINTERP_API void clear_all_buffers (void); + +extern OCTINTERP_API void cleanup_parser (void); + +// Is the given string a keyword? +extern bool is_keyword (const std::string& s); + +extern void prep_lexer_for_script_file (void); +extern void prep_lexer_for_function_file (void); +extern void prep_lexer_for_classdef_file (void); + +// For communication between the lexer and parser. + +class +lexical_feedback +{ +public: + + lexical_feedback (void) + + : bracketflag (0), braceflag (0), looping (0), + convert_spaces_to_comma (true), at_beginning_of_statement (true), + defining_func (0), looking_at_function_handle (0), + looking_at_anon_fcn_args (true), + looking_at_return_list (false), looking_at_parameter_list (false), + looking_at_decl_list (false), looking_at_initializer_expression (false), + looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), + looking_for_object_index (false), do_comma_insert (false), + looking_at_indirect_ref (false), parsed_function_name (), + parsing_class_method (false), maybe_classdef_get_set_method (false), + parsing_classdef (false), parsing_classdef_get_method (false), + parsing_classdef_set_method (false), quote_is_transpose (false), + pending_local_variables () + + { + init (); + } + + ~lexical_feedback (void) { } + + void init (void); + + // Square bracket level count. + int bracketflag; + + // Curly brace level count. + int braceflag; + + // TRUE means we're in the middle of defining a loop. + int looping; + + // TRUE means that we should convert spaces to a comma inside a + // matrix definition. + bool convert_spaces_to_comma; + + // TRUE means we are at the beginning of a statement, where a + // command name is possible. + bool at_beginning_of_statement; + + // Nonzero means we're in the middle of defining a function. + int defining_func; + + // Nonzero means we are parsing a function handle. + int looking_at_function_handle; + + // TRUE means we are parsing an anonymous function argument list. + bool looking_at_anon_fcn_args; + + // TRUE means we're parsing the return list for a function. + bool looking_at_return_list; + + // TRUE means we're parsing the parameter list for a function. + bool looking_at_parameter_list; + + // TRUE means we're parsing a declaration list (global or + // persistent). + bool looking_at_decl_list; + + // TRUE means we are looking at the initializer expression for a + // parameter list element. + bool looking_at_initializer_expression; + + // TRUE means we're parsing a matrix or the left hand side of + // multi-value assignment statement. + bool looking_at_matrix_or_assign_lhs; + + // If the front of the list is TRUE, the closest paren, brace, or + // bracket nesting is an index for an object. + std::list looking_at_object_index; + + // Object index not possible until we've seen something. + bool looking_for_object_index; + + // GAG. Stupid kludge so that [[1,2][3,4]] will work. + bool do_comma_insert; + + // TRUE means we're looking at an indirect reference to a + // structure element. + bool looking_at_indirect_ref; + + // If the top of the stack is TRUE, then we've already seen the name + // of the current function. Should only matter if + // current_function_level > 0 + std::stack parsed_function_name; + + // TRUE means we are parsing a class method in function or classdef file. + bool parsing_class_method; + + // TRUE means we are parsing a class method declaration line in a + // classdef file and can accept a property get or set method name. + // For example, "get.PropertyName" is recognized as a function name. + bool maybe_classdef_get_set_method; + + // TRUE means we are parsing a classdef file + bool parsing_classdef; + + // TRUE means we are parsing a classdef get.method. + bool parsing_classdef_get_method; + + // TRUE means we are parsing a classdef set.method. + bool parsing_classdef_set_method; + + // Return transpose or start a string? + bool quote_is_transpose; + + // Set of identifiers that might be local variable names. + std::set pending_local_variables; + +private: + + lexical_feedback (const lexical_feedback&); + + lexical_feedback& operator = (const lexical_feedback&); +}; + +class +stream_reader +{ +public: + virtual int getc (void) = 0; + virtual int ungetc (int c) = 0; + +protected: + stream_reader (void) { } + ~stream_reader (void) { } + +private: + + // No copying! + stream_reader (const stream_reader&); + stream_reader& operator = (const stream_reader&); +}; + +extern std::string +grab_comment_block (stream_reader& reader, bool at_bol, bool& eof); + +// TRUE means that we have encountered EOF on the input stream. +extern bool parser_end_of_input; + +// Flags that need to be shared between the lexer and parser. +extern lexical_feedback lexer_flags; + +#endif diff -r 069c552587a0 -r 959953dba519 src/parse-tree/lex.ll --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/lex.ll Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,3849 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +%option prefix = "octave_" + +%top { +#ifdef HAVE_CONFIG_H +#include +#endif + +} + +%s COMMAND_START +%s MATRIX_START + +%x SCRIPT_FILE_BEGIN +%x FUNCTION_FILE_BEGIN +%x CLASSDEF_FILE_BEGIN + +%{ + +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include "cmd-edit.h" +#include "quit.h" +#include "lo-mappers.h" + +// These would be alphabetical, but y.tab.h must be included before +// oct-gperf.h and y.tab.h must be included after token.h and the tree +// class declarations. We can't include y.tab.h in oct-gperf.h +// because it may not be protected to allow it to be included multiple +// times. + +#include "Cell.h" +#include "comment-list.h" +#include "defun.h" +#include "error.h" +#include "gripes.h" +#include "input.h" +#include "lex.h" +#include "ov.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "symtab.h" +#include "token.h" +#include "toplev.h" +#include "utils.h" +#include "variables.h" +#include +#include + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// flex without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fprintf GNULIB_NAMESPACE::fprintf +#define fwrite GNULIB_NAMESPACE::fwrite +#define isatty GNULIB_NAMESPACE::isatty +#define malloc GNULIB_NAMESPACE::malloc +#define realloc GNULIB_NAMESPACE::realloc +#endif + +#if ! (defined (FLEX_SCANNER) \ + && defined (YY_FLEX_MAJOR_VERSION) && YY_FLEX_MAJOR_VERSION >= 2 \ + && defined (YY_FLEX_MINOR_VERSION) && YY_FLEX_MINOR_VERSION >= 5) +#error lex.l requires flex version 2.5.4 or later +#endif + +#define yylval octave_lval + +// Arrange to get input via readline. + +#ifdef YY_INPUT +#undef YY_INPUT +#endif +#define YY_INPUT(buf, result, max_size) \ + if ((result = octave_read (buf, max_size)) < 0) \ + YY_FATAL_ERROR ("octave_read () in flex scanner failed"); + +// Try to avoid crashing out completely on fatal scanner errors. +// The call to yy_fatal_error should never happen, but it avoids a +// `static function defined but not used' warning from gcc. + +#ifdef YY_FATAL_ERROR +#undef YY_FATAL_ERROR +#endif +#define YY_FATAL_ERROR(msg) \ + do \ + { \ + error (msg); \ + OCTAVE_QUIT; \ + yy_fatal_error (msg); \ + } \ + while (0) + +#define DISPLAY_TOK_AND_RETURN(tok) \ + do \ + { \ + int tok_val = tok; \ + if (Vdisplay_tokens) \ + display_token (tok_val); \ + if (lexer_debug_flag) \ + { \ + std::cerr << "R: "; \ + display_token (tok_val); \ + std::cerr << std::endl; \ + } \ + return tok_val; \ + } \ + while (0) + +#define COUNT_TOK_AND_RETURN(tok) \ + do \ + { \ + Vtoken_count++; \ + DISPLAY_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_RETURN(tok) \ + do \ + { \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = false; \ + lexer_flags.convert_spaces_to_comma = true; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define TOK_PUSH_AND_RETURN(name, tok) \ + do \ + { \ + yylval.tok_val = new token (name, input_line_number, \ + current_input_column); \ + token_stack.push (yylval.tok_val); \ + TOK_RETURN (tok); \ + } \ + while (0) + +#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + yylval.tok_val = new token (input_line_number, current_input_column); \ + token_stack.push (yylval.tok_val); \ + current_input_column += yyleng; \ + lexer_flags.quote_is_transpose = qit; \ + lexer_flags.convert_spaces_to_comma = convert; \ + lexer_flags.looking_for_object_index = false; \ + lexer_flags.at_beginning_of_statement = bos; \ + COUNT_TOK_AND_RETURN (tok); \ + } \ + while (0) + +#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ + } \ + while (0) + +#define XBIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN (tok, convert, bos); \ + } \ + while (0) + +#define LEXER_DEBUG(pattern) \ + do \ + { \ + if (lexer_debug_flag) \ + lexer_debug (pattern, yytext); \ + } \ + while (0) + +// TRUE means that we have encountered EOF on the input stream. +bool parser_end_of_input = false; + +// Flags that need to be shared between the lexer and parser. +lexical_feedback lexer_flags; + +// Stack to hold tokens so that we can delete them when the parser is +// reset and avoid growing forever just because we are stashing some +// information. This has to appear before lex.h is included, because +// one of the macros defined there uses token_stack. +// +// FIXME -- this should really be static, but that causes +// problems on some systems. +std::stack token_stack; + +// Did eat_whitespace() eat a space or tab, or a newline, or both? + +typedef int yum_yum; + +const yum_yum ATE_NOTHING = 0; +const yum_yum ATE_SPACE_OR_TAB = 1; +const yum_yum ATE_NEWLINE = 2; + +// Is the closest nesting level a square bracket, squiggly brace or a paren? + +class bracket_brace_paren_nesting_level +{ +public: + + bracket_brace_paren_nesting_level (void) : context () { } + + ~bracket_brace_paren_nesting_level (void) { } + + void bracket (void) { context.push (BRACKET); } + bool is_bracket (void) + { return ! context.empty () && context.top () == BRACKET; } + + void brace (void) { context.push (BRACE); } + bool is_brace (void) + { return ! context.empty () && context.top () == BRACE; } + + void paren (void) { context.push (PAREN); } + bool is_paren (void) + { return ! context.empty () && context.top () == PAREN; } + + bool is_bracket_or_brace (void) + { return (! context.empty () + && (context.top () == BRACKET || context.top () == BRACE)); } + + bool none (void) { return context.empty (); } + + void remove (void) { if (! context.empty ()) context.pop (); } + + void clear (void) { while (! context.empty ()) context.pop (); } + +private: + + std::stack context; + + static const int BRACKET; + static const int BRACE; + static const int PAREN; + + bracket_brace_paren_nesting_level (const bracket_brace_paren_nesting_level&); + + bracket_brace_paren_nesting_level& + operator = (const bracket_brace_paren_nesting_level&); +}; + +const int bracket_brace_paren_nesting_level::BRACKET = 1; +const int bracket_brace_paren_nesting_level::BRACE = 2; +const int bracket_brace_paren_nesting_level::PAREN = 3; + +static bracket_brace_paren_nesting_level nesting_level; + +static bool Vdisplay_tokens = false; + +static unsigned int Vtoken_count = 0; + +// The start state that was in effect when the beginning of a block +// comment was noticed. +static int block_comment_nesting_level = 0; + +// Internal variable for lexer debugging state. +static bool lexer_debug_flag = false; + +// Forward declarations for functions defined at the bottom of this +// file. + +static int text_yyinput (void); +static void xunput (char c, char *buf); +static void fixup_column_count (char *s); +static void do_comma_insert_check (void); +static int is_keyword_token (const std::string& s); +static int process_comment (bool start_in_block, bool& eof); +static bool match_any (char c, const char *s); +static bool next_token_is_sep_op (void); +static bool next_token_is_bin_op (bool spc_prev); +static bool next_token_is_postfix_unary_op (bool spc_prev); +static std::string strip_trailing_whitespace (char *s); +static void handle_number (void); +static int handle_string (char delim); +static int handle_close_bracket (bool spc_gobbled, int bracket_type); +static int handle_superclass_identifier (void); +static int handle_meta_identifier (void); +static int handle_identifier (void); +static bool have_continuation (bool trailing_comments_ok = true); +static bool have_ellipsis_continuation (bool trailing_comments_ok = true); +static void scan_for_comments (const char *); +static yum_yum eat_whitespace (void); +static yum_yum eat_continuation (void); +static void maybe_warn_separator_insert (char sep); +static void gripe_single_quote_string (void); +static void gripe_matlab_incompatible (const std::string& msg); +static void maybe_gripe_matlab_incompatible_comment (char c); +static void gripe_matlab_incompatible_continuation (void); +static void gripe_matlab_incompatible_operator (const std::string& op); +static void display_token (int tok); +static void lexer_debug (const char *pattern, const char *text); + +%} + +D [0-9] +S [ \t] +NL ((\n)|(\r)|(\r\n)) +SNL ({S}|{NL}) +EL (\.\.\.) +BS (\\) +CONT ({EL}|{BS}) +Im [iIjJ] +CCHAR [#%] +COMMENT ({CCHAR}.*{NL}) +SNLCMT ({SNL}|{COMMENT}) +NOT ((\~)|(\!)) +POW ((\*\*)|(\^)) +EPOW (\.{POW}) +IDENT ([_$a-zA-Z][_$a-zA-Z0-9]*) +EXPON ([DdEe][+-]?{D}+) +NUMBER (({D}+\.?{D}*{EXPON}?)|(\.{D}+{EXPON}?)|(0[xX][0-9a-fA-F]+)) +%% + +%{ +// Make script and function files start with a bogus token. This makes +// the parser go down a special path. +%} + +. { + LEXER_DEBUG ("."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (SCRIPT_FILE); + } + +. { + LEXER_DEBUG ("."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (FUNCTION_FILE); + } + +. { + LEXER_DEBUG ("."); + + BEGIN (INITIAL); + xunput (yytext[0], yytext); + COUNT_TOK_AND_RETURN (CLASSDEF_FILE); + } + +%{ +// Help and other command-style functions. +%} + +{NL} { + LEXER_DEBUG ("{NL}"); + + BEGIN (INITIAL); + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + COUNT_TOK_AND_RETURN ('\n'); + } + +[\;\,] { + LEXER_DEBUG ("[\\;\\,]"); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = true; + + BEGIN (INITIAL); + + if (strcmp (yytext, ",") == 0) + TOK_RETURN (','); + else + TOK_RETURN (';'); + } + +[\"\'] { + LEXER_DEBUG ("[\\\"\\']"); + + lexer_flags.at_beginning_of_statement = false; + + current_input_column++; + int tok = handle_string (yytext[0]); + + COUNT_TOK_AND_RETURN (tok); + } + +[^#% \t\r\n\;\,\"\'][^ \t\r\n\;\,]*{S}* { + LEXER_DEBUG ("[^#% \\t\\r\\n\\;\\,\\\"\\'][^ \\t\\r\\n\\;\\,]*{S}*"); + + std::string tok = strip_trailing_whitespace (yytext); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_PUSH_AND_RETURN (tok, SQ_STRING); + } + +%{ +// For this and the next two rules, we're looking at ']', and we +// need to know if the next token is `=' or `=='. +// +// It would have been so much easier if the delimiters were simply +// different for the expression on the left hand side of the equals +// operator. +// +// It's also a pain in the ass to decide whether to insert a comma +// after seeing a ']' character... + +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*\]{S}* { + LEXER_DEBUG ("{SNLCMT}*\\]{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, ']'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*\}{S}* { + LEXER_DEBUG ("{SNLCMT}*\\}{S}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + int c = yytext[yyleng-1]; + int cont_is_spc = eat_continuation (); + bool spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + int tok_to_return = handle_close_bracket (spc_gobbled, '}'); + + if (spc_gobbled) + xunput (' ', yytext); + + COUNT_TOK_AND_RETURN (tok_to_return); + } + +%{ +// Commas are element separators in matrix constants. If we don't +// check for continuations here we can end up inserting too many +// commas. +%} + +{S}*\,{S}* { + LEXER_DEBUG ("{S}*\\,{S}*"); + + current_input_column += yyleng; + + int tmp = eat_continuation (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (! lexer_flags.looking_at_object_index.front ()) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + } + + COUNT_TOK_AND_RETURN (','); + } + +%{ +// In some cases, spaces in matrix constants can turn into commas. +// If commas are required, spaces are not important in matrix +// constants so we just eat them. If we don't check for continuations +// here we can end up inserting too many commas. +%} + +{S}+ { + LEXER_DEBUG ("{S}+"); + + current_input_column += yyleng; + + lexer_flags.at_beginning_of_statement = false; + + int tmp = eat_continuation (); + + if (! lexer_flags.looking_at_object_index.front ()) + { + bool bin_op = next_token_is_bin_op (true); + bool postfix_un_op = next_token_is_postfix_unary_op (true); + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op) + && nesting_level.is_bracket_or_brace () + && lexer_flags.convert_spaces_to_comma) + { + if ((tmp & ATE_NEWLINE) == ATE_NEWLINE) + { + maybe_warn_separator_insert (';'); + + xunput (';', yytext); + } + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + + maybe_warn_separator_insert (','); + + COUNT_TOK_AND_RETURN (','); + } + } + } + +%{ +// Semicolons are handled as row seprators in matrix constants. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +{SNLCMT}*;{SNLCMT}* { + LEXER_DEBUG ("{SNLCMT}*;{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN (';'); + } + +%{ +// In some cases, new lines can also become row separators. If we +// don't eat whitespace here we can end up inserting too many +// semicolons. + +// FIXME -- we need to handle block comments here. +%} + +{S}*{COMMENT}{SNLCMT}* | +{S}*{NL}{SNLCMT}* { + LEXER_DEBUG ("{S}*{COMMENT}{SNLCMT}*|{S}*{NL}{SNLCMT}*"); + + scan_for_comments (yytext); + fixup_column_count (yytext); + eat_whitespace (); + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = false; + + if (nesting_level.none ()) + return LEXICAL_ERROR; + + if (! lexer_flags.looking_at_object_index.front () + && nesting_level.is_bracket_or_brace ()) + { + maybe_warn_separator_insert (';'); + + COUNT_TOK_AND_RETURN (';'); + } + } + +\[{S}* { + LEXER_DEBUG ("\\[{S}*"); + + nesting_level.bracket (); + + lexer_flags.looking_at_object_index.push_front (false); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.defining_func + && ! lexer_flags.parsed_function_name.top ()) + lexer_flags.looking_at_return_list = true; + else + lexer_flags.looking_at_matrix_or_assign_lhs = true; + + promptflag--; + eat_whitespace (); + + lexer_flags.bracketflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('['); + } + +\] { + LEXER_DEBUG ("\\]"); + + nesting_level.remove (); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN (']'); + } + +%{ +// Imaginary numbers. +%} + +{NUMBER}{Im} { + LEXER_DEBUG ("{NUMBER}{Im}"); + + handle_number (); + COUNT_TOK_AND_RETURN (IMAG_NUM); + } + +%{ +// Real numbers. Don't grab the `.' part of a dot operator as part of +// the constant. +%} + +{D}+/\.[\*/\\^\'] | +{NUMBER} { + LEXER_DEBUG ("{D}+/\\.[\\*/\\^\\']|{NUMBER}"); + handle_number (); + COUNT_TOK_AND_RETURN (NUM); + } + +%{ +// Eat whitespace. Whitespace inside matrix constants is handled by +// the start state code above. +%} + +{S}* { + current_input_column += yyleng; + } + +%{ +// Continuation lines. Allow comments after continuations. +%} + +{CONT}{S}*{NL} | +{CONT}{S}*{COMMENT} { + LEXER_DEBUG ("{CONT}{S}*{NL}|{CONT}{S}*{COMMENT}"); + + if (yytext[0] == '\\') + gripe_matlab_incompatible_continuation (); + scan_for_comments (yytext); + promptflag--; + input_line_number++; + current_input_column = 1; + } + +%{ +// End of file. +%} + +<> { + LEXER_DEBUG ("<>"); + + if (block_comment_nesting_level != 0) + { + warning ("block comment open at end of input"); + + if ((reading_fcn_file || reading_script_file || reading_classdef_file) + && ! curr_fcn_file_name.empty ()) + warning ("near line %d of file `%s.m'", + input_line_number, curr_fcn_file_name.c_str ()); + } + + TOK_RETURN (END_OF_INPUT); + } + +%{ +// Identifiers. Truncate the token at the first space or tab but +// don't write directly on yytext. +%} + +{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}{S}*"); + + int id_tok = handle_identifier (); + + if (id_tok >= 0) + COUNT_TOK_AND_RETURN (id_tok); + } + +%{ +// Superclass method identifiers. +%} + +{IDENT}@{IDENT}{S}* | +{IDENT}@{IDENT}.{IDENT}{S}* { + LEXER_DEBUG ("{IDENT}@{IDENT}{S}*|{IDENT}@{IDENT}.{IDENT}{S}*"); + + int id_tok = handle_superclass_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (id_tok); + } + } + +%{ +// Metaclass query +%} + +\?{IDENT}{S}* | +\?{IDENT}\.{IDENT}{S}* { + LEXER_DEBUG ("\\?{IDENT}{S}*|\\?{IDENT}\\.{IDENT}{S}*"); + + int id_tok = handle_meta_identifier (); + + if (id_tok >= 0) + { + lexer_flags.looking_for_object_index = true; + + COUNT_TOK_AND_RETURN (id_tok); + } + } + +%{ +// Function handles and superclass references +%} + +"@" { + LEXER_DEBUG ("@"); + + current_input_column++; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = false; + lexer_flags.looking_at_function_handle++; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + COUNT_TOK_AND_RETURN ('@'); + + } + +%{ +// A new line character. New line characters inside matrix constants +// are handled by the start state code above. If closest +// nesting is inside parentheses, don't return a row separator. +%} + +{NL} { + LEXER_DEBUG ("{NL}"); + + input_line_number++; + current_input_column = 1; + + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + + if (nesting_level.none ()) + { + lexer_flags.at_beginning_of_statement = true; + COUNT_TOK_AND_RETURN ('\n'); + } + else if (nesting_level.is_paren ()) + { + lexer_flags.at_beginning_of_statement = false; + gripe_matlab_incompatible ("bare newline inside parentheses"); + } + else if (nesting_level.is_bracket_or_brace ()) + return LEXICAL_ERROR; + } + +%{ +// Single quote can either be the beginning of a string or a transpose +// operator. +%} + +"'" { + LEXER_DEBUG ("'"); + + current_input_column++; + lexer_flags.convert_spaces_to_comma = true; + + if (lexer_flags.quote_is_transpose) + { + do_comma_insert_check (); + COUNT_TOK_AND_RETURN (QUOTE); + } + else + { + int tok = handle_string ('\''); + COUNT_TOK_AND_RETURN (tok); + } + } + +%{ +// Double quotes always begin strings. +%} + +\" { + LEXER_DEBUG ("\""); + + current_input_column++; + int tok = handle_string ('"'); + + COUNT_TOK_AND_RETURN (tok); +} + +%{ +// Gobble comments. +%} + +{CCHAR} { + LEXER_DEBUG ("{CCHAR}"); + + lexer_flags.looking_for_object_index = false; + + xunput (yytext[0], yytext); + + bool eof = false; + int tok = process_comment (false, eof); + + if (eof) + TOK_RETURN (END_OF_INPUT); + else if (tok > 0) + COUNT_TOK_AND_RETURN (tok); + } + +%{ +// Block comments. +%} + +^{S}*{CCHAR}\{{S}*{NL} { + LEXER_DEBUG ("^{S}*{CCHAR}\\{{S}*{NL}"); + + lexer_flags.looking_for_object_index = false; + + input_line_number++; + current_input_column = 1; + block_comment_nesting_level++; + promptflag--; + + bool eof = false; + process_comment (true, eof); + } + +%{ +// Other operators. +%} + +":" { LEXER_DEBUG (":"); BIN_OP_RETURN (':', false, false); } + +".+" { LEXER_DEBUG (".+"); XBIN_OP_RETURN (EPLUS, false, false); } +".-" { LEXER_DEBUG (".-"); XBIN_OP_RETURN (EMINUS, false, false); } +".*" { LEXER_DEBUG (".*"); BIN_OP_RETURN (EMUL, false, false); } +"./" { LEXER_DEBUG ("./"); BIN_OP_RETURN (EDIV, false, false); } +".\\" { LEXER_DEBUG (".\\"); BIN_OP_RETURN (ELEFTDIV, false, false); } +".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } +".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } +".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } +"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } +"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } +"<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } +"==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } +"~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } +"!=" { LEXER_DEBUG ("!="); XBIN_OP_RETURN (EXPR_NE, false, false); } +">=" { LEXER_DEBUG (">="); BIN_OP_RETURN (EXPR_GE, false, false); } +"&" { LEXER_DEBUG ("&"); BIN_OP_RETURN (EXPR_AND, false, false); } +"|" { LEXER_DEBUG ("|"); BIN_OP_RETURN (EXPR_OR, false, false); } +"<" { LEXER_DEBUG ("<"); BIN_OP_RETURN (EXPR_LT, false, false); } +">" { LEXER_DEBUG (">"); BIN_OP_RETURN (EXPR_GT, false, false); } +"+" { LEXER_DEBUG ("+"); BIN_OP_RETURN ('+', false, false); } +"-" { LEXER_DEBUG ("-"); BIN_OP_RETURN ('-', false, false); } +"*" { LEXER_DEBUG ("*"); BIN_OP_RETURN ('*', false, false); } +"/" { LEXER_DEBUG ("/"); BIN_OP_RETURN ('/', false, false); } +"\\" { LEXER_DEBUG ("\\"); BIN_OP_RETURN (LEFTDIV, false, false); } +";" { LEXER_DEBUG (";"); BIN_OP_RETURN (';', true, true); } +"," { LEXER_DEBUG (","); BIN_OP_RETURN (',', true, ! lexer_flags.looking_at_object_index.front ()); } +"^" { LEXER_DEBUG ("^"); BIN_OP_RETURN (POW, false, false); } +"**" { LEXER_DEBUG ("**"); XBIN_OP_RETURN (POW, false, false); } +"=" { LEXER_DEBUG ("="); BIN_OP_RETURN ('=', true, false); } +"&&" { LEXER_DEBUG ("&&"); BIN_OP_RETURN (EXPR_AND_AND, false, false); } +"||" { LEXER_DEBUG ("||"); BIN_OP_RETURN (EXPR_OR_OR, false, false); } +"<<" { LEXER_DEBUG ("<<"); XBIN_OP_RETURN (LSHIFT, false, false); } +">>" { LEXER_DEBUG (">>"); XBIN_OP_RETURN (RSHIFT, false, false); } + +{NOT} { + LEXER_DEBUG ("{NOT}"); + + if (yytext[0] == '~') + BIN_OP_RETURN (EXPR_NOT, false, false); + else + XBIN_OP_RETURN (EXPR_NOT, false, false); + } + +"(" { + LEXER_DEBUG ("("); + + // If we are looking for an object index, then push TRUE for + // looking_at_object_index. Otherwise, just push whatever state + // is current (so that we can pop it off the stack when we find + // the matching close paren). + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + lexer_flags.looking_at_indirect_ref = false; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.paren (); + promptflag--; + + TOK_RETURN ('('); + } + +")" { + LEXER_DEBUG (")"); + + nesting_level.remove (); + current_input_column++; + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma + = (nesting_level.is_bracket_or_brace () + && ! lexer_flags.looking_at_anon_fcn_args); + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + if (lexer_flags.looking_at_anon_fcn_args) + lexer_flags.looking_at_anon_fcn_args = false; + + do_comma_insert_check (); + + COUNT_TOK_AND_RETURN (')'); + } + +"." { + LEXER_DEBUG ("."); + + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + TOK_RETURN ('.'); + } + +"+=" { LEXER_DEBUG ("+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +"-=" { LEXER_DEBUG ("-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +"*=" { LEXER_DEBUG ("*="); XBIN_OP_RETURN (MUL_EQ, false, false); } +"/=" { LEXER_DEBUG ("/="); XBIN_OP_RETURN (DIV_EQ, false, false); } +"\\=" { LEXER_DEBUG ("\\="); XBIN_OP_RETURN (LEFTDIV_EQ, false, false); } +".+=" { LEXER_DEBUG (".+="); XBIN_OP_RETURN (ADD_EQ, false, false); } +".-=" { LEXER_DEBUG (".-="); XBIN_OP_RETURN (SUB_EQ, false, false); } +".*=" { LEXER_DEBUG (".*="); XBIN_OP_RETURN (EMUL_EQ, false, false); } +"./=" { LEXER_DEBUG ("./="); XBIN_OP_RETURN (EDIV_EQ, false, false); } +".\\=" { LEXER_DEBUG (".\\="); XBIN_OP_RETURN (ELEFTDIV_EQ, false, false); } +{POW}= { LEXER_DEBUG ("{POW}="); XBIN_OP_RETURN (POW_EQ, false, false); } +{EPOW}= { LEXER_DEBUG ("{EPOW}="); XBIN_OP_RETURN (EPOW_EQ, false, false); } +"&=" { LEXER_DEBUG ("&="); XBIN_OP_RETURN (AND_EQ, false, false); } +"|=" { LEXER_DEBUG ("|="); XBIN_OP_RETURN (OR_EQ, false, false); } +"<<=" { LEXER_DEBUG ("<<="); XBIN_OP_RETURN (LSHIFT_EQ, false, false); } +">>=" { LEXER_DEBUG (">>="); XBIN_OP_RETURN (RSHIFT_EQ, false, false); } + +\{{S}* { + LEXER_DEBUG ("\\{{S}*"); + + nesting_level.brace (); + + lexer_flags.looking_at_object_index.push_front + (lexer_flags.looking_for_object_index); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + promptflag--; + eat_whitespace (); + + lexer_flags.braceflag++; + BEGIN (MATRIX_START); + COUNT_TOK_AND_RETURN ('{'); + } + +"}" { + LEXER_DEBUG ("}"); + + lexer_flags.looking_at_object_index.pop_front (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + nesting_level.remove (); + + TOK_RETURN ('}'); + } + +%{ +// Unrecognized input is a lexical error. +%} + +. { + LEXER_DEBUG ("."); + + xunput (yytext[0], yytext); + + int c = text_yyinput (); + + if (c != EOF) + { + current_input_column++; + + error ("invalid character `%s' (ASCII %d) near line %d, column %d", + undo_string_escape (static_cast (c)), c, + input_line_number, current_input_column); + + return LEXICAL_ERROR; + } + else + TOK_RETURN (END_OF_INPUT); + } + +%% + +// GAG. +// +// If we're reading a matrix and the next character is '[', make sure +// that we insert a comma ahead of it. + +void +do_comma_insert_check (void) +{ + int spc_gobbled = eat_continuation (); + + int c = text_yyinput (); + + xunput (c, yytext); + + if (spc_gobbled) + xunput (' ', yytext); + + lexer_flags.do_comma_insert = (! lexer_flags.looking_at_object_index.front () + && lexer_flags.bracketflag && c == '['); +} + +// Fix things up for errors or interrupts. The parser is never called +// recursively, so it is always safe to reinitialize its state before +// doing any parsing. + +void +reset_parser (void) +{ + // Start off on the right foot. + BEGIN (INITIAL); + + parser_end_of_input = false; + + parser_symtab_context.clear (); + + // We do want a prompt by default. + promptflag = 1; + + // We are not in a block comment. + block_comment_nesting_level = 0; + + // Error may have occurred inside some brackets, braces, or parentheses. + nesting_level.clear (); + + // Clear out the stack of token info used to track line and column + // numbers. + while (! token_stack.empty ()) + { + delete token_stack.top (); + token_stack.pop (); + } + + // Can be reset by defining a function. + if (! (reading_script_file || reading_fcn_file || reading_classdef_file)) + { + current_input_column = 1; + input_line_number = command_editor::current_command_number (); + } + + // Only ask for input from stdin if we are expecting interactive + // input. + + if (! quitting_gracefully + && (interactive || forced_interactive) + && ! (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file)) + yyrestart (stdin); + + // Clear the buffer for help text. + while (! help_buf.empty ()) + help_buf.pop (); + + // Reset other flags. + lexer_flags.init (); +} + +static void +display_character (char c) +{ + if (isgraph (c)) + std::cerr << c; + else + switch (c) + { + case 0: + std::cerr << "NUL"; + break; + + case 1: + std::cerr << "SOH"; + break; + + case 2: + std::cerr << "STX"; + break; + + case 3: + std::cerr << "ETX"; + break; + + case 4: + std::cerr << "EOT"; + break; + + case 5: + std::cerr << "ENQ"; + break; + + case 6: + std::cerr << "ACK"; + break; + + case 7: + std::cerr << "\\a"; + break; + + case 8: + std::cerr << "\\b"; + break; + + case 9: + std::cerr << "\\t"; + break; + + case 10: + std::cerr << "\\n"; + break; + + case 11: + std::cerr << "\\v"; + break; + + case 12: + std::cerr << "\\f"; + break; + + case 13: + std::cerr << "\\r"; + break; + + case 14: + std::cerr << "SO"; + break; + + case 15: + std::cerr << "SI"; + break; + + case 16: + std::cerr << "DLE"; + break; + + case 17: + std::cerr << "DC1"; + break; + + case 18: + std::cerr << "DC2"; + break; + + case 19: + std::cerr << "DC3"; + break; + + case 20: + std::cerr << "DC4"; + break; + + case 21: + std::cerr << "NAK"; + break; + + case 22: + std::cerr << "SYN"; + break; + + case 23: + std::cerr << "ETB"; + break; + + case 24: + std::cerr << "CAN"; + break; + + case 25: + std::cerr << "EM"; + break; + + case 26: + std::cerr << "SUB"; + break; + + case 27: + std::cerr << "ESC"; + break; + + case 28: + std::cerr << "FS"; + break; + + case 29: + std::cerr << "GS"; + break; + + case 30: + std::cerr << "RS"; + break; + + case 31: + std::cerr << "US"; + break; + + case 32: + std::cerr << "SPACE"; + break; + + case 127: + std::cerr << "DEL"; + break; + } +} + +static int +text_yyinput (void) +{ + int c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = yyinput (); + + if (lexer_debug_flag) + { + std::cerr << "I: "; + display_character (c); + std::cerr << std::endl; + } + + if (c != '\n') + { + xunput (c, yytext); + c = '\n'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +static void +xunput (char c, char *buf) +{ + if (lexer_debug_flag) + { + std::cerr << "U: "; + display_character (c); + std::cerr << std::endl; + } + + if (c == '\n') + input_line_number--; + + yyunput (c, buf); +} + +// If we read some newlines, we need figure out what column we're +// really looking at. + +static void +fixup_column_count (char *s) +{ + char c; + while ((c = *s++) != '\0') + { + if (c == '\n') + { + input_line_number++; + current_input_column = 1; + } + else + current_input_column++; + } +} + +// Include these so that we don't have to link to libfl.a. + +int +yywrap (void) +{ + return 1; +} + +// Tell us all what the current buffer is. + +YY_BUFFER_STATE +current_buffer (void) +{ + return YY_CURRENT_BUFFER; +} + +// Create a new buffer. + +YY_BUFFER_STATE +create_buffer (FILE *f) +{ + return yy_create_buffer (f, YY_BUF_SIZE); +} + +// Start reading a new buffer. + +void +switch_to_buffer (YY_BUFFER_STATE buf) +{ + yy_switch_to_buffer (buf); +} + +// Delete a buffer. + +void +delete_buffer (YY_BUFFER_STATE buf) +{ + yy_delete_buffer (buf); + + // Prevent invalid yyin from being used by yyrestart. + if (! current_buffer ()) + yyin = 0; +} + +// Delete all buffers from the stack. +void +clear_all_buffers (void) +{ + while (current_buffer ()) + octave_pop_buffer_state (); +} + +void +cleanup_parser (void) +{ + reset_parser (); + + clear_all_buffers (); +} + +// Restore a buffer (for unwind-prot). + +void +restore_input_buffer (void *buf) +{ + switch_to_buffer (static_cast (buf)); +} + +// Delete a buffer (for unwind-prot). + +void +delete_input_buffer (void *buf) +{ + delete_buffer (static_cast (buf)); +} + +static bool +inside_any_object_index (void) +{ + bool retval = false; + + for (std::list::const_iterator i = lexer_flags.looking_at_object_index.begin (); + i != lexer_flags.looking_at_object_index.end (); i++) + { + if (*i) + { + retval = true; + break; + } + } + + return retval; +} + +// Handle keywords. Return -1 if the keyword should be ignored. + +static int +is_keyword_token (const std::string& s) +{ + int l = input_line_number; + int c = current_input_column; + + int len = s.length (); + + const octave_kw *kw = octave_kw_hash::in_word_set (s.c_str (), len); + + if (kw) + { + yylval.tok_val = 0; + + switch (kw->kw_id) + { + case break_kw: + case catch_kw: + case continue_kw: + case else_kw: + case otherwise_kw: + case return_kw: + case unwind_protect_cleanup_kw: + lexer_flags.at_beginning_of_statement = true; + break; + + case static_kw: + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d of file `%s'", + input_line_number, + curr_fcn_file_full_name.c_str ()); + else + warning_with_id ("Octave:deprecated-keyword", + "the `static' keyword is obsolete and will be removed from a future version of Octave; please use `persistent' instead; near line %d", + input_line_number); + // fall through ... + + case persistent_kw: + break; + + case case_kw: + case elseif_kw: + case global_kw: + case until_kw: + break; + + case end_kw: + if (inside_any_object_index () + || (! reading_classdef_file + && (lexer_flags.defining_func + && ! (lexer_flags.looking_at_return_list + || lexer_flags.parsed_function_name.top ())))) + return 0; + + yylval.tok_val = new token (token::simple_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_try_catch_kw: + yylval.tok_val = new token (token::try_catch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case end_unwind_protect_kw: + yylval.tok_val = new token (token::unwind_protect_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfor_kw: + yylval.tok_val = new token (token::for_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endfunction_kw: + yylval.tok_val = new token (token::function_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endif_kw: + yylval.tok_val = new token (token::if_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endparfor_kw: + yylval.tok_val = new token (token::parfor_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endswitch_kw: + yylval.tok_val = new token (token::switch_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endwhile_kw: + yylval.tok_val = new token (token::while_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endclassdef_kw: + yylval.tok_val = new token (token::classdef_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endenumeration_kw: + yylval.tok_val = new token (token::enumeration_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endevents_kw: + yylval.tok_val = new token (token::events_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endmethods_kw: + yylval.tok_val = new token (token::methods_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + case endproperties_kw: + yylval.tok_val = new token (token::properties_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + + + case for_kw: + case parfor_kw: + case while_kw: + promptflag--; + lexer_flags.looping++; + break; + + case do_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + lexer_flags.looping++; + break; + + case try_kw: + case unwind_protect_kw: + lexer_flags.at_beginning_of_statement = true; + promptflag--; + break; + + case if_kw: + case switch_kw: + promptflag--; + break; + + case get_kw: + case set_kw: + // 'get' and 'set' are keywords in classdef method + // declarations. + if (! lexer_flags.maybe_classdef_get_set_method) + return 0; + break; + + case enumeration_kw: + case events_kw: + case methods_kw: + case properties_kw: + // 'properties', 'methods' and 'events' are keywords for + // classdef blocks. + if (! lexer_flags.parsing_classdef) + return 0; + // fall through ... + + case classdef_kw: + // 'classdef' is always a keyword. + promptflag--; + break; + + case function_kw: + promptflag--; + + lexer_flags.defining_func++; + lexer_flags.parsed_function_name.push (false); + + if (! (reading_fcn_file || reading_script_file + || reading_classdef_file)) + input_line_number = 1; + break; + + case magic_file_kw: + { + if ((reading_fcn_file || reading_script_file + || reading_classdef_file) + && ! curr_fcn_file_full_name.empty ()) + yylval.tok_val = new token (curr_fcn_file_full_name, l, c); + else + yylval.tok_val = new token ("stdin", l, c); + } + break; + + case magic_line_kw: + yylval.tok_val = new token (static_cast (l), "", l, c); + break; + + default: + panic_impossible (); + } + + if (! yylval.tok_val) + yylval.tok_val = new token (l, c); + + token_stack.push (yylval.tok_val); + + return kw->tok; + } + + return 0; +} + +static bool +is_variable (const std::string& name) +{ + return (symbol_table::is_variable (name) + || (lexer_flags.pending_local_variables.find (name) + != lexer_flags.pending_local_variables.end ())); +} + +static std::string +grab_block_comment (stream_reader& reader, bool& eof) +{ + std::string buf; + + bool at_bol = true; + bool look_for_marker = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (look_for_marker) + { + at_bol = false; + look_for_marker = false; + + if (c == '{' || c == '}') + { + std::string tmp_buf (1, static_cast (c)); + + int type = c; + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + if (type == '{') + { + block_comment_nesting_level++; + promptflag--; + } + else + { + block_comment_nesting_level--; + promptflag++; + + if (block_comment_nesting_level == 0) + { + buf += grab_comment_block (reader, true, eof); + + return buf; + } + } + } + break; + + default: + at_bol = false; + tmp_buf += static_cast (c); + buf += tmp_buf; + done = true; + break; + } + } + } + } + + if (at_bol && (c == '%' || c == '#')) + { + if (c == '#' && ! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + + at_bol = false; + look_for_marker = true; + } + else + { + buf += static_cast (c); + + if (c == '\n') + { + current_input_column = 0; + at_bol = true; + } + } + } + + if (c == EOF) + eof = true; + + return buf; +} + +std::string +grab_comment_block (stream_reader& reader, bool at_bol, + bool& eof) +{ + std::string buf; + + // TRUE means we are at the beginning of a comment block. + bool begin_comment = false; + + // TRUE means we are currently reading a comment block. + bool in_comment = false; + + bool warned_incompatible = false; + + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + current_input_column++; + + if (begin_comment) + { + if (c == '%' || c == '#') + { + at_bol = false; + continue; + } + else if (at_bol && c == '{') + { + std::string tmp_buf (1, static_cast (c)); + + bool done = false; + + while ((c = reader.getc ()) != EOF && ! done) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + tmp_buf += static_cast (c); + break; + + case '\n': + { + current_input_column = 0; + at_bol = true; + done = true; + + block_comment_nesting_level++; + promptflag--; + + buf += grab_block_comment (reader, eof); + + in_comment = false; + + if (eof) + goto done; + } + break; + + default: + at_bol = false; + tmp_buf += static_cast (c); + buf += tmp_buf; + done = true; + break; + } + } + } + else + { + at_bol = false; + begin_comment = false; + } + } + + if (in_comment) + { + buf += static_cast (c); + + if (c == '\n') + { + at_bol = true; + current_input_column = 0; + in_comment = false; + + // FIXME -- bailing out here prevents things like + // + // octave> # comment + // octave> x = 1 + // + // from failing at the command line, while still + // allowing blocks of comments to be grabbed properly + // for function doc strings. But only the first line of + // a mult-line doc string will be picked up for + // functions defined on the command line. We need a + // better way of collecting these comments... + if (! (reading_fcn_file || reading_script_file)) + goto done; + } + } + else + { + switch (c) + { + case ' ': + case '\t': + break; + + case '#': + if (! warned_incompatible) + { + warned_incompatible = true; + maybe_gripe_matlab_incompatible_comment (c); + } + // fall through... + + case '%': + in_comment = true; + begin_comment = true; + break; + + default: + current_input_column--; + reader.ungetc (c); + goto done; + } + } + } + + done: + + if (c == EOF) + eof = true; + + return buf; +} + +class +flex_stream_reader : public stream_reader +{ +public: + flex_stream_reader (char *buf_arg) : stream_reader (), buf (buf_arg) { } + + int getc (void) { return ::text_yyinput (); } + int ungetc (int c) { ::xunput (c, buf); return 0; } + +private: + + // No copying! + + flex_stream_reader (const flex_stream_reader&); + + flex_stream_reader& operator = (const flex_stream_reader&); + + char *buf; +}; + +static int +process_comment (bool start_in_block, bool& eof) +{ + eof = false; + + std::string help_txt; + + if (! help_buf.empty ()) + help_txt = help_buf.top (); + + flex_stream_reader flex_reader (yytext); + + // process_comment is only supposed to be called when we are not + // initially looking at a block comment. + + std::string txt = start_in_block + ? grab_block_comment (flex_reader, eof) + : grab_comment_block (flex_reader, false, eof); + + if (lexer_debug_flag) + std::cerr << "C: " << txt << std::endl; + + if (help_txt.empty () && nesting_level.none ()) + { + if (! help_buf.empty ()) + help_buf.pop (); + + help_buf.push (txt); + } + + octave_comment_buffer::append (txt); + + current_input_column = 1; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.at_beginning_of_statement = true; + + if (YY_START == COMMAND_START) + BEGIN (INITIAL); + + if (nesting_level.none ()) + return '\n'; + else if (nesting_level.is_bracket_or_brace ()) + return ';'; + else + return 0; +} + +// Return 1 if the given character matches any character in the given +// string. + +static bool +match_any (char c, const char *s) +{ + char tmp; + while ((tmp = *s++) != '\0') + { + if (c == tmp) + return true; + } + return false; +} + +// Given information about the spacing surrounding an operator, +// return 1 if it looks like it should be treated as a binary +// operator. For example, +// +// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary +// +// [ 1 +2 ] ==> unary + +static bool +looks_like_bin_op (bool spc_prev, int next_char) +{ + bool spc_next = (next_char == ' ' || next_char == '\t'); + + return ((spc_prev && spc_next) || ! spc_prev); +} + +// Recognize separators. If the separator is a CRLF pair, it is +// replaced by a single LF. + +static bool +next_token_is_sep_op (void) +{ + bool retval = false; + + int c = text_yyinput (); + + retval = match_any (c, ",;\n]"); + + xunput (c, yytext); + + return retval; +} + +// Try to determine if the next token should be treated as a postfix +// unary operator. This is ugly, but it seems to do the right thing. + +static bool +next_token_is_postfix_unary_op (bool spc_prev) +{ + bool un_op = false; + + int c0 = text_yyinput (); + + if (c0 == '\'' && ! spc_prev) + { + un_op = true; + } + else if (c0 == '.') + { + int c1 = text_yyinput (); + un_op = (c1 == '\''); + xunput (c1, yytext); + } + else if (c0 == '+') + { + int c1 = text_yyinput (); + un_op = (c1 == '+'); + xunput (c1, yytext); + } + else if (c0 == '-') + { + int c1 = text_yyinput (); + un_op = (c1 == '-'); + xunput (c1, yytext); + } + + xunput (c0, yytext); + + return un_op; +} + +// Try to determine if the next token should be treated as a binary +// operator. +// +// This kluge exists because whitespace is not always ignored inside +// the square brackets that are used to create matrix objects (though +// spacing only really matters in the cases that can be interpreted +// either as binary ops or prefix unary ops: currently just +, -). +// +// Note that a line continuation directly following a + or - operator +// (e.g., the characters '[' 'a' ' ' '+' '\' LFD 'b' ']') will be +// parsed as a binary operator. + +static bool +next_token_is_bin_op (bool spc_prev) +{ + bool bin_op = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '=': + // Binary ops, spacing doesn't matter. + bin_op = true; + break; + + default: + // Could be either, spacing matters. + bin_op = looks_like_bin_op (spc_prev, c1); + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + // Always a binary op (may also include /=, \=, and ^=). + bin_op = true; + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + // Always a binary op (may also include .+=, .-=, ./=, ...). + bin_op = true; + else if (! isdigit (c1) && c1 != ' ' && c1 != '\t' && c1 != '.') + // A structure element reference is a binary op. + bin_op = true; + + xunput (c1, yytext); + } + break; + + // = == & && | || * ** + case '=': + case '&': + case '|': + case '*': + // Always a binary op (may also include ==, &&, ||, **). + bin_op = true; + break; + + // < <= <> > >= + case '<': + case '>': + // Always a binary op (may also include <=, <>, >=). + bin_op = true; + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + bin_op = true; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return bin_op; +} + +// Used to delete trailing white space from tokens. + +static std::string +strip_trailing_whitespace (char *s) +{ + std::string retval = s; + + size_t pos = retval.find_first_of (" \t"); + + if (pos != std::string::npos) + retval.resize (pos); + + return retval; +} + +// FIXME -- we need to handle block comments here. + +static void +scan_for_comments (const char *text) +{ + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int len = strlen (text); + int i = 0; + + while (i < len) + { + char c = text[i++]; + + switch (c) + { + case '%': + case '#': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + break; + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + break; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); +} + +// Discard whitespace, including comments and continuations. +// +// Return value is logical OR of the following values: +// +// ATE_NOTHING : no spaces to eat +// ATE_SPACE_OR_TAB : space or tab in input +// ATE_NEWLINE : bare new line in input + +// FIXME -- we need to handle block comments here. + +static yum_yum +eat_whitespace (void) +{ + yum_yum retval = ATE_NOTHING; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + retval |= ATE_SPACE_OR_TAB; + break; + + case '\n': + retval |= ATE_NEWLINE; + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + comment_buf.resize (0); + in_comment = false; + beginning_of_comment = false; + } + current_input_column = 0; + break; + + case '#': + case '%': + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + break; + + case '.': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + { + if (have_ellipsis_continuation ()) + break; + else + goto done; + } + + case '\\': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + { + if (have_continuation ()) + break; + else + goto done; + } + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + break; + } + else + goto done; + } + } + + if (! comment_buf.empty ()) + octave_comment_buffer::append (comment_buf); + + done: + xunput (c, yytext); + current_input_column--; + return retval; +} + +static inline bool +looks_like_hex (const char *s, int len) +{ + return (len > 2 && s[0] == '0' && (s[1] == 'x' || s[1] == 'X')); +} + +static void +handle_number (void) +{ + double value = 0.0; + int nread = 0; + + if (looks_like_hex (yytext, strlen (yytext))) + { + unsigned long ival; + + nread = sscanf (yytext, "%lx", &ival); + + value = static_cast (ival); + } + else + { + char *tmp = strsave (yytext); + + char *idx = strpbrk (tmp, "Dd"); + + if (idx) + *idx = 'e'; + + nread = sscanf (tmp, "%lf", &value); + + delete [] tmp; + } + + // If yytext doesn't contain a valid number, we are in deep doo doo. + + assert (nread == 1); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + lexer_flags.at_beginning_of_statement = false; + + yylval.tok_val = new token (value, yytext, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + + do_comma_insert_check (); +} + +// We have seen a backslash and need to find out if it should be +// treated as a continuation character. If so, this eats it, up to +// and including the new line character. +// +// Match whitespace only, followed by a comment character or newline. +// Once a comment character is found, discard all input until newline. +// If non-whitespace characters are found before comment +// characters, return 0. Otherwise, return 1. + +// FIXME -- we need to handle block comments here. + +static bool +have_continuation (bool trailing_comments_ok) +{ + std::ostringstream buf; + + std::string comment_buf; + + bool in_comment = false; + bool beginning_of_comment = false; + + int c = 0; + + while ((c = text_yyinput ()) != EOF) + { + buf << static_cast (c); + + switch (c) + { + case ' ': + case '\t': + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + break; + + case '%': + case '#': + if (trailing_comments_ok) + { + if (in_comment) + { + if (! beginning_of_comment) + comment_buf += static_cast (c); + } + else + { + maybe_gripe_matlab_incompatible_comment (c); + in_comment = true; + beginning_of_comment = true; + } + } + else + goto cleanup; + break; + + case '\n': + if (in_comment) + { + comment_buf += static_cast (c); + octave_comment_buffer::append (comment_buf); + } + current_input_column = 0; + promptflag--; + gripe_matlab_incompatible_continuation (); + return true; + + default: + if (in_comment) + { + comment_buf += static_cast (c); + beginning_of_comment = false; + } + else + goto cleanup; + break; + } + } + + xunput (c, yytext); + return false; + +cleanup: + + std::string s = buf.str (); + + int len = s.length (); + while (len--) + xunput (s[len], yytext); + + return false; +} + +// We have seen a `.' and need to see if it is the start of a +// continuation. If so, this eats it, up to and including the new +// line character. + +static bool +have_ellipsis_continuation (bool trailing_comments_ok) +{ + char c1 = text_yyinput (); + if (c1 == '.') + { + char c2 = text_yyinput (); + if (c2 == '.' && have_continuation (trailing_comments_ok)) + return true; + else + { + xunput (c2, yytext); + xunput (c1, yytext); + } + } + else + xunput (c1, yytext); + + return false; +} + +// See if we have a continuation line. If so, eat it and the leading +// whitespace on the next line. +// +// Return value is the same as described for eat_whitespace(). + +static yum_yum +eat_continuation (void) +{ + int retval = ATE_NOTHING; + + int c = text_yyinput (); + + if ((c == '.' && have_ellipsis_continuation ()) + || (c == '\\' && have_continuation ())) + retval = eat_whitespace (); + else + xunput (c, yytext); + + return retval; +} + +static int +handle_string (char delim) +{ + std::ostringstream buf; + + int bos_line = input_line_number; + int bos_col = current_input_column; + + int c; + int escape_pending = 0; + + while ((c = text_yyinput ()) != EOF) + { + current_input_column++; + + if (c == '\\') + { + if (delim == '\'' || escape_pending) + { + buf << static_cast (c); + escape_pending = 0; + } + else + { + if (have_continuation (false)) + escape_pending = 0; + else + { + buf << static_cast (c); + escape_pending = 1; + } + } + continue; + } + else if (c == '.') + { + if (delim == '\'' || ! have_ellipsis_continuation (false)) + buf << static_cast (c); + } + else if (c == '\n') + { + error ("unterminated string constant"); + break; + } + else if (c == delim) + { + if (escape_pending) + buf << static_cast (c); + else + { + c = text_yyinput (); + if (c == delim) + { + buf << static_cast (c); + } + else + { + std::string s; + xunput (c, yytext); + + if (delim == '\'') + s = buf.str (); + else + s = do_string_escapes (buf.str ()); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + yylval.tok_val = new token (s, bos_line, bos_col); + token_stack.push (yylval.tok_val); + + if (delim == '"') + gripe_matlab_incompatible ("\" used as string delimiter"); + else if (delim == '\'') + gripe_single_quote_string (); + + lexer_flags.looking_for_object_index = true; + lexer_flags.at_beginning_of_statement = false; + + return delim == '"' ? DQ_STRING : SQ_STRING; + } + } + } + else + { + buf << static_cast (c); + } + + escape_pending = 0; + } + + return LEXICAL_ERROR; +} + +static bool +next_token_is_assign_op (void) +{ + bool retval = false; + + int c0 = text_yyinput (); + + switch (c0) + { + case '=': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 != '=') + retval = true; + } + break; + + case '+': + case '-': + case '*': + case '/': + case '\\': + case '&': + case '|': + { + int c1 = text_yyinput (); + xunput (c1, yytext); + if (c1 == '=') + retval = true; + } + break; + + case '.': + { + int c1 = text_yyinput (); + if (match_any (c1, "+-*/\\")) + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '>': + { + int c1 = text_yyinput (); + if (c1 == '>') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + case '<': + { + int c1 = text_yyinput (); + if (c1 == '<') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + if (c2 == '=') + retval = true; + } + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static bool +next_token_is_index_op (void) +{ + int c = text_yyinput (); + xunput (c, yytext); + return c == '(' || c == '{'; +} + +static int +handle_close_bracket (bool spc_gobbled, int bracket_type) +{ + int retval = bracket_type; + + if (! nesting_level.none ()) + { + nesting_level.remove (); + + if (bracket_type == ']') + lexer_flags.bracketflag--; + else if (bracket_type == '}') + lexer_flags.braceflag--; + else + panic_impossible (); + } + + if (lexer_flags.bracketflag == 0 && lexer_flags.braceflag == 0) + BEGIN (INITIAL); + + if (bracket_type == ']' + && next_token_is_assign_op () + && ! lexer_flags.looking_at_return_list) + { + retval = CLOSE_BRACE; + } + else if ((lexer_flags.bracketflag || lexer_flags.braceflag) + && lexer_flags.convert_spaces_to_comma + && (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ()))) + { + bool index_op = next_token_is_index_op (); + + // Don't insert comma if we are looking at something like + // + // [x{i}{j}] or [x{i}(j)] + // + // but do if we are looking at + // + // [x{i} {j}] or [x{i} (j)] + + if (spc_gobbled || ! (bracket_type == '}' && index_op)) + { + bool bin_op = next_token_is_bin_op (spc_gobbled); + + bool postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + bool sep_op = next_token_is_sep_op (); + + if (! (postfix_un_op || bin_op || sep_op)) + { + maybe_warn_separator_insert (','); + + xunput (',', yytext); + return retval; + } + } + } + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + + return retval; +} + +static void +maybe_unput_comma (int spc_gobbled) +{ + if (nesting_level.is_bracket () + || (nesting_level.is_brace () + && ! lexer_flags.looking_at_object_index.front ())) + { + int bin_op = next_token_is_bin_op (spc_gobbled); + + int postfix_un_op = next_token_is_postfix_unary_op (spc_gobbled); + + int c1 = text_yyinput (); + int c2 = text_yyinput (); + + xunput (c2, yytext); + xunput (c1, yytext); + + int sep_op = next_token_is_sep_op (); + + int dot_op = (c1 == '.' + && (isalpha (c2) || isspace (c2) || c2 == '_')); + + if (postfix_un_op || bin_op || sep_op || dot_op) + return; + + int index_op = (c1 == '(' || c1 == '{'); + + // If there is no space before the indexing op, we don't insert + // a comma. + + if (index_op && ! spc_gobbled) + return; + + maybe_warn_separator_insert (','); + + xunput (',', yytext); + } +} + +static bool +next_token_can_follow_bin_op (void) +{ + std::stack buf; + + int c = EOF; + + // Skip whitespace in current statement on current line + while (true) + { + c = text_yyinput (); + + buf.push (c); + + if (match_any (c, ",;\n") || (c != ' ' && c != '\t')) + break; + } + + // Restore input. + while (! buf.empty ()) + { + xunput (buf.top (), yytext); + + buf.pop (); + } + + return (isalnum (c) || match_any (c, "!\"'(-[_{~")); +} + +static bool +can_be_command (const std::string& tok) +{ + // Don't allow these names to be treated as commands to avoid + // surprises when parsing things like "NaN ^2". + + return ! (tok == "e" + || tok == "I" || tok == "i" + || tok == "J" || tok == "j" + || tok == "Inf" || tok == "inf" + || tok == "NaN" || tok == "nan"); +} + +static bool +looks_like_command_arg (void) +{ + bool retval = true; + + int c0 = text_yyinput (); + + switch (c0) + { + // = == + case '=': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else + retval = false; + + xunput (c1, yytext); + } + break; + + case '(': + case '{': + // Indexing. + retval = false; + break; + + case '\n': + // EOL. + break; + + case '\'': + case '"': + // Beginning of a character string. + break; + + // + - ++ -- += -= + case '+': + case '-': + { + int c1 = text_yyinput (); + + switch (c1) + { + case '\n': + // EOL. + case '+': + case '-': + // Unary ops, spacing doesn't matter. + break; + + case '\t': + case ' ': + { + if (next_token_can_follow_bin_op ()) + retval = false; + } + break; + + case '=': + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + break; + } + + xunput (c1, yytext); + } + break; + + case ':': + case '/': + case '\\': + case '^': + { + int c1 = text_yyinput (); + + if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // .+ .- ./ .\ .^ .* .** + case '.': + { + int c1 = text_yyinput (); + + if (match_any (c1, "+-/\\^*")) + { + int c2 = text_yyinput (); + + if (c2 == '=') + { + int c3 = text_yyinput (); + + if (! match_any (c3, ",;\n") && (c3 == ' ' || c3 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c3, yytext); + } + else if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") + && (! isdigit (c1) && c1 != ' ' && c1 != '\t' + && c1 != '.')) + { + // Structure reference. FIXME -- is this a complete check? + + retval = false; + } + + xunput (c1, yytext); + } + break; + + // & && | || * ** + case '&': + case '|': + case '*': + { + int c1 = text_yyinput (); + + if (c1 == c0) + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // < <= > >= + case '<': + case '>': + { + int c1 = text_yyinput (); + + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + // ~= != + case '~': + case '!': + { + int c1 = text_yyinput (); + + // ~ and ! can be unary ops, so require following =. + if (c1 == '=') + { + int c2 = text_yyinput (); + + if (! match_any (c2, ",;\n") && (c2 == ' ' || c2 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c2, yytext); + } + else if (! match_any (c1, ",;\n") && (c1 == ' ' || c1 == '\t') + && next_token_can_follow_bin_op ()) + retval = false; + + xunput (c1, yytext); + } + break; + + default: + break; + } + + xunput (c0, yytext); + + return retval; +} + +static int +handle_superclass_identifier (void) +{ + int c = yytext[yyleng-1]; + + std::string meth = strip_trailing_whitespace (yytext); + + int cont_is_spc = eat_continuation (); + + int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + + size_t pos = meth.find ("@"); + std::string cls = meth.substr (pos + 1); + meth = meth.substr (0, pos); + + std::string pkg; + pos = cls.find ("."); + if (pos != std::string::npos) + { + pkg = cls.substr (0, pos); + cls = cls.substr (pos + 1); + } + + int kw_token = (is_keyword_token (meth) || is_keyword_token (cls) + || is_keyword_token (pkg)); + if (kw_token) + { + error ("method, class, and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val = new token (meth, pkg, cls, input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); + + do_comma_insert_check (); + maybe_unput_comma (spc_gobbled); + current_input_column += yyleng; + + return SUPERCLASSREF; +} + +static int +handle_meta_identifier (void) +{ + int c = yytext[yyleng-1]; + + std::string cls = strip_trailing_whitespace (yytext).substr (1); + + int cont_is_spc = eat_continuation (); + + int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + + std::string pkg; + size_t pos = cls.find ("."); + if (pos != std::string::npos) + { + pkg = cls.substr (0, pos); + cls = cls.substr (pos + 1); + } + + int kw_token = is_keyword_token (cls) || is_keyword_token (pkg); + if (kw_token) + { + error ("class and package names may not be keywords"); + return LEXICAL_ERROR; + } + + yylval.tok_val = new token (pkg, cls, input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); + + do_comma_insert_check (); + maybe_unput_comma (spc_gobbled); + current_input_column += yyleng; + + return METAQUERY; +} + +// Figure out exactly what kind of token to return when we have seen +// an identifier. Handles keywords. Return -1 if the identifier +// should be ignored. + +static int +handle_identifier (void) +{ + bool at_bos = lexer_flags.at_beginning_of_statement; + + std::string tok = strip_trailing_whitespace (yytext); + + int c = yytext[yyleng-1]; + + int cont_is_spc = eat_continuation (); + + int spc_gobbled = (cont_is_spc || c == ' ' || c == '\t'); + + // If we are expecting a structure element, avoid recognizing + // keywords and other special names and return STRUCT_ELT, which is + // a string that is also a valid identifier. But first, we have to + // decide whether to insert a comma. + + if (lexer_flags.looking_at_indirect_ref) + { + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + lexer_flags.quote_is_transpose = true; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + current_input_column += yyleng; + + return STRUCT_ELT; + } + + lexer_flags.at_beginning_of_statement = false; + + // The is_keyword_token may reset + // lexer_flags.at_beginning_of_statement. For example, if it sees + // an else token, then the next token is at the beginning of a + // statement. + + int kw_token = is_keyword_token (tok); + + // If we found a keyword token, then the beginning_of_statement flag + // is already set. Otherwise, we won't be at the beginning of a + // statement. + + if (lexer_flags.looking_at_function_handle) + { + if (kw_token) + { + error ("function handles may not refer to keywords"); + + return LEXICAL_ERROR; + } + else + { + yylval.tok_val = new token (tok, input_line_number, + current_input_column); + + token_stack.push (yylval.tok_val); + + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = true; + + return FCN_HANDLE; + } + } + + // If we have a regular keyword, return it. + // Keywords can be followed by identifiers. + + if (kw_token) + { + if (kw_token >= 0) + { + current_input_column += yyleng; + lexer_flags.quote_is_transpose = false; + lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; + } + + return kw_token; + } + + // See if we have a plot keyword (title, using, with, or clear). + + int c1 = text_yyinput (); + + bool next_tok_is_eq = false; + if (c1 == '=') + { + int c2 = text_yyinput (); + xunput (c2, yytext); + + if (c2 != '=') + next_tok_is_eq = true; + } + + xunput (c1, yytext); + + // Kluge alert. + // + // If we are looking at a text style function, set up to gobble its + // arguments. + // + // If the following token is `=', or if we are parsing a function + // return list or function parameter list, or if we are looking at + // something like [ab,cd] = foo (), force the symbol to be inserted + // as a variable in the current symbol table. + + if (! is_variable (tok)) + { + if (at_bos && spc_gobbled && can_be_command (tok) + && looks_like_command_arg ()) + { + BEGIN (COMMAND_START); + } + else if (next_tok_is_eq + || lexer_flags.looking_at_decl_list + || lexer_flags.looking_at_return_list + || (lexer_flags.looking_at_parameter_list + && ! lexer_flags.looking_at_initializer_expression)) + { + symbol_table::force_variable (tok); + } + else if (lexer_flags.looking_at_matrix_or_assign_lhs) + { + lexer_flags.pending_local_variables.insert (tok); + } + } + + // Find the token in the symbol table. Beware the magic + // transformation of the end keyword... + + if (tok == "end") + tok = "__end__"; + + yylval.tok_val = new token (&(symbol_table::insert (tok)), + input_line_number, current_input_column); + + token_stack.push (yylval.tok_val); + + // After seeing an identifer, it is ok to convert spaces to a comma + // (if needed). + + lexer_flags.convert_spaces_to_comma = true; + + if (! (next_tok_is_eq || YY_START == COMMAND_START)) + { + lexer_flags.quote_is_transpose = true; + + do_comma_insert_check (); + + maybe_unput_comma (spc_gobbled); + } + + current_input_column += yyleng; + + if (tok != "__end__") + lexer_flags.looking_for_object_index = true; + + return NAME; +} + +void +lexical_feedback::init (void) +{ + // Not initially defining a matrix list. + bracketflag = 0; + + // Not initially defining a cell array list. + braceflag = 0; + + // Not initially inside a loop or if statement. + looping = 0; + + // Not initially defining a function. + defining_func = 0; + + // Not parsing an object index. + while (! parsed_function_name.empty ()) + parsed_function_name.pop (); + + parsing_class_method = false; + + // Not initially defining a class with classdef. + maybe_classdef_get_set_method = false; + parsing_classdef = false; + parsing_classdef_get_method = false; + parsing_classdef_set_method = false; + + // Not initiallly looking at a function handle. + looking_at_function_handle = 0; + + // Not initiallly looking at an anonymous function argument list. + looking_at_anon_fcn_args = 0; + + // Not parsing a function return, parameter, or declaration list. + looking_at_return_list = false; + looking_at_parameter_list = false; + looking_at_decl_list = false; + + // Not looking at an argument list initializer expression. + looking_at_initializer_expression = false; + + // Not parsing a matrix or the left hand side of multi-value + // assignment statement. + looking_at_matrix_or_assign_lhs = false; + + // Not parsing an object index. + while (! looking_at_object_index.empty ()) + looking_at_object_index.pop_front (); + + looking_at_object_index.push_front (false); + + // Object index not possible until we've seen something. + looking_for_object_index = false; + + // Yes, we are at the beginning of a statement. + at_beginning_of_statement = true; + + // No need to do comma insert or convert spaces to comma at + // beginning of input. + convert_spaces_to_comma = true; + do_comma_insert = false; + + // Not initially looking at indirect references. + looking_at_indirect_ref = false; + + // Quote marks strings intially. + quote_is_transpose = false; + + // Set of identifiers that might be local variable names is empty. + pending_local_variables.clear (); +} + +bool +is_keyword (const std::string& s) +{ + // Parsing function names like "set.property_name" inside + // classdef-style class definitions is simplified by handling the + // "set" and "get" portions of the names using the same mechanism as + // is used for keywords. However, they are not really keywords in + // the language, so omit them from the list of possible keywords. + + return (octave_kw_hash::in_word_set (s.c_str (), s.length ()) != 0 + && ! (s == "set" || s == "get")); +} + +DEFUN (iskeyword, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} iskeyword ()\n\ +@deftypefnx {Built-in Function} {} iskeyword (@var{name})\n\ +Return true if @var{name} is an Octave keyword. If @var{name}\n\ +is omitted, return a list of keywords.\n\ +@seealso{isvarname, exist}\n\ +@end deftypefn") +{ + octave_value retval; + + int argc = args.length () + 1; + + string_vector argv = args.make_argv ("iskeyword"); + + if (error_state) + return retval; + + if (argc == 1) + { + // Neither set and get are keywords. See the note in the + // is_keyword function for additional details. + + string_vector lst (TOTAL_KEYWORDS); + + int j = 0; + + for (int i = 0; i < TOTAL_KEYWORDS; i++) + { + std::string tmp = wordlist[i].name; + + if (! (tmp == "set" || tmp == "get")) + lst[j++] = tmp; + } + + lst.resize (j); + + retval = Cell (lst.sort ()); + } + else if (argc == 2) + { + retval = is_keyword (argv[1]); + } + else + print_usage (); + + return retval; +} + +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + +void +prep_lexer_for_script_file (void) +{ + BEGIN (SCRIPT_FILE_BEGIN); +} + +void +prep_lexer_for_function_file (void) +{ + BEGIN (FUNCTION_FILE_BEGIN); +} + +void +prep_lexer_for_classdef_file (void) +{ + BEGIN (CLASSDEF_FILE_BEGIN); +} + +static void +maybe_warn_separator_insert (char sep) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d", + sep, input_line_number); + else + warning_with_id ("Octave:separator-insert", + "potential auto-insertion of `%c' near line %d of file %s", + sep, input_line_number, nm.c_str ()); +} + +static void +gripe_single_quote_string (void) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d", + input_line_number); + else + warning_with_id ("Octave:single-quote-string", + "single quote delimited string near line %d of file %s", + input_line_number, nm.c_str ()); +} + +static void +gripe_matlab_incompatible (const std::string& msg) +{ + std::string nm = curr_fcn_file_full_name; + + if (nm.empty ()) + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s", + msg.c_str ()); + else + warning_with_id ("Octave:matlab-incompatible", + "potential Matlab compatibility problem: %s near line %d offile %s", + msg.c_str (), input_line_number, nm.c_str ()); +} + +static void +maybe_gripe_matlab_incompatible_comment (char c) +{ + if (c == '#') + gripe_matlab_incompatible ("# used as comment character"); +} + +static void +gripe_matlab_incompatible_continuation (void) +{ + gripe_matlab_incompatible ("\\ used as line continuation marker"); +} + +static void +gripe_matlab_incompatible_operator (const std::string& op) +{ + std::string t = op; + int n = t.length (); + if (t[n-1] == '\n') + t.resize (n-1); + gripe_matlab_incompatible (t + " used as operator"); +} + +static void +display_token (int tok) +{ + switch (tok) + { + case '=': std::cerr << "'='\n"; break; + case ':': std::cerr << "':'\n"; break; + case '-': std::cerr << "'-'\n"; break; + case '+': std::cerr << "'+'\n"; break; + case '*': std::cerr << "'*'\n"; break; + case '/': std::cerr << "'/'\n"; break; + case ADD_EQ: std::cerr << "ADD_EQ\n"; break; + case SUB_EQ: std::cerr << "SUB_EQ\n"; break; + case MUL_EQ: std::cerr << "MUL_EQ\n"; break; + case DIV_EQ: std::cerr << "DIV_EQ\n"; break; + case LEFTDIV_EQ: std::cerr << "LEFTDIV_EQ\n"; break; + case POW_EQ: std::cerr << "POW_EQ\n"; break; + case EMUL_EQ: std::cerr << "EMUL_EQ\n"; break; + case EDIV_EQ: std::cerr << "EDIV_EQ\n"; break; + case ELEFTDIV_EQ: std::cerr << "ELEFTDIV_EQ\n"; break; + case EPOW_EQ: std::cerr << "EPOW_EQ\n"; break; + case AND_EQ: std::cerr << "AND_EQ\n"; break; + case OR_EQ: std::cerr << "OR_EQ\n"; break; + case LSHIFT_EQ: std::cerr << "LSHIFT_EQ\n"; break; + case RSHIFT_EQ: std::cerr << "RSHIFT_EQ\n"; break; + case LSHIFT: std::cerr << "LSHIFT\n"; break; + case RSHIFT: std::cerr << "RSHIFT\n"; break; + case EXPR_AND_AND: std::cerr << "EXPR_AND_AND\n"; break; + case EXPR_OR_OR: std::cerr << "EXPR_OR_OR\n"; break; + case EXPR_AND: std::cerr << "EXPR_AND\n"; break; + case EXPR_OR: std::cerr << "EXPR_OR\n"; break; + case EXPR_NOT: std::cerr << "EXPR_NOT\n"; break; + case EXPR_LT: std::cerr << "EXPR_LT\n"; break; + case EXPR_LE: std::cerr << "EXPR_LE\n"; break; + case EXPR_EQ: std::cerr << "EXPR_EQ\n"; break; + case EXPR_NE: std::cerr << "EXPR_NE\n"; break; + case EXPR_GE: std::cerr << "EXPR_GE\n"; break; + case EXPR_GT: std::cerr << "EXPR_GT\n"; break; + case LEFTDIV: std::cerr << "LEFTDIV\n"; break; + case EMUL: std::cerr << "EMUL\n"; break; + case EDIV: std::cerr << "EDIV\n"; break; + case ELEFTDIV: std::cerr << "ELEFTDIV\n"; break; + case EPLUS: std::cerr << "EPLUS\n"; break; + case EMINUS: std::cerr << "EMINUS\n"; break; + case QUOTE: std::cerr << "QUOTE\n"; break; + case TRANSPOSE: std::cerr << "TRANSPOSE\n"; break; + case PLUS_PLUS: std::cerr << "PLUS_PLUS\n"; break; + case MINUS_MINUS: std::cerr << "MINUS_MINUS\n"; break; + case POW: std::cerr << "POW\n"; break; + case EPOW: std::cerr << "EPOW\n"; break; + + case NUM: + case IMAG_NUM: + std::cerr << (tok == NUM ? "NUM" : "IMAG_NUM") + << " [" << yylval.tok_val->number () << "]\n"; + break; + + case STRUCT_ELT: + std::cerr << "STRUCT_ELT [" << yylval.tok_val->text () << "]\n"; break; + + case NAME: + { + symbol_table::symbol_record *sr = yylval.tok_val->sym_rec (); + std::cerr << "NAME"; + if (sr) + std::cerr << " [" << sr->name () << "]"; + std::cerr << "\n"; + } + break; + + case END: std::cerr << "END\n"; break; + + case DQ_STRING: + case SQ_STRING: + std::cerr << (tok == DQ_STRING ? "DQ_STRING" : "SQ_STRING") + << " [" << yylval.tok_val->text () << "]\n"; + break; + + case FOR: std::cerr << "FOR\n"; break; + case WHILE: std::cerr << "WHILE\n"; break; + case DO: std::cerr << "DO\n"; break; + case UNTIL: std::cerr << "UNTIL\n"; break; + case IF: std::cerr << "IF\n"; break; + case ELSEIF: std::cerr << "ELSEIF\n"; break; + case ELSE: std::cerr << "ELSE\n"; break; + case SWITCH: std::cerr << "SWITCH\n"; break; + case CASE: std::cerr << "CASE\n"; break; + case OTHERWISE: std::cerr << "OTHERWISE\n"; break; + case BREAK: std::cerr << "BREAK\n"; break; + case CONTINUE: std::cerr << "CONTINUE\n"; break; + case FUNC_RET: std::cerr << "FUNC_RET\n"; break; + case UNWIND: std::cerr << "UNWIND\n"; break; + case CLEANUP: std::cerr << "CLEANUP\n"; break; + case TRY: std::cerr << "TRY\n"; break; + case CATCH: std::cerr << "CATCH\n"; break; + case GLOBAL: std::cerr << "GLOBAL\n"; break; + case PERSISTENT: std::cerr << "PERSISTENT\n"; break; + case FCN_HANDLE: std::cerr << "FCN_HANDLE\n"; break; + case END_OF_INPUT: std::cerr << "END_OF_INPUT\n\n"; break; + case LEXICAL_ERROR: std::cerr << "LEXICAL_ERROR\n\n"; break; + case FCN: std::cerr << "FCN\n"; break; + case CLOSE_BRACE: std::cerr << "CLOSE_BRACE\n"; break; + case SCRIPT_FILE: std::cerr << "SCRIPT_FILE\n"; break; + case FUNCTION_FILE: std::cerr << "FUNCTION_FILE\n"; break; + case CLASSDEF_FILE: std::cerr << "CLASSDEF_FILE\n"; break; + case SUPERCLASSREF: std::cerr << "SUPERCLASSREF\n"; break; + case METAQUERY: std::cerr << "METAQUERY\n"; break; + case GET: std::cerr << "GET\n"; break; + case SET: std::cerr << "SET\n"; break; + case PROPERTIES: std::cerr << "PROPERTIES\n"; break; + case METHODS: std::cerr << "METHODS\n"; break; + case EVENTS: std::cerr << "EVENTS\n"; break; + case CLASSDEF: std::cerr << "CLASSDEF\n"; break; + case '\n': std::cerr << "\\n\n"; break; + case '\r': std::cerr << "\\r\n"; break; + case '\t': std::cerr << "TAB\n"; break; + default: + { + if (tok < 256) + std::cerr << static_cast (tok) << "\n"; + else + std::cerr << "UNKNOWN(" << tok << ")\n"; + } + break; + } +} + +static void +display_state (void) +{ + std::cerr << "S: "; + + switch (YY_START) + { + case INITIAL: + std::cerr << "INITIAL" << std::endl; + break; + + case COMMAND_START: + std::cerr << "COMMAND_START" << std::endl; + break; + + case MATRIX_START: + std::cerr << "MATRIX_START" << std::endl; + break; + + case SCRIPT_FILE_BEGIN: + std::cerr << "SCRIPT_FILE_BEGIN" << std::endl; + break; + + case FUNCTION_FILE_BEGIN: + std::cerr << "FUNCTION_FILE_BEGIN" << std::endl; + break; + + case CLASSDEF_FILE_BEGIN: + std::cerr << "CLASSDEF_FILE_BEGIN" << std::endl; + break; + + default: + std::cerr << "UNKNOWN START STATE!" << std::endl; + break; + } +} + +static void +lexer_debug (const char *pattern, const char *text) +{ + std::cerr << std::endl; + + display_state (); + + std::cerr << "P: " << pattern << std::endl; + std::cerr << "T: " << text << std::endl; +} + +DEFUN (__display_tokens__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __display_tokens__ ()\n\ +Query or set the internal variable that determines whether Octave's\n\ +lexer displays tokens as they are read.\n\ +@end deftypefn") +{ + return SET_INTERNAL_VARIABLE (display_tokens); +} + +DEFUN (__token_count__, , , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __token_count__ ()\n\ +Number of language tokens processed since Octave startup.\n\ +@end deftypefn") +{ + return octave_value (Vtoken_count); +} + +DEFUN (__lexer_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __lexer_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + retval = set_internal_variable (lexer_debug_flag, args, nargout, + "__lexer_debug_flag__"); + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/parse-tree/module.mk --- a/src/parse-tree/module.mk Tue Jul 31 09:54:19 2012 -0400 +++ b/src/parse-tree/module.mk Fri Aug 03 14:35:44 2012 -0400 @@ -1,6 +1,18 @@ EXTRA_DIST += \ parse-tree/module.mk +PARSER_INCLUDES = \ + parse-tree/lex.h \ + parse-tree/parse.h \ + parse-tree/parse-private.h + +PARSER_SRC = \ + parse-tree/lex.ll \ + parse-tree/oct-parse.yy + +lex.lo lex.o oct-parse.lo oct-parse.o: \ + AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) + PT_INCLUDES = \ parse-tree/pt-all.h \ parse-tree/pt-arg-list.h \ @@ -31,7 +43,8 @@ parse-tree/pt-stmt.h \ parse-tree/pt-unop.h \ parse-tree/pt-walk.h \ - parse-tree/pt.h + parse-tree/pt.h \ + $(PARSER_INCLUDES) PARSE_TREE_SRC = \ parse-tree/pt-arg-list.cc \ @@ -61,5 +74,6 @@ parse-tree/pt-select.cc \ parse-tree/pt-stmt.cc \ parse-tree/pt-unop.cc \ - parse-tree/pt.cc + parse-tree/pt.cc \ + $(PARSER_SRC) diff -r 069c552587a0 -r 959953dba519 src/parse-tree/oct-parse.yy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/oct-parse.yy Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,5027 @@ +/* + +Copyright (C) 1993-2012 John W. Eaton +Copyright (C) 2009 David Grundberg +Copyright (C) 2009-2010 VZLU Prague + +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 3 of the License, 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, see +. + +*/ + +// Parser for Octave. + +// C decarations. + +%{ +#define YYDEBUG 1 + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include +#include +#include + +#include +#include +#include + +#include "Cell.h" +#include "Matrix.h" +#include "cmd-edit.h" +#include "cmd-hist.h" +#include "file-ops.h" +#include "file-stat.h" +#include "oct-env.h" +#include "oct-time.h" +#include "quit.h" + +#include "comment-list.h" +#include "defaults.h" +#include "defun.h" +#include "dirfns.h" +#include "dynamic-ld.h" +#include "error.h" +#include "input.h" +#include "lex.h" +#include "load-path.h" +#include "oct-hist.h" +#include "oct-map.h" +#include "ov-classdef.h" +#include "ov-fcn-handle.h" +#include "ov-usr-fcn.h" +#include "ov-null-mat.h" +#include "toplev.h" +#include "pager.h" +#include "parse.h" +#include "parse-private.h" +#include "pt-all.h" +#include "pt-eval.h" +#include "pt-funcall.h" +#include "symtab.h" +#include "token.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +#if defined (GNULIB_NAMESPACE) +// Calls to the following functions appear in the generated output from +// Bison without the namespace tag. Redefine them so we will use them +// via the gnulib namespace. +#define fclose GNULIB_NAMESPACE::fclose +#define fprintf GNULIB_NAMESPACE::fprintf +#define malloc GNULIB_NAMESPACE::malloc +#endif + +// The current input line number. +int input_line_number = 1; + +// The column of the current token. +int current_input_column = 1; + +// Buffer for help text snagged from function files. +std::stack help_buf; + +// Buffer for comments appearing before a function statement. +static std::string fcn_comment_header; + +// TRUE means we are using readline. +// (--no-line-editing) +bool line_editing = true; + +// TRUE means we printed messages about reading startup files. +bool reading_startup_message_printed = false; + +// TRUE means input is coming from startup file. +bool input_from_startup_file = false; + +// = 0 currently outside any function. +// = 1 inside the primary function or a subfunction. +// > 1 means we are looking at a function definition that seems to be +// inside a function. Note that the function still might not be a +// nested function. +static int current_function_depth = 0; + +// A stack holding the nested function scopes being parsed. +// We don't use std::stack, because we want the clear method. Also, we +// must access one from the top +static std::vector function_scopes; + +// Maximum function depth detected. Just here to determine whether +// we have nested functions or just implicitly ended subfunctions. +static int max_function_depth = 0; + +// FALSE if we are still at the primary function. Subfunctions can +// only be declared inside function files. +static int parsing_subfunctions = false; + +// Have we found an explicit end to a function? +static bool endfunction_found = false; + +// Keep track of symbol table information when parsing functions. +symtab_context parser_symtab_context; + +// Name of the current class when we are parsing class methods or +// constructors. +std::string current_class_name; + +// TRUE means we are in the process of autoloading a function. +static bool autoloading = false; + +// TRUE means the current function file was found in a relative path +// element. +static bool fcn_file_from_relative_lookup = false; + +// Pointer to the primary user function or user script function. +static octave_function *primary_fcn_ptr = 0; + +// Scope where we install all subfunctions and nested functions. Only +// used while reading function files. +static symbol_table::scope_id primary_fcn_scope; + +// Pointer to the classdef object we just parsed, if any. +static tree_classdef *classdef_object = 0; + +// List of autoloads (function -> file mapping). +static std::map autoload_map; + +// Forward declarations for some functions defined at the bottom of +// the file. + +// Generic error messages. +static void +yyerror (const char *s); + +// Error mesages for mismatched end tokens. +static void +end_error (const char *type, token::end_tok_type ettype, int l, int c); + +// Check to see that end tokens are properly matched. +static bool +end_token_ok (token *tok, token::end_tok_type expected); + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. +static void +maybe_warn_assign_as_truth_value (tree_expression *expr); + +// Maybe print a warning about switch labels that aren't constants. +static void +maybe_warn_variable_switch_label (tree_expression *expr); + +// Finish building a range. +static tree_expression * +finish_colon_expression (tree_colon_expression *e); + +// Build a constant. +static tree_constant * +make_constant (int op, token *tok_val); + +// Build a function handle. +static tree_fcn_handle * +make_fcn_handle (token *tok_val); + +// Build an anonymous function handle. +static tree_anon_fcn_handle * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt); + +// Build a binary expression. +static tree_expression * +make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a boolean expression. +static tree_expression * +make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2); + +// Build a prefix expression. +static tree_expression * +make_prefix_op (int op, tree_expression *op1, token *tok_val); + +// Build a postfix expression. +static tree_expression * +make_postfix_op (int op, tree_expression *op1, token *tok_val); + +// Build an unwind-protect command. +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a try-catch command. +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc); + +// Build a while command. +static tree_command * +make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); + +// Build a do-until command. +static tree_command * +make_do_until_command (token *until_tok, tree_statement_list *body, + tree_expression *expr, octave_comment_list *lc); + +// Build a for command. +static tree_command * +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); + +// Build a break command. +static tree_command * +make_break_command (token *break_tok); + +// Build a continue command. +static tree_command * +make_continue_command (token *continue_tok); + +// Build a return command. +static tree_command * +make_return_command (token *return_tok); + +// Start an if command. +static tree_if_command_list * +start_if_command (tree_expression *expr, tree_statement_list *list); + +// Finish an if command. +static tree_if_command * +finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc); + +// Build an elseif clause. +static tree_if_clause * +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Finish a switch command. +static tree_switch_command * +finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, token *end_tok, + octave_comment_list *lc); + +// Build a switch case. +static tree_switch_case * +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); + +// Build an assignment to a variable. +static tree_expression * +make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs); + +// Define a script. +static void +make_script (tree_statement_list *cmds, tree_statement *end_script); + +// Begin defining a function. +static octave_user_function * +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_function); + +// Create a no-op statement for end_function. +static tree_statement * +make_end (const std::string& type, int l, int c); + +// Do most of the work for defining a function. +static octave_user_function * +frob_function (const std::string& fname, octave_user_function *fcn); + +// Finish defining a function. +static tree_function_def * +finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, octave_comment_list *lc); + +// Reset state after parsing function. +static void +recover_from_parsing_function (void); + +// Make an index expression. +static tree_index_expression * +make_index_expression (tree_expression *expr, + tree_argument_list *args, char type); + +// Make an indirect reference expression. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, const std::string&); + +// Make an indirect reference expression with dynamic field name. +static tree_index_expression * +make_indirect_ref (tree_expression *expr, tree_expression *field); + +// Make a declaration command. +static tree_decl_command * +make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst); + +// Validate argument list forming a matrix or cell row. +static tree_argument_list * +validate_matrix_row (tree_argument_list *row); + +// Finish building a matrix list. +static tree_expression * +finish_matrix (tree_matrix *m); + +// Finish building a cell list. +static tree_expression * +finish_cell (tree_cell *c); + +// Maybe print a warning. Duh. +static void +maybe_warn_missing_semi (tree_statement_list *); + +// Set the print flag for a statement based on the separator type. +static tree_statement_list * +set_stmt_print_flag (tree_statement_list *, char, bool); + +// Create a statement list. +static tree_statement_list *make_statement_list (tree_statement *stmt); + +// Append a statement to an existing statement list. +static tree_statement_list * +append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, bool warn_missing_semi); + +static tree_funcall * +make_superclass_ref (const std::string& method_nm, + const std::string& package_nm, + const std::string& class_nm, + int l, int c); + +static tree_funcall * +make_meta_class_query (const std::string& package_nm, + const std::string& class_nm, + int l, int c); + +static tree_classdef * +make_classdef (token *tok_val, tree_classdef_attribute_list *a, + tree_identifier *id, tree_classdef_superclass_list *sc, + tree_classdef_body *body, token *end_tok, + octave_comment_list *lc); + +static tree_classdef_properties_block * +make_classdef_properties_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_property_list *plist, + token *end_tok, octave_comment_list *lc); + +static tree_classdef_methods_block * +make_classdef_methods_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_methods_list *mlist, + token *end_tok, octave_comment_list *lc); + +static tree_classdef_events_block * +make_classdef_events_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_events_list *elist, + token *end_tok, octave_comment_list *lc); + +static tree_classdef_enum_block * +make_classdef_enum_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_enum_list *elist, + token *end_tok, octave_comment_list *lc); + +// Finish building a statement. +template +static tree_statement * +make_statement (T *arg) +{ + octave_comment_list *comment = octave_comment_buffer::get_comment (); + + return new tree_statement (arg, comment); +} + +#define ABORT_PARSE \ + do \ + { \ + global_command = 0; \ + yyerrok; \ + if (! parser_symtab_context.empty ()) \ + parser_symtab_context.pop (); \ + if ((interactive || forced_interactive) \ + && ! get_input_from_eval_string) \ + YYACCEPT; \ + else \ + YYABORT; \ + } \ + while (0) + +%} + +// Bison declarations. + +// Don't add spaces around the = here; it causes some versions of +// bison to fail to properly recognize the directive. + +%name-prefix="octave_" + +%union +{ + // The type of the basic tokens returned by the lexer. + token *tok_val; + + // Comment strings that we need to deal with mid-rule. + octave_comment_list *comment_type; + + // Types for the nonterminals we generate. + char sep_type; + token *tok_type; + tree *tree_type; + tree_matrix *tree_matrix_type; + tree_cell *tree_cell_type; + tree_expression *tree_expression_type; + tree_constant *tree_constant_type; + tree_fcn_handle *tree_fcn_handle_type; + tree_funcall *tree_funcall_type; + tree_function_def *tree_function_def_type; + tree_anon_fcn_handle *tree_anon_fcn_handle_type; + tree_identifier *tree_identifier_type; + tree_index_expression *tree_index_expression_type; + tree_colon_expression *tree_colon_expression_type; + tree_argument_list *tree_argument_list_type; + tree_parameter_list *tree_parameter_list_type; + tree_command *tree_command_type; + tree_if_command *tree_if_command_type; + tree_if_clause *tree_if_clause_type; + tree_if_command_list *tree_if_command_list_type; + tree_switch_command *tree_switch_command_type; + tree_switch_case *tree_switch_case_type; + tree_switch_case_list *tree_switch_case_list_type; + tree_decl_elt *tree_decl_elt_type; + tree_decl_init_list *tree_decl_init_list_type; + tree_decl_command *tree_decl_command_type; + tree_statement *tree_statement_type; + tree_statement_list *tree_statement_list_type; + octave_user_function *octave_user_function_type; + + tree_classdef *tree_classdef_type; + tree_classdef_attribute* tree_classdef_attribute_type; + tree_classdef_attribute_list* tree_classdef_attribute_list_type; + tree_classdef_superclass* tree_classdef_superclass_type; + tree_classdef_superclass_list* tree_classdef_superclass_list_type; + tree_classdef_body* tree_classdef_body_type; + tree_classdef_property* tree_classdef_property_type; + tree_classdef_property_list* tree_classdef_property_list_type; + tree_classdef_properties_block* tree_classdef_properties_block_type; + tree_classdef_methods_list* tree_classdef_methods_list_type; + tree_classdef_methods_block* tree_classdef_methods_block_type; + tree_classdef_event* tree_classdef_event_type; + tree_classdef_events_list* tree_classdef_events_list_type; + tree_classdef_events_block* tree_classdef_events_block_type; + tree_classdef_enum* tree_classdef_enum_type; + tree_classdef_enum_list* tree_classdef_enum_list_type; + tree_classdef_enum_block* tree_classdef_enum_block_type; +} + +// Tokens with line and column information. +%token '=' ':' '-' '+' '*' '/' +%token ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ +%token EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ AND_EQ OR_EQ +%token LSHIFT_EQ RSHIFT_EQ LSHIFT RSHIFT +%token EXPR_AND_AND EXPR_OR_OR +%token EXPR_AND EXPR_OR EXPR_NOT +%token EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%token LEFTDIV EMUL EDIV ELEFTDIV EPLUS EMINUS +%token QUOTE TRANSPOSE +%token PLUS_PLUS MINUS_MINUS POW EPOW +%token NUM IMAG_NUM +%token STRUCT_ELT +%token NAME +%token END +%token DQ_STRING SQ_STRING +%token FOR PARFOR WHILE DO UNTIL +%token IF ELSEIF ELSE +%token SWITCH CASE OTHERWISE +%token BREAK CONTINUE FUNC_RET +%token UNWIND CLEANUP +%token TRY CATCH +%token GLOBAL PERSISTENT +%token FCN_HANDLE +%token CLASSDEF +%token PROPERTIES METHODS EVENTS ENUMERATION +%token METAQUERY +%token SUPERCLASSREF +%token GET SET + +// Other tokens. +%token END_OF_INPUT LEXICAL_ERROR +%token FCN SCRIPT_FILE CLASSDEF_FILE FUNCTION_FILE +// %token VARARGIN VARARGOUT +%token CLOSE_BRACE + +// Nonterminals we construct. +%type stash_comment function_beg +%type classdef_beg +%type sep_no_nl opt_sep_no_nl sep opt_sep opt_comma +%type input +%type string constant magic_colon +%type anon_fcn_handle +%type fcn_handle +%type matrix_rows matrix_rows1 +%type cell_rows cell_rows1 +%type matrix cell +%type primary_expr oper_expr +%type simple_expr colon_expr assign_expr expression +%type identifier fcn_name magic_tilde +%type superclass_identifier meta_identifier +%type function1 function2 +%type word_list_cmd +%type colon_expr1 +%type arg_list word_list assign_lhs +%type cell_or_matrix_row +%type param_list param_list1 param_list2 +%type return_list return_list1 +%type command select_command loop_command +%type jump_command except_command +%type function +%type classdef +%type script_file classdef_file +%type function_file function_list +%type if_command +%type elseif_clause else_clause +%type if_cmd_list1 if_cmd_list +%type switch_command +%type switch_case default_case +%type case_list1 case_list +%type decl2 +%type decl1 +%type declaration +%type statement function_end +%type simple_list simple_list1 list list1 +%type opt_list input1 + +%type attr +%type attr_list opt_attr_list +%type superclass +%type superclass_list opt_superclass_list +%type class_body +%type class_property +%type property_list +%type properties_block +%type methods_list +%type methods_block +%type class_event +%type events_list +%type events_block +%type class_enum +%type enum_list +%type enum_block + +// Precedence and associativity. +%right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ +%left EXPR_OR_OR +%left EXPR_AND_AND +%left EXPR_OR +%left EXPR_AND +%left EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%left LSHIFT RSHIFT +%left ':' +%left '-' '+' EPLUS EMINUS +%left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV +%right UNARY EXPR_NOT +%left POW EPOW QUOTE TRANSPOSE +%right PLUS_PLUS MINUS_MINUS +%left '(' '.' '{' + +// Where to start. +%start input + +%% + +// ============================== +// Statements and statement lists +// ============================== + +input : input1 + { + global_command = $1; + promptflag = 1; + YYACCEPT; + } + | function_file + { YYACCEPT; } + | classdef_file + { YYACCEPT; } + | simple_list parse_error + { ABORT_PARSE; } + | parse_error + { ABORT_PARSE; } + ; + +input1 : '\n' + { $$ = 0; } + | END_OF_INPUT + { + parser_end_of_input = 1; + $$ = 0; + } + | simple_list + { $$ = $1; } + | simple_list '\n' + { $$ = $1; } + | simple_list END_OF_INPUT + { $$ = $1; } + ; + +simple_list : simple_list1 opt_sep_no_nl + { $$ = set_stmt_print_flag ($1, $2, false); } + ; + +simple_list1 : statement + { $$ = make_statement_list ($1); } + | simple_list1 sep_no_nl statement + { $$ = append_statement_list ($1, $2, $3, false); } + ; + +opt_list : // empty + { $$ = new tree_statement_list (); } + | list + { $$ = $1; } + ; + +list : list1 opt_sep + { $$ = set_stmt_print_flag ($1, $2, true); } + ; + +list1 : statement + { $$ = make_statement_list ($1); } + | list1 sep statement + { $$ = append_statement_list ($1, $2, $3, true); } + ; + +statement : expression + { $$ = make_statement ($1); } + | command + { $$ = make_statement ($1); } + | word_list_cmd + { $$ = make_statement ($1); } + ; + +// ================= +// Word-list command +// ================= + +// These are not really like expressions since they can't appear on +// the RHS of an assignment. But they are also not like commands (IF, +// WHILE, etc. + +word_list_cmd : identifier word_list + { $$ = make_index_expression ($1, $2, '('); } + ; + +word_list : string + { $$ = new tree_argument_list ($1); } + | word_list string + { + $1->append ($2); + $$ = $1; + } + ; + +// =========== +// Expressions +// =========== + +identifier : NAME + { + symbol_table::symbol_record *sr = $1->sym_rec (); + $$ = new tree_identifier (*sr, $1->line (), $1->column ()); + } + ; + +superclass_identifier + : SUPERCLASSREF + { + std::string method_nm = $1->superclass_method_name (); + std::string package_nm = $1->superclass_package_name (); + std::string class_nm = $1->superclass_class_name (); + + $$ = make_superclass_ref (method_nm, package_nm, class_nm, + $1->line (), $1->column ()); + } + ; + +meta_identifier : METAQUERY + { + std::string package_nm = $1->meta_package_name (); + std::string class_nm = $1->meta_class_name (); + + $$ = make_meta_class_query (package_nm, class_nm, + $1->line (), $1->column ()); + } + ; + +string : DQ_STRING + { $$ = make_constant (DQ_STRING, $1); } + | SQ_STRING + { $$ = make_constant (SQ_STRING, $1); } + ; + +constant : NUM + { $$ = make_constant (NUM, $1); } + | IMAG_NUM + { $$ = make_constant (IMAG_NUM, $1); } + | string + { $$ = $1; } + ; + +matrix : '[' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ';' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' ',' ']' + { + $$ = new tree_constant (octave_null_matrix::instance); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + | '[' matrix_rows ']' + { + $$ = finish_matrix ($2); + lexer_flags.looking_at_matrix_or_assign_lhs = false; + lexer_flags.pending_local_variables.clear (); + } + ; + +matrix_rows : matrix_rows1 + { $$ = $1; } + | matrix_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +matrix_rows1 : cell_or_matrix_row + { $$ = new tree_matrix ($1); } + | matrix_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell : '{' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' ';' '}' + { $$ = new tree_constant (octave_value (Cell ())); } + | '{' cell_rows '}' + { $$ = finish_cell ($2); } + ; + +cell_rows : cell_rows1 + { $$ = $1; } + | cell_rows1 ';' // Ignore trailing semicolon. + { $$ = $1; } + ; + +cell_rows1 : cell_or_matrix_row + { $$ = new tree_cell ($1); } + | cell_rows1 ';' cell_or_matrix_row + { + $1->append ($3); + $$ = $1; + } + ; + +cell_or_matrix_row + : arg_list + { $$ = validate_matrix_row ($1); } + | arg_list ',' // Ignore trailing comma. + { $$ = validate_matrix_row ($1); } + ; + +fcn_handle : '@' FCN_HANDLE + { + $$ = make_fcn_handle ($2); + lexer_flags.looking_at_function_handle--; + } + ; + +anon_fcn_handle : '@' param_list statement + { + lexer_flags.quote_is_transpose = false; + $$ = make_anon_fcn_handle ($2, $3); + } + ; + +primary_expr : identifier + { $$ = $1; } + | constant + { $$ = $1; } + | fcn_handle + { $$ = $1; } + | matrix + { $$ = $1; } + | cell + { $$ = $1; } + | meta_identifier + { $$ = $1; } + | superclass_identifier + { $$ = $1; } + | '(' expression ')' + { $$ = $2->mark_in_parens (); } + ; + +magic_colon : ':' + { + octave_value tmp (octave_value::magic_colon_t); + $$ = new tree_constant (tmp); + } + ; + +magic_tilde : EXPR_NOT + { + $$ = new tree_black_hole (); + } + ; + +arg_list : expression + { $$ = new tree_argument_list ($1); } + | magic_colon + { $$ = new tree_argument_list ($1); } + | magic_tilde + { $$ = new tree_argument_list ($1); } + | arg_list ',' magic_colon + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' magic_tilde + { + $1->append ($3); + $$ = $1; + } + | arg_list ',' expression + { + $1->append ($3); + $$ = $1; + } + ; + +indirect_ref_op : '.' + { lexer_flags.looking_at_indirect_ref = true; } + ; + +oper_expr : primary_expr + { $$ = $1; } + | oper_expr PLUS_PLUS + { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' + { $$ = make_index_expression ($1, 0, '('); } + | oper_expr '(' arg_list ')' + { $$ = make_index_expression ($1, $3, '('); } + | oper_expr '{' '}' + { $$ = make_index_expression ($1, 0, '{'); } + | oper_expr '{' arg_list '}' + { $$ = make_index_expression ($1, $3, '{'); } + | oper_expr QUOTE + { $$ = make_postfix_op (QUOTE, $1, $2); } + | oper_expr TRANSPOSE + { $$ = make_postfix_op (TRANSPOSE, $1, $2); } + | oper_expr indirect_ref_op STRUCT_ELT + { $$ = make_indirect_ref ($1, $3->text ()); } + | oper_expr indirect_ref_op '(' expression ')' + { $$ = make_indirect_ref ($1, $4); } + | PLUS_PLUS oper_expr %prec UNARY + { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } + | MINUS_MINUS oper_expr %prec UNARY + { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } + | EXPR_NOT oper_expr %prec UNARY + { $$ = make_prefix_op (EXPR_NOT, $2, $1); } + | '+' oper_expr %prec UNARY + { $$ = make_prefix_op ('+', $2, $1); } + | '-' oper_expr %prec UNARY + { $$ = make_prefix_op ('-', $2, $1); } + | oper_expr POW oper_expr + { $$ = make_binary_op (POW, $1, $2, $3); } + | oper_expr EPOW oper_expr + { $$ = make_binary_op (EPOW, $1, $2, $3); } + | oper_expr '+' oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr '-' oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr '*' oper_expr + { $$ = make_binary_op ('*', $1, $2, $3); } + | oper_expr '/' oper_expr + { $$ = make_binary_op ('/', $1, $2, $3); } + | oper_expr EPLUS oper_expr + { $$ = make_binary_op ('+', $1, $2, $3); } + | oper_expr EMINUS oper_expr + { $$ = make_binary_op ('-', $1, $2, $3); } + | oper_expr EMUL oper_expr + { $$ = make_binary_op (EMUL, $1, $2, $3); } + | oper_expr EDIV oper_expr + { $$ = make_binary_op (EDIV, $1, $2, $3); } + | oper_expr LEFTDIV oper_expr + { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } + | oper_expr ELEFTDIV oper_expr + { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } + ; + +colon_expr : colon_expr1 + { $$ = finish_colon_expression ($1); } + ; + +colon_expr1 : oper_expr + { $$ = new tree_colon_expression ($1); } + | colon_expr1 ':' oper_expr + { + if (! ($$ = $1->append ($3))) + ABORT_PARSE; + } + ; + +simple_expr : colon_expr + { $$ = $1; } + | simple_expr LSHIFT simple_expr + { $$ = make_binary_op (LSHIFT, $1, $2, $3); } + | simple_expr RSHIFT simple_expr + { $$ = make_binary_op (RSHIFT, $1, $2, $3); } + | simple_expr EXPR_LT simple_expr + { $$ = make_binary_op (EXPR_LT, $1, $2, $3); } + | simple_expr EXPR_LE simple_expr + { $$ = make_binary_op (EXPR_LE, $1, $2, $3); } + | simple_expr EXPR_EQ simple_expr + { $$ = make_binary_op (EXPR_EQ, $1, $2, $3); } + | simple_expr EXPR_GE simple_expr + { $$ = make_binary_op (EXPR_GE, $1, $2, $3); } + | simple_expr EXPR_GT simple_expr + { $$ = make_binary_op (EXPR_GT, $1, $2, $3); } + | simple_expr EXPR_NE simple_expr + { $$ = make_binary_op (EXPR_NE, $1, $2, $3); } + | simple_expr EXPR_AND simple_expr + { $$ = make_binary_op (EXPR_AND, $1, $2, $3); } + | simple_expr EXPR_OR simple_expr + { $$ = make_binary_op (EXPR_OR, $1, $2, $3); } + | simple_expr EXPR_AND_AND simple_expr + { $$ = make_boolean_op (EXPR_AND_AND, $1, $2, $3); } + | simple_expr EXPR_OR_OR simple_expr + { $$ = make_boolean_op (EXPR_OR_OR, $1, $2, $3); } + ; + +// Arrange for the lexer to return CLOSE_BRACE for `]' by looking ahead +// one token for an assignment op. + +assign_lhs : simple_expr + { + $$ = new tree_argument_list ($1); + $$->mark_as_simple_assign_lhs (); + } + | '[' arg_list opt_comma CLOSE_BRACE + { + $$ = $2; + lexer_flags.looking_at_matrix_or_assign_lhs = false; + for (std::set::const_iterator p = lexer_flags.pending_local_variables.begin (); + p != lexer_flags.pending_local_variables.end (); + p++) + { + symbol_table::force_variable (*p); + } + lexer_flags.pending_local_variables.clear (); + } + ; + +assign_expr : assign_lhs '=' expression + { $$ = make_assign_op ('=', $1, $2, $3); } + | assign_lhs ADD_EQ expression + { $$ = make_assign_op (ADD_EQ, $1, $2, $3); } + | assign_lhs SUB_EQ expression + { $$ = make_assign_op (SUB_EQ, $1, $2, $3); } + | assign_lhs MUL_EQ expression + { $$ = make_assign_op (MUL_EQ, $1, $2, $3); } + | assign_lhs DIV_EQ expression + { $$ = make_assign_op (DIV_EQ, $1, $2, $3); } + | assign_lhs LEFTDIV_EQ expression + { $$ = make_assign_op (LEFTDIV_EQ, $1, $2, $3); } + | assign_lhs POW_EQ expression + { $$ = make_assign_op (POW_EQ, $1, $2, $3); } + | assign_lhs LSHIFT_EQ expression + { $$ = make_assign_op (LSHIFT_EQ, $1, $2, $3); } + | assign_lhs RSHIFT_EQ expression + { $$ = make_assign_op (RSHIFT_EQ, $1, $2, $3); } + | assign_lhs EMUL_EQ expression + { $$ = make_assign_op (EMUL_EQ, $1, $2, $3); } + | assign_lhs EDIV_EQ expression + { $$ = make_assign_op (EDIV_EQ, $1, $2, $3); } + | assign_lhs ELEFTDIV_EQ expression + { $$ = make_assign_op (ELEFTDIV_EQ, $1, $2, $3); } + | assign_lhs EPOW_EQ expression + { $$ = make_assign_op (EPOW_EQ, $1, $2, $3); } + | assign_lhs AND_EQ expression + { $$ = make_assign_op (AND_EQ, $1, $2, $3); } + | assign_lhs OR_EQ expression + { $$ = make_assign_op (OR_EQ, $1, $2, $3); } + ; + +expression : simple_expr + { $$ = $1; } + | assign_expr + { $$ = $1; } + | anon_fcn_handle + { $$ = $1; } + ; + +// ================================================ +// Commands, declarations, and function definitions +// ================================================ + +command : declaration + { $$ = $1; } + | select_command + { $$ = $1; } + | loop_command + { $$ = $1; } + | jump_command + { $$ = $1; } + | except_command + { $$ = $1; } + | function + { $$ = $1; } + | script_file + { $$ = $1; } + ; + +// ===================== +// Declaration statemnts +// ===================== + +parsing_decl_list + : // empty + { lexer_flags.looking_at_decl_list = true; } + +declaration : GLOBAL parsing_decl_list decl1 + { + $$ = make_decl_command (GLOBAL, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + | PERSISTENT parsing_decl_list decl1 + { + $$ = make_decl_command (PERSISTENT, $1, $3); + lexer_flags.looking_at_decl_list = false; + } + ; + +decl1 : decl2 + { $$ = new tree_decl_init_list ($1); } + | decl1 decl2 + { + $1->append ($2); + $$ = $1; + } + ; + +decl_param_init : // empty + { lexer_flags.looking_at_initializer_expression = true; } + +decl2 : identifier + { $$ = new tree_decl_elt ($1); } + | identifier '=' decl_param_init expression + { + lexer_flags.looking_at_initializer_expression = false; + $$ = new tree_decl_elt ($1, $4); + } + | magic_tilde + { + $$ = new tree_decl_elt ($1); + } + ; + +// ==================== +// Selection statements +// ==================== + +select_command : if_command + { $$ = $1; } + | switch_command + { $$ = $1; } + ; + +// ============ +// If statement +// ============ + +if_command : IF stash_comment if_cmd_list END + { + if (! ($$ = finish_if_command ($1, $3, $4, $2))) + ABORT_PARSE; + } + ; + +if_cmd_list : if_cmd_list1 + { $$ = $1; } + | if_cmd_list1 else_clause + { + $1->append ($2); + $$ = $1; + } + ; + +if_cmd_list1 : expression opt_sep opt_list + { + $1->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = start_if_command ($1, $3); + } + | if_cmd_list1 elseif_clause + { + $1->append ($2); + $$ = $1; + } + ; + +elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list + { + $4->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + $$ = make_elseif_clause ($1, $4, $6, $2); + } + ; + +else_clause : ELSE stash_comment opt_sep opt_list + { $$ = new tree_if_clause ($4, $2); } + ; + +// ================ +// Switch statement +// ================ + +switch_command : SWITCH stash_comment expression opt_sep case_list END + { + if (! ($$ = finish_switch_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + ; + +case_list : // empty + { $$ = new tree_switch_case_list (); } + | default_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 + { $$ = $1; } + | case_list1 default_case + { + $1->append ($2); + $$ = $1; + } + ; + +case_list1 : switch_case + { $$ = new tree_switch_case_list ($1); } + | case_list1 switch_case + { + $1->append ($2); + $$ = $1; + } + ; + +switch_case : CASE stash_comment opt_sep expression opt_sep opt_list + { $$ = make_switch_case ($1, $4, $6, $2); } + ; + +default_case : OTHERWISE stash_comment opt_sep opt_list + { + $$ = new tree_switch_case ($4, $2); + } + ; + +// ======= +// Looping +// ======= + +loop_command : WHILE stash_comment expression opt_sep opt_list END + { + $3->mark_braindead_shortcircuit (curr_fcn_file_full_name); + + if (! ($$ = make_while_command ($1, $3, $5, $6, $2))) + ABORT_PARSE; + } + | DO stash_comment opt_sep opt_list UNTIL expression + { + if (! ($$ = make_do_until_command ($5, $4, $6, $2))) + ABORT_PARSE; + } + | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, + $7, $8, $2))) + ABORT_PARSE; + } + | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, + $9, $10, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $3, $5, + 0, $7, $8, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) + ABORT_PARSE; + } + ; + +// ======= +// Jumping +// ======= + +jump_command : BREAK + { + if (! ($$ = make_break_command ($1))) + ABORT_PARSE; + } + | CONTINUE + { + if (! ($$ = make_continue_command ($1))) + ABORT_PARSE; + } + | FUNC_RET + { + if (! ($$ = make_return_command ($1))) + ABORT_PARSE; + } + ; + +// ========== +// Exceptions +// ========== + +except_command : UNWIND stash_comment opt_sep opt_list CLEANUP + stash_comment opt_sep opt_list END + { + if (! ($$ = make_unwind_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list CATCH + stash_comment opt_sep opt_list END + { + if (! ($$ = make_try_command ($1, $4, $8, $9, $2, $6))) + ABORT_PARSE; + } + | TRY stash_comment opt_sep opt_list END + { + if (! ($$ = make_try_command ($1, $4, 0, $5, $2, 0))) + ABORT_PARSE; + } + ; + +// =========================================== +// Some `subroutines' for function definitions +// =========================================== + +push_fcn_symtab : // empty + { + current_function_depth++; + + if (max_function_depth < current_function_depth) + max_function_depth = current_function_depth; + + parser_symtab_context.push (); + + symbol_table::set_scope (symbol_table::alloc_scope ()); + + function_scopes.push_back (symbol_table::current_scope ()); + + if (! reading_script_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_scope = symbol_table::current_scope (); + + if (reading_script_file && current_function_depth > 1) + yyerror ("nested functions not implemented in this context"); + } + ; + +// =========================== +// List of function parameters +// =========================== + +param_list_beg : '(' + { + lexer_flags.looking_at_parameter_list = true; + + if (lexer_flags.looking_at_function_handle) + { + parser_symtab_context.push (); + symbol_table::set_scope (symbol_table::alloc_scope ()); + lexer_flags.looking_at_function_handle--; + lexer_flags.looking_at_anon_fcn_args = true; + } + } + ; + +param_list_end : ')' + { + lexer_flags.looking_at_parameter_list = false; + lexer_flags.looking_for_object_index = false; + } + ; + +param_list : param_list_beg param_list1 param_list_end + { + lexer_flags.quote_is_transpose = false; + $$ = $2; + } + | param_list_beg error + { + yyerror ("invalid parameter list"); + $$ = 0; + ABORT_PARSE; + } + ; + +param_list1 : // empty + { $$ = 0; } + | param_list2 + { + $1->mark_as_formal_parameters (); + if ($1->validate (tree_parameter_list::in)) + $$ = $1; + else + ABORT_PARSE; + } + ; + +param_list2 : decl2 + { $$ = new tree_parameter_list ($1); } + | param_list2 ',' decl2 + { + $1->append ($3); + $$ = $1; + } + ; + +// =================================== +// List of function return value names +// =================================== + +return_list : '[' ']' + { + lexer_flags.looking_at_return_list = false; + $$ = new tree_parameter_list (); + } + | return_list1 + { + lexer_flags.looking_at_return_list = false; + if ($1->validate (tree_parameter_list::out)) + $$ = $1; + else + ABORT_PARSE; + } + | '[' return_list1 ']' + { + lexer_flags.looking_at_return_list = false; + if ($2->validate (tree_parameter_list::out)) + $$ = $2; + else + ABORT_PARSE; + } + ; + +return_list1 : identifier + { $$ = new tree_parameter_list (new tree_decl_elt ($1)); } + | return_list1 ',' identifier + { + $1->append (new tree_decl_elt ($3)); + $$ = $1; + } + ; + +// =========== +// Script file +// =========== + +script_file : SCRIPT_FILE opt_list END_OF_INPUT + { + tree_statement *end_of_script + = make_end ("endscript", input_line_number, + current_input_column); + + make_script ($2, end_of_script); + + $$ = 0; + } + ; + +// ============= +// Function file +// ============= + +function_file : FUNCTION_FILE function_list opt_sep END_OF_INPUT + { $$ = 0; } + ; + +function_list : function + | function_list sep function + ; + +// =================== +// Function definition +// =================== + +function_beg : push_fcn_symtab FCN stash_comment + { + $$ = $3; + + if (reading_classdef_file || lexer_flags.parsing_classdef) + lexer_flags.maybe_classdef_get_set_method = true; + } + ; + +function : function_beg function1 + { + $$ = finish_function (0, $2, $1); + recover_from_parsing_function (); + } + | function_beg return_list '=' function1 + { + $$ = finish_function ($2, $4, $1); + recover_from_parsing_function (); + } + ; + +fcn_name : identifier + { + std::string id_name = $1->name (); + + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + + $$ = $1; + } + | GET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + lexer_flags.parsing_classdef_get_method = true; + $$ = $3; + } + | SET '.' identifier + { + lexer_flags.parsed_function_name.top () = true; + lexer_flags.maybe_classdef_get_set_method = false; + lexer_flags.parsing_classdef_set_method = true; + $$ = $3; + } + ; + +function1 : fcn_name function2 + { + std::string fname = $1->name (); + + delete $1; + + if (! ($$ = frob_function (fname, $2))) + ABORT_PARSE; + } + ; + +function2 : param_list opt_sep opt_list function_end + { $$ = start_function ($1, $3, $4); } + | opt_sep opt_list function_end + { $$ = start_function (0, $2, $3); } + ; + +function_end : END + { + endfunction_found = true; + if (end_token_ok ($1, token::function_end)) + $$ = make_end ("endfunction", $1->line (), $1->column ()); + else + ABORT_PARSE; + } + | END_OF_INPUT + { +// A lot of tests are based on the assumption that this is OK +// if (reading_script_file) +// { +// yyerror ("function body open at end of script"); +// YYABORT; +// } + + if (endfunction_found) + { + yyerror ("inconsistent function endings -- " + "if one function is explicitly ended, " + "so must all the others"); + YYABORT; + } + + if (! (reading_fcn_file || reading_script_file + || get_input_from_eval_string)) + { + yyerror ("function body open at end of input"); + YYABORT; + } + + if (reading_classdef_file) + { + yyerror ("classdef body open at end of input"); + YYABORT; + } + + $$ = make_end ("endfunction", input_line_number, + current_input_column); + } + ; + +// ============= +// Classdef file +// ============= + +classdef_file : CLASSDEF_FILE classdef opt_sep END_OF_INPUT + { + classdef_object = $2; + $$ = 0; + } + ; + +// ======== +// Classdef +// ======== + +classdef_beg : CLASSDEF + { + if (! reading_classdef_file) + { + yyerror ("classdef must appear inside a file containing only a class definition"); + YYABORT; + } + + lexer_flags.parsing_classdef = true; + $$ = $1; + } + ; + +classdef : classdef_beg stash_comment opt_attr_list identifier opt_superclass_list opt_sep class_body opt_sep END + { + lexer_flags.parsing_classdef = false; + $$ = make_classdef ($1, $3, $4, $5, $7, $9, $2); + } + ; + +opt_attr_list : // empty + { $$ = 0; } + | '(' attr_list ')' + { $$ = $2; } + ; + +attr_list : attr + { $$ = new tree_classdef_attribute_list ($1); } + | attr_list ',' attr + { + $1->append ($3); + $$ = $1; + } + ; + +attr : identifier + { $$ = new tree_classdef_attribute ($1); } + | identifier '=' decl_param_init expression + { + lexer_flags.looking_at_initializer_expression = false; + $$ = new tree_classdef_attribute ($1, $4); + } + | EXPR_NOT identifier + { $$ = new tree_classdef_attribute ($2, false); } + ; + +opt_superclass_list + : // empty + { $$ = 0; } + | superclass_list + { $$ = $1; } + ; + +superclass_list : EXPR_LT superclass + { $$ = new tree_classdef_superclass_list ($2); } + | superclass_list EXPR_AND superclass + { + $1->append ($3); + $$ = $1; + } + ; + +superclass : identifier + { $$ = new tree_classdef_superclass ($1); } + | identifier '.' identifier + { $$ = new tree_classdef_superclass ($3, $1); } + ; + +class_body : properties_block + { $$ = new tree_classdef_body ($1); } + | methods_block + { $$ = new tree_classdef_body ($1); } + | events_block + { $$ = new tree_classdef_body ($1); } + | enum_block + { $$ = new tree_classdef_body ($1); } + | class_body opt_sep properties_block + { + $1->append ($3); + $$ = $1; + } + | class_body opt_sep methods_block + { + $1->append ($3); + $$ = $1; + } + | class_body opt_sep events_block + { + $1->append ($3); + $$ = $1; + } + | class_body opt_sep enum_block + { + $1->append ($3); + $$ = $1; + } + ; + +properties_block + : PROPERTIES stash_comment opt_attr_list opt_sep property_list opt_sep END + { + if (! ($$ = make_classdef_properties_block ($1, $3, $5, $7, $2))) + ABORT_PARSE; + } + ; + +property_list + : class_property + { $$ = new tree_classdef_property_list ($1); } + | property_list opt_sep class_property + { + $1->append ($3); + $$ = $1; + } + ; + +class_property : identifier + { $$ = new tree_classdef_property ($1); } + | identifier '=' decl_param_init expression ';' + { + lexer_flags.looking_at_initializer_expression = false; + $$ = new tree_classdef_property ($1, $4); + } + ; + +methods_block : METHODS stash_comment opt_attr_list opt_sep methods_list opt_sep END + { + if (! ($$ = make_classdef_methods_block ($1, $3, $5, $7, $2))) + ABORT_PARSE; + } + ; + +methods_list : function + { + octave_value fcn; + if ($1) + fcn = $1->function (); + delete $1; + $$ = new tree_classdef_methods_list (fcn); + } + | methods_list opt_sep function + { + octave_value fcn; + if ($3) + fcn = $3->function (); + delete $3; + + $1->append (fcn); + $$ = $1; + } + ; + +events_block : EVENTS stash_comment opt_attr_list opt_sep events_list opt_sep END + { + if (! ($$ = make_classdef_events_block ($1, $3, $5, $7, $2))) + ABORT_PARSE; + } + ; + +events_list : class_event + { $$ = new tree_classdef_events_list ($1); } + | events_list opt_sep class_event + { + $1->append ($3); + $$ = $1; + } + ; + +class_event : identifier + { $$ = new tree_classdef_event ($1); } + ; + +enum_block : ENUMERATION stash_comment opt_attr_list opt_sep enum_list opt_sep END + { + if (! ($$ = make_classdef_enum_block ($1, $3, $5, $7, $2))) + ABORT_PARSE; + } + ; + +enum_list : class_enum + { $$ = new tree_classdef_enum_list ($1); } + | enum_list opt_sep class_enum + { + $1->append ($3); + $$ = $1; + } + ; + +class_enum : identifier '(' expression ')' + { $$ = new tree_classdef_enum ($1, $3); } + ; + +// ============= +// Miscellaneous +// ============= + +stash_comment : // empty + { $$ = octave_comment_buffer::get_comment (); } + ; + +parse_error : LEXICAL_ERROR + { yyerror ("parse error"); } + | error + ; + +sep_no_nl : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | sep_no_nl ',' + { $$ = $1; } + | sep_no_nl ';' + { $$ = $1; } + ; + +opt_sep_no_nl : // empty + { $$ = 0; } + | sep_no_nl + { $$ = $1; } + ; + +sep : ',' + { $$ = ','; } + | ';' + { $$ = ';'; } + | '\n' + { $$ = '\n'; } + | sep ',' + { $$ = $1; } + | sep ';' + { $$ = $1; } + | sep '\n' + { $$ = $1; } + ; + +opt_sep : // empty + { $$ = 0; } + | sep + { $$ = $1; } + ; + +opt_comma : // empty + { $$ = 0; } + | ',' + { $$ = ','; } + ; + +%% + +// Generic error messages. + +static void +yyerror (const char *s) +{ + int err_col = current_input_column - 1; + + std::ostringstream output_buf; + + if (reading_fcn_file || reading_script_file || reading_classdef_file) + output_buf << "parse error near line " << input_line_number + << " of file " << curr_fcn_file_full_name; + else + output_buf << "parse error:"; + + if (s && strcmp (s, "parse error") != 0) + output_buf << "\n\n " << s; + + output_buf << "\n\n"; + + if (! current_input_line.empty ()) + { + size_t len = current_input_line.length (); + + if (current_input_line[len-1] == '\n') + current_input_line.resize (len-1); + + // Print the line, maybe with a pointer near the error token. + + output_buf << ">>> " << current_input_line << "\n"; + + if (err_col == 0) + err_col = len; + + for (int i = 0; i < err_col + 3; i++) + output_buf << " "; + + output_buf << "^"; + } + + output_buf << "\n"; + + std::string msg = output_buf.str (); + + parse_error ("%s", msg.c_str ()); +} + +// Error mesages for mismatched end tokens. + +static void +end_error (const char *type, token::end_tok_type ettype, int l, int c) +{ + static const char *fmt + = "`%s' command matched by `%s' near line %d column %d"; + + switch (ettype) + { + case token::simple_end: + error (fmt, type, "end", l, c); + break; + + case token::for_end: + error (fmt, type, "endfor", l, c); + break; + + case token::function_end: + error (fmt, type, "endfunction", l, c); + break; + + case token::classdef_end: + error (fmt, type, "endclassdef", l, c); + break; + + case token::if_end: + error (fmt, type, "endif", l, c); + break; + + case token::switch_end: + error (fmt, type, "endswitch", l, c); + break; + + case token::while_end: + error (fmt, type, "endwhile", l, c); + break; + + case token::try_catch_end: + error (fmt, type, "end_try_catch", l, c); + break; + + case token::unwind_protect_end: + error (fmt, type, "end_unwind_protect", l, c); + break; + + default: + panic_impossible (); + break; + } +} + +// Check to see that end tokens are properly matched. + +static bool +end_token_ok (token *tok, token::end_tok_type expected) +{ + bool retval = true; + + token::end_tok_type ettype = tok->ettype (); + + if (ettype != expected && ettype != token::simple_end) + { + retval = false; + + yyerror ("parse error"); + + int l = tok->line (); + int c = tok->column (); + + switch (expected) + { + case token::classdef_end: + end_error ("classdef", ettype, l, c); + break; + + case token::for_end: + end_error ("for", ettype, l, c); + break; + + case token::enumeration_end: + end_error ("enumeration", ettype, l, c); + break; + + case token::function_end: + end_error ("function", ettype, l, c); + break; + + case token::if_end: + end_error ("if", ettype, l, c); + break; + + case token::parfor_end: + end_error ("parfor", ettype, l, c); + break; + + case token::try_catch_end: + end_error ("try", ettype, l, c); + break; + + case token::switch_end: + end_error ("switch", ettype, l, c); + break; + + case token::unwind_protect_end: + end_error ("unwind_protect", ettype, l, c); + break; + + case token::while_end: + end_error ("while", ettype, l, c); + break; + + default: + panic_impossible (); + break; + } + } + + return retval; +} + +// Maybe print a warning if an assignment expression is used as the +// test in a logical expression. + +static void +maybe_warn_assign_as_truth_value (tree_expression *expr) +{ + if (expr->is_assignment_expression () + && expr->paren_count () < 2) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value"); + else + warning_with_id + ("Octave:assign-as-truth-value", + "suggest parenthesis around assignment used as truth value near line %d, column %d in file `%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +// Maybe print a warning about switch labels that aren't constants. + +static void +maybe_warn_variable_switch_label (tree_expression *expr) +{ + if (! expr->is_constant ()) + { + if (curr_fcn_file_full_name.empty ()) + warning_with_id ("Octave:variable-switch-label", + "variable switch label"); + else + warning_with_id + ("Octave:variable-switch-label", + "variable switch label near line %d, column %d in file `%s'", + expr->line (), expr->column (), curr_fcn_file_full_name.c_str ()); + } +} + +static tree_expression * +fold (tree_binary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op1 = e->lhs (); + tree_expression *op2 = e->rhs (); + + if (op1->is_constant () && op2->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op1->line (), op1->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +static tree_expression * +fold (tree_unary_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *op = e->operand (); + + if (op->is_constant ()) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, op->line (), op->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a range. + +static tree_expression * +finish_colon_expression (tree_colon_expression *e) +{ + tree_expression *retval = e; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + tree_expression *base = e->base (); + tree_expression *limit = e->limit (); + tree_expression *incr = e->increment (); + + if (base) + { + if (limit) + { + if (base->is_constant () && limit->is_constant () + && (! incr || (incr && incr->is_constant ()))) + { + octave_value tmp = e->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, base->line (), base->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + e->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete e; + + retval = tc_retval; + } + } + } + else + { + e->preserve_base (); + delete e; + + // FIXME -- need to attempt constant folding here + // too (we need a generic way to do that). + retval = base; + } + } + + return retval; +} + +// Make a constant. + +static tree_constant * +make_constant (int op, token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_constant *retval = 0; + + switch (op) + { + case NUM: + { + octave_value tmp (tok_val->number ()); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case IMAG_NUM: + { + octave_value tmp (Complex (0.0, tok_val->number ())); + retval = new tree_constant (tmp, l, c); + retval->stash_original_text (tok_val->text_rep ()); + } + break; + + case DQ_STRING: + case SQ_STRING: + { + std::string txt = tok_val->text (); + + char delim = op == DQ_STRING ? '"' : '\''; + octave_value tmp (txt, delim); + + if (txt.empty ()) + { + if (op == DQ_STRING) + tmp = octave_null_str::instance; + else + tmp = octave_null_sq_str::instance; + } + + retval = new tree_constant (tmp, l, c); + + if (op == DQ_STRING) + txt = undo_string_escapes (txt); + + // FIXME -- maybe this should also be handled by + // tok_val->text_rep () for character strings? + retval->stash_original_text (delim + txt + delim); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +// Make a function handle. + +static tree_fcn_handle * +make_fcn_handle (token *tok_val) +{ + int l = tok_val->line (); + int c = tok_val->column (); + + tree_fcn_handle *retval = new tree_fcn_handle (tok_val->text (), l, c); + + return retval; +} + +// Make an anonymous function handle. + +static tree_anon_fcn_handle * +make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) +{ + // FIXME -- need to get these from the location of the @ symbol. + int l = input_line_number; + int c = current_input_column; + + tree_parameter_list *ret_list = 0; + + symbol_table::scope_id fcn_scope = symbol_table::current_scope (); + + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + stmt->set_print_flag (false); + + tree_statement_list *body = new tree_statement_list (stmt); + + body->mark_as_anon_function_body (); + + tree_anon_fcn_handle *retval + = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); + // FIXME: Stash the filename. This does not work and produces + // errors when executed. + //retval->stash_file_name (curr_fcn_file_name); + + return retval; +} + +// Build a binary expression. + +static tree_expression * +make_binary_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + octave_value::binary_op t = octave_value::unknown_binary_op; + + switch (op) + { + case POW: + t = octave_value::op_pow; + break; + + case EPOW: + t = octave_value::op_el_pow; + break; + + case '+': + t = octave_value::op_add; + break; + + case '-': + t = octave_value::op_sub; + break; + + case '*': + t = octave_value::op_mul; + break; + + case '/': + t = octave_value::op_div; + break; + + case EMUL: + t = octave_value::op_el_mul; + break; + + case EDIV: + t = octave_value::op_el_div; + break; + + case LEFTDIV: + t = octave_value::op_ldiv; + break; + + case ELEFTDIV: + t = octave_value::op_el_ldiv; + break; + + case LSHIFT: + t = octave_value::op_lshift; + break; + + case RSHIFT: + t = octave_value::op_rshift; + break; + + case EXPR_LT: + t = octave_value::op_lt; + break; + + case EXPR_LE: + t = octave_value::op_le; + break; + + case EXPR_EQ: + t = octave_value::op_eq; + break; + + case EXPR_GE: + t = octave_value::op_ge; + break; + + case EXPR_GT: + t = octave_value::op_gt; + break; + + case EXPR_NE: + t = octave_value::op_ne; + break; + + case EXPR_AND: + t = octave_value::op_el_and; + break; + + case EXPR_OR: + t = octave_value::op_el_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_binary_expression *e + = maybe_compound_binary_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a boolean expression. + +static tree_expression * +make_boolean_op (int op, tree_expression *op1, token *tok_val, + tree_expression *op2) +{ + tree_boolean_expression::type t; + + switch (op) + { + case EXPR_AND_AND: + t = tree_boolean_expression::bool_and; + break; + + case EXPR_OR_OR: + t = tree_boolean_expression::bool_or; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_boolean_expression *e + = new tree_boolean_expression (op1, op2, l, c, t); + + return fold (e); +} + +// Build a prefix expression. + +static tree_expression * +make_prefix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case EXPR_NOT: + t = octave_value::op_not; + break; + + case '+': + t = octave_value::op_uplus; + break; + + case '-': + t = octave_value::op_uminus; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_prefix_expression *e + = new tree_prefix_expression (op1, l, c, t); + + return fold (e); +} + +// Build a postfix expression. + +static tree_expression * +make_postfix_op (int op, tree_expression *op1, token *tok_val) +{ + octave_value::unary_op t = octave_value::unknown_unary_op; + + switch (op) + { + case QUOTE: + t = octave_value::op_hermitian; + break; + + case TRANSPOSE: + t = octave_value::op_transpose; + break; + + case PLUS_PLUS: + t = octave_value::op_incr; + break; + + case MINUS_MINUS: + t = octave_value::op_decr; + break; + + default: + panic_impossible (); + break; + } + + int l = tok_val->line (); + int c = tok_val->column (); + + tree_postfix_expression *e + = new tree_postfix_expression (op1, l, c, t); + + return fold (e); +} + +// Build an unwind-protect command. + +static tree_command * +make_unwind_command (token *unwind_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::unwind_protect_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = unwind_tok->line (); + int c = unwind_tok->column (); + + retval = new tree_unwind_protect_command (body, cleanup, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a try-catch command. + +static tree_command * +make_try_command (token *try_tok, tree_statement_list *body, + tree_statement_list *cleanup, token *end_tok, + octave_comment_list *lc, octave_comment_list *mc) +{ + tree_command *retval = 0; + + if (end_token_ok (end_tok, token::try_catch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = try_tok->line (); + int c = try_tok->column (); + + retval = new tree_try_catch_command (body, cleanup, + lc, mc, tc, l, c); + } + + return retval; +} + +// Build a while command. + +static tree_command * +make_while_command (token *while_tok, tree_expression *expr, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + if (end_token_ok (end_tok, token::while_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = while_tok->line (); + int c = while_tok->column (); + + retval = new tree_while_command (expr, body, lc, tc, l, c); + } + + return retval; +} + +// Build a do-until command. + +static tree_command * +make_do_until_command (token *until_tok, tree_statement_list *body, + tree_expression *expr, octave_comment_list *lc) +{ + tree_command *retval = 0; + + maybe_warn_assign_as_truth_value (expr); + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = until_tok->line (); + int c = until_tok->column (); + + retval = new tree_do_until_command (expr, body, lc, tc, l, c); + + return retval; +} + +// Build a for command. + +static tree_command * +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) +{ + tree_command *retval = 0; + + bool parfor = tok_id == PARFOR; + + if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + lexer_flags.looping--; + + int l = for_tok->line (); + int c = for_tok->column (); + + if (lhs->length () == 1) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, + body, lc, tc, l, c); + + delete lhs; + } + else + { + if (parfor) + yyerror ("invalid syntax for parfor statement"); + else + retval = new tree_complex_for_command (lhs, expr, body, + lc, tc, l, c); + } + } + + return retval; +} + +// Build a break command. + +static tree_command * +make_break_command (token *break_tok) +{ + tree_command *retval = 0; + + int l = break_tok->line (); + int c = break_tok->column (); + + retval = new tree_break_command (l, c); + + return retval; +} + +// Build a continue command. + +static tree_command * +make_continue_command (token *continue_tok) +{ + tree_command *retval = 0; + + int l = continue_tok->line (); + int c = continue_tok->column (); + + retval = new tree_continue_command (l, c); + + return retval; +} + +// Build a return command. + +static tree_command * +make_return_command (token *return_tok) +{ + tree_command *retval = 0; + + int l = return_tok->line (); + int c = return_tok->column (); + + retval = new tree_return_command (l, c); + + return retval; +} + +// Start an if command. + +static tree_if_command_list * +start_if_command (tree_expression *expr, tree_statement_list *list) +{ + maybe_warn_assign_as_truth_value (expr); + + tree_if_clause *t = new tree_if_clause (expr, list); + + return new tree_if_command_list (t); +} + +// Finish an if command. + +static tree_if_command * +finish_if_command (token *if_tok, tree_if_command_list *list, + token *end_tok, octave_comment_list *lc) +{ + tree_if_command *retval = 0; + + if (end_token_ok (end_tok, token::if_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = if_tok->line (); + int c = if_tok->column (); + + if (list && ! list->empty ()) + { + tree_if_clause *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_if_command (list, lc, tc, l, c); + } + + return retval; +} + +// Build an elseif clause. + +static tree_if_clause * +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) +{ + maybe_warn_assign_as_truth_value (expr); + + int l = elseif_tok->line (); + int c = elseif_tok->column (); + + return new tree_if_clause (expr, list, lc, l, c); +} + +// Finish a switch command. + +static tree_switch_command * +finish_switch_command (token *switch_tok, tree_expression *expr, + tree_switch_case_list *list, token *end_tok, + octave_comment_list *lc) +{ + tree_switch_command *retval = 0; + + if (end_token_ok (end_tok, token::switch_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = switch_tok->line (); + int c = switch_tok->column (); + + if (list && ! list->empty ()) + { + tree_switch_case *elt = list->front (); + + if (elt) + { + elt->line (l); + elt->column (c); + } + } + + retval = new tree_switch_command (expr, list, lc, tc, l, c); + } + + return retval; +} + +// Build a switch case. + +static tree_switch_case * +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) +{ + maybe_warn_variable_switch_label (expr); + + int l = case_tok->line (); + int c = case_tok->column (); + + return new tree_switch_case (expr, list, lc, l, c); +} + +// Build an assignment to a variable. + +static tree_expression * +make_assign_op (int op, tree_argument_list *lhs, token *eq_tok, + tree_expression *rhs) +{ + tree_expression *retval = 0; + + octave_value::assign_op t = octave_value::unknown_assign_op; + + switch (op) + { + case '=': + t = octave_value::op_asn_eq; + break; + + case ADD_EQ: + t = octave_value::op_add_eq; + break; + + case SUB_EQ: + t = octave_value::op_sub_eq; + break; + + case MUL_EQ: + t = octave_value::op_mul_eq; + break; + + case DIV_EQ: + t = octave_value::op_div_eq; + break; + + case LEFTDIV_EQ: + t = octave_value::op_ldiv_eq; + break; + + case POW_EQ: + t = octave_value::op_pow_eq; + break; + + case LSHIFT_EQ: + t = octave_value::op_lshift_eq; + break; + + case RSHIFT_EQ: + t = octave_value::op_rshift_eq; + break; + + case EMUL_EQ: + t = octave_value::op_el_mul_eq; + break; + + case EDIV_EQ: + t = octave_value::op_el_div_eq; + break; + + case ELEFTDIV_EQ: + t = octave_value::op_el_ldiv_eq; + break; + + case EPOW_EQ: + t = octave_value::op_el_pow_eq; + break; + + case AND_EQ: + t = octave_value::op_el_and_eq; + break; + + case OR_EQ: + t = octave_value::op_el_or_eq; + break; + + default: + panic_impossible (); + break; + } + + int l = eq_tok->line (); + int c = eq_tok->column (); + + if (lhs->is_simple_assign_lhs ()) + { + tree_expression *tmp = lhs->remove_front (); + + retval = new tree_simple_assignment (tmp, rhs, false, l, c, t); + + delete lhs; + } + else if (t == octave_value::op_asn_eq) + return new tree_multi_assignment (lhs, rhs, false, l, c); + else + yyerror ("computed multiple assignment not allowed"); + + return retval; +} + +// Define a script. + +static void +make_script (tree_statement_list *cmds, tree_statement *end_script) +{ + std::string doc_string; + + if (! help_buf.empty ()) + { + doc_string = help_buf.top (); + help_buf.pop (); + } + + if (! cmds) + cmds = new tree_statement_list (); + + cmds->append (end_script); + + octave_user_script *script + = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, + cmds, doc_string); + + octave_time now; + + script->stash_fcn_file_time (now); + + primary_fcn_ptr = script; + + // Unmark any symbols that may have been tagged as local variables + // while parsing (for example, by force_local_variable in lex.l). + + symbol_table::unmark_forced_variables (); +} + +// Begin defining a function. + +static octave_user_function * +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_fcn_stmt) +{ + // We'll fill in the return list later. + + if (! body) + body = new tree_statement_list (); + + body->append (end_fcn_stmt); + + octave_user_function *fcn + = new octave_user_function (symbol_table::current_scope (), + param_list, 0, body); + + if (fcn) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + fcn->stash_trailing_comment (tc); + } + + return fcn; +} + +static tree_statement * +make_end (const std::string& type, int l, int c) +{ + return make_statement (new tree_no_op_command (type, l, c)); +} + +// Do most of the work for defining a function. + +static octave_user_function * +frob_function (const std::string& fname, octave_user_function *fcn) +{ + std::string id_name = fname; + + // If input is coming from a file, issue a warning if the name of + // the file does not match the name of the function stated in the + // file. Matlab doesn't provide a diagnostic (it ignores the stated + // name). + if (! autoloading && reading_fcn_file + && current_function_depth == 1 && ! parsing_subfunctions) + { + // FIXME -- should curr_fcn_file_name already be + // preprocessed when we get here? It seems to only be a + // problem with relative file names. + + std::string nm = curr_fcn_file_name; + + size_t pos = nm.find_last_of (file_ops::dir_sep_chars ()); + + if (pos != std::string::npos) + nm = curr_fcn_file_name.substr (pos+1); + + if (nm != id_name) + { + warning_with_id + ("Octave:function-name-clash", + "function name `%s' does not agree with function file name `%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + + id_name = nm; + } + } + + if (reading_fcn_file || reading_classdef_file || autoloading) + { + octave_time now; + + fcn->stash_fcn_file_name (curr_fcn_file_full_name); + fcn->stash_fcn_file_time (now); + fcn->mark_as_system_fcn_file (); + + if (fcn_file_from_relative_lookup) + fcn->mark_relative (); + + if (current_function_depth > 1 || parsing_subfunctions) + { + fcn->stash_parent_fcn_name (curr_fcn_file_name); + + if (current_function_depth > 1) + fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size ()-2]); + else + fcn->stash_parent_fcn_scope (primary_fcn_scope); + } + + if (lexer_flags.parsing_class_method) + { + if (current_class_name == id_name) + fcn->mark_as_class_constructor (); + else + fcn->mark_as_class_method (); + + fcn->stash_dispatch_class (current_class_name); + } + + std::string nm = fcn->fcn_file_name (); + + file_stat fs (nm); + + if (fs && fs.is_newer (now)) + warning_with_id ("Octave:future-time-stamp", + "time stamp for `%s' is in the future", nm.c_str ()); + } + else if (! (input_from_tmp_history_file || input_from_startup_file) + && reading_script_file + && curr_fcn_file_name == id_name) + { + warning ("function `%s' defined within script file `%s'", + id_name.c_str (), curr_fcn_file_full_name.c_str ()); + } + + fcn->stash_function_name (id_name); + fcn->stash_fcn_location (input_line_number, current_input_column); + + if (! help_buf.empty () && current_function_depth == 1 + && ! parsing_subfunctions) + { + fcn->document (help_buf.top ()); + + help_buf.pop (); + } + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + primary_fcn_ptr = fcn; + + return fcn; +} + +static tree_function_def * +finish_function (tree_parameter_list *ret_list, + octave_user_function *fcn, octave_comment_list *lc) +{ + tree_function_def *retval = 0; + + if (ret_list) + ret_list->mark_as_formal_parameters (); + + if (fcn) + { + std::string nm = fcn->name (); + std::string file = fcn->fcn_file_name (); + + std::string tmp = nm; + if (! file.empty ()) + tmp += ": " + file; + + symbol_table::cache_name (fcn->scope (), tmp); + + if (lc) + fcn->stash_leading_comment (lc); + + fcn->define_ret_list (ret_list); + + if (current_function_depth > 1 || parsing_subfunctions) + { + fcn->mark_as_subfunction (); + + if (endfunction_found && function_scopes.size () > 1) + { + symbol_table::scope_id pscope + = function_scopes[function_scopes.size ()-2]; + + symbol_table::install_nestfunction (nm, octave_value (fcn), + pscope); + } + else + symbol_table::install_subfunction (nm, octave_value (fcn), + primary_fcn_scope); + } + + if (current_function_depth == 1 && fcn) + symbol_table::update_nest (fcn->scope ()); + + if (! reading_fcn_file && current_function_depth == 1) + { + // We are either reading a script file or defining a function + // at the command line, so this definition creates a + // tree_function object that is placed in the parse tree. + // Otherwise, it is just inserted in the symbol table, + // either as a subfunction or nested function (see above), + // or as the primary function for the file, via + // primary_fcn_ptr (see also load_fcn_from_file,, + // parse_fcn_file, and + // symbol_table::fcn_info::fcn_info_rep::find_user_function). + + retval = new tree_function_def (fcn); + } + + // Unmark any symbols that may have been tagged as local + // variables while parsing (for example, by force_local_variable + // in lex.l). + + symbol_table::unmark_forced_variables (fcn->scope ()); + } + + return retval; +} + +static void +recover_from_parsing_function (void) +{ + if (parser_symtab_context.empty ()) + panic_impossible (); + + parser_symtab_context.pop (); + + if (reading_fcn_file && current_function_depth == 1 + && ! parsing_subfunctions) + parsing_subfunctions = true; + + current_function_depth--; + function_scopes.pop_back (); + + lexer_flags.defining_func--; + lexer_flags.parsed_function_name.pop (); + lexer_flags.looking_at_return_list = false; + lexer_flags.looking_at_parameter_list = false; +} + +// Make an index expression. + +static tree_index_expression * +make_index_expression (tree_expression *expr, tree_argument_list *args, + char type) +{ + tree_index_expression *retval = 0; + + if (args && args->has_magic_tilde ()) + { + yyerror ("invalid use of empty argument (~) in index expression"); + return retval; + } + + int l = expr->line (); + int c = expr->column (); + + expr->mark_postfix_indexed (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (args, type); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, args, l, c, type); + + return retval; +} + +// Make an indirect reference expression. + +static tree_index_expression * +make_indirect_ref (tree_expression *expr, const std::string& elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make an indirect reference expression with dynamic field name. + +static tree_index_expression * +make_indirect_ref (tree_expression *expr, tree_expression *elt) +{ + tree_index_expression *retval = 0; + + int l = expr->line (); + int c = expr->column (); + + if (expr->is_index_expression ()) + { + tree_index_expression *tmp = static_cast (expr); + + tmp->append (elt); + + retval = tmp; + } + else + retval = new tree_index_expression (expr, elt, l, c); + + lexer_flags.looking_at_indirect_ref = false; + + return retval; +} + +// Make a declaration command. + +static tree_decl_command * +make_decl_command (int tok, token *tok_val, tree_decl_init_list *lst) +{ + tree_decl_command *retval = 0; + + int l = tok_val->line (); + int c = tok_val->column (); + + switch (tok) + { + case GLOBAL: + retval = new tree_global_command (lst, l, c); + break; + + case PERSISTENT: + if (current_function_depth > 0) + retval = new tree_persistent_command (lst, l, c); + else + { + if (reading_script_file) + warning ("ignoring persistent declaration near line %d of file `%s'", + l, curr_fcn_file_full_name.c_str ()); + else + warning ("ignoring persistent declaration near line %d", l); + } + break; + + default: + panic_impossible (); + break; + } + + return retval; +} + +static tree_argument_list * +validate_matrix_row (tree_argument_list *row) +{ + if (row && row->has_magic_tilde ()) + yyerror ("invalid use of tilde (~) in matrix expression"); + return row; +} + +// Finish building a matrix list. + +static tree_expression * +finish_matrix (tree_matrix *m) +{ + tree_expression *retval = m; + + unwind_protect frame; + + frame.protect_var (error_state); + frame.protect_var (warning_state); + + frame.protect_var (discard_error_messages); + frame.protect_var (discard_warning_messages); + + discard_error_messages = true; + discard_warning_messages = true; + + if (m->all_elements_are_constant ()) + { + octave_value tmp = m->rvalue1 (); + + if (! (error_state || warning_state)) + { + tree_constant *tc_retval + = new tree_constant (tmp, m->line (), m->column ()); + + std::ostringstream buf; + + tree_print_code tpc (buf); + + m->accept (tpc); + + tc_retval->stash_original_text (buf.str ()); + + delete m; + + retval = tc_retval; + } + } + + return retval; +} + +// Finish building a cell list. + +static tree_expression * +finish_cell (tree_cell *c) +{ + return finish_matrix (c); +} + +static void +maybe_warn_missing_semi (tree_statement_list *t) +{ + if (current_function_depth > 0) + { + tree_statement *tmp = t->back (); + + if (tmp->is_expression ()) + warning_with_id + ("Octave:missing-semicolon", + "missing semicolon near line %d, column %d in file `%s'", + tmp->line (), tmp->column (), curr_fcn_file_full_name.c_str ()); + } +} + +static tree_statement_list * +set_stmt_print_flag (tree_statement_list *list, char sep, + bool warn_missing_semi) +{ + tree_statement *tmp = list->back (); + + switch (sep) + { + case ';': + tmp->set_print_flag (false); + break; + + case 0: + case ',': + case '\n': + tmp->set_print_flag (true); + if (warn_missing_semi) + maybe_warn_missing_semi (list); + break; + + default: + warning ("unrecognized separator type!"); + break; + } + + // Even if a statement is null, we add it to the list then remove it + // here so that the print flag is applied to the correct statement. + + if (tmp->is_null_statement ()) + { + list->pop_back (); + delete tmp; + } + + return list; +} + +static tree_statement_list * +make_statement_list (tree_statement *stmt) +{ + return new tree_statement_list (stmt); +} + +static tree_statement_list * +append_statement_list (tree_statement_list *list, char sep, + tree_statement *stmt, bool warn_missing_semi) +{ + set_stmt_print_flag (list, sep, warn_missing_semi); + + list->append (stmt); + + return list; +} + +static tree_funcall * +make_superclass_ref (const std::string& method_nm, + const std::string& package_nm, + const std::string& class_nm, + int l, int c) +{ + octave_value_list args; + + args(2) = class_nm; + args(1) = package_nm; + args(0) = method_nm; + + octave_value fcn + = symbol_table::find_built_in_function ("__superclass_reference__"); + + return new tree_funcall (fcn, args); +} + +static tree_funcall * +make_meta_class_query (const std::string& package_nm, + const std::string& class_nm, + int l, int c) +{ + octave_value_list args; + + args(1) = class_nm; + args(0) = package_nm; + + octave_value fcn + = symbol_table::find_built_in_function ("__meta_class_query__"); + + return new tree_funcall (fcn, args); +} + +// A CLASSDEF block defines a class that has a constructor and other +// methods, but it is not an executable command. Parsing the block +// makes some changes in the symbol table (inserting the constructor +// and methods, and adding to the list of known objects) and creates +// a parse tree containing meta information about the class. + +static tree_classdef * +make_classdef (token *tok_val, tree_classdef_attribute_list *a, + tree_identifier *id, tree_classdef_superclass_list *sc, + tree_classdef_body *body, token *end_tok, + octave_comment_list *lc) +{ + tree_classdef *retval = 0; + + if (end_token_ok (end_tok, token::classdef_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = tok_val->line (); + int c = tok_val->column (); + + retval = new tree_classdef (a, id, sc, body, lc, tc, l, c); + } + + return retval; +} + +static tree_classdef_properties_block * +make_classdef_properties_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_property_list *plist, + token *end_tok, octave_comment_list *lc) +{ + tree_classdef_properties_block *retval = 0; + + if (end_token_ok (end_tok, token::properties_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = tok_val->line (); + int c = tok_val->column (); + + retval = new tree_classdef_properties_block (a, plist, lc, tc, l, c); + } + + return retval; +} + +static tree_classdef_methods_block * +make_classdef_methods_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_methods_list *mlist, + token *end_tok, octave_comment_list *lc) +{ + tree_classdef_methods_block *retval = 0; + + if (end_token_ok (end_tok, token::methods_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = tok_val->line (); + int c = tok_val->column (); + + retval = new tree_classdef_methods_block (a, mlist, lc, tc, l, c); + } + + return retval; +} + +static tree_classdef_events_block * +make_classdef_events_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_events_list *elist, + token *end_tok, octave_comment_list *lc) +{ + tree_classdef_events_block *retval = 0; + + if (end_token_ok (end_tok, token::events_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = tok_val->line (); + int c = tok_val->column (); + + retval = new tree_classdef_events_block (a, elist, lc, tc, l, c); + } + + return retval; +} + +static tree_classdef_enum_block * +make_classdef_enum_block (token *tok_val, + tree_classdef_attribute_list *a, + tree_classdef_enum_list *elist, + token *end_tok, octave_comment_list *lc) +{ + tree_classdef_enum_block *retval = 0; + + if (end_token_ok (end_tok, token::enumeration_end)) + { + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + int l = tok_val->line (); + int c = tok_val->column (); + + retval = new tree_classdef_enum_block (a, elist, lc, tc, l, c); + } + + return retval; +} + +static void +safe_fclose (FILE *f) +{ + // FIXME -- comments at the end of an input file are + // discarded (otherwise, they would be appended to the next + // statement, possibly from the command line or another file, which + // can be quite confusing). + + octave_comment_list *tc = octave_comment_buffer::get_comment (); + + delete tc; + + if (f) + fclose (static_cast (f)); +} + +static bool +looks_like_copyright (const std::string& s) +{ + bool retval = false; + + if (! s.empty ()) + { + size_t offset = s.find_first_not_of (" \t"); + + retval = (s.substr (offset, 9) == "Copyright" || s.substr (offset, 6) == "Author"); + } + + return retval; +} + +static int +text_getc (FILE *f) +{ + int c = gnulib::getc (f); + + // Convert CRLF into just LF and single CR into LF. + + if (c == '\r') + { + c = gnulib::getc (f); + + if (c != '\n') + { + ungetc (c, f); + c = '\n'; + } + } + + if (c == '\n') + input_line_number++; + + return c; +} + +class +stdio_stream_reader : public stream_reader +{ +public: + stdio_stream_reader (FILE *f_arg) : stream_reader (), f (f_arg) { } + + int getc (void) { return ::text_getc (f); } + int ungetc (int c) + { + if (c == '\n') + input_line_number--; + + return ::ungetc (c, f); + } + +private: + FILE *f; + + // No copying! + + stdio_stream_reader (const stdio_stream_reader&); + + stdio_stream_reader & operator = (const stdio_stream_reader&); +}; + +static bool +skip_white_space (stream_reader& reader) +{ + int c = 0; + + while ((c = reader.getc ()) != EOF) + { + switch (c) + { + case ' ': + case '\t': + current_input_column++; + break; + + case '\n': + current_input_column = 1; + break; + + default: + reader.ungetc (c); + goto done; + } + } + + done: + + return (c == EOF); +} + +static bool +looking_at_classdef_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "classdef", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; + } + +static std::string +gobble_leading_white_space (FILE *ffile, bool& eof) +{ + std::string help_txt; + + eof = false; + + // TRUE means we have already cached the help text. + bool have_help_text = false; + + std::string txt; + + stdio_stream_reader stdio_reader (ffile); + + while (true) + { + eof = skip_white_space (stdio_reader); + + if (eof) + break; + + txt = grab_comment_block (stdio_reader, true, eof); + + if (txt.empty ()) + break; + + if (! (have_help_text || looks_like_copyright (txt))) + { + help_txt = txt; + have_help_text = true; + } + + octave_comment_buffer::append (txt); + + if (eof) + break; + } + + return help_txt; +} + +static bool +looking_at_function_keyword (FILE *ffile) +{ + bool status = false; + + long pos = gnulib::ftell (ffile); + + char buf [10]; + gnulib::fgets (buf, 10, ffile); + size_t len = strlen (buf); + if (len > 8 && strncmp (buf, "function", 8) == 0 + && ! (isalnum (buf[8]) || buf[8] == '_')) + status = true; + + gnulib::fseek (ffile, pos, SEEK_SET); + + return status; +} + +static octave_function * +parse_fcn_file (const std::string& ff, const std::string& dispatch_type, + bool force_script = false, bool require_file = true, + const std::string& warn_for = std::string ()) +{ + unwind_protect frame; + + octave_function *fcn_ptr = 0; + + // Open function file and parse. + + FILE *in_stream = command_editor::get_input_stream (); + + frame.add_fcn (command_editor::set_input_stream, in_stream); + + frame.protect_var (ff_instream); + + frame.protect_var (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (reading_fcn_file); + frame.protect_var (line_editing); + frame.protect_var (current_class_name); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + + input_line_number = 1; + current_input_column = 1; + reading_fcn_file = true; + line_editing = false; + current_class_name = dispatch_type; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = false; + + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + + command_history::ignore_entries (); + + FILE *ffile = get_input_from_file (ff, 0); + + frame.add_fcn (safe_fclose, ffile); + + if (ffile) + { + bool eof; + + std::string help_txt = gobble_leading_white_space (ffile, eof); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (! eof) + { + std::string file_type; + + frame.protect_var (get_input_from_eval_string); + frame.protect_var (parser_end_of_input); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + frame.protect_var (Vecho_executing_commands); + + + get_input_from_eval_string = false; + parser_end_of_input = false; + + if (! force_script && looking_at_function_keyword (ffile)) + { + file_type = "function"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = true; + reading_script_file = false; + } + else if (! force_script && looking_at_classdef_keyword (ffile)) + { + file_type = "classdef"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = true; + reading_fcn_file = false; + reading_script_file = false; + } + else + { + file_type = "script"; + + Vecho_executing_commands = ECHO_OFF; + + reading_classdef_file = false; + reading_fcn_file = false; + reading_script_file = true; + } + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (ffile); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + frame.protect_var (primary_fcn_ptr); + primary_fcn_ptr = 0; + + frame.protect_var (classdef_object); + classdef_object = 0; + + reset_parser (); + + // Do this with an unwind-protect cleanup function so that + // the forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + if (! help_txt.empty ()) + help_buf.push (help_txt); + + if (reading_script_file) + prep_lexer_for_script_file (); + else if (reading_classdef_file) + prep_lexer_for_classdef_file (); + else + prep_lexer_for_function_file (); + + lexer_flags.parsing_class_method = ! dispatch_type.empty (); + + frame.protect_var (global_command); + + global_command = 0; + + int status = yyparse (); + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + frame.add_fcn (cleanup_statement_list, &global_command); + + fcn_ptr = primary_fcn_ptr; + + if (status == 0) + { + if (reading_classdef_file && classdef_object) + { + // Convert parse tree for classdef object to + // meta.class info (and stash it in the symbol + // table?). Return pointer to constructor? + + octave_value meta_class = classdef_object->make_meta_class (); + } + } + else + { + error ("parse error while reading %s file %s", + file_type.c_str(), ff.c_str ()); + } + } + else + { + tree_statement *end_of_script + = make_end ("endscript", input_line_number, current_input_column); + + make_script (0, end_of_script); + + fcn_ptr = primary_fcn_ptr; + } + } + else if (require_file) + error ("no such file, `%s'", ff.c_str ()); + else if (! warn_for.empty ()) + error ("%s: unable to open file `%s'", warn_for.c_str (), ff.c_str ()); + + return fcn_ptr; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file) +{ + std::string retval; + + file = fcn_file_in_path (nm); + + if (! file.empty ()) + { + symbol_found = true; + + FILE *fptr = gnulib::fopen (file.c_str (), "r"); + + if (fptr) + { + unwind_protect frame; + frame.add_fcn (safe_fclose, fptr); + + bool eof; + retval = gobble_leading_white_space (fptr, eof); + + if (retval.empty ()) + { + octave_function *fcn = parse_fcn_file (file, ""); + + if (fcn) + { + retval = fcn->doc_string (); + + delete fcn; + } + } + } + } + + return retval; +} + +std::string +get_help_from_file (const std::string& nm, bool& symbol_found) +{ + std::string file; + return get_help_from_file (nm, symbol_found, file); +} + +std::string +lookup_autoload (const std::string& nm) +{ + std::string retval; + + typedef std::map::const_iterator am_iter; + + am_iter p = autoload_map.find (nm); + + if (p != autoload_map.end ()) + retval = load_path::find_file (p->second); + + return retval; +} + +string_vector +autoloaded_functions (void) +{ + string_vector names (autoload_map.size ()); + + octave_idx_type i = 0; + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + names[i++] = p->first; + + return names; +} + +string_vector +reverse_lookup_autoload (const std::string& nm) +{ + string_vector names; + + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + if (nm == p->second) + names.append (p->first); + + return names; +} + +octave_function * +load_fcn_from_file (const std::string& file_name, const std::string& dir_name, + const std::string& dispatch_type, + const std::string& fcn_name, bool autoload) +{ + octave_function *retval = 0; + + unwind_protect frame; + + std::string nm = file_name; + + size_t nm_len = nm.length (); + + std::string file; + + frame.protect_var (fcn_file_from_relative_lookup); + + fcn_file_from_relative_lookup = false; + + file = nm; + + if ((nm_len > 4 && nm.substr (nm_len-4) == ".oct") + || (nm_len > 4 && nm.substr (nm_len-4) == ".mex") + || (nm_len > 2 && nm.substr (nm_len-2) == ".m")) + { + nm = octave_env::base_pathname (file); + nm = nm.substr (0, nm.find_last_of ('.')); + + size_t pos = nm.find_last_of (file_ops::dir_sep_str ()); + if (pos != std::string::npos) + nm = nm.substr (pos+1); + } + + if (autoload) + { + frame.protect_var (autoloading); + autoloading = true; + } + + fcn_file_from_relative_lookup = ! octave_env::absolute_pathname (file); + + file = octave_env::make_absolute (file); + + int len = file.length (); + + if (len > 4 && file.substr (len-4, len-1) == ".oct") + { + if (autoload && ! fcn_name.empty ()) + nm = fcn_name; + + retval = octave_dynamic_loader::load_oct (nm, file, fcn_file_from_relative_lookup); + } + else if (len > 4 && file.substr (len-4, len-1) == ".mex") + { + // Temporarily load m-file version of mex-file, if it exists, + // to get the help-string to use. + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file.substr (0, len - 2); + + octave_function *tmpfcn = parse_fcn_file (file.substr (0, len - 2), + dispatch_type, autoloading, + false); + + retval = octave_dynamic_loader::load_mex (nm, file, fcn_file_from_relative_lookup); + + if (tmpfcn) + retval->document (tmpfcn->doc_string ()); + delete tmpfcn; + } + else if (len > 2) + { + // These are needed by yyparse. + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = nm; + curr_fcn_file_full_name = file; + + retval = parse_fcn_file (file, dispatch_type, autoloading); + } + + if (retval) + { + retval->stash_dir_name (dir_name); + + if (retval->is_user_function ()) + { + symbol_table::scope_id id = retval->scope (); + + symbol_table::stash_dir_name_for_subfunctions (id, dir_name); + } + } + + return retval; +} + +DEFUN (autoload, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ +Define @var{function} to autoload from @var{file}.\n\ +\n\ +The second argument, @var{file}, should be an absolute file name or\n\ +a file name in the same directory as the function or script from which\n\ +the autoload command was run. @var{file} should not depend on the\n\ +Octave load path.\n\ +\n\ +Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ +are evaluated when a directory is added to the Octave's load path. To\n\ +avoid having to hardcode directory names in @var{file}, if @var{file}\n\ +is in the same directory as the PKG_ADD script then\n\ +\n\ +@example\n\ +autoload (\"foo\", \"bar.oct\");\n\ +@end example\n\ +\n\ +@noindent\n\ +will load the function @code{foo} from the file @code{bar.oct}. The above\n\ +when @code{bar.oct} is not in the same directory or uses like\n\ +\n\ +@example\n\ +autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ +@end example\n\ +\n\ +@noindent\n\ +are strongly discouraged, as their behavior might be unpredictable.\n\ +\n\ +With no arguments, return a structure containing the current autoload map.\n\ +@seealso{PKG_ADD}\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + { + Cell func_names (dim_vector (autoload_map.size (), 1)); + Cell file_names (dim_vector (autoload_map.size (), 1)); + + octave_idx_type i = 0; + typedef std::map::const_iterator am_iter; + for (am_iter p = autoload_map.begin (); p != autoload_map.end (); p++) + { + func_names(i) = p->first; + file_names(i) = p->second; + + i++; + } + + octave_map m; + + m.assign ("function", func_names); + m.assign ("file", file_names); + + retval = m; + } + else if (nargin == 2) + { + string_vector argv = args.make_argv ("autoload"); + + if (! error_state) + { + std::string nm = argv[2]; + + if (! octave_env::absolute_pathname (nm)) + { + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + bool found = false; + + if (fcn) + { + std::string fname = fcn->fcn_file_name (); + + if (! fname.empty ()) + { + fname = octave_env::make_absolute (fname); + fname = fname.substr (0, fname.find_last_of (file_ops::dir_sep_str ()) + 1); + + file_stat fs (fname + nm); + + if (fs.exists ()) + { + nm = fname + nm; + found = true; + } + } + } + if (! found) + warning_with_id ("Octave:autoload-relative-file-name", + "autoload: `%s' is not an absolute file name", + nm.c_str ()); + } + autoload_map[argv[1]] = nm; + } + } + else + print_usage (); + + return retval; +} + +void +source_file (const std::string& file_name, const std::string& context, + bool verbose, bool require_file, const std::string& warn_for) +{ + // Map from absolute name of script file to recursion level. We + // use a map instead of simply placing a limit on recursion in the + // source_file function so that two mutually recursive scripts + // written as + // + // foo1.m: + // ------ + // foo2 + // + // foo2.m: + // ------ + // foo1 + // + // and called with + // + // foo1 + // + // (for example) will behave the same if they are written as + // + // foo1.m: + // ------ + // source ("foo2.m") + // + // foo2.m: + // ------ + // source ("foo1.m") + // + // and called with + // + // source ("foo1.m") + // + // (for example). + + static std::map source_call_depth; + + std::string file_full_name = file_ops::tilde_expand (file_name); + + file_full_name = octave_env::make_absolute (file_full_name); + + unwind_protect frame; + + frame.protect_var (curr_fcn_file_name); + frame.protect_var (curr_fcn_file_full_name); + + curr_fcn_file_name = file_name; + curr_fcn_file_full_name = file_full_name; + + if (source_call_depth.find (file_full_name) == source_call_depth.end ()) + source_call_depth[file_full_name] = -1; + + frame.protect_var (source_call_depth[file_full_name]); + + source_call_depth[file_full_name]++; + + if (source_call_depth[file_full_name] >= Vmax_recursion_depth) + { + error ("max_recursion_depth exceeded"); + return; + } + + if (! context.empty ()) + { + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("source: context must be \"caller\" or \"base\""); + + if (! error_state) + frame.add_fcn (octave_call_stack::pop); + } + + if (! error_state) + { + octave_function *fcn = parse_fcn_file (file_full_name, "", true, + require_file, warn_for); + + if (! error_state) + { + if (fcn && fcn->is_user_script ()) + { + octave_value_list args; + + if (verbose) + { + std::cout << "executing commands from " << file_full_name << " ... "; + reading_startup_message_printed = true; + std::cout.flush (); + } + + fcn->do_multi_index_op (0, args); + + if (verbose) + std::cout << "done." << std::endl; + + delete fcn; + } + } + else + error ("source: error sourcing file `%s'", + file_full_name.c_str ()); + } +} + +DEFUN (mfilename, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} mfilename ()\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpath\")\n\ +@deftypefnx {Built-in Function} {} mfilename (\"fullpathext\")\n\ +Return the name of the currently executing file. At the top-level,\n\ +return the empty string. Given the argument @code{\"fullpath\"},\n\ +include the directory part of the file name, but not the extension.\n\ +Given the argument @code{\"fullpathext\"}, include the directory part\n\ +of the file name and the extension.\n\ +@end deftypefn") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin > 1) + { + print_usage (); + return retval; + } + + std::string arg; + + if (nargin == 1) + { + arg = args(0).string_value (); + + if (error_state) + { + error ("mfilename: expecting argument to be a character string"); + return retval; + } + } + + std::string fname; + + octave_user_code *fcn = octave_call_stack::caller_user_code (); + + if (fcn) + { + fname = fcn->fcn_file_name (); + + if (fname.empty ()) + fname = fcn->name (); + } + + if (arg == "fullpathext") + retval = fname; + else + { + size_t dpos = fname.rfind (file_ops::dir_sep_char ()); + size_t epos = fname.rfind ('.'); + + if (epos <= dpos) + epos = std::string::npos; + + fname = (epos != std::string::npos) ? fname.substr (0, epos) : fname; + + if (arg == "fullpath") + retval = fname; + else + retval = (dpos != std::string::npos) ? fname.substr (dpos+1) : fname; + } + + return retval; +} + + +DEFUN (source, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} source (@var{file})\n\ +Parse and execute the contents of @var{file}. This is equivalent to\n\ +executing commands from a script file, but without requiring the file to\n\ +be named @file{@var{file}.m}.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + { + std::string file_name = args(0).string_value (); + + if (! error_state) + { + std::string context; + + if (nargin == 2) + context = args(1).string_value (); + + if (! error_state) + source_file (file_name, context); + else + error ("source: expecting context to be character string"); + } + else + error ("source: expecting file name as argument"); + } + else + print_usage (); + + return retval; +} + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. NAME is the name of the function to +// call. ARGS are the arguments to the function. NARGOUT is the +// number of output arguments expected. + +octave_value_list +feval (const std::string& name, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + octave_value fcn = symbol_table::find_function (name, args); + + if (fcn.is_defined ()) + retval = fcn.do_multi_index_op (nargout, args); + else + { + maybe_missing_function_hook (name); + if (! error_state) + error ("feval: function `%s' not found", name.c_str ()); + } + + return retval; +} + +octave_value_list +feval (octave_function *fcn, const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + if (fcn) + retval = fcn->do_multi_index_op (nargout, args); + + return retval; +} + +static octave_value_list +get_feval_args (const octave_value_list& args) +{ + return args.slice (1, args.length () - 1, true); +} + + +// Evaluate an Octave function (built-in or interpreted) and return +// the list of result values. The first element of ARGS should be a +// string containing the name of the function to call, then the rest +// are the actual arguments to the function. NARGOUT is the number of +// output arguments expected. + +octave_value_list +feval (const octave_value_list& args, int nargout) +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + octave_value f_arg = args(0); + + if (f_arg.is_string ()) + { + std::string name = f_arg.string_value (); + + if (! error_state) + { + octave_value_list tmp_args = get_feval_args (args); + + retval = feval (name, tmp_args, nargout); + } + } + else if (f_arg.is_function_handle () + || f_arg.is_anonymous_function () + || f_arg.is_inline_function ()) + { + const octave_value_list tmp_args = get_feval_args (args); + + retval = f_arg.do_multi_index_op (nargout, tmp_args); + } + else + error ("feval: first argument must be a string, inline function or a function handle"); + } + + return retval; +} + +DEFUN (feval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} feval (@var{name}, @dots{})\n\ +Evaluate the function named @var{name}. Any arguments after the first\n\ +are passed on to the named function. For example,\n\ +\n\ +@example\n\ +@group\n\ +feval (\"acos\", -1)\n\ + @result{} 3.1416\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +calls the function @code{acos} with the argument @samp{-1}.\n\ +\n\ +The function @code{feval} can also be used with function handles of\n\ +any sort (@pxref{Function Handles}). Historically, @code{feval} was\n\ +the only way to call user-supplied functions in strings, but\n\ +function handles are now preferred due to the cleaner syntax they\n\ +offer. For example,\n\ +\n\ +@example\n\ +@group\n\ +@var{f} = @@exp;\n\ +feval (@var{f}, 1)\n\ + @result{} 2.7183\n\ +@var{f} (1)\n\ + @result{} 2.7183\n\ +@end group\n\ +@end example\n\ +\n\ +@noindent\n\ +are equivalent ways to call the function referred to by @var{f}. If it\n\ +cannot be predicted beforehand that @var{f} is a function handle or the\n\ +function name in a string, @code{feval} can be used instead.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + retval = feval (args, nargout); + else + print_usage (); + + return retval; +} + +DEFUN (builtin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ +Call the base function @var{f} even if @var{f} is overloaded to\n\ +another function for the given type signature.\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + const std::string name (args(0).string_value ()); + + if (! error_state) + { + octave_value fcn = symbol_table::builtin_find (name); + + if (fcn.is_defined ()) + retval = feval (fcn.function_value (), args.splice (0, 1), + nargout); + else + error ("builtin: lookup for symbol `%s' failed", name.c_str ()); + } + else + error ("builtin: function name (F) must be a string"); + } + else + print_usage (); + + return retval; +} + +octave_value_list +eval_string (const std::string& s, bool silent, int& parse_status, int nargout) +{ + octave_value_list retval; + + unwind_protect frame; + + frame.protect_var (input_line_number); + frame.protect_var (current_input_column); + frame.protect_var (get_input_from_eval_string); + frame.protect_var (input_from_eval_string_pending); + frame.protect_var (parser_end_of_input); + frame.protect_var (line_editing); + frame.protect_var (current_eval_string); + frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); + frame.protect_var (max_function_depth); + frame.protect_var (parsing_subfunctions); + frame.protect_var (endfunction_found); + frame.protect_var (reading_fcn_file); + frame.protect_var (reading_script_file); + frame.protect_var (reading_classdef_file); + + input_line_number = 1; + current_input_column = 1; + get_input_from_eval_string = true; + input_from_eval_string_pending = true; + parser_end_of_input = false; + line_editing = false; + current_function_depth = 0; + function_scopes.clear (); + max_function_depth = 0; + parsing_subfunctions = false; + endfunction_found = false; + reading_fcn_file = false; + reading_script_file = false; + reading_classdef_file = false; + + current_eval_string = s; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (0); + + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); + + switch_to_buffer (new_buf); + + do + { + reset_parser (); + + frame.protect_var (global_command); + + global_command = 0; + + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an + // interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); + + parse_status = yyparse (); + + tree_statement_list *command_list = global_command; + + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); + + if (parse_status == 0) + { + if (command_list) + { + unwind_protect inner_frame; + + // Use an unwind-protect cleanup function so that the + // global_command list will be deleted in the event of an + // interrupt. + + inner_frame.add_fcn (cleanup_statement_list, &command_list); + + tree_statement *stmt = 0; + + if (command_list->length () == 1 + && (stmt = command_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + if (silent) + expr->set_print_flag (false); + + bool do_bind_ans = false; + + if (expr->is_identifier ()) + { + tree_identifier *id + = dynamic_cast (expr); + + do_bind_ans = (! id->is_variable ()); + } + else + do_bind_ans = (! expr->is_assignment_expression ()); + + retval = expr->rvalue (nargout); + + if (do_bind_ans && ! (error_state || retval.empty ())) + bind_ans (retval(0), expr->print_result ()); + + if (nargout == 0) + retval = octave_value_list (); + } + else if (nargout == 0) + command_list->accept (*current_evaluator); + else + error ("eval: invalid use of statement list"); + + if (error_state + || tree_return_command::returning + || tree_break_command::breaking + || tree_continue_command::continuing) + break; + } + else if (parser_end_of_input) + break; + } + } + while (parse_status == 0); + + return retval; +} + +octave_value +eval_string (const std::string& s, bool silent, int& parse_status) +{ + octave_value retval; + + octave_value_list tmp = eval_string (s, silent, parse_status, 1); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +static octave_value_list +eval_string (const octave_value& arg, bool silent, int& parse_status, + int nargout) +{ + std::string s = arg.string_value (); + + if (error_state) + { + error ("eval: expecting std::string argument"); + return octave_value (-1); + } + + return eval_string (s, silent, parse_status, nargout); +} + +void +cleanup_statement_list (tree_statement_list **lst) +{ + if (*lst) + { + delete *lst; + *lst = 0; + } +} + +DEFUN (eval, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} eval (@var{try})\n\ +@deftypefnx {Built-in Function} {} eval (@var{try}, @var{catch})\n\ +Parse the string @var{try} and evaluate it as if it were an Octave\n\ +program. If that fails, evaluate the optional string @var{catch}.\n\ +The string @var{try} is evaluated in the current context,\n\ +so any results remain available after @code{eval} returns.\n\ +\n\ +The following example makes the variable @var{a} with the approximate\n\ +value 3.1416 available.\n\ +\n\ +@example\n\ +eval (\"a = acos(-1);\");\n\ +@end example\n\ +\n\ +If an error occurs during the evaluation of @var{try} the @var{catch}\n\ +string is evaluated, as the following example shows:\n\ +\n\ +@example\n\ +@group\n\ +eval ('error (\"This is a bad example\");',\n\ + 'printf (\"This error occurred:\\n%s\\n\", lasterr ());');\n\ + @print{} This error occurred:\n\ + This is a bad example\n\ +@end group\n\ +@end example\n\ +\n\ +Consider using try/catch blocks instead if you are only using @code{eval}\n\ +as an error-capturing mechanism rather than for the execution of arbitrary\n\ +code strings.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 0) + { + unwind_protect frame; + + if (nargin > 1) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(0), nargout > 0, + parse_status, nargout); + + if (nargin > 1 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(1), nargout > 0, parse_status, nargout); + + if (nargout > 0) + retval = tmp; + } + else if (nargout > 0) + retval = tmp; + } + else + print_usage (); + + return retval; +} + +/* + +%!shared x +%! x = 1; + +%!assert (eval ("x"), 1) +%!assert (eval ("x;")) +%!assert (eval ("x;"), 1); + +%!test +%! y = eval ("x"); +%! assert (y, 1); + +%!test +%! y = eval ("x;"); +%! assert (y, 1); + +%!test +%! eval ("x = 1;") +%! assert (x,1); + +%!test +%! eval ("flipud = 2;"); +%! assert (flipud, 2); + +%!function y = __f () +%! eval ("flipud = 2;"); +%! y = flipud; +%!endfunction +%!assert (__f(), 2) + +% bug #35645 +%!test +%! [a,] = gcd (1,2); +%! [a,b,] = gcd (1, 2); + +*/ + +DEFUN (assignin, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} assignin (@var{context}, @var{varname}, @var{value})\n\ +Assign @var{value} to @var{varname} in context @var{context}, which\n\ +may be either @code{\"base\"} or @code{\"caller\"}.\n\ +@seealso{evalin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 3) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("assignin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + std::string nm = args(1).string_value (); + + if (! error_state) + { + if (valid_identifier (nm)) + symbol_table::varref (nm) = args(2); + else + error ("assignin: invalid variable name in argument VARNAME"); + } + else + error ("assignin: VARNAME must be a string"); + } + } + else + error ("assignin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (evalin, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} evalin (@var{context}, @var{try})\n\ +@deftypefnx {Built-in Function} {} evalin (@var{context}, @var{try}, @var{catch})\n\ +Like @code{eval}, except that the expressions are evaluated in the\n\ +context @var{context}, which may be either @code{\"caller\"} or\n\ +@code{\"base\"}.\n\ +@seealso{eval, assignin}\n\ +@end deftypefn") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin > 1) + { + std::string context = args(0).string_value (); + + if (! error_state) + { + unwind_protect frame; + + if (context == "caller") + octave_call_stack::goto_caller_frame (); + else if (context == "base") + octave_call_stack::goto_base_frame (); + else + error ("evalin: CONTEXT must be \"caller\" or \"base\""); + + if (! error_state) + { + frame.add_fcn (octave_call_stack::pop); + + if (nargin > 2) + { + frame.protect_var (buffer_error_messages); + buffer_error_messages++; + } + + int parse_status = 0; + + octave_value_list tmp = eval_string (args(1), nargout > 0, + parse_status, nargout); + + if (nargout > 0) + retval = tmp; + + if (nargin > 2 && (parse_status != 0 || error_state)) + { + error_state = 0; + + // Set up for letting the user print any messages from + // errors that occurred in the first part of this eval(). + + buffer_error_messages--; + + tmp = eval_string (args(2), nargout > 0, + parse_status, nargout); + + retval = (nargout > 0) ? tmp : octave_value_list (); + } + } + } + else + error ("evalin: CONTEXT must be a string"); + } + else + print_usage (); + + return retval; +} + +DEFUN (__parser_debug_flag__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {@var{old_val} =} __parser_debug_flag__ (@var{new_val}))\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + bool debug_flag = octave_debug; + + retval = set_internal_variable (debug_flag, args, nargout, + "__parser_debug_flag__"); + + octave_debug = debug_flag; + + return retval; +} diff -r 069c552587a0 -r 959953dba519 src/parse-tree/parse-private.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse-private.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,96 @@ +/* + +Copyright (C) 2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_parse_private_h) +#define octave_parse_private_h 1 + +#include + +#include "symtab.h" + +// Keep track of symbol table information when parsing functions. +class symtab_context +{ +private: + + class frame + { + public: + frame (symbol_table::scope_id s, symbol_table::scope_id c) + : m_scope (s), m_context (c) { } + + frame (const frame& f) : m_scope (f.m_scope), m_context (f.m_context) { } + + frame& operator = (const frame& f) + { + if (&f != this) + { + m_scope = f.m_scope; + m_context = f.m_context; + } + + return *this; + } + + ~frame (void) { } + + symbol_table::scope_id scope (void) const { return m_scope; } + symbol_table::scope_id context (void) const { return m_context; } + + private: + + symbol_table::scope_id m_scope; + symbol_table::scope_id m_context; + }; + + std::stack frame_stack; + +public: + symtab_context (void) : frame_stack () { } + + void clear (void) + { + while (! frame_stack.empty ()) + frame_stack.pop (); + } + + bool empty (void) const { return frame_stack.empty (); } + + void pop (void) + { + frame tmp = frame_stack.top (); + + symbol_table::set_scope_and_context (tmp.scope (), tmp.context ()); + + frame_stack.pop (); + } + + void push (void) + { + frame_stack.push (frame (symbol_table::current_scope (), + symbol_table::current_context ())); + } +}; + +extern symtab_context parser_symtab_context; + +#endif diff -r 069c552587a0 -r 959953dba519 src/parse-tree/parse.h --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parse-tree/parse.h Fri Aug 03 14:35:44 2012 -0400 @@ -0,0 +1,116 @@ +/* + +Copyright (C) 1993-2012 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 3 of the License, 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, see +. + +*/ + +#if !defined (octave_parse_h) +#define octave_parse_h 1 + +#include + +#include + +#include + +extern void reset_parser (void); +extern int octave_lex (void); +extern int octave_parse (void); + +class tree; +class tree_matrix; +class tree_identifier; +class tree_statement_list; +class octave_function; + +#include "oct-obj.h" + +// Nonzero means print parser debugging info (-d). +extern int octave_debug; + +// The current input line number. +extern int input_line_number; + +// The column of the current token. +extern int current_input_column; + +// Buffer for help text snagged from function files. +extern std::stack help_buf; + +// TRUE means we are using readline. +extern bool line_editing; + +// TRUE means we printed messages about reading startup files. +extern bool reading_startup_message_printed; + +// TRUE means input is coming from startup file. +extern bool input_from_startup_file; + +// Name of the current class when we are parsing class methods or +// constructors. +extern std::string current_class_name; + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found, + std::string& file); + +extern OCTINTERP_API std::string +get_help_from_file (const std::string& nm, bool& symbol_found); + +extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); + +extern OCTINTERP_API string_vector autoloaded_functions (void); + +extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); + +extern OCTINTERP_API octave_function * +load_fcn_from_file (const std::string& file_name, + const std::string& dir_name = std::string (), + const std::string& dispatch_type = std::string (), + const std::string& fcn_name = std::string (), + bool autoload = false); + +extern OCTINTERP_API void +source_file (const std::string& file_name, + const std::string& context = std::string (), + bool verbose = false, bool require_file = true, + const std::string& warn_for = std::string ()); + +extern OCTINTERP_API octave_value_list +feval (const std::string& name, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (octave_function *fcn, + const octave_value_list& args = octave_value_list (), + int nargout = 0); + +extern OCTINTERP_API octave_value_list +feval (const octave_value_list& args, int nargout = 0); + +extern OCTINTERP_API octave_value_list +eval_string (const std::string&, bool silent, int& parse_status, int hargout); + +extern OCTINTERP_API octave_value +eval_string (const std::string&, bool silent, int& parse_status); + +extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); + +#endif diff -r 069c552587a0 -r 959953dba519 src/parse.h --- a/src/parse.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,116 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_parse_h) -#define octave_parse_h 1 - -#include - -#include - -#include - -extern void reset_parser (void); -extern int octave_lex (void); -extern int octave_parse (void); - -class tree; -class tree_matrix; -class tree_identifier; -class tree_statement_list; -class octave_function; - -#include "oct-obj.h" - -// Nonzero means print parser debugging info (-d). -extern int octave_debug; - -// The current input line number. -extern int input_line_number; - -// The column of the current token. -extern int current_input_column; - -// Buffer for help text snagged from function files. -extern std::stack help_buf; - -// TRUE means we are using readline. -extern bool line_editing; - -// TRUE means we printed messages about reading startup files. -extern bool reading_startup_message_printed; - -// TRUE means input is coming from startup file. -extern bool input_from_startup_file; - -// Name of the current class when we are parsing class methods or -// constructors. -extern std::string current_class_name; - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found, - std::string& file); - -extern OCTINTERP_API std::string -get_help_from_file (const std::string& nm, bool& symbol_found); - -extern OCTINTERP_API std::string lookup_autoload (const std::string& nm); - -extern OCTINTERP_API string_vector autoloaded_functions (void); - -extern OCTINTERP_API string_vector reverse_lookup_autoload (const std::string& nm); - -extern OCTINTERP_API octave_function * -load_fcn_from_file (const std::string& file_name, - const std::string& dir_name = std::string (), - const std::string& dispatch_type = std::string (), - const std::string& fcn_name = std::string (), - bool autoload = false); - -extern OCTINTERP_API void -source_file (const std::string& file_name, - const std::string& context = std::string (), - bool verbose = false, bool require_file = true, - const std::string& warn_for = std::string ()); - -extern OCTINTERP_API octave_value_list -feval (const std::string& name, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (octave_function *fcn, - const octave_value_list& args = octave_value_list (), - int nargout = 0); - -extern OCTINTERP_API octave_value_list -feval (const octave_value_list& args, int nargout = 0); - -extern OCTINTERP_API octave_value_list -eval_string (const std::string&, bool silent, int& parse_status, int hargout); - -extern OCTINTERP_API octave_value -eval_string (const std::string&, bool silent, int& parse_status); - -extern OCTINTERP_API void cleanup_statement_list (tree_statement_list **lst); - -#endif diff -r 069c552587a0 -r 959953dba519 src/pr-output.cc --- a/src/pr-output.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4089 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include -#include - -#include "Array-util.h" -#include "CMatrix.h" -#include "Range.h" -#include "cmd-edit.h" -#include "dMatrix.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-cmplx.h" -#include "quit.h" -#include "str-vec.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "oct-obj.h" -#include "oct-stream.h" -#include "pager.h" -#include "pr-output.h" -#include "sysdep.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// TRUE means use a scaled fixed point format for `format long' and -// `format short'. -static bool Vfixed_point_format = false; - -// The maximum field width for a number printed by the default output -// routines. -static int Voutput_max_field_width = 10; - -// The precision of the numbers printed by the default output -// routines. -static int Voutput_precision = 5; - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -bool Vprint_empty_dimensions = true; - -// TRUE means that the rows of big matrices should be split into -// smaller slices that fit on the screen. -static bool Vsplit_long_rows = true; - -// TRUE means don't do any fancy formatting. -static bool free_format = false; - -// TRUE means print plus sign for nonzero, blank for zero. -static bool plus_format = false; - -// First char for > 0, second for < 0, third for == 0. -static std::string plus_format_chars = "+ "; - -// TRUE means always print in a rational approximation -static bool rat_format = false; - -// Used to force the length of the rational approximation string for Frats -static int rat_string_len = -1; - -// TRUE means always print like dollars and cents. -static bool bank_format = false; - -// TRUE means print data in hexadecimal format. -static int hex_format = 0; - -// TRUE means print data in binary-bit-pattern format. -static int bit_format = 0; - -// TRUE means don't put newlines around the column number headers. -bool Vcompact_format = false; - -// TRUE means use an e format. -static bool print_e = false; - -// TRUE means use a g format. -static bool print_g = false; - -// TRUE means print E instead of e for exponent field. -static bool print_big_e = false; - -// TRUE means use an engineering format. -static bool print_eng = false; - -class pr_engineering_float; -class pr_formatted_float; -class pr_rational_float; - -static int -current_output_max_field_width (void) -{ - return Voutput_max_field_width; -} - -static int -current_output_precision (void) -{ - return Voutput_precision; -} - -class -float_format -{ -public: - - float_format (int w = current_output_max_field_width (), - int p = current_output_precision (), int f = 0) - : fw (w), ex (0), prec (p), fmt (f), up (0), sp (0) { } - - float_format (int w, int e, int p, int f) - : fw (w), ex (e), prec (p), fmt (f), up (0), sp (0) { } - - float_format (const float_format& ff) - : fw (ff.fw), ex (ff.ex), prec (ff.prec), fmt (ff.fmt), up (ff.up), sp (ff.sp) { } - - float_format& operator = (const float_format& ff) - { - if (&ff != this) - { - fw = ff.fw; - ex = ff.ex; - prec = ff.prec; - fmt = ff.fmt; - up = ff.up; - sp = ff.sp; - } - - return *this; - } - - ~float_format (void) { } - - float_format& scientific (void) { fmt = std::ios::scientific; return *this; } - float_format& fixed (void) { fmt = std::ios::fixed; return *this; } - float_format& general (void) { fmt = 0; return *this; } - - float_format& uppercase (void) { up = std::ios::uppercase; return *this; } - float_format& lowercase (void) { up = 0; return *this; } - - float_format& precision (int p) { prec = p; return *this; } - - float_format& width (int w) { fw = w; return *this; } - - float_format& trailing_zeros (bool tz = true) - { sp = tz ? std::ios::showpoint : 0; return *this; } - - friend std::ostream& operator << (std::ostream& os, - const pr_engineering_float& pef); - - friend std::ostream& operator << (std::ostream& os, - const pr_formatted_float& pff); - - friend std::ostream& operator << (std::ostream& os, - const pr_rational_float& prf); - -private: - - // Field width. Zero means as wide as necessary. - int fw; - - // Exponent Field width. Zero means as wide as necessary. - int ex; - - // Precision. - int prec; - - // Format. - int fmt; - - // E or e. - int up; - - // Show trailing zeros. - int sp; -}; - -static int -calc_scale_exp (const int& x) -{ - if (! print_eng) - return x; - else - return x - 3*static_cast (x/3); - /* The expression above is equivalent to x - (x % 3). - * According to the ISO specification for C++ the modulo operator is - * compiler dependent if any of the arguments are negative. Since this - * function will need to work on negative arguments, and we want to avoid - * portability issues, we re-implement the modulo function to the desired - * behavior (truncation). There may be a gnulib replacement. - * - * ISO/IEC 14882:2003 : Programming languages -- C++. 5.6.4: ISO, IEC. 2003 . - * "the binary % operator yields the remainder from the division of the first - * expression by the second. .... If both operands are nonnegative then the - * remainder is nonnegative; if not, the sign of the remainder is - * implementation-defined". */ -} - -static int -engineering_exponent (const double& x) -{ - int ex = 0; - if (x != 0) - { - double absval = (x < 0.0 ? -x : x); - int logabsval = static_cast (gnulib::floor (log10 (absval))); - /* Avoid using modulo function with negative arguments for portability. - * See extended comment at calc_scale_exp */ - if (logabsval < 0.0) - ex = logabsval - 2 + ((-logabsval + 2) % 3); - else - ex = logabsval - (logabsval % 3); - } - return ex; -} - -static int -num_digits (const double& x) -{ - return 1 + (print_eng - ? engineering_exponent (x) - : static_cast (gnulib::floor (log10 (x)))); -} - -class -pr_engineering_float -{ -public: - - const float_format& f; - - double val; - - int exponent (void) const - { - return engineering_exponent (val); - } - - double mantissa (void) const - { - return val / std::pow (10.0, exponent ()); - } - - pr_engineering_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_engineering_float& pef) -{ - if (pef.f.fw >= 0) - os << std::setw (pef.f.fw - pef.f.ex); - - if (pef.f.prec >= 0) - os << std::setprecision (pef.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pef.f.fmt | pef.f.up | pef.f.sp)); - - os << pef.mantissa (); - - int ex = pef.exponent (); - if (ex < 0) - { - os << std::setw (0) << "e-"; - ex = -ex; - } - else - os << std::setw (0) << "e+"; - - os << std::setw (pef.f.ex - 2) << std::setfill ('0') << ex - << std::setfill (' '); - - os.flags (oflags); - - return os; -} - -class -pr_formatted_float -{ -public: - - const float_format& f; - - double val; - - pr_formatted_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_formatted_float& pff) -{ - if (pff.f.fw >= 0) - os << std::setw (pff.f.fw); - - if (pff.f.prec >= 0) - os << std::setprecision (pff.f.prec); - - std::ios::fmtflags oflags = - os.flags (static_cast - (pff.f.fmt | pff.f.up | pff.f.sp)); - - os << pff.val; - - os.flags (oflags); - - return os; -} - -static inline std::string -rational_approx (double val, int len) -{ - std::string s; - - if (len <= 0) - len = 10; - - if (xisinf (val)) - s = "1/0"; - else if (xisnan (val)) - s = "0/0"; - else if (val < INT_MIN || val > INT_MAX || D_NINT (val) == val) - { - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << xround (val); - s = buf.str (); - } - else - { - double lastn = 1.; - double lastd = 0.; - double n = xround (val); - double d = 1.; - double frac = val - n; - int m = 0; - - std::ostringstream buf2; - buf2.flags (std::ios::fixed); - buf2 << std::setprecision (0) << static_cast(n); - s = buf2.str (); - - while (1) - { - double flip = 1. / frac; - double step = xround (flip); - double nextn = n; - double nextd = d; - - // Have we converged to 1/intmax ? - if (m > 100 || fabs (frac) < 1 / static_cast(INT_MAX)) - { - lastn = n; - lastd = d; - break; - } - - frac = flip - step; - n = n * step + lastn; - d = d * step + lastd; - lastn = nextn; - lastd = nextd; - - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(n) - << "/" << static_cast(d); - m++; - - if (n < 0 && d < 0) - { - // Double negative, string can be two characters longer.. - if (buf.str ().length () > static_cast(len + 2) && - m > 1) - break; - } - else if (buf.str ().length () > static_cast(len) && - m > 1) - break; - - s = buf.str (); - } - - if (lastd < 0.) - { - // Move sign to the top - lastd = - lastd; - lastn = - lastn; - std::ostringstream buf; - buf.flags (std::ios::fixed); - buf << std::setprecision (0) << static_cast(lastn) - << "/" << static_cast(lastd); - s = buf.str (); - } - } - - return s; -} - -class -pr_rational_float -{ -public: - - const float_format& f; - - double val; - - pr_rational_float (const float_format& f_arg, double val_arg) - : f (f_arg), val (val_arg) { } -}; - -std::ostream& -operator << (std::ostream& os, const pr_rational_float& prf) -{ - int fw = (rat_string_len > 0 ? rat_string_len : prf.f.fw); - std::string s = rational_approx (prf.val, fw); - - if (fw >= 0) - os << std::setw (fw); - - std::ios::fmtflags oflags = - os.flags (static_cast - (prf.f.fmt | prf.f.up | prf.f.sp)); - - if (fw > 0 && s.length () > static_cast(fw)) - os << "*"; - else - os << s; - - os.flags (oflags); - - return os; -} - -// Current format for real numbers and the real part of complex -// numbers. -static float_format *curr_real_fmt = 0; - -// Current format for the imaginary part of complex numbers. -static float_format *curr_imag_fmt = 0; - -static double -pr_max_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = -DBL_MAX; - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val > result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -static double -pr_min_internal (const Matrix& m) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - double result = DBL_MAX; - - bool all_inf_or_nan = true; - - for (octave_idx_type j = 0; j < nc; j++) - for (octave_idx_type i = 0; i < nr; i++) - { - double val = m(i,j); - if (xisinf (val) || xisnan (val)) - continue; - - all_inf_or_nan = false; - - if (val < result) - result = val; - } - - if (all_inf_or_nan) - result = 0.0; - - return result; -} - -// FIXME -- it would be nice to share more code among these -// functions,.. - -static void -set_real_format (int digits, bool inf_or_nan, bool int_only, int &fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 0; - rd = 0; - } - else if (bank_format) - { - fw = digits < 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - fw = 1 + digits; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - if (digits > 0) - { - ld = digits; - rd = prec > digits ? prec - digits : prec; - digits++; - } - else - { - ld = 1; - rd = prec > digits ? prec - digits : prec; - digits = -digits + 1; - } - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (fw > Voutput_max_field_width || print_e || print_g || print_eng)) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (digits > 100) - ex++; - - if (print_eng) - { - fw = 4 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 2 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && (inf_or_nan || int_only)) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (double d, int& fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = (xisinf (d) || xisnan (d)); - - bool int_only = (! inf_or_nan && D_NINT (d) == d); - - double d_abs = d < 0.0 ? -d : d; - - int digits = (inf_or_nan || d_abs == 0.0) - ? 0 : num_digits (d_abs); - - set_real_format (digits, inf_or_nan, int_only, fw); -} - -static inline void -set_format (double d) -{ - int fw; - set_format (d, fw); -} - -static void -set_real_matrix_format (int x_max, int x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && fw < 4) - fw = 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 2; - if (inf_or_nan && fw < 4) - fw = 4; - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits <= 0 ? 2 : digits + 1; - if (inf_or_nan && fw < 4) - fw = 4; - rd = fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = 1 + ld + 1 + rd; - if (inf_or_nan && fw < 4) - fw = 4; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 4 + prec + ex; - if (inf_or_nan && fw < 6) - fw = 6; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 2 + prec + ex; - if (inf_or_nan && fw < 4) - fw = 4; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && int_or_inf_or_nan) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Matrix& m, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - bool inf_or_nan = m.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = m.all_elements_are_int_or_inf_or_nan (); - - Matrix m_abs = m.abs (); - double max_abs = pr_max_internal (m_abs); - double min_abs = pr_min_internal (m_abs); - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_real_matrix_format (x_max, x_min, inf_or_nan, int_or_inf_or_nan, fw); -} - -static inline void -set_format (const Matrix& m) -{ - int fw; - double scale; - set_format (m, fw, scale); -} - -static void -set_complex_format (int x_max, int x_min, int r_x, bool inf_or_nan, - int int_only, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 0; - r_fw = 0; - rd = 0; - } - else if (bank_format) - { - int digits = r_x; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (inf_or_nan || int_only) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (r_fw > Voutput_max_field_width || print_e || print_eng || print_g)) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && (inf_or_nan || int_only)) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const Complex& c, int& r_fw, int& i_fw) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double rp = c.real (); - double ip = c.imag (); - - bool inf_or_nan = (xisinf (c) || xisnan (c)); - - bool int_only = (D_NINT (rp) == rp && D_NINT (ip) == ip); - - double r_abs = rp < 0.0 ? -rp : rp; - double i_abs = ip < 0.0 ? -ip : ip; - - int r_x = (xisinf (rp) || xisnan (rp) || r_abs == 0.0) - ? 0 : num_digits (r_abs); - - int i_x = (xisinf (ip) || xisnan (ip) || i_abs == 0.0) - ? 0 : num_digits (i_abs); - - int x_max, x_min; - - if (r_x > i_x) - { - x_max = r_x; - x_min = i_x; - } - else - { - x_max = i_x; - x_min = r_x; - } - - set_complex_format (x_max, x_min, r_x, inf_or_nan, int_only, r_fw, i_fw); -} - -static inline void -set_format (const Complex& c) -{ - int r_fw, i_fw; - set_format (c, r_fw, i_fw); -} - -static void -set_complex_matrix_format (int x_max, int x_min, int r_x_max, - int r_x_min, bool inf_or_nan, - int int_or_inf_or_nan, int& r_fw, int& i_fw) -{ - static float_format r_fmt; - static float_format i_fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - i_fw = 9; - r_fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = r_x_max > r_x_min ? r_x_max : r_x_min; - i_fw = 0; - r_fw = digits <= 0 ? 4 : digits + 3; - if (inf_or_nan && r_fw < 4) - r_fw = 4; - rd = 2; - } - else if (hex_format) - { - r_fw = 2 * sizeof (double); - i_fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - r_fw = 8 * sizeof (double); - i_fw = 8 * sizeof (double); - rd = 0; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - i_fw = rd + 1; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - else if (int_or_inf_or_nan) - { - int digits = x_max > x_min ? x_max : x_min; - i_fw = digits <= 0 ? 1 : digits; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - rd = r_fw; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - i_fw = ld + 1 + rd; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && r_fw > Voutput_max_field_width))) - { - if (print_g) - { - r_fmt = float_format (); - i_fmt = float_format (); - } - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - i_fw = 3 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 5) - { - i_fw = 5; - r_fw = 6; - } - r_fmt = float_format (r_fw, ex, prec - 1, std::ios::fixed); - i_fmt = float_format (i_fw, ex, prec - 1, std::ios::fixed); - } - else - { - i_fw = 1 + prec + ex; - r_fw = i_fw + 1; - if (inf_or_nan && i_fw < 3) - { - i_fw = 3; - r_fw = 4; - } - r_fmt = float_format (r_fw, prec - 1, std::ios::scientific); - i_fmt = float_format (i_fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - { - r_fmt.uppercase (); - i_fmt.uppercase (); - } - } - else if (! bank_format && int_or_inf_or_nan) - { - r_fmt = float_format (r_fw, rd); - i_fmt = float_format (i_fw, rd); - } - else - { - r_fmt = float_format (r_fw, rd, std::ios::fixed); - i_fmt = float_format (i_fw, rd, std::ios::fixed); - } - - curr_real_fmt = &r_fmt; - curr_imag_fmt = &i_fmt; -} - -static void -set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - Matrix rp = real (cm); - Matrix ip = imag (cm); - - bool inf_or_nan = cm.any_element_is_inf_or_nan (); - - bool int_or_inf_or_nan = (rp.all_elements_are_int_or_inf_or_nan () - && ip.all_elements_are_int_or_inf_or_nan ()); - - Matrix r_m_abs = rp.abs (); - double r_max_abs = pr_max_internal (r_m_abs); - double r_min_abs = pr_min_internal (r_m_abs); - - Matrix i_m_abs = ip.abs (); - double i_max_abs = pr_max_internal (i_m_abs); - double i_min_abs = pr_min_internal (i_m_abs); - - int r_x_max = r_max_abs == 0.0 ? 0 : num_digits (r_max_abs); - - int r_x_min = r_min_abs == 0.0 ? 0 : num_digits (r_min_abs); - - int i_x_max = i_max_abs == 0.0 ? 0 : num_digits (i_max_abs); - - int i_x_min = i_min_abs == 0.0 ? 0 : num_digits (i_min_abs); - - int x_max = r_x_max > i_x_max ? r_x_max : i_x_max; - int x_min = r_x_min > i_x_min ? r_x_min : i_x_min; - - scale = (x_max == 0 || int_or_inf_or_nan) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_complex_matrix_format (x_max, x_min, r_x_max, r_x_min, inf_or_nan, - int_or_inf_or_nan, r_fw, i_fw); -} - -static inline void -set_format (const ComplexMatrix& cm) -{ - int r_fw, i_fw; - double scale; - set_format (cm, r_fw, i_fw, scale); -} - -static void -set_range_format (int x_max, int x_min, int all_ints, int& fw) -{ - static float_format fmt; - - int prec = Voutput_precision; - - int ld, rd; - - if (rat_format) - { - fw = 9; - rd = 0; - } - else if (bank_format) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits < 0 ? 5 : digits + 4; - rd = 2; - } - else if (hex_format) - { - fw = 2 * sizeof (double); - rd = 0; - } - else if (bit_format) - { - fw = 8 * sizeof (double); - rd = 0; - } - else if (all_ints) - { - int digits = x_max > x_min ? x_max : x_min; - fw = digits + 1; - rd = fw; - } - else if (Vfixed_point_format && ! print_g) - { - rd = prec; - fw = rd + 3; - } - else - { - int ld_max, rd_max; - if (x_max > 0) - { - ld_max = x_max; - rd_max = prec > x_max ? prec - x_max : prec; - x_max++; - } - else - { - ld_max = 1; - rd_max = prec > x_max ? prec - x_max : prec; - x_max = -x_max + 1; - } - - int ld_min, rd_min; - if (x_min > 0) - { - ld_min = x_min; - rd_min = prec > x_min ? prec - x_min : prec; - x_min++; - } - else - { - ld_min = 1; - rd_min = prec > x_min ? prec - x_min : prec; - x_min = -x_min + 1; - } - - ld = ld_max > ld_min ? ld_max : ld_min; - rd = rd_max > rd_min ? rd_max : rd_min; - - fw = ld + rd + 3; - } - - if (! (rat_format || bank_format || hex_format || bit_format) - && (print_e - || print_eng || print_g - || (! Vfixed_point_format && fw > Voutput_max_field_width))) - { - if (print_g) - fmt = float_format (); - else - { - int ex = 4; - if (x_max > 100 || x_min > 100) - ex++; - - if (print_eng) - { - fw = 5 + prec + ex; - fmt = float_format (fw, ex, prec - 1, std::ios::fixed); - } - else - { - fw = 3 + prec + ex; - fmt = float_format (fw, prec - 1, std::ios::scientific); - } - } - - if (print_big_e) - fmt.uppercase (); - } - else if (! bank_format && all_ints) - fmt = float_format (fw, rd); - else - fmt = float_format (fw, rd, std::ios::fixed); - - curr_real_fmt = &fmt; -} - -static void -set_format (const Range& r, int& fw, double& scale) -{ - curr_real_fmt = 0; - curr_imag_fmt = 0; - - if (free_format) - return; - - double r_min = r.base (); - double r_max = r.limit (); - - if (r_max < r_min) - { - double tmp = r_max; - r_max = r_min; - r_min = tmp; - } - - bool all_ints = r.all_elements_are_ints (); - - double max_abs = r_max < 0.0 ? -r_max : r_max; - double min_abs = r_min < 0.0 ? -r_min : r_min; - - int x_max = max_abs == 0.0 ? 0 : num_digits (max_abs); - - int x_min = min_abs == 0.0 ? 0 : num_digits (min_abs); - - scale = (x_max == 0 || all_ints) ? 1.0 - : std::pow (10.0, calc_scale_exp (x_max - 1)); - - set_range_format (x_max, x_min, all_ints, fw); -} - -static inline void -set_format (const Range& r) -{ - int fw; - double scale; - set_format (r, fw, scale); -} - -union equiv -{ - double d; - unsigned char i[sizeof (double)]; -}; - -#define PRINT_CHAR_BITS(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -#define PRINT_CHAR_BITS_SWAPPED(os, c) \ - do \ - { \ - unsigned char ctmp = c; \ - char stmp[9]; \ - stmp[0] = (ctmp & 0x01) ? '1' : '0'; \ - stmp[1] = (ctmp & 0x02) ? '1' : '0'; \ - stmp[2] = (ctmp & 0x04) ? '1' : '0'; \ - stmp[3] = (ctmp & 0x08) ? '1' : '0'; \ - stmp[4] = (ctmp & 0x10) ? '1' : '0'; \ - stmp[5] = (ctmp & 0x20) ? '1' : '0'; \ - stmp[6] = (ctmp & 0x40) ? '1' : '0'; \ - stmp[7] = (ctmp & 0x80) ? '1' : '0'; \ - stmp[8] = '\0'; \ - os << stmp; \ - } \ - while (0) - -static void -pr_any_float (const float_format *fmt, std::ostream& os, double d, int fw = 0) -{ - if (fmt) - { - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - equiv tmp; - tmp.d = d; - - // Unless explicitly asked for, always print in big-endian - // format. - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - // FIXME -- will bad things happen if we are - // interrupted before resetting the format flags and fill - // character? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - os << std::setw (2) << static_cast (tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmp.i[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - equiv tmp; - tmp.d = d; - - // FIXME -- is it correct to swap bytes for VAX - // formats and not for Cray? - - oct_mach_info::float_format flt_fmt = - oct_mach_info::native_float_format (); - - if (flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian - || flt_fmt == oct_mach_info::flt_fmt_cray - || flt_fmt == oct_mach_info::flt_fmt_unknown) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sizeof (double); i++) - PRINT_CHAR_BITS_SWAPPED (os, tmp.i[i]); - } - else - { - for (int i = sizeof (double) - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmp.i[i]); - } - } - } - else if (octave_is_NA (d)) - { - if (fw > 0) - os << std::setw (fw) << "NA"; - else - os << "NA"; - } - else if (rat_format) - os << pr_rational_float (*fmt, d); - else if (xisinf (d)) - { - const char *s; - if (d < 0.0) - s = "-Inf"; - else - s = "Inf"; - - if (fw > 0) - os << std::setw (fw) << s; - else - os << s; - } - else if (xisnan (d)) - { - if (fw > 0) - os << std::setw (fw) << "NaN"; - else - os << "NaN"; - } - else if (print_eng) - os << pr_engineering_float (*fmt, d); - else - os << pr_formatted_float (*fmt, d); - } - else - os << d; -} - -static inline void -pr_float (std::ostream& os, double d, int fw = 0, double scale = 1.0) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - d /= scale; - - pr_any_float (curr_real_fmt, os, d, fw); -} - -static inline void -pr_imag_float (std::ostream& os, double d, int fw = 0) -{ - pr_any_float (curr_imag_fmt, os, d, fw); -} - -static void -pr_complex (std::ostream& os, const Complex& c, int r_fw = 0, - int i_fw = 0, double scale = 1.0) -{ - Complex tmp - = (Vfixed_point_format && ! print_g && scale != 1.0) ? c / scale : c; - - double r = tmp.real (); - - pr_float (os, r, r_fw); - - if (! bank_format) - { - double i = tmp.imag (); - if (! (hex_format || bit_format) && lo_ieee_signbit (i)) - { - os << " - "; - i = -i; - pr_imag_float (os, i, i_fw); - } - else - { - if (hex_format || bit_format) - os << " "; - else - os << " + "; - - pr_imag_float (os, i, i_fw); - } - os << "i"; - } -} - -static void -print_empty_matrix (std::ostream& os, octave_idx_type nr, octave_idx_type nc, bool pr_as_read_syntax) -{ - assert (nr == 0 || nc == 0); - - if (pr_as_read_syntax) - { - if (nr == 0 && nc == 0) - os << "[]"; - else - os << "zeros (" << nr << ", " << nc << ")"; - } - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << nr << "x" << nc << ")"; - } -} - -static void -print_empty_nd_array (std::ostream& os, const dim_vector& dims, - bool pr_as_read_syntax) -{ - assert (dims.any_zero ()); - - if (pr_as_read_syntax) - os << "zeros (" << dims.str (',') << ")"; - else - { - os << "[]"; - - if (Vprint_empty_dimensions) - os << "(" << dims.str () << ")"; - } -} - -static void -pr_scale_header (std::ostream& os, double scale) -{ - if (Vfixed_point_format && ! print_g && scale != 1.0) - { - os << " " - << std::setw (8) << std::setprecision (1) - << std::setiosflags (std::ios::scientific|std::ios::left) - << scale - << std::resetiosflags (std::ios::scientific|std::ios::left) - << " *\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -static void -pr_col_num_header (std::ostream& os, octave_idx_type total_width, int max_width, - octave_idx_type lim, octave_idx_type col, int extra_indent) -{ - if (total_width > max_width && Vsplit_long_rows) - { - if (col != 0) - { - if (Vcompact_format) - os << "\n"; - else - os << "\n\n"; - } - - octave_idx_type num_cols = lim - col; - - os << std::setw (extra_indent) << ""; - - if (num_cols == 1) - os << " Column " << col + 1 << ":\n"; - else if (num_cols == 2) - os << " Columns " << col + 1 << " and " << lim << ":\n"; - else - os << " Columns " << col + 1 << " through " << lim << ":\n"; - - if (! Vcompact_format) - os << "\n"; - } -} - -template -/* static */ inline void -pr_plus_format (std::ostream& os, const T& val) -{ - if (val > T (0)) - os << plus_format_chars[0]; - else if (val < T (0)) - os << plus_format_chars[1]; - else - os << plus_format_chars[2]; -} - -void -octave_print_internal (std::ostream& os, double d, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, d); - } - else - { - set_format (d); - if (free_format) - os << d; - else - pr_float (os, d); - } -} - -void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (m, fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << m; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_float (os, m(i,j), fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw; - double scale = 1.0; - set_format (Matrix (m.diag ()), fw, scale); - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_float (os, m(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_float (tmp_oss, 0.0, fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_float (os, m(i,j), fw, scale); - else - os << std::setw (zero_fw) << '0'; - - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -template -void print_nd_array (std::ostream& os, const NDA_T& nda, - bool pr_as_read_syntax) -{ - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else - { - - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - octave_quit (); - - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - octave_value page - = MAT_T (Array (nda.index (idx), dim_vector (nr, nc))); - - if (i != m - 1) - { - page.print_with_name (os, nm); - } - else - { - page.print_name_tag (os, nm); - page.print_raw (os); - } - - if (i < m) - NDA_T::increment_index (ra_idx, dims, 2); - } - } -} - -void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -template <> -/* static */ inline void -pr_plus_format<> (std::ostream& os, const Complex& c) -{ - double rp = c.real (); - double ip = c.imag (); - - if (rp == 0.0) - { - if (ip == 0.0) - os << " "; - else - os << "i"; - } - else if (ip == 0.0) - pr_plus_format (os, rp); - else - os << "c"; -} - -void -octave_print_internal (std::ostream& os, const Complex& c, - bool /* pr_as_read_syntax */) -{ - if (plus_format) - { - pr_plus_format (os, c); - } - else - { - set_format (c); - if (free_format) - os << c; - else - pr_complex (os, c); - } -} - -void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (cm, r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << cm; - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (i == 0 && j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(i,j)); - } - - col += inc; - - if (col >= nc) - { - if (i == nr - 1) - os << " ]"; - else - os << ";\n"; - } - else - os << " ...\n"; - } - } - } - else - { - pr_scale_header (os, scale); - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = cm.rows (); - octave_idx_type nc = cm.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, cm(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int r_fw, i_fw; - double scale = 1.0; - set_format (ComplexMatrix (cm.diag ()), r_fw, i_fw, scale); - int column_width = i_fw + r_fw; - column_width += (rat_format || bank_format || hex_format - || bit_format) ? 2 : 7; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << ComplexMatrix (cm); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - os << "diag ("; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - pr_complex (os, cm(j,j)); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - os << ")"; - } - else - { - os << "Diagonal Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - pr_scale_header (os, scale); - - // kluge. Get the true width of a number. - int zero_fw; - - { - std::ostringstream tmp_oss; - pr_complex (tmp_oss, Complex (0.0), r_fw, i_fw, scale); - zero_fw = tmp_oss.str ().length (); - } - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - if (i == j) - pr_complex (os, cm(i,j), r_fw, i_fw, scale); - else - os << std::setw (zero_fw) << '0'; - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_idx_type nr = m.rows (); - octave_idx_type nc = m.columns (); - - if (nr == 0 || nc == 0) - print_empty_matrix (os, nr, nc, pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < nr; i++) - { - for (octave_idx_type j = 0; j < nc; j++) - { - octave_quit (); - - pr_plus_format (os, m(i,j)); - } - - if (i < nr - 1) - os << "\n"; - } - } - else - { - int fw = 2; - int column_width = fw + 2; - octave_idx_type total_width = nc * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (pr_as_read_syntax) - max_width -= 4; - else - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - os << Matrix (m); - - if (pr_as_read_syntax) - os << "]"; - - return; - } - - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - if (pr_as_read_syntax) - { - Array pvec = m.pvec (); - bool colp = m.is_col_perm (); - - os << "eye ("; - if (colp) os << ":, "; - - octave_idx_type col = 0; - while (col < nc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - if (j == 0) - os << "[ "; - else - { - if (j > col && j < lim) - os << ", "; - else - os << " "; - } - - os << pvec (j); - } - - col += inc; - - if (col >= nc) - os << " ]"; - else - os << " ...\n"; - } - if (! colp) os << ", :"; - os << ")"; - } - else - { - os << "Permutation Matrix\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type col = 0; col < nc; col += inc) - { - octave_idx_type lim = col + inc < nc ? col + inc : nc; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type i = 0; i < nr; i++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type j = col; j < lim; j++) - { - octave_quit (); - - os << " "; - - os << std::setw (fw) << m(i,j); - } - - if (i < nr - 1) - os << "\n"; - } - } - } - } -} - -void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, bool d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -// FIXME -- write single precision versions of the printing functions. - -void -octave_print_internal (std::ostream& os, float d, bool pr_as_read_syntax) -{ - octave_print_internal (os, double (d), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, Matrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, DiagMatrix (m), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, NDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax) -{ - octave_print_internal (os, Complex (c), pr_as_read_syntax); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexDiagMatrix (cm), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - octave_print_internal (os, ComplexNDArray (nda), pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax, int extra_indent) -{ - double base = r.base (); - double increment = r.inc (); - double limit = r.limit (); - octave_idx_type num_elem = r.nelem (); - - if (plus_format && ! pr_as_read_syntax) - { - for (octave_idx_type i = 0; i < num_elem; i++) - { - octave_quit (); - - double val = base + i * increment; - - pr_plus_format (os, val); - } - } - else - { - int fw = 0; - double scale = 1.0; - set_format (r, fw, scale); - - if (pr_as_read_syntax) - { - if (free_format) - { - os << base << " : "; - if (increment != 1.0) - os << increment << " : "; - os << limit; - } - else - { - pr_float (os, base, fw); - os << " : "; - if (increment != 1.0) - { - pr_float (os, increment, fw); - os << " : "; - } - pr_float (os, limit, fw); - } - } - else - { - int column_width = fw + 2; - octave_idx_type total_width = num_elem * column_width; - octave_idx_type max_width = command_editor::terminal_cols (); - - if (free_format) - { - os << r; - return; - } - - octave_idx_type inc = num_elem; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - max_width -= extra_indent; - - if (max_width < 0) - max_width = 0; - - pr_scale_header (os, scale); - - octave_idx_type col = 0; - while (col < num_elem) - { - octave_idx_type lim = col + inc < num_elem ? col + inc : num_elem; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - os << std::setw (extra_indent) << ""; - - for (octave_idx_type i = col; i < lim; i++) - { - octave_quit (); - - double val = base + i * increment; - - if (i == num_elem - 1) - { - // See the comments in Range::matrix_value. - - if ((increment > 0 && val > limit) - || (increment < 0 && val < limit)) - val = limit; - } - - os << " "; - - pr_float (os, val, fw, scale); - } - - col += inc; - } - } - } -} - -void -octave_print_internal (std::ostream& os, const boolMatrix& bm, - bool pr_as_read_syntax, - int extra_indent) -{ - Matrix tmp (bm); - octave_print_internal (os, tmp, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const boolNDArray& nda, - bool pr_as_read_syntax, - int extra_indent) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax, - int /* extra_indent FIXME */, - bool pr_as_string) -{ - if (pr_as_string) - { - octave_idx_type nstr = chm.rows (); - - if (pr_as_read_syntax && nstr > 1) - os << "[ "; - - if (nstr != 0) - { - for (octave_idx_type i = 0; i < nstr; i++) - { - octave_quit (); - - std::string row = chm.row_as_string (i); - - if (pr_as_read_syntax) - { - os << "\"" << undo_string_escapes (row) << "\""; - - if (i < nstr - 1) - os << "; "; - } - else - { - os << row; - - if (i < nstr - 1) - os << "\n"; - } - } - } - - if (pr_as_read_syntax && nstr > 1) - os << " ]"; - } - else - { - os << "sorry, printing char matrices not implemented yet\n"; - } -} - -void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax, int extra_indent, - bool pr_as_string) -{ - switch (nda.ndims ()) - { - case 1: - case 2: - octave_print_internal (os, nda.matrix_value (), - pr_as_read_syntax, extra_indent, pr_as_string); - break; - - default: - print_nd_array (os, nda, pr_as_read_syntax); - break; - } -} - -void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax, int extra_indent) -{ - Array nda (dim_vector (1, 1), s); - - octave_print_internal (os, nda, pr_as_read_syntax, extra_indent); -} - -void -octave_print_internal (std::ostream& os, const Array& nda, - bool pr_as_read_syntax, int /* extra_indent */) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - { - os << nda(0); - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - std::string nm = "ans"; - - if (m > 1) - { - nm += "(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - // FIXME -- need to do some more work to put these - // in neatly aligned columns... - - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - for (octave_idx_type jj = 0; jj < n_cols; jj++) - os << " " << page(ii,jj); - - os << "\n"; - } - - if (i < m - 1) - os << "\n"; - - if (i < m) - increment_index (ra_idx, dims, 2); - } - } -} - -template -class -octave_print_conv -{ -public: - typedef T print_conv_type; -}; - -#define PRINT_CONV(T1, T2) \ - template <> \ - class \ - octave_print_conv \ - { \ - public: \ - typedef T2 print_conv_type; \ - } - -PRINT_CONV (octave_int8, octave_int16); -PRINT_CONV (octave_uint8, octave_uint16); - -#undef PRINT_CONV - -template -/* static */ inline void -pr_int (std::ostream& os, const T& d, int fw = 0) -{ - size_t sz = d.byte_size (); - const unsigned char * tmpi = d.iptr (); - - // Unless explicitly asked for, always print in big-endian - // format for hex and bit formats. - // - // {bit,hex}_format == 1: print big-endian - // {bit,hex}_format == 2: print native - - if (hex_format) - { - char ofill = os.fill ('0'); - - std::ios::fmtflags oflags - = os.flags (std::ios::right | std::ios::hex); - - if (hex_format > 1 || oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - os << std::setw (2) << static_cast (tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - os << std::setw (2) << static_cast (tmpi[i]); - } - - os.fill (ofill); - os.setf (oflags); - } - else if (bit_format) - { - if (oct_mach_info::words_big_endian ()) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS (os, tmpi[i]); - } - else - { - if (bit_format > 1) - { - for (size_t i = 0; i < sz; i++) - PRINT_CHAR_BITS_SWAPPED (os, tmpi[i]); - } - else - { - for (int i = sz - 1; i >= 0; i--) - PRINT_CHAR_BITS (os, tmpi[i]); - } - } - } - else - { - os << std::setw (fw) - << typename octave_print_conv::print_conv_type (d); - - if (bank_format) - os << ".00"; - } -} - -// FIXME -- all this mess with abs is an attempt to avoid seeing -// -// warning: comparison of unsigned expression < 0 is always false -// -// from GCC. Isn't there a better way - -template -/* static */ inline T -abs (T x) -{ - return x < 0 ? -x : x; -} - -#define INSTANTIATE_ABS(T) \ - template /* static */ T abs (T) - -INSTANTIATE_ABS(signed char); -INSTANTIATE_ABS(short); -INSTANTIATE_ABS(int); -INSTANTIATE_ABS(long); -INSTANTIATE_ABS(long long); - -#define SPECIALIZE_UABS(T) \ - template <> \ - /* static */ inline unsigned T \ - abs (unsigned T x) \ - { \ - return x; \ - } - -SPECIALIZE_UABS(char) -SPECIALIZE_UABS(short) -SPECIALIZE_UABS(int) -SPECIALIZE_UABS(long) -SPECIALIZE_UABS(long long) - -template void -pr_int (std::ostream&, const octave_int8&, int); - -template void -pr_int (std::ostream&, const octave_int16&, int); - -template void -pr_int (std::ostream&, const octave_int32&, int); - -template void -pr_int (std::ostream&, const octave_int64&, int); - -template void -pr_int (std::ostream&, const octave_uint8&, int); - -template void -pr_int (std::ostream&, const octave_uint16&, int); - -template void -pr_int (std::ostream&, const octave_uint32&, int); - -template void -pr_int (std::ostream&, const octave_uint64&, int); - -template -void -octave_print_internal_template (std::ostream& os, const octave_int& val, - bool) -{ - if (plus_format) - { - pr_plus_format (os, val); - } - else - { - if (free_format) - os << typename octave_print_conv >::print_conv_type (val); - else - pr_int (os, val); - } -} - -#define PRINT_INT_SCALAR_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const octave_int& val, bool dummy) \ - { \ - octave_print_internal_template (os, val, dummy); \ - } - -PRINT_INT_SCALAR_INTERNAL (int8_t) -PRINT_INT_SCALAR_INTERNAL (uint8_t) -PRINT_INT_SCALAR_INTERNAL (int16_t) -PRINT_INT_SCALAR_INTERNAL (uint16_t) -PRINT_INT_SCALAR_INTERNAL (int32_t) -PRINT_INT_SCALAR_INTERNAL (uint32_t) -PRINT_INT_SCALAR_INTERNAL (int64_t) -PRINT_INT_SCALAR_INTERNAL (uint64_t) - -template -/* static */ inline void -octave_print_internal_template (std::ostream& os, const intNDArray& nda, - bool pr_as_read_syntax, int extra_indent) -{ - // FIXME -- this mostly duplicates the code in the print_nd_array<> - // function. Can fix this with std::is_same from C++11. - - if (nda.is_empty ()) - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); - else if (nda.length () == 1) - octave_print_internal_template (os, nda(0), pr_as_read_syntax); - else if (plus_format && ! pr_as_read_syntax) - { - int ndims = nda.ndims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - dim_vector dims = nda.dims (); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - - pr_plus_format (os, page(ii,jj)); - } - - if ((ii < nr - 1) || (i < m -1)) - os << "\n"; - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } - else - { - int ndims = nda.ndims (); - - dim_vector dims = nda.dims (); - - Array ra_idx (dim_vector (ndims, 1), 0); - - octave_idx_type m = 1; - - for (int i = 2; i < ndims; i++) - m *= dims(i); - - octave_idx_type nr = dims(0); - octave_idx_type nc = dims(1); - - int fw = 0; - if (hex_format) - fw = 2 * nda(0).byte_size (); - else if (bit_format) - fw = nda(0).nbits (); - else - { - bool isneg = false; - int digits = 0; - - for (octave_idx_type i = 0; i < dims.numel (); i++) - { - int new_digits = static_cast - (gnulib::floor (log10 (double (abs (nda(i).value ()))) + 1.0)); - - if (new_digits > digits) - digits = new_digits; - - if (! isneg) - isneg = (abs (nda(i).value ()) != nda(i).value ()); - } - - fw = digits + isneg; - } - - int column_width = fw + (rat_format ? 0 : (bank_format ? 5 : 2)); - octave_idx_type total_width = nc * column_width; - int max_width = command_editor::terminal_cols () - extra_indent; - octave_idx_type inc = nc; - if (total_width > max_width && Vsplit_long_rows) - { - inc = max_width / column_width; - if (inc == 0) - inc++; - } - - for (octave_idx_type i = 0; i < m; i++) - { - if (m > 1) - { - std::string nm = "ans(:,:,"; - - std::ostringstream buf; - - for (int k = 2; k < ndims; k++) - { - buf << ra_idx(k) + 1; - - if (k < ndims - 1) - buf << ","; - else - buf << ")"; - } - - nm += buf.str (); - - os << nm << " =\n"; - if (! Vcompact_format) - os << "\n"; - } - - Array idx (dim_vector (ndims, 1)); - - idx(0) = idx_vector (':'); - idx(1) = idx_vector (':'); - - for (int k = 2; k < ndims; k++) - idx(k) = idx_vector (ra_idx(k)); - - Array page (nda.index (idx), dim_vector (nr, nc)); - - if (free_format) - { - if (pr_as_read_syntax) - os << "[\n"; - - for (octave_idx_type ii = 0; ii < nr; ii++) - { - for (octave_idx_type jj = 0; jj < nc; jj++) - { - octave_quit (); - os << " "; - os << typename octave_print_conv::print_conv_type (page(ii,jj)); - } - os << "\n"; - } - - if (pr_as_read_syntax) - os << "]"; - } - else - { - octave_idx_type n_rows = page.rows (); - octave_idx_type n_cols = page.cols (); - - for (octave_idx_type col = 0; col < n_cols; col += inc) - { - octave_idx_type lim = col + inc < n_cols ? col + inc : n_cols; - - pr_col_num_header (os, total_width, max_width, lim, col, - extra_indent); - - for (octave_idx_type ii = 0; ii < n_rows; ii++) - { - os << std::setw (extra_indent) << ""; - - for (octave_idx_type jj = col; jj < lim; jj++) - { - octave_quit (); - os << " "; - pr_int (os, page(ii,jj), fw); - } - if ((ii < n_rows - 1) || (i < m -1)) - os << "\n"; - } - } - } - - if (i < m - 1) - { - os << "\n"; - increment_index (ra_idx, dims, 2); - } - } - } -} - -#define PRINT_INT_ARRAY_INTERNAL(TYPE) \ - OCTINTERP_API void \ - octave_print_internal (std::ostream& os, const intNDArray& nda, \ - bool pr_as_read_syntax, int extra_indent) \ - { \ - octave_print_internal_template (os, nda, pr_as_read_syntax, extra_indent); \ - } - -PRINT_INT_ARRAY_INTERNAL (octave_int8) -PRINT_INT_ARRAY_INTERNAL (octave_uint8) -PRINT_INT_ARRAY_INTERNAL (octave_int16) -PRINT_INT_ARRAY_INTERNAL (octave_uint16) -PRINT_INT_ARRAY_INTERNAL (octave_int32) -PRINT_INT_ARRAY_INTERNAL (octave_uint32) -PRINT_INT_ARRAY_INTERNAL (octave_int64) -PRINT_INT_ARRAY_INTERNAL (octave_uint64) - -void -octave_print_internal (std::ostream&, const Cell&, bool, int, bool) -{ - panic_impossible (); -} - -DEFUN (rats, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} rats (@var{x}, @var{len})\n\ -Convert @var{x} into a rational approximation represented as a string.\n\ -You can convert the string back into a matrix as follows:\n\ -\n\ -@example\n\ -@group\n\ -r = rats (hilb (4));\n\ -x = str2num (r)\n\ -@end group\n\ -@end example\n\ -\n\ -The optional second argument defines the maximum length of the string\n\ -representing the elements of @var{x}. By default @var{len} is 9.\n\ -@seealso{format, rat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 2 || nargout > 1) - print_usage (); - else - { - unwind_protect frame; - - frame.protect_var (rat_string_len); - - rat_string_len = 9; - - if (nargin == 2) - rat_string_len = args(1).nint_value (); - - if (! error_state) - { - octave_value arg = args(0); - - if (arg.is_numeric_type ()) - { - frame.protect_var (rat_format); - - rat_format = true; - - std::ostringstream buf; - args(0).print (buf); - std::string s = buf.str (); - - std::list lst; - - size_t n = 0; - size_t s_len = s.length (); - - while (n < s_len) - { - size_t m = s.find ('\n', n); - - if (m == std::string::npos) - { - lst.push_back (s.substr (n)); - break; - } - else - { - lst.push_back (s.substr (n, m - n)); - n = m + 1; - } - } - - retval = string_vector (lst); - } - else - error ("rats: X must be numeric"); - } - } - - return retval; -} - -DEFUN (disp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} disp (@var{x})\n\ -Display the value of @var{x}. For example:\n\ -\n\ -@example\n\ -@group\n\ -disp (\"The value of pi is:\"), disp (pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{disp} always ends with a newline.\n\ -\n\ -If an output value is requested, @code{disp} prints nothing and\n\ -returns the formatted output in a string.\n\ -@seealso{fdisp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 && nargout < 2) - { - if (nargout == 0) - args(0).print (octave_stdout); - else - { - octave_value arg = args(0); - std::ostringstream buf; - arg.print (buf); - retval = octave_value (buf.str (), arg.is_dq_string () ? '"' : '\''); - } - } - else - print_usage (); - - return retval; -} - -DEFUN (fdisp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} fdisp (@var{fid}, @var{x})\n\ -Display the value of @var{x} on the stream @var{fid}. For example:\n\ -\n\ -@example\n\ -@group\n\ -fdisp (stdout, \"The value of pi is:\"), fdisp (stdout, pi)\n\ -\n\ - @print{} the value of pi is:\n\ - @print{} 3.1416\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Note that the output from @code{fdisp} always ends with a newline.\n\ -@seealso{disp}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2) - { - int fid = octave_stream_list::get_file_number (args (0)); - - octave_stream os = octave_stream_list::lookup (fid, "fdisp"); - - if (! error_state) - { - std::ostream *osp = os.output_stream (); - - if (osp) - args(1).print (*osp); - else - error ("fdisp: stream FID not open for writing"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! format short -%! fd = tmpfile (); -%! for r = [0, Inf -Inf, NaN] -%! for i = [0, Inf -Inf, NaN] -%! fdisp (fd, complex (r, i)); -%! endfor -%! endfor -%! fclose (fd); - -%!test -%! foo.real = pi * ones (3,20,3); -%! foo.complex = pi * ones (3,20,3) + 1i; -%! foo.char = repmat ("- Hello World -", [3, 20]); -%! foo.cell = {foo.real, foo.complex, foo.char}; -%! fields = fieldnames (foo); -%! for f = 1:numel (fields) -%! format loose; -%! loose = disp (foo.(fields{f})); -%! format compact; -%! compact = disp (foo.(fields{f})); -%! expected = strrep (loose, "\n\n", "\n"); -%! assert (expected, compact); -%! endfor -*/ - -static void -init_format_state (void) -{ - free_format = false; - plus_format = false; - rat_format = false; - bank_format = false; - hex_format = 0; - bit_format = 0; - Vcompact_format = false; - print_e = false; - print_big_e = false; - print_g = false; - print_eng = false; -} - -static void -set_output_prec_and_fw (int prec, int fw) -{ - Voutput_precision = prec; - Voutput_max_field_width = fw; -} - -static void -set_format_style (int argc, const string_vector& argv) -{ - int idx = 1; - - if (--argc > 0) - { - std::string arg = argv[idx++]; - - if (arg == "short") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option `short %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (5, 10); - } - else if (arg == "long") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg == "e") - { - init_format_state (); - print_e = true; - } - else if (arg == "E") - { - init_format_state (); - print_e = true; - print_big_e = true; - } - else if (arg == "g") - { - init_format_state (); - print_g = true; - } - else if (arg == "G") - { - init_format_state (); - print_g = true; - print_big_e = true; - } - else if (arg == "eng") - { - init_format_state (); - print_eng = true; - } - else - { - error ("format: unrecognized option `long %s'", - arg.c_str ()); - return; - } - } - else - init_format_state (); - - set_output_prec_and_fw (15, 20); - } - else if (arg == "hex") - { - init_format_state (); - hex_format = 1; - } - else if (arg == "native-hex") - { - init_format_state (); - hex_format = 2; - } - else if (arg == "bit") - { - init_format_state (); - bit_format = 1; - } - else if (arg == "native-bit") - { - init_format_state (); - bit_format = 2; - } - else if (arg == "+" || arg == "plus") - { - if (--argc > 0) - { - arg = argv[idx++]; - - if (arg.length () == 3) - plus_format_chars = arg; - else - { - error ("format: invalid option for plus format"); - return; - } - } - else - plus_format_chars = "+ "; - - init_format_state (); - plus_format = true; - } - else if (arg == "rat") - { - init_format_state (); - rat_format = true; - } - else if (arg == "bank") - { - init_format_state (); - bank_format = true; - } - else if (arg == "free") - { - init_format_state (); - free_format = true; - } - else if (arg == "none") - { - init_format_state (); - free_format = true; - } - else if (arg == "compact") - { - Vcompact_format = true; - } - else if (arg == "loose") - { - Vcompact_format = false; - } - else - error ("format: unrecognized format state `%s'", arg.c_str ()); - } - else - { - init_format_state (); - set_output_prec_and_fw (5, 10); - } -} - -DEFUN (format, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} format\n\ -@deftypefnx {Command} {} format options\n\ -Reset or specify the format of the output produced by @code{disp} and\n\ -Octave's normal echoing mechanism. This command only affects the display\n\ -of numbers but not how they are stored or computed. To change the internal\n\ -representation from the default double use one of the conversion functions\n\ -such as @code{single}, @code{uint8}, @code{int64}, etc.\n\ -\n\ -By default, Octave displays 5 significant digits in a human readable form\n\ -(option @samp{short} paired with @samp{loose} format for matrices).\n\ -If @code{format} is invoked without any options, this default format\n\ -is restored.\n\ -\n\ -Valid formats for floating point numbers are listed in the following\n\ -table.\n\ -\n\ -@table @code\n\ -@item short\n\ -Fixed point format with 5 significant figures in a field that is a maximum\n\ -of 10 characters wide. (default).\n\ -\n\ -If Octave is unable to format a matrix so that columns line up on the\n\ -decimal point and all numbers fit within the maximum field width then\n\ -it switches to an exponential @samp{e} format.\n\ -\n\ -@item long\n\ -Fixed point format with 15 significant figures in a field that is a maximum\n\ -of 20 characters wide.\n\ -\n\ -As with the @samp{short} format, Octave will switch to an exponential\n\ -@samp{e} format if it is unable to format a matrix properly using the\n\ -current format.\n\ -\n\ -@item short e\n\ -@itemx long e\n\ -Exponential format. The number to be represented is split between a mantissa\n\ -and an exponent (power of 10). The mantissa has 5 significant digits in the\n\ -short format and 15 digits in the long format.\n\ -For example, with the @samp{short e} format, @code{pi} is displayed as\n\ -@code{3.1416e+00}.\n\ -\n\ -@item short E\n\ -@itemx long E\n\ -Identical to @samp{short e} or @samp{long e} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -For example, with the @samp{long E} format, @code{pi} is displayed as\n\ -@code{3.14159265358979E+00}.\n\ -\n\ -@item short g\n\ -@itemx long g\n\ -Optimally choose between fixed point and exponential format based on\n\ -the magnitude of the number.\n\ -For example, with the @samp{short g} format,\n\ -@code{pi .^ [2; 4; 8; 16; 32]} is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ - 9.8696\n\ - 97.409\n\ - 9488.5\n\ - 9.0032e+07\n\ - 8.1058e+15\n\ -@end group\n\ -@end example\n\ -\n\ -@item short eng\n\ -@itemx long eng\n\ -Identical to @samp{short e} or @samp{long e} but displays the value\n\ -using an engineering format, where the exponent is divisible by 3. For\n\ -example, with the @samp{short eng} format, @code{10 * pi} is displayed as\n\ -@code{31.4159e+00}.\n\ -\n\ -@item long G\n\ -@itemx short G\n\ -Identical to @samp{short g} or @samp{long g} but displays an uppercase\n\ -@samp{E} to indicate the exponent.\n\ -\n\ -@item free\n\ -@itemx none\n\ -Print output in free format, without trying to line up columns of\n\ -matrices on the decimal point. This also causes complex numbers to be\n\ -formatted as numeric pairs like this @samp{(0.60419, 0.60709)} instead\n\ -of like this @samp{0.60419 + 0.60709i}.\n\ -@end table\n\ -\n\ -The following formats affect all numeric output (floating point and\n\ -integer types).\n\ -\n\ -@table @code\n\ -@item +\n\ -@itemx + @var{chars}\n\ -@itemx plus\n\ -@itemx plus @var{chars}\n\ -Print a @samp{+} symbol for nonzero matrix elements and a space for zero\n\ -matrix elements. This format can be very useful for examining the\n\ -structure of a large sparse matrix.\n\ -\n\ -The optional argument @var{chars} specifies a list of 3 characters to use\n\ -for printing values greater than zero, less than zero and equal to zero.\n\ -For example, with the @samp{+ \"+-.\"} format, @code{[1, 0, -1; -1, 0, 1]}\n\ -is displayed as\n\ -\n\ -@example\n\ -@group\n\ -ans =\n\ -\n\ -+.-\n\ --.+\n\ -@end group\n\ -@end example\n\ -\n\ -@item bank\n\ -Print in a fixed format with two digits to the right of the decimal\n\ -point.\n\ -\n\ -@item native-hex\n\ -Print the hexadecimal representation of numbers as they are stored in\n\ -memory. For example, on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first, the value of\n\ -@code{pi} when printed in @code{native-hex} format is\n\ -@code{400921fb54442d18}.\n\ -\n\ -@item hex\n\ -The same as @code{native-hex}, but always print the most significant\n\ -byte first.\n\ -\n\ -@item native-bit\n\ -Print the bit representation of numbers as stored in memory.\n\ -For example, the value of @code{pi} is\n\ -\n\ -@example\n\ -@group\n\ -01000000000010010010000111111011\n\ -01010100010001000010110100011000\n\ -@end group\n\ -@end example\n\ -\n\ -(shown here in two 32 bit sections for typesetting purposes) when\n\ -printed in native-bit format on a workstation which stores 8 byte real values\n\ -in IEEE format with the least significant byte first.\n\ -\n\ -@item bit\n\ -The same as @code{native-bit}, but always print the most significant\n\ -bits first.\n\ -\n\ -@item rat\n\ -Print a rational approximation, i.e., values are approximated\n\ -as the ratio of small integers.\n\ -For example, with the @samp{rat} format,\n\ -@code{pi} is displayed as @code{355/113}.\n\ -@end table\n\ -\n\ -The following two options affect the display of all matrices.\n\ -\n\ -@table @code\n\ -@item compact\n\ -Remove blank lines around column number labels and between\n\ -matrices producing more compact output with more data per page.\n\ -\n\ -@item loose\n\ -Insert blank lines above and below column number labels and between matrices\n\ -to produce a more readable output with less data per page. (default).\n\ -@end table\n\ -@seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("format"); - - if (error_state) - return retval; - - set_format_style (argc, argv); - - return retval; -} - -DEFUN (fixed_point_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} fixed_point_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} fixed_point_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} fixed_point_format (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will\n\ -use a scaled format to print matrix values such that the largest\n\ -element may be written with a single leading digit with the scaling\n\ -factor is printed on the first line of output. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:1> logspace (1, 7, 5)'\n\ -ans =\n\ -\n\ - 1.0e+07 *\n\ -\n\ - 0.00000\n\ - 0.00003\n\ - 0.00100\n\ - 0.03162\n\ - 1.00000\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -Notice that first value appears to be zero when it is actually 1. For\n\ -this reason, you should be careful when setting\n\ -@code{fixed_point_format} to a nonzero value.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, output_max_field_width, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (fixed_point_format); -} - -DEFUN (print_empty_dimensions, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} print_empty_dimensions ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} print_empty_dimensions (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} print_empty_dimensions (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether the\n\ -dimensions of empty matrices are printed along with the empty matrix\n\ -symbol, @samp{[]}. For example, the expression\n\ -\n\ -@example\n\ -zeros (3, 0)\n\ -@end example\n\ -\n\ -@noindent\n\ -will print\n\ -\n\ -@example\n\ -ans = [](3x0)\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (print_empty_dimensions); -} - -DEFUN (split_long_rows, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} split_long_rows ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} split_long_rows (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} split_long_rows (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether rows of a matrix\n\ -may be split when displayed to a terminal window. If the rows are split,\n\ -Octave will display the matrix in a series of smaller pieces, each of\n\ -which can fit within the limits of your terminal width and each set of\n\ -rows is labeled so that you can easily see which columns are currently\n\ -being displayed. For example:\n\ -\n\ -@example\n\ -@group\n\ -octave:13> rand (2,10)\n\ -ans =\n\ -\n\ - Columns 1 through 6:\n\ -\n\ - 0.75883 0.93290 0.40064 0.43818 0.94958 0.16467\n\ - 0.75697 0.51942 0.40031 0.61784 0.92309 0.40201\n\ -\n\ - Columns 7 through 10:\n\ -\n\ - 0.90174 0.11854 0.72313 0.73326\n\ - 0.44672 0.94303 0.56564 0.82150\n\ -@end group\n\ -@end example\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (split_long_rows); -} - -DEFUN (output_max_field_width, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_max_field_width ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_max_field_width (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_max_field_width (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the maximum width\n\ -of a numeric output field.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_precision}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_max_field_width, 0, INT_MAX); -} - -DEFUN (output_precision, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} output_precision ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} output_precision (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} output_precision (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the minimum number of\n\ -significant figures to display for numeric output.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{format, fixed_point_format, output_max_field_width}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE_WITH_LIMITS (output_precision, -1, INT_MAX); -} diff -r 069c552587a0 -r 959953dba519 src/pr-output.h --- a/src/pr-output.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,262 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_pr_output_h) -#define octave_pr_output_h 1 - -#include - -#include "oct-cmplx.h" - -template class Array; -class ComplexMatrix; -class FloatComplexMatrix; -class ComplexDiagMatrix; -class FloatComplexDiagMatrix; -class ComplexNDArray; -class FloatComplexNDArray; -class Matrix; -class FloatMatrix; -class DiagMatrix; -class FloatDiagMatrix; -class NDArray; -class FloatNDArray; -class Range; -class boolMatrix; -class boolNDArray; -class charMatrix; -class charNDArray; -class PermMatrix; -class Cell; - -#include "intNDArray.h" -#include "oct-inttypes.h" - - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, bool d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, double d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, float d, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Matrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const DiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatDiagMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const NDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Complex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplex& c, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexDiagMatrix& cm, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const ComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const FloatComplexNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const PermMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Range& r, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolMatrix& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const boolNDArray& m, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charMatrix& chm, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const charNDArray& nda, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const std::string& s, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Array& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const intNDArray& sa, - bool pr_as_read_syntax = false, - int extra_indent = 0); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const octave_int& sa, - bool pr_as_read_syntax = false); - -extern OCTINTERP_API void -octave_print_internal (std::ostream& os, const Cell& cell, - bool pr_as_read_syntax = false, - int extra_indent = 0, - bool pr_as_string = false); - -// TRUE means that the dimensions of empty objects should be printed -// like this: x = [](2x0). -extern bool Vprint_empty_dimensions; - -// TRUE means don't put empty lines in output -extern bool Vcompact_format; - -#endif diff -r 069c552587a0 -r 959953dba519 src/profiler.cc --- a/src/profiler.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,470 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include "defun.h" -#include "oct-time.h" -#include "ov-struct.h" -#include "pager.h" -#include "profiler.h" - -profile_data_accumulator::enter::enter (profile_data_accumulator& a, - const std::string& f) - : acc (a) -{ - if (acc.is_active ()) - { - fcn = f; - acc.enter_function (fcn); - } - else - fcn = ""; -} - -profile_data_accumulator::enter::~enter () -{ - if (fcn != "") - acc.exit_function (fcn); -} - -profile_data_accumulator::stats::stats () - : time (0.0), calls (0), recursive (false), - parents (), children () -{} - -octave_value -profile_data_accumulator::stats::function_set_value (const function_set& list) -{ - const octave_idx_type n = list.size (); - - RowVector retval (n); - octave_idx_type i = 0; - for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) - { - retval(i) = *p; - ++i; - } - assert (i == n); - - return retval; -} - -profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) - : parent (p), fcn_id (f), children (), time (0.0), calls (0) -{} - -profile_data_accumulator::tree_node::~tree_node () -{ - for (child_map::iterator i = children.begin (); i != children.end (); ++i) - delete i->second; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::enter (octave_idx_type fcn) -{ - tree_node* retval; - - child_map::iterator pos = children.find (fcn); - if (pos == children.end ()) - { - retval = new tree_node (this, fcn); - children[fcn] = retval; - } - else - retval = pos->second; - - ++retval->calls; - return retval; -} - -profile_data_accumulator::tree_node* -profile_data_accumulator::tree_node::exit (octave_idx_type fcn) -{ - assert (parent); - assert (fcn_id == fcn); - - return parent; -} - -void -profile_data_accumulator::tree_node::build_flat (flat_profile& data) const -{ - // If this is not the top-level node, update profile entry for this function. - if (fcn_id != 0) - { - stats& entry = data[fcn_id - 1]; - - entry.time += time; - entry.calls += calls; - - assert (parent); - if (parent->fcn_id != 0) - { - entry.parents.insert (parent->fcn_id); - data[parent->fcn_id - 1].children.insert (fcn_id); - } - - if (!entry.recursive) - for (const tree_node* i = parent; i; i = i->parent) - if (i->fcn_id == fcn_id) - { - entry.recursive = true; - break; - } - } - - // Recurse on children. - for (child_map::const_iterator i = children.begin (); - i != children.end (); ++i) - i->second->build_flat (data); -} - -octave_value -profile_data_accumulator::tree_node::get_hierarchical (double* total) const -{ - /* Note that we don't generate the entry just for this node, but rather - a struct-array with entries for all children. This way, the top-node - (for which we don't want a real entry) generates already the final - hierarchical profile data. */ - - const octave_idx_type n = children.size (); - - Cell rv_indices (n, 1); - Cell rv_times (n, 1); - Cell rv_totals (n, 1); - Cell rv_calls (n, 1); - Cell rv_children (n, 1); - - octave_idx_type i = 0; - for (child_map::const_iterator p = children.begin (); - p != children.end (); ++p) - { - const tree_node& entry = *p->second; - double child_total = entry.time; - - rv_indices(i) = octave_value (p->first); - rv_times(i) = octave_value (entry.time); - rv_calls(i) = octave_value (entry.calls); - rv_children(i) = entry.get_hierarchical (&child_total); - rv_totals(i) = octave_value (child_total); - - if (total) - *total += child_total; - - ++i; - } - assert (i == n); - - octave_map retval; - - retval.assign ("Index", rv_indices); - retval.assign ("SelfTime", rv_times); - retval.assign ("TotalTime", rv_totals); - retval.assign ("NumCalls", rv_calls); - retval.assign ("Children", rv_children); - - return retval; -} - -profile_data_accumulator::profile_data_accumulator () - : known_functions (), fcn_index (), - enabled (false), call_tree (NULL), last_time (-1.0) -{} - -profile_data_accumulator::~profile_data_accumulator () -{ - if (call_tree) - delete call_tree; -} - -void -profile_data_accumulator::set_active (bool value) -{ - if (value) - { - // Create a call-tree top-node if there isn't yet one. - if (!call_tree) - call_tree = new tree_node (NULL, 0); - - // Let the top-node be the active one. This ensures we have a clean - // fresh start collecting times. - active_fcn = call_tree; - } - else - { - // Make sure we start with fresh timing if we're re-enabled later. - last_time = -1.0; - } - - enabled = value; -} - -void -profile_data_accumulator::enter_function (const std::string& fcn) -{ - // The enter class will check and only call us if the profiler is active. - assert (is_active ()); - assert (call_tree); - - // If there is already an active function, add to its time before - // pushing the new one. - if (active_fcn != call_tree) - add_current_time (); - - // Map the function's name to its index. - octave_idx_type fcn_idx; - fcn_index_map::iterator pos = fcn_index.find (fcn); - if (pos == fcn_index.end ()) - { - known_functions.push_back (fcn); - fcn_idx = known_functions.size (); - fcn_index[fcn] = fcn_idx; - } - else - fcn_idx = pos->second; - - active_fcn = active_fcn->enter (fcn_idx); - last_time = query_time (); -} - -void -profile_data_accumulator::exit_function (const std::string& fcn) -{ - assert (call_tree); - assert (active_fcn != call_tree); - - // Usually, if we are disabled this function is not even called. But the - // call disabling the profiler is an exception. So also check here - // and only record the time if enabled. - if (is_active ()) - add_current_time (); - - fcn_index_map::iterator pos = fcn_index.find (fcn); - assert (pos != fcn_index.end ()); - active_fcn = active_fcn->exit (pos->second); - - // If this was an "inner call", we resume executing the parent function - // up the stack. So note the start-time for this! - last_time = query_time (); -} - -void -profile_data_accumulator::reset (void) -{ - if (is_active ()) - { - error ("Can't reset active profiler."); - return; - } - - known_functions.clear (); - fcn_index.clear (); - - if (call_tree) - { - delete call_tree; - call_tree = NULL; - } - - last_time = -1.0; -} - -octave_value -profile_data_accumulator::get_flat (void) const -{ - octave_value retval; - - const octave_idx_type n = known_functions.size (); - - flat_profile flat (n); - - if (call_tree) - { - call_tree->build_flat (flat); - - Cell rv_names (n, 1); - Cell rv_times (n, 1); - Cell rv_calls (n, 1); - Cell rv_recursive (n, 1); - Cell rv_parents (n, 1); - Cell rv_children (n, 1); - - for (octave_idx_type i = 0; i != n; ++i) - { - rv_names(i) = octave_value (known_functions[i]); - rv_times(i) = octave_value (flat[i].time); - rv_calls(i) = octave_value (flat[i].calls); - rv_recursive(i) = octave_value (flat[i].recursive); - rv_parents(i) = stats::function_set_value (flat[i].parents); - rv_children(i) = stats::function_set_value (flat[i].children); - } - - octave_map m; - - m.assign ("FunctionName", rv_names); - m.assign ("TotalTime", rv_times); - m.assign ("NumCalls", rv_calls); - m.assign ("IsRecursive", rv_recursive); - m.assign ("Parents", rv_parents); - m.assign ("Children", rv_children); - - retval = m; - } - else - { - static const char *fn[] = - { - "FunctionName", - "TotalTime", - "NumCalls", - "IsRecursive", - "Parents", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -octave_value -profile_data_accumulator::get_hierarchical (void) const -{ - octave_value retval; - - if (call_tree) - retval = call_tree->get_hierarchical (); - else - { - static const char *fn[] = - { - "Index", - "SelfTime", - "NumCalls", - "Children", - 0 - }; - - static octave_map m (dim_vector (0, 1), string_vector (fn)); - - retval = m; - } - - return retval; -} - -double -profile_data_accumulator::query_time (void) const -{ - octave_time now; - - // FIXME -- is this volatile declaration really needed? - // See bug #34210 for additional details. - volatile double dnow = now.double_value (); - - return dnow; -} - -void -profile_data_accumulator::add_current_time (void) -{ - const double t = query_time (); - assert (last_time >= 0.0 && last_time <= t); - - assert (call_tree && active_fcn != call_tree); - active_fcn->add_time (t - last_time); -} - -profile_data_accumulator profiler; - -// Enable or disable the profiler data collection. -DEFUN (__profiler_enable__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_enable ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - const int nargin = args.length (); - if (nargin > 0) - { - if (nargin > 1) - { - print_usage (); - return retval; - } - - profiler.set_active (args(0).bool_value ()); - } - - retval(0) = profiler.is_active (); - - return retval; -} - -// Clear all collected profiling data. -DEFUN (__profiler_reset__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_reset ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_reset: ignoring extra arguments"); - - profiler.reset (); - - return retval; -} - -// Query the timings collected by the profiler. -DEFUN (__profiler_data__, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Function File} __profiler_data ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - const int nargin = args.length (); - - if (nargin > 0) - warning ("profiler_data: ignoring extra arguments"); - - retval(0) = profiler.get_flat (); - if (nargout > 1) - retval(1) = profiler.get_hierarchical (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/profiler.h --- a/src/profiler.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,190 +0,0 @@ -/* - -Copyright (C) 2012 Daniel Kraft - -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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_profiler_h) -#define octave_profiler_h 1 - -#include -#include -#include -#include -#include - -class octave_value; - -class -OCTINTERP_API -profile_data_accumulator -{ -public: - - // This is a utility class that can be used to call the enter/exit - // functions in a manner protected from stack unwinding. - class enter - { - private: - - profile_data_accumulator& acc; - std::string fcn; - - public: - - enter (profile_data_accumulator&, const std::string&); - virtual ~enter (void); - - private: - - // No copying! - enter (const enter&); - enter& operator = (const enter&); - }; - - profile_data_accumulator (void); - virtual ~profile_data_accumulator (); - - bool is_active (void) const { return enabled; } - void set_active (bool); - - void reset (void); - - octave_value get_flat (void) const; - octave_value get_hierarchical (void) const; - -private: - - // One entry in the flat profile (i.e., a collection of data for a single - // function). This is filled in when building the flat profile from the - // hierarchical call tree. - struct stats - { - stats (); - - double time; - unsigned calls; - - bool recursive; - - typedef std::set function_set; - function_set parents; - function_set children; - - // Convert a function_set list to an Octave array of indices. - static octave_value function_set_value (const function_set&); - }; - - typedef std::vector flat_profile; - - // Store data for one node in the call-tree of the hierarchical profiler - // data we collect. - class tree_node - { - public: - - tree_node (tree_node*, octave_idx_type); - virtual ~tree_node (); - - void add_time (double dt) { time += dt; } - - // Enter a child function. It is created in the list of children if it - // wasn't already there. The now-active child node is returned. - tree_node* enter (octave_idx_type); - - // Exit function. As a sanity-check, it is verified that the currently - // active function actually is the one handed in here. Returned is the - // then-active node, which is our parent. - tree_node* exit (octave_idx_type); - - void build_flat (flat_profile&) const; - - // Get the hierarchical profile for this node and its children. If total - // is set, accumulate total time of the subtree in that variable as - // additional return value. - octave_value get_hierarchical (double* total = NULL) const; - - private: - - tree_node* parent; - octave_idx_type fcn_id; - - typedef std::map child_map; - child_map children; - - // This is only time spent *directly* on this level, excluding children! - double time; - - unsigned calls; - - // No copying! - tree_node (const tree_node&); - tree_node& operator = (const tree_node&); - }; - - // Each function we see in the profiler is given a unique index (which - // simply counts starting from 1). We thus have to map profiler-names to - // those indices. For all other stuff, we identify functions by their index. - - typedef std::vector function_set; - typedef std::map fcn_index_map; - - function_set known_functions; - fcn_index_map fcn_index; - - bool enabled; - - tree_node* call_tree; - tree_node* active_fcn; - - // Store last timestamp we had, when the currently active function was called. - double last_time; - - // These are private as only the unwind-protecting inner class enter - // should be allowed to call them. - void enter_function (const std::string&); - void exit_function (const std::string&); - - // Query a timestamp, used for timing calls (obviously). - // This is not static because in the future, maybe we want a flag - // in the profiler or something to choose between cputime, wall-time, - // user-time, system-time, ... - double query_time () const; - - // Add the time elapsed since last_time to the function we're currently in. - // This is called from two different positions, thus it is useful to have - // it as a seperate function. - void add_current_time (void); - - // No copying! - profile_data_accumulator (const profile_data_accumulator&); - profile_data_accumulator& operator = (const profile_data_accumulator&); -}; - -// The instance used. -extern OCTINTERP_API profile_data_accumulator profiler; - -// Helper macro to profile a block of code. -#define BEGIN_PROFILER_BLOCK(name) \ - { \ - profile_data_accumulator::enter pe (profiler, (name)); -#define END_PROFILER_BLOCK \ - } - -#endif diff -r 069c552587a0 -r 959953dba519 src/pt-jit.cc --- a/src/pt-jit.cc Tue Jul 31 09:54:19 2012 -0400 +++ b/src/pt-jit.cc Fri Aug 03 14:35:44 2012 -0400 @@ -518,11 +518,7 @@ void jit_convert::visit_index_expression (tree_index_expression& exp) { - std::pair res = resolve (exp); - jit_value *object = res.first; - jit_value *index = res.second; - - result = create_checked (jit_typeinfo::paren_subsref, object, index); + result = resolve (jit_typeinfo::paren_subsref (), exp); } void @@ -813,8 +809,9 @@ return ss.str (); } -std::pair -jit_convert::resolve (tree_index_expression& exp) +jit_instruction * +jit_convert::resolve (const jit_operation& fres, tree_index_expression& exp, + jit_value *extra_arg) { std::string type = exp.type_tags (); if (! (type.size () == 1 && type[0] == '(')) @@ -828,21 +825,31 @@ if (! arg_list) throw jit_fail_exception ("null argument list"); - if (arg_list->size () != 1) - throw jit_fail_exception ("Bad number of arguments in arg_list"); + if (arg_list->size () < 1) + throw jit_fail_exception ("Empty arg_list"); tree_expression *tree_object = exp.expression (); jit_value *object = visit (tree_object); - end_context.push_back (object); - - unwind_protect prot; - prot.add_method (&end_context, &std::vector::pop_back); + size_t narg = arg_list->size (); + tree_argument_list::iterator iter = arg_list->begin (); + bool have_extra = extra_arg; + std::vector call_args (narg + 1 + have_extra); + call_args[0] = object; - tree_expression *arg0 = arg_list->front (); - jit_value *index = visit (arg0); + for (size_t idx = 0; iter != arg_list->end (); ++idx, ++iter) + { + unwind_protect prot; + prot.add_method (&end_context, + &std::vector::pop_back); + end_context.push_back (jit_magic_end::context (object, idx, narg)); + call_args[idx + 1] = visit (*iter); + } - return std::make_pair (object, index); + if (extra_arg) + call_args[call_args.size () - 1] = extra_arg; + + return create_checked (fres, call_args); } jit_value * @@ -856,14 +863,9 @@ else if (tree_index_expression *idx = dynamic_cast (exp)) { - std::pair res = resolve (*idx); - jit_value *object = res.first; - jit_value *index = res.second; - jit_call *new_object = create (&jit_typeinfo::paren_subsasgn, - object, index, rhs); - block->append (new_object); + jit_value *new_object = resolve (jit_typeinfo::paren_subsasgn (), *idx, + rhs); do_assign (idx->expression (), new_object, true); - create_check (new_object); // FIXME: Will not work for values that must be release/grabed return rhs; @@ -1853,4 +1855,53 @@ %! endfor %! assert (result == m(end) * niter); +%!test +%! ndim = 100; +%! result = 0; +%! m = zeros (ndim); +%! m(:) = 1:ndim^2; +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! result = result + m(i, j); +%! endfor +%! i = i + 1; +%! endwhile +%! assert (result == sum (sum (m))); + +%!test +%! ndim = 100; +%! m = zeros (ndim); +%! i = 1; +%! while (i <= ndim) +%! for j = 1:ndim +%! m(i, j) = (j - 1) * ndim + i; +%! endfor +%! i = i + 1; +%! endwhile +%! m2 = zeros (ndim); +%! m2(:) = 1:(ndim^2); +%! assert (all (m == m2)); + +%!test +%! ndim = 2; +%! m = zeros (ndim, ndim, ndim, ndim); +%! result = 0; +%! i0 = 1; +%! while (i0 <= ndim) +%! for i1 = 1:ndim +%! for i2 = 1:ndim +%! for i3 = 1:ndim +%! m(i0, i1, i2, i3) = 1; +%! m(i0, i1, i2, i3, 1, 1, 1, 1, 1, 1) = 1; +%! result = result + m(i0, i1, i2, i3); +%! endfor +%! endfor +%! endfor +%! i0 = i0 + 1; +%! endwhile +%! expected = ones (ndim, ndim, ndim, ndim); +%! assert (all (m == expected)); +%! assert (result == sum (expected (:))); + */ diff -r 069c552587a0 -r 959953dba519 src/pt-jit.h --- a/src/pt-jit.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/pt-jit.h Fri Aug 03 14:35:44 2012 -0400 @@ -244,7 +244,7 @@ std::list all_values; - std::vector end_context; + std::vector end_context; size_t iterator_count; size_t for_bounds_count; @@ -296,7 +296,9 @@ std::string next_name (const char *prefix, size_t& count, bool inc); - std::pair resolve (tree_index_expression& exp); + jit_instruction *resolve (const jit_operation& fres, + tree_index_expression& exp, + jit_value *extra_arg = 0); jit_value *do_assign (tree_expression *exp, jit_value *rhs, bool artificial = false); diff -r 069c552587a0 -r 959953dba519 src/sighandlers.cc --- a/src/sighandlers.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1054 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "oct-syscalls.h" -#include "quit.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "load-save.h" -#include "oct-map.h" -#include "pager.h" -#include "pt-bp.h" -#include "pt-eval.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "utils.h" -#include "variables.h" - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -int pipe_handler_error_count = 0; - -// TRUE means we can be interrupted. -bool can_interrupt = false; - -// TRUE means we should try to enter the debugger on SIGINT. -static bool Vdebug_on_interrupt = false; - -// Allow users to avoid writing octave-workspace for SIGHUP (sent by -// closing gnome-terminal, for example). Note that this variable has -// no effect if Vcrash_dumps_octave_core is FALSE. -static bool Vsighup_dumps_octave_core = true; - -// Similar to Vsighup_dumps_octave_core, but for SIGTERM signal. -static bool Vsigterm_dumps_octave_core = true; - -// List of signals we have caught since last call to octave_signal_handler. -static bool octave_signals_caught[NSIG]; - -// Signal handler return type. -#ifndef BADSIG -#define BADSIG (void (*)(int))-1 -#endif - -// The following is a workaround for an apparent bug in GCC 4.1.2 and -// possibly earlier versions. See Octave bug report #30685 for details. -#if defined (__GNUC__) -# if ! (__GNUC__ > 4 \ - || (__GNUC__ == 4 && (__GNUC_MINOR__ > 1 \ - || (__GNUC_MINOR__ == 1 && __GNUC_PATCHLEVEL__ > 2)))) -# undef GNULIB_NAMESPACE -# define GNULIB_NAMESPACE -# warning "disabling GNULIB_NAMESPACE for signal functions -- consider upgrading to a current version of GCC" -# endif -#endif - -#define BLOCK_SIGNAL(sig, nvar, ovar) \ - do \ - { \ - GNULIB_NAMESPACE::sigemptyset (&nvar); \ - GNULIB_NAMESPACE::sigaddset (&nvar, sig); \ - GNULIB_NAMESPACE::sigemptyset (&ovar); \ - GNULIB_NAMESPACE::sigprocmask (SIG_BLOCK, &nvar, &ovar); \ - } \ - while (0) - -#if !defined (SIGCHLD) && defined (SIGCLD) -#define SIGCHLD SIGCLD -#endif - -#define BLOCK_CHILD(nvar, ovar) BLOCK_SIGNAL (SIGCHLD, nvar, ovar) -#define UNBLOCK_CHILD(ovar) GNULIB_NAMESPACE::sigprocmask (SIG_SETMASK, &ovar, 0) - -// Called from octave_quit () to actually do something about the signals -// we have caught. - -void -octave_signal_handler (void) -{ - // The list of signals is relatively short, so we will just go - // linearly through the list. - - for (int i = 0; i < NSIG; i++) - { - if (octave_signals_caught[i]) - { - octave_signals_caught[i] = false; - - switch (i) - { -#ifdef SIGCHLD - case SIGCHLD: - { - volatile octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - sigset_t set, oset; - - BLOCK_CHILD (set, oset); - - octave_child_list::wait (); - - octave_set_interrupt_handler (saved_interrupt_handler); - - UNBLOCK_CHILD (oset); - - octave_child_list::reap (); - } - break; -#endif - - case SIGFPE: - std::cerr << "warning: floating point exception" << std::endl; - break; - -#ifdef SIGPIPE - case SIGPIPE: - std::cerr << "warning: broken pipe" << std::endl; - break; -#endif - } - } - } -} - -static void -my_friendly_exit (const char *sig_name, int sig_number, - bool save_vars = true) -{ - static bool been_there_done_that = false; - - if (been_there_done_that) - { -#if defined (SIGABRT) - octave_set_signal_handler (SIGABRT, SIG_DFL); -#endif - - std::cerr << "panic: attempted clean up apparently failed -- aborting...\n"; - - MINGW_SIGNAL_CLEANUP (); - - abort (); - } - else - { - been_there_done_that = true; - - std::cerr << "panic: " << sig_name << " -- stopping myself...\n"; - - if (save_vars) - dump_octave_core (); - - if (sig_number < 0) - { - MINGW_SIGNAL_CLEANUP (); - - exit (1); - } - else - { - octave_set_signal_handler (sig_number, SIG_DFL); - - GNULIB_NAMESPACE::raise (sig_number); - } - } -} - -sig_handler * -octave_set_signal_handler (int sig, sig_handler *handler, - bool restart_syscalls) -{ - struct sigaction act, oact; - - act.sa_handler = handler; - act.sa_flags = 0; - -#if defined (SIGALRM) - if (sig == SIGALRM) - { -#if defined (SA_INTERRUPT) - act.sa_flags |= SA_INTERRUPT; -#endif - } -#endif -#if defined (SA_RESTART) -#if defined (SIGALRM) - else -#endif - // FIXME -- Do we also need to explicitly disable SA_RESTART? - if (restart_syscalls) - act.sa_flags |= SA_RESTART; -#endif - - GNULIB_NAMESPACE::sigemptyset (&act.sa_mask); - GNULIB_NAMESPACE::sigemptyset (&oact.sa_mask); - - GNULIB_NAMESPACE::sigaction (sig, &act, &oact); - - return oact.sa_handler; -} - -static void -generic_sig_handler (int sig) -{ - my_friendly_exit (strsignal (sig), sig); -} - -// Handle SIGCHLD. - -#ifdef SIGCHLD -static void -sigchld_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGCHLD] = true; -} -#endif /* defined (SIGCHLD) */ - -#ifdef SIGFPE -#if defined (__alpha__) -static void -sigfpe_handler (int /* sig */) -{ - if (can_interrupt && octave_interrupt_state >= 0) - { - octave_signal_caught = 1; - - octave_signals_caught[SIGFPE] = true; - - octave_interrupt_state++; - } -} -#endif /* defined (__alpha__) */ -#endif /* defined (SIGFPE) */ - -#if defined (SIGHUP) || defined (SIGTERM) -static void -sig_hup_or_term_handler (int sig) -{ - switch (sig) - { -#if defined (SIGHUP) - case SIGHUP: - { - if (Vsighup_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - -#if defined (SIGTERM) - case SIGTERM: - { - if (Vsigterm_dumps_octave_core) - dump_octave_core (); - } - break; -#endif - - default: - break; - } - - clean_up_and_exit (0); -} -#endif - -#if 0 -#if defined (SIGWINCH) -static void -sigwinch_handler (int /* sig */) -{ - command_editor::resize_terminal (); -} -#endif -#endif - -// Handle SIGINT by restarting the parser (see octave.cc). -// -// This also has to work for SIGBREAK (on systems that have it), so we -// use the value of sig, instead of just assuming that it is called -// for SIGINT only. - -static void -user_abort (const char *sig_name, int sig_number) -{ - if (! octave_initialized) - exit (1); - - if (can_interrupt) - { - if (Vdebug_on_interrupt) - { - if (! octave_debug_on_interrupt_state) - { - tree_evaluator::debug_mode = true; - octave_debug_on_interrupt_state = true; - - return; - } - else - { - // Clear the flag and do normal interrupt stuff. - - tree_evaluator::debug_mode - = bp_table::have_breakpoints () || Vdebugging; - octave_debug_on_interrupt_state = false; - } - } - - if (octave_interrupt_immediately) - { - if (octave_interrupt_state == 0) - octave_interrupt_state = 1; - - octave_jump_to_enclosing_context (); - } - else - { - // If we are already cleaning up from a previous interrupt, - // take note of the fact that another interrupt signal has - // arrived. - - if (octave_interrupt_state < 0) - octave_interrupt_state = 0; - - octave_signal_caught = 1; - octave_interrupt_state++; - - if (interactive && octave_interrupt_state == 2) - std::cerr << "Press Control-C again to abort." << std::endl; - - if (octave_interrupt_state >= 3) - my_friendly_exit (sig_name, sig_number, true); - } - } - -} - -static void -sigint_handler (int sig) -{ -#ifdef USE_W32_SIGINT - if (w32_in_main_thread ()) - user_abort (strsignal (sig), sig); - else - w32_raise (sig); -#else - user_abort (strsignal (sig), sig); -#endif -} - -#ifdef SIGPIPE -static void -sigpipe_handler (int /* sig */) -{ - octave_signal_caught = 1; - - octave_signals_caught[SIGPIPE] = true; - - // Don't loop forever on account of this. - - if (pipe_handler_error_count++ > 100 && octave_interrupt_state >= 0) - octave_interrupt_state++; -} -#endif /* defined (SIGPIPE) */ - -#ifdef USE_W32_SIGINT -static BOOL CALLBACK -w32_sigint_handler (DWORD sig) -{ - const char *sig_name; - - switch (sig) - { - case CTRL_BREAK_EVENT: - sig_name = "Ctrl-Break"; - break; - case CTRL_C_EVENT: - sig_name = "Ctrl-C"; - break; - case CTRL_CLOSE_EVENT: - sig_name = "close console"; - break; - case CTRL_LOGOFF_EVENT: - sig_name = "logoff"; - break; - case CTRL_SHUTDOWN_EVENT: - sig_name = "shutdown"; - break; - default: - sig_name = "unknown console event"; - break; - } - - switch (sig) - { - case CTRL_BREAK_EVENT: - case CTRL_C_EVENT: - w32_raise (SIGINT); - break; - - case CTRL_CLOSE_EVENT: - clean_up_and_exit (0); - break; - case CTRL_LOGOFF_EVENT: - case CTRL_SHUTDOWN_EVENT: - default: - // We should do the following: - // clean_up_and_exit (0); - // We can't because we aren't running in the normal Octave thread. - user_abort (sig_name, sig); - break; - } - - // Return TRUE if the event was handled, or FALSE if another handler - // should be called. - // FIXME check that windows terminates the thread. - return TRUE; -} -#endif /* w32_sigint_handler */ - - -octave_interrupt_handler -octave_catch_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, sigint_handler); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, sigint_handler); -#endif - -#ifdef USE_W32_SIGINT - - // Intercept windows console control events. - // Note that the windows console signal handlers chain, so if - // install_signal_handlers is called more than once in the same program, - // then first call the following to avoid duplicates: - // - // SetConsoleCtrlHandler (w32_sigint_handler, FALSE); - - if (! SetConsoleCtrlHandler (w32_sigint_handler, TRUE)) - error ("SetConsoleCtrlHandler failed with %ld\n", GetLastError ()); - - w32_set_quiet_shutdown (); - -#endif - - return retval; -} - -octave_interrupt_handler -octave_ignore_interrupts (void) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, SIG_IGN); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, SIG_IGN); -#endif - - return retval; -} - -octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler& h, - bool restart_syscalls) -{ - octave_interrupt_handler retval; - -#ifdef SIGINT - retval.int_handler = octave_set_signal_handler (SIGINT, h.int_handler, - restart_syscalls); -#endif - -#ifdef SIGBREAK - retval.brk_handler = octave_set_signal_handler (SIGBREAK, h.brk_handler, - restart_syscalls); -#endif - - return retval; -} - -// Install all the handlers for the signals we might care about. - -void -install_signal_handlers (void) -{ - for (int i = 0; i < NSIG; i++) - octave_signals_caught[i] = false; - - octave_catch_interrupts (); - -#ifdef SIGABRT - octave_set_signal_handler (SIGABRT, generic_sig_handler); -#endif - -#ifdef SIGALRM - octave_set_signal_handler (SIGALRM, generic_sig_handler); -#endif - -#ifdef SIGBUS - octave_set_signal_handler (SIGBUS, generic_sig_handler); -#endif - -#ifdef SIGCHLD - octave_set_signal_handler (SIGCHLD, sigchld_handler); -#endif - - // SIGCLD - // SIGCONT - -#ifdef SIGEMT - octave_set_signal_handler (SIGEMT, generic_sig_handler); -#endif - -#ifdef SIGFPE -#if defined (__alpha__) - octave_set_signal_handler (SIGFPE, sigfpe_handler); -#else - octave_set_signal_handler (SIGFPE, generic_sig_handler); -#endif -#endif - -#ifdef SIGHUP - octave_set_signal_handler (SIGHUP, sig_hup_or_term_handler); -#endif - -#ifdef SIGILL - octave_set_signal_handler (SIGILL, generic_sig_handler); -#endif - - // SIGINFO - // SIGINT - -#ifdef SIGIOT - octave_set_signal_handler (SIGIOT, generic_sig_handler); -#endif - -#ifdef SIGLOST - octave_set_signal_handler (SIGLOST, generic_sig_handler); -#endif - -#ifdef SIGPIPE - octave_set_signal_handler (SIGPIPE, sigpipe_handler); -#endif - -#ifdef SIGPOLL - octave_set_signal_handler (SIGPOLL, SIG_IGN); -#endif - - // SIGPROF - // SIGPWR - -#ifdef SIGQUIT - octave_set_signal_handler (SIGQUIT, generic_sig_handler); -#endif - -#ifdef SIGSEGV - octave_set_signal_handler (SIGSEGV, generic_sig_handler); -#endif - - // SIGSTOP - -#ifdef SIGSYS - octave_set_signal_handler (SIGSYS, generic_sig_handler); -#endif - -#ifdef SIGTERM - octave_set_signal_handler (SIGTERM, sig_hup_or_term_handler); -#endif - -#ifdef SIGTRAP - octave_set_signal_handler (SIGTRAP, generic_sig_handler); -#endif - - // SIGTSTP - // SIGTTIN - // SIGTTOU - // SIGURG - -#ifdef SIGUSR1 - octave_set_signal_handler (SIGUSR1, generic_sig_handler); -#endif - -#ifdef SIGUSR2 - octave_set_signal_handler (SIGUSR2, generic_sig_handler); -#endif - -#ifdef SIGVTALRM - octave_set_signal_handler (SIGVTALRM, generic_sig_handler); -#endif - -#ifdef SIGIO - octave_set_signal_handler (SIGIO, SIG_IGN); -#endif - -#if 0 -#ifdef SIGWINCH - octave_set_signal_handler (SIGWINCH, sigwinch_handler); -#endif -#endif - -#ifdef SIGXCPU - octave_set_signal_handler (SIGXCPU, generic_sig_handler); -#endif - -#ifdef SIGXFSZ - octave_set_signal_handler (SIGXFSZ, generic_sig_handler); -#endif - -} - -static octave_scalar_map -make_sig_struct (void) -{ - octave_scalar_map m; - -#ifdef SIGABRT - m.assign ("ABRT", SIGABRT); -#endif - -#ifdef SIGALRM - m.assign ("ALRM", SIGALRM); -#endif - -#ifdef SIGBUS - m.assign ("BUS", SIGBUS); -#endif - -#ifdef SIGCHLD - m.assign ("CHLD", SIGCHLD); -#endif - -#ifdef SIGCLD - m.assign ("CLD", SIGCLD); -#endif - -#ifdef SIGCONT - m.assign ("CONT", SIGCONT); -#endif - -#ifdef SIGEMT - m.assign ("EMT", SIGEMT); -#endif - -#ifdef SIGFPE - m.assign ("FPE", SIGFPE); -#endif - -#ifdef SIGHUP - m.assign ("HUP", SIGHUP); -#endif - -#ifdef SIGILL - m.assign ("ILL", SIGILL); -#endif - -#ifdef SIGINFO - m.assign ("INFO", SIGINFO); -#endif - -#ifdef SIGINT - m.assign ("INT", SIGINT); -#endif - -#ifdef SIGIOT - m.assign ("IOT", SIGIOT); -#endif - -#ifdef SIGLOST - m.assign ("LOST", SIGLOST); -#endif - -#ifdef SIGPIPE - m.assign ("PIPE", SIGPIPE); -#endif - -#ifdef SIGPOLL - m.assign ("POLL", SIGPOLL); -#endif - -#ifdef SIGPROF - m.assign ("PROF", SIGPROF); -#endif - -#ifdef SIGPWR - m.assign ("PWR", SIGPWR); -#endif - -#ifdef SIGQUIT - m.assign ("QUIT", SIGQUIT); -#endif - -#ifdef SIGSEGV - m.assign ("SEGV", SIGSEGV); -#endif - -#ifdef SIGSTOP - m.assign ("STOP", SIGSTOP); -#endif - -#ifdef SIGSYS - m.assign ("SYS", SIGSYS); -#endif - -#ifdef SIGTERM - m.assign ("TERM", SIGTERM); -#endif - -#ifdef SIGTRAP - m.assign ("TRAP", SIGTRAP); -#endif - -#ifdef SIGTSTP - m.assign ("TSTP", SIGTSTP); -#endif - -#ifdef SIGTTIN - m.assign ("TTIN", SIGTTIN); -#endif - -#ifdef SIGTTOU - m.assign ("TTOU", SIGTTOU); -#endif - -#ifdef SIGURG - m.assign ("URG", SIGURG); -#endif - -#ifdef SIGUSR1 - m.assign ("USR1", SIGUSR1); -#endif - -#ifdef SIGUSR2 - m.assign ("USR2", SIGUSR2); -#endif - -#ifdef SIGVTALRM - m.assign ("VTALRM", SIGVTALRM); -#endif - -#ifdef SIGIO - m.assign ("IO", SIGIO); -#endif - -#ifdef SIGWINCH - m.assign ("WINCH", SIGWINCH); -#endif - -#ifdef SIGXCPU - m.assign ("XCPU", SIGXCPU); -#endif - -#ifdef SIGXFSZ - m.assign ("XFSZ", SIGXFSZ); -#endif - - return m; -} - -octave_child_list::octave_child_list_rep *octave_child_list::instance = 0; - -bool -octave_child_list::instance_ok (void) -{ - bool retval = true; - - if (! instance) - { - instance = new octave_child_list_rep (); - - if (instance) - singleton_cleanup_list::add (cleanup_instance); - } - - if (! instance) - { - ::error ("unable to create child list object!"); - - retval = false; - } - - return retval; -} - -void -octave_child_list::insert (pid_t pid, octave_child::child_event_handler f) -{ - if (instance_ok ()) - instance->insert (pid, f); -} - -void -octave_child_list::reap (void) -{ - if (instance_ok ()) - instance->reap (); -} - -bool -octave_child_list::wait (void) -{ - return (instance_ok ()) ? instance->wait () : false; -} - -class pid_equal -{ -public: - - pid_equal (pid_t v) : val (v) { } - - bool operator () (const octave_child& oc) const { return oc.pid == val; } - -private: - - pid_t val; -}; - -void -octave_child_list::remove (pid_t pid) -{ - if (instance_ok ()) - instance->remove_if (pid_equal (pid)); -} - -#define OCL_REP octave_child_list::octave_child_list_rep - -void -OCL_REP::insert (pid_t pid, octave_child::child_event_handler f) -{ - append (octave_child (pid, f)); -} - -void -OCL_REP::reap (void) -{ - // Mark the record for PID invalid. - - for (iterator p = begin (); p != end (); p++) - { - // The call to the octave_child::child_event_handler might - // invalidate the iterator (for example, by calling - // octave_child_list::remove), so we increment the iterator - // here. - - octave_child& oc = *p; - - if (oc.have_status) - { - oc.have_status = 0; - - octave_child::child_event_handler f = oc.handler; - - if (f && f (oc.pid, oc.status)) - oc.pid = -1; - } - } - - remove_if (pid_equal (-1)); -} - -// Wait on our children and record any changes in their status. - -bool -OCL_REP::wait (void) -{ - bool retval = false; - - for (iterator p = begin (); p != end (); p++) - { - octave_child& oc = *p; - - pid_t pid = oc.pid; - - if (pid > 0) - { - int status; - - if (octave_syscalls::waitpid (pid, &status, WNOHANG) > 0) - { - oc.have_status = 1; - - oc.status = status; - - retval = true; - - break; - } - } - } - - return retval; -} - -DEFUN (SIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} SIG ()\n\ -Return a structure containing Unix signal names and their defined values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - { - static octave_scalar_map m = make_sig_struct (); - - retval = m; - } - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (SIG ())) -%!assert (! isempty (SIG ())) - -%!error SIG (1) -*/ - -DEFUN (debug_on_interrupt, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} debug_on_interrupt (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} debug_on_interrupt (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave will try\n\ -to enter debugging mode when it receives an interrupt signal (typically\n\ -generated with @kbd{C-c}). If a second interrupt signal is received\n\ -before reaching the debugging mode, a normal interrupt will occur.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (debug_on_interrupt); -} - -/* -%!test -%! orig_val = debug_on_interrupt (); -%! old_val = debug_on_interrupt (! orig_val); -%! assert (orig_val, old_val); -%! assert (debug_on_interrupt (), ! orig_val); -%! debug_on_interrupt (orig_val); -%! assert (debug_on_interrupt (), orig_val); - -%!error (debug_on_interrupt (1, 2)) -*/ - -DEFUN (sighup_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sighup_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sighup_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a hangup signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); -} - -/* -%!test -%! orig_val = sighup_dumps_octave_core (); -%! old_val = sighup_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sighup_dumps_octave_core (), ! orig_val); -%! sighup_dumps_octave_core (orig_val); -%! assert (sighup_dumps_octave_core (), orig_val); - -%!error (sighup_dumps_octave_core (1, 2)) -*/ - -DEFUN (sigterm_dumps_octave_core, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} sigterm_dumps_octave_core (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} sigterm_dumps_octave_core (@var{new_val}, \"local\")\n\ -Query or set the internal variable that controls whether Octave tries\n\ -to save all current variables to the file \"octave-workspace\" if it receives\n\ -a terminate signal.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); -} - -/* -%!test -%! orig_val = sigterm_dumps_octave_core (); -%! old_val = sigterm_dumps_octave_core (! orig_val); -%! assert (orig_val, old_val); -%! assert (sigterm_dumps_octave_core (), ! orig_val); -%! sigterm_dumps_octave_core (orig_val); -%! assert (sigterm_dumps_octave_core (), orig_val); - -%!error (sigterm_dumps_octave_core (1, 2)) -*/ diff -r 069c552587a0 -r 959953dba519 src/sighandlers.h --- a/src/sighandlers.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,177 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -/* - -The signal blocking macros defined below were adapted from similar -functions from GNU Bash, the Bourne Again SHell, copyright (C) 1994 -Free Software Foundation, Inc. - -*/ - -// This file should always be included after config.h! - -#if !defined (octave_sighandlers_h) -#define octave_sighandlers_h 1 - -// Include signal.h, not csignal since the latter might only define -// the ANSI standard C signal interface. - -#include - -#include "syswait.h" -#include "siglist.h" - -#include "base-list.h" - -typedef void sig_handler (int); - -// FIXME -- the data should probably be private... - -struct -octave_interrupt_handler -{ -#ifdef SIGINT - sig_handler *int_handler; -#endif - -#ifdef SIGBREAK - sig_handler *brk_handler; -#endif -}; - -// Nonzero means we have already printed a message for this series of -// SIGPIPES. We assume that the writer will eventually give up. -extern int pipe_handler_error_count; - -// TRUE means we can be interrupted. -extern OCTINTERP_API bool can_interrupt; - -extern OCTINTERP_API sig_handler *octave_set_signal_handler (int, sig_handler *, - bool restart_syscalls = true); - -extern OCTINTERP_API void install_signal_handlers (void); - -extern OCTINTERP_API void octave_signal_handler (void); - -extern OCTINTERP_API octave_interrupt_handler octave_catch_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler octave_ignore_interrupts (void); - -extern OCTINTERP_API octave_interrupt_handler -octave_set_interrupt_handler (const volatile octave_interrupt_handler&, - bool restart_syscalls = true); - -// extern void ignore_sigchld (void); - -// Maybe this should be in a separate file? - -class -OCTINTERP_API -octave_child -{ -public: - - // Do whatever to handle event for child with PID (might not - // actually be dead, could just be stopped). Return true if - // the list element corresponding to PID should be removed from - // list. This function should not call any functions that modify - // the octave_child_list. - - typedef bool (*child_event_handler) (pid_t, int); - - octave_child (pid_t id = -1, child_event_handler f = 0) - : pid (id), handler (f), have_status (0), status (0) { } - - octave_child (const octave_child& oc) - : pid (oc.pid), handler (oc.handler), - have_status (oc.have_status), status (oc.status) { } - - octave_child& operator = (const octave_child& oc) - { - if (&oc != this) - { - pid = oc.pid; - handler = oc.handler; - have_status = oc.have_status; - status = oc.status; - } - return *this; - } - - ~octave_child (void) { } - - // The process id of this child. - pid_t pid; - - // The function we call if an event happens for this child. - child_event_handler handler; - - // Nonzero if this child has stopped or terminated. - sig_atomic_t have_status; - - // The status of this child; 0 if running, otherwise a status value - // from waitpid. - int status; -}; - -class -OCTINTERP_API -octave_child_list -{ -protected: - - octave_child_list (void) { } - - class octave_child_list_rep : public octave_base_list - { - public: - - void insert (pid_t pid, octave_child::child_event_handler f); - - void reap (void); - - bool wait (void); - }; - -public: - - ~octave_child_list (void) { } - - static void insert (pid_t pid, octave_child::child_event_handler f); - - static void reap (void); - - static bool wait (void); - - static void remove (pid_t pid); - -private: - - static bool instance_ok (void); - - static octave_child_list_rep *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } -}; - -#endif diff -r 069c552587a0 -r 959953dba519 src/sparse.cc --- a/src/sparse.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,268 +0,0 @@ -/* - -Copyright (C) 2004-2012 David Bateman -Copyright (C) 1998-2004 Andy Adler -Copyright (C) 2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include "variables.h" -#include "utils.h" -#include "pager.h" -#include "defun.h" -#include "gripes.h" -#include "quit.h" -#include "unwind-prot.h" - -#include "ov-re-sparse.h" -#include "ov-cx-sparse.h" -#include "ov-bool-sparse.h" - -DEFUN (issparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} issparse (@var{x})\n\ -Return true if @var{x} is a sparse matrix.\n\ -@seealso{ismatrix}\n\ -@end deftypefn") -{ - if (args.length () != 1) - { - print_usage (); - return octave_value (); - } - else - return octave_value (args(0).is_sparse_type ()); -} - -DEFUN (sparse, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} sparse (@var{a})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}, @var{nzmax})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{sv})\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{i}, @var{j}, @var{s}, @var{m}, @var{n}, \"unique\")\n\ -@deftypefnx {Built-in Function} {@var{s} =} sparse (@var{m}, @var{n})\n\ -Create a sparse matrix from the full matrix or row, column, value triplets.\n\ -If @var{a} is a full matrix, convert it to a sparse matrix representation,\n\ -removing all zero values in the process.\n\ -\n\ -Given the integer index vectors @var{i} and @var{j}, a 1-by-@code{nnz} vector\n\ -of real of complex values @var{sv}, overall dimensions @var{m} and @var{n}\n\ -of the sparse matrix. The argument @code{nzmax} is ignored but accepted for\n\ -compatibility with @sc{matlab}. If @var{m} or @var{n} are not specified\n\ -their values are derived from the maximum index in the vectors @var{i} and\n\ -@var{j} as given by @code{@var{m} = max (@var{i})},\n\ -@code{@var{n} = max (@var{j})}.\n\ -\n\ -@strong{Note}: if multiple values are specified with the same\n\ -@var{i}, @var{j} indices, the corresponding values in @var{s} will\n\ -be added. See @code{accumarray} for an example of how to produce different\n\ -behavior, such as taking the minimum instead.\n\ -\n\ -The following are all equivalent:\n\ -\n\ -@example\n\ -@group\n\ -s = sparse (i, j, s, m, n)\n\ -s = sparse (i, j, s, m, n, \"summation\")\n\ -s = sparse (i, j, s, m, n, \"sum\")\n\ -@end group\n\ -@end example\n\ -\n\ -Given the option \"unique\". if more than two values are specified for the\n\ -same @var{i}, @var{j} indices, the last specified value will be used.\n\ -\n\ -@code{sparse (@var{m}, @var{n})} is equivalent to\n\ -@code{sparse ([], [], [], @var{m}, @var{n}, 0)}\n\ -\n\ -If any of @var{sv}, @var{i} or @var{j} are scalars, they are expanded\n\ -to have a common size.\n\ -@seealso{full, accumarray}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - // Temporarily disable sparse_auto_mutate if set (it's obsolete anyway). - unwind_protect frame; - frame.protect_var (Vsparse_auto_mutate); - Vsparse_auto_mutate = false; - - if (nargin == 1) - { - octave_value arg = args (0); - if (arg.is_bool_type ()) - retval = arg.sparse_bool_matrix_value (); - else if (arg.is_complex_type ()) - retval = arg.sparse_complex_matrix_value (); - else if (arg.is_numeric_type ()) - retval = arg.sparse_matrix_value (); - else - gripe_wrong_type_arg ("sparse", arg); - } - else if (nargin == 2) - { - octave_idx_type m = 0, n = 0; - if (args(0).is_scalar_type () && args(1).is_scalar_type ()) - { - m = args(0).idx_type_value (); - n = args(1).idx_type_value (); - } - else - error ("sparse: dimensions M,N must be scalar"); - - if (! error_state) - { - if (m >= 0 && n >= 0) - retval = SparseMatrix (m, n); - else - error ("sparse: dimensions M,N must be positive or zero"); - } - } - else if (nargin >= 3) - { - bool summation = true; - if (nargin > 3 && args(nargin-1).is_string ()) - { - std::string opt = args(nargin-1).string_value (); - if (opt == "unique") - summation = false; - else if (opt == "sum" || opt == "summation") - summation = true; - else - error ("sparse: invalid option: %s", opt.c_str ()); - - nargin -= 1; - } - - if (! error_state) - { - octave_idx_type m = -1, n = -1, nzmax = -1; - if (nargin == 6) - { - nzmax = args(5).idx_type_value (); - nargin --; - } - - if (nargin == 5) - { - if (args(3).is_scalar_type () && args(4).is_scalar_type ()) - { - m = args(3).idx_type_value (); - n = args(4).idx_type_value (); - } - else - error ("sparse: expecting scalar dimensions"); - - - if (! error_state && (m < 0 || n < 0)) - error ("sparse: dimensions must be non-negative"); - } - else if (nargin != 3) - print_usage (); - - if (! error_state) - { - idx_vector i = args(0).index_vector (); - idx_vector j = args(1).index_vector (); - - if (args(2).is_bool_type ()) - retval = SparseBoolMatrix (args(2).bool_array_value (), i, j, - m, n, summation, nzmax); - else if (args(2).is_complex_type ()) - retval = SparseComplexMatrix (args(2).complex_array_value (), - i, j, m, n, summation, nzmax); - else if (args(2).is_numeric_type ()) - retval = SparseMatrix (args(2).array_value (), i, j, - m, n, summation, nzmax); - else - gripe_wrong_type_arg ("sparse", args(2)); - } - - } - } - - return retval; -} - -DEFUN (spalloc, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{s} =} spalloc (@var{m}, @var{n}, @var{nz})\n\ -Create an @var{m}-by-@var{n} sparse matrix with pre-allocated space for at\n\ -most @var{nz} nonzero elements. This is useful for building the matrix\n\ -incrementally by a sequence of indexed assignments. Subsequent indexed\n\ -assignments will reuse the pre-allocated memory, provided they are of one of\n\ -the simple forms\n\ -\n\ -@itemize\n\ -@item @code{@var{s}(I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(:,I:J) = @var{x}}\n\ -\n\ -@item @code{@var{s}(K:L,I:J) = @var{x}}\n\ -@end itemize\n\ -\n\ -@b{and} that the following conditions are met:\n\ -\n\ -@itemize\n\ -@item the assignment does not decrease nnz (@var{S}).\n\ -\n\ -@item after the assignment, nnz (@var{S}) does not exceed @var{nz}.\n\ -\n\ -@item no index is out of bounds.\n\ -@end itemize\n\ -\n\ -Partial movement of data may still occur, but in general the assignment will\n\ -be more memory and time-efficient under these circumstances. In particular,\n\ -it is possible to efficiently build a pre-allocated sparse matrix from\n\ -contiguous block of columns.\n\ -\n\ -The amount of pre-allocated memory for a given matrix may be queried using\n\ -the function @code{nzmax}.\n\ -@seealso{nzmax, sparse}\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - octave_idx_type m = args(0).idx_type_value (); - octave_idx_type n = args(1).idx_type_value (); - octave_idx_type nz = 0; - if (nargin == 3) - nz = args(2).idx_type_value (); - if (error_state) - ; - else if (m >= 0 && n >= 0 && nz >= 0) - retval = SparseMatrix (dim_vector (m, n), nz); - else - error ("spalloc: M,N,NZ must be non-negative"); - } - else - print_usage (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/strfns.cc --- a/src/strfns.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,973 +0,0 @@ -/* - -Copyright (C) 1994-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include - -#include -#include - -#include "dMatrix.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "ov.h" -#include "oct-obj.h" -#include "unwind-prot.h" -#include "utils.h" - -DEFUN (char, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} char (@var{x})\n\ -@deftypefnx {Built-in Function} {} char (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} char (@var{cell_array})\n\ -Create a string array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Empty input strings are\n\ -significant and will concatenated in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{char} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -char ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \" \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{strvcat, cellstr}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = ""; - else if (nargin == 1) - retval = args(0).convert_to_str (true, true, - args(0).is_dq_string () ? '"' : '\''); - else - { - int n_elts = 0; - - int max_len = 0; - - std::queue args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("char: unable to convert some args to strings"); - return retval; - } - - if (s.length () > 0) - n_elts += s.length (); - else - n_elts += 1; - - int s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - int k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - int n = s.length (); - - if (n > 0) - { - for (int j = 0; j < n; j++) - { - std::string t = s[j]; - int t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - else - result[k++] = std::string (max_len, ' '); - } - - retval = octave_value (result, '\''); - } - - return retval; -} - -/* -%!assert (char (), ''); -%!assert (char (100), "d"); -%!assert (char (100,100), ["d";"d"]) -%!assert (char ({100,100}), ["d";"d"]) -%!assert (char ([100,100]), ["dd"]) -%!assert (char ({100,{100}}), ["d";"d"]) -%!assert (char (100, [], 100), ["d";" ";"d"]) -%!assert (char ({100, [], 100}), ["d";" ";"d"]) -%!assert (char ({100,{100, {""}}}), ["d";"d";" "]) -%!assert (char (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) -%!assert (char ([65, 83, 67, 73, 73]), "ASCII") - -%!test -%! x = char ("foo", "bar", "foobar"); -%! assert (x(1,:), "foo "); -%! assert (x(2,:), "bar "); -%! assert (x(3,:), "foobar"); -*/ - -DEFUN (strvcat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strvcat (@var{x})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{x}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{s1}, @var{s2}, @dots{})\n\ -@deftypefnx {Built-in Function} {} strvcat (@var{cell_array})\n\ -Create a character array from one or more numeric matrices, character\n\ -matrices, or cell arrays. Arguments are concatenated vertically.\n\ -The returned values are padded with blanks as needed to make each row\n\ -of the string array have the same length. Unlike @code{char}, empty\n\ -strings are removed and will not appear in the output.\n\ -\n\ -For numerical input, each element is converted\n\ -to the corresponding ASCII character. A range error results if an input\n\ -is outside the ASCII range (0-255).\n\ -\n\ -For cell arrays, each element is concatenated separately. Cell arrays\n\ -converted through\n\ -@code{strvcat} can mostly be converted back with @code{cellstr}.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -strvcat ([97, 98, 99], \"\", @{\"98\", \"99\", 100@}, \"str1\", [\"ha\", \"lf\"])\n\ - @result{} [\"abc \"\n\ - \"98 \"\n\ - \"99 \"\n\ - \"d \"\n\ - \"str1 \"\n\ - \"half \"]\n\ -@end group\n\ -@end example\n\ -@seealso{char, strcat, cstrcat}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin > 0) - { - int n_elts = 0; - - size_t max_len = 0; - - std::queue args_as_strings; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args(i).all_strings (); - - if (error_state) - { - error ("strvcat: unable to convert some args to strings"); - return retval; - } - - size_t n = s.length (); - - // do not count empty strings in calculation of number of elements - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - if (s[j].length () > 0) - n_elts++; - } - } - - size_t s_max_len = s.max_length (); - - if (s_max_len > max_len) - max_len = s_max_len; - - args_as_strings.push (s); - } - - string_vector result (n_elts); - - octave_idx_type k = 0; - - for (int i = 0; i < nargin; i++) - { - string_vector s = args_as_strings.front (); - args_as_strings.pop (); - - size_t n = s.length (); - - if (n > 0) - { - for (size_t j = 0; j < n; j++) - { - std::string t = s[j]; - if (t.length () > 0) - { - size_t t_len = t.length (); - - if (max_len > t_len) - t += std::string (max_len - t_len, ' '); - - result[k++] = t; - } - } - } - } - - retval = octave_value (result, '\''); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strvcat (""), ""); -%!assert (strvcat (100) == "d"); -%!assert (strvcat (100,100), ["d";"d"]) -%!assert (strvcat ({100,100}), ["d";"d"]) -%!assert (strvcat ([100,100]), ["dd"]) -%!assert (strvcat ({100,{100}}), ["d";"d"]) -%!assert (strvcat (100, [], 100), ["d";"d"]) -%!assert (strvcat ({100, [], 100}), ["d";"d"]) -%!assert (strvcat ({100,{100, {""}}}), ["d";"d"]) -%!assert (strvcat (["a";"be"], {"c", 100}), ["a";"be";"c";"d"]) -%!assert (strvcat ("a", "bb", "ccc"), ["a "; "bb "; "ccc"]) - -%!error strvcat () -*/ - - -DEFUN (ischar, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} ischar (@var{x})\n\ -Return true if @var{x} is a character array.\n\ -@seealso{isfloat, isinteger, islogical, isnumeric, iscellstr, isa}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 && args(0).is_defined ()) - retval = args(0).is_string (); - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar ("a"), true) -%!assert (ischar (["ab";"cd"]), true) -%!assert (ischar ({"ab"}), false) -%!assert (ischar (1), false) -%!assert (ischar ([1, 2]), false) -%!assert (ischar ([]), false) -%!assert (ischar ([1, 2; 3, 4]), false) -%!assert (ischar (""), true) -%!assert (ischar ("test"), true) -%!assert (ischar (["test"; "ing"]), true) -%!assert (ischar (struct ("foo", "bar")), false) - -%!error ischar () -%!error ischar ("test", 1) -*/ - -static octave_value -do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, - octave_idx_type n, const char *fcn_name, - bool (*array_op) (const charNDArray&, const charNDArray&, octave_idx_type), - bool (*str_op) (const std::string&, const std::string&, octave_idx_type)) - -{ - octave_value retval; - - bool s1_string = arg0.is_string (); - bool s1_cell = arg0.is_cell (); - bool s2_string = arg1.is_string (); - bool s2_cell = arg1.is_cell (); - - if (s1_string && s2_string) - retval = array_op (arg0.char_array_value (), arg1.char_array_value (), n); - else if ((s1_string && s2_cell) || (s1_cell && s2_string)) - { - octave_value str_val, cell_val; - - if (s1_string) - { - str_val = arg0; - cell_val = arg1; - } - else - { - str_val = arg1; - cell_val = arg0; - } - - const Cell cell = cell_val.cell_value (); - const string_vector str = str_val.all_strings (); - octave_idx_type r = str.length (); - - if (r == 0 || r == 1) - { - // Broadcast the string. - - boolNDArray output (cell_val.dims (), false); - - std::string s = r == 0 ? std::string () : str[0]; - - if (cell_val.is_cellstr ()) - { - const Array cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), s, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < cell.length (); i++) - { - if (cell(i).is_string ()) - output(i) = str_op (cell(i).string_value (), s, n); - } - } - - retval = output; - } - else if (r > 1) - { - if (cell.length () == 1) - { - // Broadcast the cell. - - const dim_vector dv (r, 1); - boolNDArray output (dv, false); - - if (cell(0).is_string ()) - { - const std::string str2 = cell(0).string_value (); - - for (octave_idx_type i = 0; i < r; i++) - output(i) = str_op (str[i], str2, n); - } - - retval = output; - } - else - { - // Must match in all dimensions. - - boolNDArray output (cell.dims (), false); - - if (cell.length () == r) - { - if (cell_val.is_cellstr ()) - { - const Array cellstr = cell_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (str[i], cellstr(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r; i++) - { - if (cell(i).is_string ()) - output(i) = str_op (str[i], cell(i).string_value (), n); - } - } - - retval = output; - } - else - retval = false; - } - } - } - else if (s1_cell && s2_cell) - { - octave_value cell1_val, cell2_val; - octave_idx_type r1 = arg0.numel (), r2; - - if (r1 == 1) - { - // Make the singleton cell2. - - cell1_val = arg1; - cell2_val = arg0; - } - else - { - cell1_val = arg0; - cell2_val = arg1; - } - - const Cell cell1 = cell1_val.cell_value (); - const Cell cell2 = cell2_val.cell_value (); - r1 = cell1.numel (); - r2 = cell2.numel (); - - const dim_vector size1 = cell1.dims (); - const dim_vector size2 = cell2.dims (); - - boolNDArray output (size1, false); - - if (r2 == 1) - { - // Broadcast cell2. - - if (cell2(0).is_string ()) - { - const std::string str2 = cell2(0).string_value (); - - if (cell1_val.is_cellstr ()) - { - const Array cellstr = cell1_val.cellstr_value (); - for (octave_idx_type i = 0; i < cellstr.length (); i++) - output(i) = str_op (cellstr(i), str2, n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - } - else - { - if (size1 != size2) - { - error ("%s: nonconformant cell arrays", fcn_name); - return retval; - } - - if (cell1.is_cellstr () && cell2.is_cellstr ()) - { - const Array cellstr1 = cell1_val.cellstr_value (); - const Array cellstr2 = cell2_val.cellstr_value (); - for (octave_idx_type i = 0; i < r1; i++) - output (i) = str_op (cellstr1(i), cellstr2(i), n); - } - else - { - // FIXME: should we warn here? - for (octave_idx_type i = 0; i < r1; i++) - { - if (cell1(i).is_string () && cell2(i).is_string ()) - { - const std::string str1 = cell1(i).string_value (); - const std::string str2 = cell2(i).string_value (); - output(i) = str_op (str1, str2, n); - } - } - } - } - - retval = output; - } - else - retval = false; - - return retval; -} - -// If both args are arrays, dimensions may be significant. -static bool -strcmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data ())); -} - -// Otherwise, just use strings. -static bool -strcmp_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return s1 == s2; -} - -DEFUN (strcmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmp (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strcmpi, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmp", strcmp_array_op, strcmp_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!shared x -%! x = char (zeros (0, 2)); -%!assert (strcmp ("", x), false) -%!assert (strcmp (x, ""), false) -%!assert (strcmp (x, x), true) -## %!assert (strcmp ({""}, x), true) -## %!assert (strcmp ({x}, ""), false) -## %!assert (strcmp ({x}, x), true) -## %!assert (strcmp ("", {x}), false) -## %!assert (strcmp (x, {""}), false) -## %!assert (strcmp (x, {x}), true) -## %!assert (strcmp ({x; x}, ""), [false; false]) -## %!assert (strcmp ({x; x}, {""}), [false; false]) -## %!assert (strcmp ("", {x; x}), [false; false]) -## %!assert (strcmp ({""}, {x; x}), [false; false]) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp ({"foo"}, "foo"), true) -%!assert (strcmp ({"foo"}, x), false) -%!assert (strcmp (x, {"foo"}), false) -%!assert (strcmp ("foo", {"foo"}), true) -%!assert (strcmp (x, {"foo"}), false) -%!shared y -%! y = char (zeros (2, 0)); -%!assert (strcmp ("", y), false) -%!assert (strcmp (y, ""), false) -%!assert (strcmp (y, y), true) -%!assert (strcmp ({""}, y), [true; true]) -%!assert (strcmp ({y}, ""), true) -%!assert (strcmp ({y}, y), [true; true]) -%!assert (strcmp ("", {y}), true) -%!assert (strcmp (y, {""}), [true; true]) -%!assert (strcmp (y, {y}), [true; true]) -%!assert (strcmp ({y; y}, ""), [true; true]) -%!assert (strcmp ({y; y}, {""}), [true; true]) -%!assert (strcmp ("", {y; y}), [true; true]) -%!assert (strcmp ({""}, {y; y}), [true; true]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp ({"foo"}, y), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp (y, {"foo"}), [false; false]) -%!assert (strcmp ("foobar", "foobar"), true) -%!assert (strcmp ("fooba", "foobar"), false) - -%!error strcmp () -%!error strcmp ("foo", "bar", 3) -*/ - -// Apparently, Matlab ignores the dims with strncmp. It also -static bool -strncmp_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -// Otherwise, just use strings. Note that we neither extract substrings (which -// would mean a copy, at least in GCC), nor use string::compare (which is a -// 3-way compare). -static bool -strncmp_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data ())); -} - -DEFUN (strncmp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmp (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} characters of strings @var{s1} and @var{s2} are\n\ -the same, and 0 otherwise.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", \"abcd\", 3)\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@example\n\ -@group\n\ -strncmp (\"abce\", @{\"abcd\", \"bca\", \"abc\"@}, 3)\n\ - @result{} [1, 0, 1]\n\ -@end group\n\ -@end example\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -@seealso{strncmpi, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmp", - strncmp_array_op, strncmp_str_op); - } - else - error ("strncmp: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmp ("abce", "abc", 3), true) -%!assert (strncmp (100, 100, 1), false) -%!assert (strncmp ("abce", {"abcd", "bca", "abc"}, 3), logical ([1, 0, 1])) -%!assert (strncmp ("abc", {"abcd", "bca", "abc"}, 4), logical ([0, 0, 0])) -%!assert (strncmp ({"abcd", "bca", "abc"},"abce", 3), logical ([1, 0, 1])) -%!assert (strncmp ({"abcd", "bca", "abc"},{"abcd", "bca", "abe"}, 3), logical ([1, 1, 0])) -%!assert (strncmp ("abc", {"abcd", 10}, 2), logical ([1, 0])) - -%!error strncmp () -%!error strncmp ("abc", "def") -*/ - -// case-insensitive character equality functor -struct icmp_char_eq : public std::binary_function -{ - bool operator () (char x, char y) const - { return std::toupper (x) == std::toupper (y); } -}; - -// strcmpi is equivalent to strcmp in that it checks all dims. -static bool -strcmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type) -{ - return (s1.dims () == s2.dims () - && std::equal (s1.data (), s1.data () + s1.numel (), s2.data (), - icmp_char_eq ())); -} - -// Ditto for string. -static bool -strcmpi_str_op (const std::string& s1, const std::string& s2, - octave_idx_type) -{ - return (s1.size () == s2.size () - && std::equal (s1.data (), s1.data () + s1.size (), s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strcmpi", Fstrcmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strcmpi (@var{s1}, @var{s2})\n\ -Return 1 if the character strings @var{s1} and @var{s2} are the same,\n\ -disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strcmp\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strcmp, strncmp, strncmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - { - retval = do_strcmp_fun (args (0), args (1), 0, - "strcmpi", strcmpi_array_op, strcmpi_str_op); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strcmpi ("abc123", "ABC123"), true) -*/ - -// Like strncmp. -static bool -strncmpi_array_op (const charNDArray& s1, const charNDArray& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.numel (), l2 = s2.numel (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -// Ditto. -static bool -strncmpi_str_op (const std::string& s1, const std::string& s2, octave_idx_type n) -{ - octave_idx_type l1 = s1.length (), l2 = s2.length (); - return (n > 0 && n <= l1 && n <= l2 - && std::equal (s1.data (), s1.data () + n, s2.data (), - icmp_char_eq ())); -} - -DEFUNX ("strncmpi", Fstrncmpi, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} strncmpi (@var{s1}, @var{s2}, @var{n})\n\ -Return 1 if the first @var{n} character of @var{s1} and @var{s2} are the\n\ -same, disregarding case of alphabetic characters, and 0 otherwise.\n\ -\n\ -If either @var{s1} or @var{s2} is a cell array of strings, then an array\n\ -of the same size is returned, containing the values described above for\n\ -every member of the cell array. The other argument may also be a cell\n\ -array of strings (of the same size or with only one element), char matrix\n\ -or character string.\n\ -\n\ -@strong{Caution:} For compatibility with @sc{matlab}, Octave's strncmpi\n\ -function returns 1 if the character strings are equal, and 0 otherwise.\n\ -This is just the opposite of the corresponding C library function.\n\ -\n\ -@strong{Caution:} National alphabets are not supported.\n\ -@seealso{strncmp, strcmp, strcmpi}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 3) - { - octave_idx_type n = args(2).idx_type_value (); - - if (! error_state) - { - if (n > 0) - { - retval = do_strcmp_fun (args(0), args(1), n, "strncmpi", - strncmpi_array_op, strncmpi_str_op); - } - else - error ("strncmpi: N must be greater than 0"); - } - } - else - print_usage (); - - return retval; -} - -/* -%!assert (strncmpi ("abc123", "ABC456", 3), true) -*/ - -DEFUN (list_in_columns, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} list_in_columns (@var{arg}, @var{width}, @var{prefix})\n\ -Return a string containing the elements of @var{arg} listed in\n\ -columns with an overall maximum width of @var{width} and optional\n\ -prefix @var{prefix}. The argument @var{arg} must be a cell array\n\ -of character strings or a character array. If @var{width} is not\n\ -specified or is an empty matrix, or less than or equal to zero,\n\ -the width of the terminal screen is used.\n\ -Newline characters are used to break the lines in the output string.\n\ -For example:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -@group\n\ -list_in_columns (@{\"abc\", \"def\", \"ghijkl\", \"mnop\", \"qrs\", \"tuv\"@}, 20)\n\ - @result{} abc mnop\n\ - def qrs\n\ - ghijkl tuv\n\ -\n\ -whos ans\n\ - @result{}\n\ - Variables in the current scope:\n\ -\n\ - Attr Name Size Bytes Class\n\ - ==== ==== ==== ===== =====\n\ - ans 1x37 37 char\n\ -\n\ - Total is 37 elements using 37 bytes\n\ -@end group\n\ -@end smallexample\n\ -\n\ -@seealso{terminal_size}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin < 1 || nargin > 3) - { - print_usage (); - return retval; - } - - string_vector s = args(0).all_strings (); - - if (error_state) - { - error ("list_in_columns: expecting cellstr or char array"); - return retval; - } - - int width = -1; - - if (nargin > 1 && ! args(1).is_empty ()) - { - width = args(1).int_value (); - - if (error_state) - { - error ("list_in_columns: WIDTH must be an integer"); - return retval; - } - } - - std::string prefix; - - if (nargin > 2) - { - if (args(2).is_string ()) - { - prefix = args(2).string_value (); - - if (error_state) - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - else - { - error ("list_in_columns: PREFIX must be a character string"); - return retval; - } - } - - std::ostringstream buf; - - s.list_in_columns (buf, width, prefix); - - retval = buf.str (); - - return retval; -} - -/* -%!test -%! input = {"abc", "def", "ghijkl", "mnop", "qrs", "tuv"}; -%! result = "abc mnop\ndef qrs\nghijkl tuv\n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = "abc mnop \ndef qrs \nghijkl tuv \n"; -%! assert (list_in_columns (input, 20), result); -%!test -%! input = ["abc"; "def"; "ghijkl"; "mnop"; "qrs"; "tuv"]; -%! result = " abc mnop \n def qrs \n ghijkl tuv \n"; -%! assert (list_in_columns (input, 20, " "), result); - -%!error list_in_columns () -%!error list_in_columns (["abc", "def"], 20, 2) -%!error list_in_columns (["abc", "def"], 20, " ", 3) -%!error list_in_columns (["abc", "def"], "a") -*/ diff -r 069c552587a0 -r 959953dba519 src/symtab.cc --- a/src/symtab.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1744 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague, a.s. - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-time.h" -#include "singleton-cleanup.h" - -#include "debug.h" -#include "defun.h" -#include "dirfns.h" -#include "input.h" -#include "load-path.h" -#include "ov-fcn.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "pt-arg-list.h" -#include "symtab.h" -#include "unwind-prot.h" -#include "utils.h" - -symbol_table *symbol_table::instance = 0; - -symbol_table::scope_id_cache *symbol_table::scope_id_cache::instance = 0; - -std::map symbol_table::all_instances; - -std::map symbol_table::global_table; - -std::map symbol_table::fcn_table; - -std::map > symbol_table::class_precedence_table; - -std::map > symbol_table::parent_map; - -const symbol_table::scope_id symbol_table::xglobal_scope = 0; -const symbol_table::scope_id symbol_table::xtop_scope = 1; - -symbol_table::scope_id symbol_table::xcurrent_scope = 1; - -symbol_table::context_id symbol_table::xcurrent_context = 0; - -// Should Octave always check to see if function files have changed -// since they were last compiled? -static int Vignore_function_time_stamp = 1; - -void -symbol_table::scope_id_cache::create_instance (void) -{ - instance = new scope_id_cache (); - - singleton_cleanup_list::add (cleanup_instance); -} - -symbol_table::context_id -symbol_table::symbol_record::symbol_record_rep::active_context (void) const -{ - octave_user_function *fcn = curr_fcn; - - // FIXME -- If active_context () == -1, then it does not make much - // sense to use this symbol_record. This means an attempt at accessing - // a variable from a function that has not been called yet is - // happening. This should be cleared up when an implementing closures. - - return fcn && fcn->active_context () != static_cast (-1) - ? fcn->active_context () : xcurrent_context; -} - -void -symbol_table::symbol_record::symbol_record_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - octave_value val = varval (); - - os << prefix << name; - - if (val.is_defined ()) - { - os << " [" - << (is_local () ? "l" : "") - << (is_automatic () ? "a" : "") - << (is_formal () ? "f" : "") - << (is_hidden () ? "h" : "") - << (is_inherited () ? "i" : "") - << (is_global () ? "g" : "") - << (is_persistent () ? "p" : "") - << "] "; - val.dump (os); - } - - os << "\n"; -} - -octave_value -symbol_table::symbol_record::find (const octave_value_list& args) const -{ - octave_value retval; - - if (is_global ()) - retval = symbol_table::global_varref (name ()); - else - { - retval = varval (); - - if (retval.is_undefined ()) - { - // Use cached fcn_info pointer if possible. - if (rep->finfo) - retval = rep->finfo->find (args); - else - { - retval = symbol_table::find_function (name (), args); - - if (retval.is_defined ()) - rep->finfo = get_fcn_info (name ()); - } - } - } - - return retval; -} - -// Check the load path to see if file that defined this is still -// visible. If the file is no longer visible, then erase the -// definition and move on. If the file is visible, then we also -// need to check to see whether the file has changed since the the -// function was loaded/parsed. However, this check should only -// happen once per prompt (for files found from relative path -// elements, we also check if the working directory has changed -// since the last time the function was loaded/parsed). -// -// FIXME -- perhaps this should be done for all loaded functions when -// the prompt is printed or the directory has changed, and then we -// would not check for it when finding symbol definitions. - -static inline bool -load_out_of_date_fcn (const std::string& ff, const std::string& dir_name, - octave_value& function, - const std::string& dispatch_type = std::string ()) -{ - bool retval = false; - - octave_function *fcn = load_fcn_from_file (ff, dir_name, dispatch_type); - - if (fcn) - { - retval = true; - - function = octave_value (fcn); - } - else - function = octave_value (); - - return retval; -} - -bool -out_of_date_check (octave_value& function, - const std::string& dispatch_type, - bool check_relative) -{ - bool retval = false; - - octave_function *fcn = function.function_value (true); - - if (fcn) - { - // FIXME -- we need to handle subfunctions properly here. - - if (! fcn->is_subfunction ()) - { - std::string ff = fcn->fcn_file_name (); - - if (! ff.empty ()) - { - octave_time tc = fcn->time_checked (); - - bool relative = check_relative && fcn->is_relative (); - - if (tc < Vlast_prompt_time - || (relative && tc < Vlast_chdir_time)) - { - bool clear_breakpoints = false; - std::string nm = fcn->name (); - - bool is_same_file = false; - - std::string file; - std::string dir_name; - - if (check_relative) - { - int nm_len = nm.length (); - - if (octave_env::absolute_pathname (nm) - && ((nm_len > 4 && (nm.substr (nm_len-4) == ".oct" - || nm.substr (nm_len-4) == ".mex")) - || (nm_len > 2 && nm.substr (nm_len-2) == ".m"))) - file = nm; - else - { - // We don't want to make this an absolute name, - // because load_fcn_file looks at the name to - // decide whether it came from a relative lookup. - - if (! dispatch_type.empty ()) - { - file = load_path::find_method (dispatch_type, nm, - dir_name); - - if (file.empty ()) - { - const std::list& plist - = symbol_table::parent_classes (dispatch_type); - std::list::const_iterator it - = plist.begin (); - - while (it != plist.end ()) - { - file = load_path::find_method (*it, nm, dir_name); - if (! file.empty ()) - break; - - it++; - } - } - } - - // Maybe it's an autoload? - if (file.empty ()) - file = lookup_autoload (nm); - - if (file.empty ()) - file = load_path::find_fcn (nm, dir_name); - } - - if (! file.empty ()) - is_same_file = same_file (file, ff); - } - else - { - is_same_file = true; - file = ff; - } - - if (file.empty ()) - { - // Can't see this function from current - // directory, so we should clear it. - - function = octave_value (); - - clear_breakpoints = true; - } - else if (is_same_file) - { - // Same file. If it is out of date, then reload it. - - octave_time ottp = fcn->time_parsed (); - time_t tp = ottp.unix_time (); - - fcn->mark_fcn_file_up_to_date (octave_time ()); - - if (! (Vignore_function_time_stamp == 2 - || (Vignore_function_time_stamp - && fcn->is_system_fcn_file ()))) - { - file_stat fs (ff); - - if (fs) - { - if (fs.is_newer (tp)) - { - retval = load_out_of_date_fcn (ff, dir_name, - function, - dispatch_type); - - clear_breakpoints = true; - } - } - else - { - function = octave_value (); - - clear_breakpoints = true; - } - } - } - else - { - // Not the same file, so load the new file in - // place of the old. - - retval = load_out_of_date_fcn (file, dir_name, function, - dispatch_type); - - clear_breakpoints = true; - } - - // If the function has been replaced then clear any - // breakpoints associated with it - if (clear_breakpoints) - bp_table::remove_all_breakpoints_in_file (nm, true); - } - } - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_private_function - (const std::string& dir_name) -{ - octave_value retval; - - std::string file_name = load_path::find_private_fcn (dir_name, name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - { - std::string class_name; - - size_t pos = dir_name.find_last_of (file_ops::dir_sep_chars ()); - - if (pos != std::string::npos) - { - std::string tmp = dir_name.substr (pos+1); - - if (tmp[0] == '@') - class_name = tmp.substr (1); - } - - fcn->mark_as_private_function (class_name); - - retval = octave_value (fcn); - - private_functions[dir_name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_constructor (void) -{ - octave_value retval; - - std::string dir_name; - - std::string file_name = load_path::find_method (name, name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, name); - - if (fcn) - { - retval = octave_value (fcn); - - class_constructors[name] = retval; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::load_class_method - (const std::string& dispatch_type) -{ - octave_value retval; - - if (name == dispatch_type) - retval = load_class_constructor (); - else - { - std::string dir_name; - - std::string file_name = load_path::find_method (dispatch_type, name, - dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - dispatch_type); - - if (fcn) - { - retval = octave_value (fcn); - - class_methods[dispatch_type] = retval; - } - } - - if (retval.is_undefined ()) - { - // Search parent classes - - const std::list& plist = parent_classes (dispatch_type); - - std::list::const_iterator it = plist.begin (); - - while (it != plist.end ()) - { - retval = find_method (*it); - - if (retval.is_defined ()) - { - class_methods[dispatch_type] = retval; - break; - } - - it++; - } - } - } - - return retval; -} - -void -symbol_table::fcn_info::fcn_info_rep:: mark_subfunction_in_scope_as_private - (scope_id scope, const std::string& class_name) -{ - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - { - octave_function *fcn = p->second.function_value (); - - if (fcn) - fcn->mark_as_private_function (class_name); - } -} - -void -symbol_table::fcn_info::fcn_info_rep::print_dispatch (std::ostream& os) const -{ - if (dispatch_map.empty ()) - os << "dispatch: " << name << " is not overloaded" << std::endl; - else - { - os << "Overloaded function " << name << ":\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << " " << name << " (" << p->first << ", ...) -> " - << p->second << " (" << p->first << ", ...)\n"; - - os << std::endl; - } -} - -std::string -symbol_table::fcn_info::fcn_info_rep::help_for_dispatch (void) const -{ - std::string retval; - - if (! dispatch_map.empty ()) - { - retval = "Overloaded function:\n\n"; - - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - retval += " " + p->second + " (" + p->first + ", ...)\n\n"; - } - - return retval; -} - -// :-) JWE, can you parse this? Returns a 2D array with second dimension equal -// to btyp_num_types (static constant). Only the leftmost dimension can be -// variable in C/C++. Typedefs are boring. - -static builtin_type_t (*build_sup_table (void))[btyp_num_types] -{ - static builtin_type_t sup_table[btyp_num_types][btyp_num_types]; - for (int i = 0; i < btyp_num_types; i++) - for (int j = 0; j < btyp_num_types; j++) - { - builtin_type_t ityp = static_cast (i); - builtin_type_t jtyp = static_cast (j); - // FIXME: Is this really right? - bool use_j = - (jtyp == btyp_func_handle || ityp == btyp_bool - || (btyp_isarray (ityp) - && (! btyp_isarray (jtyp) - || (btyp_isinteger (jtyp) && ! btyp_isinteger (ityp)) - || ((ityp == btyp_double || ityp == btyp_complex || ityp == btyp_char) - && (jtyp == btyp_float || jtyp == btyp_float_complex))))); - - sup_table[i][j] = use_j ? jtyp : ityp; - } - - return sup_table; -} - -std::string -get_dispatch_type (const octave_value_list& args, - builtin_type_t& builtin_type) -{ - static builtin_type_t (*sup_table)[btyp_num_types] = build_sup_table (); - std::string dispatch_type; - - int n = args.length (); - - if (n > 0) - { - int i = 0; - builtin_type = args(0).builtin_type (); - if (builtin_type != btyp_unknown) - { - for (i = 1; i < n; i++) - { - builtin_type_t bti = args(i).builtin_type (); - if (bti != btyp_unknown) - builtin_type = sup_table[builtin_type][bti]; - else - { - builtin_type = btyp_unknown; - break; - } - } - } - - if (builtin_type == btyp_unknown) - { - // There's a non-builtin class in the argument list. - dispatch_type = args(i).class_name (); - - for (int j = i+1; j < n; j++) - { - octave_value arg = args(j); - - if (arg.builtin_type () == btyp_unknown) - { - std::string cname = arg.class_name (); - - // Only switch to type of ARG if it is marked superior - // to the current DISPATCH_TYPE. - if (! symbol_table::is_superiorto (dispatch_type, cname) - && symbol_table::is_superiorto (cname, dispatch_type)) - dispatch_type = cname; - } - } - } - else - dispatch_type = btyp_class_name[builtin_type]; - } - else - builtin_type = btyp_unknown; - - return dispatch_type; -} - -std::string -get_dispatch_type (const octave_value_list& args) -{ - builtin_type_t builtin_type; - return get_dispatch_type (args, builtin_type); -} - -// Find the definition of NAME according to the following precedence -// list: -// -// variable -// subfunction -// private function -// class method -// class constructor -// legacy dispatch -// command-line function -// autoload function -// function on the path -// built-in function -// -// Matlab documentation states that constructors have higher precedence -// than methods, but that does not seem to be the case. - -octave_value -symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, - bool local_funcs) -{ - octave_value retval = xfind (args, local_funcs); - - if (! (error_state || retval.is_defined ())) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = xfind (args, local_funcs); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::xfind (const octave_value_list& args, - bool local_funcs) -{ - if (local_funcs) - { - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - // Private function. - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, "", false); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - } - - // Class methods. - - if (! args.empty ()) - { - std::string dispatch_type = get_dispatch_type (args); - - octave_value fcn = find_method (dispatch_type); - - if (fcn.is_defined ()) - return fcn; - } - - // Class constructors. The class name and function name are the same. - - str_val_iterator q = class_constructors.find (name); - - if (q == class_constructors.end ()) - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, name); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_constructor (); - - if (val.is_defined ()) - return val; - } - } - - // Legacy dispatch. - - if (! args.empty () && ! dispatch_map.empty ()) - { - std::string dispatch_type = args(0).type_name (); - - std::string fname; - - dispatch_map_iterator p = dispatch_map.find (dispatch_type); - - if (p == dispatch_map.end ()) - p = dispatch_map.find ("any"); - - if (p != dispatch_map.end ()) - { - fname = p->second; - - octave_value fcn - = symbol_table::find_function (fname, args); - - if (fcn.is_defined ()) - return fcn; - } - } - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Autoload? - - octave_value fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Function on the path. - - fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Built-in function (might be undefined). - - return built_in_function; -} - -// Find the definition of NAME according to the following precedence -// list: -// -// built-in function -// function on the path -// autoload function -// command-line function -// private function -// subfunction - -// This function is used to implement the "builtin" function, which -// searches for "built-in" functions. In Matlab, "builtin" only -// returns functions that are actually built-in to the interpreter. -// But since the list of built-in functions is different in Octave and -// Matlab, we also search up the precedence list until we find -// something that matches. Note that we are only searching by name, -// so class methods, constructors, and legacy dispatch functions are -// skipped. - -octave_value -symbol_table::fcn_info::fcn_info_rep::builtin_find (void) -{ - octave_value retval = x_builtin_find (); - - if (! retval.is_defined ()) - { - // It is possible that the user created a file on the fly since - // the last prompt or chdir, so try updating the load path and - // searching again. - - load_path::update (); - - retval = x_builtin_find (); - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::x_builtin_find (void) -{ - // Built-in function. - if (built_in_function.is_defined ()) - return built_in_function; - - // Function on the path. - - octave_value fcn = find_user_function (); - - if (fcn.is_defined ()) - return fcn; - - // Autoload? - - fcn = find_autoload (); - - if (fcn.is_defined ()) - return fcn; - - // Command-line function. - - if (cmdline_function.is_defined ()) - return cmdline_function; - - // Private function. - - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - - if (curr_fcn) - { - std::string dir_name = curr_fcn->dir_name (); - - if (! dir_name.empty ()) - { - str_val_iterator q = private_functions.find (dir_name); - - if (q == private_functions.end ()) - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_private_function (dir_name); - - if (val.is_defined ()) - return val; - } - } - } - } - - // Subfunction. I think it only makes sense to check for - // subfunctions if we are currently executing a function defined - // from a .m file. - - for (scope_id scope = xcurrent_scope; scope >= 0;) - { - scope_val_iterator r = subfunctions.find (scope); - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - - octave_user_function *scope_curr_fcn = get_curr_fcn (scope); - if (scope_curr_fcn) - scope = scope_curr_fcn->parent_fcn_scope (); - else - scope = -1; - } - - return octave_value (); -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_method (const std::string& dispatch_type) -{ - octave_value retval; - - str_val_iterator q = class_methods.find (dispatch_type); - - if (q == class_methods.end ()) - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - else - { - octave_value& fval = q->second; - - if (fval.is_defined ()) - out_of_date_check (fval, dispatch_type); - - if (fval.is_defined ()) - return fval; - else - { - octave_value val = load_class_method (dispatch_type); - - if (val.is_defined ()) - return val; - } - } - - return retval; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_autoload (void) -{ - octave_value retval; - - // Autoloaded function. - - if (autoload_function.is_defined ()) - out_of_date_check (autoload_function); - - if (! autoload_function.is_defined ()) - { - std::string file_name = lookup_autoload (name); - - if (! file_name.empty ()) - { - size_t pos = file_name.find_last_of (file_ops::dir_sep_chars ()); - - std::string dir_name = file_name.substr (0, pos); - - octave_function *fcn = load_fcn_from_file (file_name, dir_name, - "", name, true); - - if (fcn) - autoload_function = octave_value (fcn); - } - } - - return autoload_function; -} - -octave_value -symbol_table::fcn_info::fcn_info_rep::find_user_function (void) -{ - // Function on the path. - - if (function_on_path.is_defined ()) - out_of_date_check (function_on_path); - - if (! (error_state || function_on_path.is_defined ())) - { - std::string dir_name; - - std::string file_name = load_path::find_fcn (name, dir_name); - - if (! file_name.empty ()) - { - octave_function *fcn = load_fcn_from_file (file_name, dir_name); - - if (fcn) - function_on_path = octave_value (fcn); - } - } - - return function_on_path; -} - -// Insert INF_CLASS in the set of class names that are considered -// inferior to SUP_CLASS. Return FALSE if INF_CLASS is currently -// marked as superior to SUP_CLASS. - -bool -symbol_table::set_class_relationship (const std::string& sup_class, - const std::string& inf_class) -{ - class_precedence_table_const_iterator p - = class_precedence_table.find (inf_class); - - if (p != class_precedence_table.end ()) - { - const std::set& inferior_classes = p->second; - - std::set::const_iterator q - = inferior_classes.find (sup_class); - - if (q != inferior_classes.end ()) - return false; - } - - class_precedence_table[sup_class].insert (inf_class); - - return true; -} - -// Has class A been marked as superior to class B? Also returns -// TRUE if B has been marked as inferior to A, since we only keep -// one table, and convert inferiort information to a superiorto -// relationship. Two calls are required to determine whether there -// is no relationship between two classes: -// -// if (symbol_table::is_superiorto (a, b)) -// // A is superior to B, or B has been marked inferior to A. -// else if (symbol_table::is_superiorto (b, a)) -// // B is superior to A, or A has been marked inferior to B. -// else -// // No relation. - -bool -symbol_table::is_superiorto (const std::string& a, const std::string& b) -{ - bool retval = false; - - class_precedence_table_const_iterator p = class_precedence_table.find (a); - - if (p != class_precedence_table.end ()) - { - const std::set& inferior_classes = p->second; - std::set::const_iterator q = inferior_classes.find (b); - - if (q != inferior_classes.end ()) - retval = true; - } - - return retval; -} - -static std::string -fcn_file_name (const octave_value& fcn) -{ - const octave_function *f = fcn.function_value (); - - return f ? f->fcn_file_name () : std::string (); -} - -void -symbol_table::fcn_info::fcn_info_rep::dump - (std::ostream& os, const std::string& prefix) const -{ - os << prefix << name - << " [" - << (cmdline_function.is_defined () ? "c" : "") - << (built_in_function.is_defined () ? "b" : "") - << "]\n"; - - std::string tprefix = prefix + " "; - - if (autoload_function.is_defined ()) - os << tprefix << "autoload: " - << fcn_file_name (autoload_function) << "\n"; - - if (function_on_path.is_defined ()) - os << tprefix << "function from path: " - << fcn_file_name (function_on_path) << "\n"; - - if (! subfunctions.empty ()) - { - for (scope_val_const_iterator p = subfunctions.begin (); - p != subfunctions.end (); p++) - os << tprefix << "subfunction: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! private_functions.empty ()) - { - for (str_val_const_iterator p = private_functions.begin (); - p != private_functions.end (); p++) - os << tprefix << "private: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_constructors.empty ()) - { - for (str_val_const_iterator p = class_constructors.begin (); - p != class_constructors.end (); p++) - os << tprefix << "constructor: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! class_methods.empty ()) - { - for (str_val_const_iterator p = class_methods.begin (); - p != class_methods.end (); p++) - os << tprefix << "method: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } - - if (! dispatch_map.empty ()) - { - for (dispatch_map_const_iterator p = dispatch_map.begin (); - p != dispatch_map.end (); p++) - os << tprefix << "dispatch: " << fcn_file_name (p->second) - << " [" << p->first << "]\n"; - } -} - -void -symbol_table::install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope) -{ - install_subfunction (name, fcn, parent_scope); - - // Stash the nest_parent for resolving variables after parsing is done. - octave_function *fv = fcn.function_value (); - - symbol_table *fcn_table_loc = get_instance (fv->scope ()); - - symbol_table *parent_table = get_instance (parent_scope); - - parent_table->add_nest_child (*fcn_table_loc); -} - -octave_value -symbol_table::find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst - ? inst->do_find (name, args, skip_variables, local_funcs) - : octave_value (); -} - -octave_value -symbol_table::builtin_find (const std::string& name) -{ - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_builtin_find (name) : octave_value (); -} - -octave_value -symbol_table::find_function (const std::string& name, - const octave_value_list& args, - bool local_funcs) -{ - octave_value retval; - - if (! name.empty () && name[0] == '@') - { - // Look for a class specific function. - std::string dispatch_type = - name.substr (1, name.find_first_of (file_ops::dir_sep_str ()) - 1); - - std::string method = - name.substr (name.find_last_of (file_ops::dir_sep_str ()) + 1, - std::string::npos); - - retval = find_method (method, dispatch_type); - } - else - { - size_t pos = name.find_first_of (Vfilemarker); - - if (pos == std::string::npos) - retval = find (name, args, true, local_funcs); - else - { - std::string fcn_scope = name.substr (0, pos); - scope_id stored_scope = xcurrent_scope; - xcurrent_scope = xtop_scope; - octave_value parent = find_function (name.substr (0, pos), - octave_value_list (), false); - - if (parent.is_defined ()) - { - octave_function *parent_fcn = parent.function_value (); - - if (parent_fcn) - { - xcurrent_scope = parent_fcn->scope (); - - if (xcurrent_scope > 1) - retval = find_function (name.substr (pos + 1), args); - } - } - - xcurrent_scope = stored_scope; - } - } - - return retval; -} - -void -symbol_table::dump (std::ostream& os, scope_id scope) -{ - if (scope == xglobal_scope) - dump_global (os); - else - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - { - os << "*** dumping symbol table scope " << scope - << " (" << inst->table_name << ")\n\n"; - - std::map sfuns - = symbol_table::subfunctions_defined_in_scope (scope); - - if (! sfuns.empty ()) - { - os << " subfunctions defined in this scope:\n"; - - for (std::map::const_iterator p = sfuns.begin (); - p != sfuns.end (); p++) - os << " " << p->first << "\n"; - - os << "\n"; - } - - inst->do_dump (os); - } - } -} - -void -symbol_table::dump_global (std::ostream& os) -{ - if (! global_table.empty ()) - { - os << "*** dumping global symbol table\n\n"; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - } -} - -void -symbol_table::dump_functions (std::ostream& os) -{ - if (! fcn_table.empty ()) - { - os << "*** dumping globally visible functions from symbol table\n" - << " (c=commandline, b=built-in)\n\n"; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void -symbol_table::stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name) -{ - // FIXME -- is this the best way to do this? Maybe it would be - // better if we had a map from scope to list of subfunctions - // stored with the function. Do we? - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - { - octave_value& fcn = tmp.second; - - octave_user_function *f = fcn.user_function_value (); - - if (f) - f->stash_dir_name (dir_name); - } - } -} - -octave_value -symbol_table::do_find (const std::string& name, - const octave_value_list& args, - bool skip_variables, - bool local_funcs) -{ - octave_value retval; - - // Variable. - - if (! skip_variables) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record sr = p->second; - - // FIXME -- should we be using something other than varref here? - - if (sr.is_global ()) - return symbol_table::global_varref (name); - else - { - octave_value& val = sr.varref (); - - if (val.is_defined ()) - return val; - } - } - } - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find (args, local_funcs); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find (args, local_funcs); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -octave_value -symbol_table::do_builtin_find (const std::string& name) -{ - octave_value retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.builtin_find (); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.builtin_find (); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - - return retval; -} - -void -symbol_table::do_dump (std::ostream& os) -{ - if (! persistent_table.empty ()) - { - os << " persistent variables in this scope:\n\n"; - - for (persistent_table_const_iterator p = persistent_table.begin (); - p != persistent_table.end (); p++) - { - std::string nm = p->first; - octave_value val = p->second; - - os << " " << nm << " "; - val.dump (os); - os << "\n"; - } - - os << "\n"; - } - - if (! table.empty ()) - { - os << " other symbols in this scope (l=local; a=auto; f=formal\n" - << " h=hidden; i=inherited; g=global; p=persistent)\n\n"; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - p->second.dump (os, " "); - - os << "\n"; - } -} - -void symbol_table::cleanup (void) -{ - // Clear variables in top scope. - all_instances[xtop_scope]->clear_variables (); - - // Clear function table. This is a hard clear, ignoring mlocked functions. - fcn_table.clear (); - - // Clear variables in global scope. - // FIXME: are there any? - all_instances[xglobal_scope]->clear_variables (); - - // Clear global variables. - global_table.clear (); - - // Delete all possibly remaining scopes. - for (all_instances_iterator iter = all_instances.begin (); - iter != all_instances.end (); iter++) - { - scope_id scope = iter->first; - if (scope != xglobal_scope && scope != xtop_scope) - scope_id_cache::free (scope); - - // First zero the table entry to avoid possible duplicate delete. - symbol_table *inst = iter->second; - iter->second = 0; - - // Now delete the scope. Note that there may be side effects, such as - // deleting other scopes. - delete inst; - } -} - -void -symbol_table::do_update_nest (void) -{ - if (nest_parent || nest_children.size ()) - curr_fcn->mark_as_nested_function (); - - if (nest_parent) - { - // fix bad symbol_records - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - { - symbol_record &ours = ti->second; - symbol_record parents; - if (! ours.is_formal () - && nest_parent->look_nonlocal (ti->first, parents)) - { - if (ours.is_global () || ours.is_persistent ()) - ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); - - if (! ours.is_formal ()) - { - ours.invalidate (); - ti->second = parents; - } - } - else - ours.set_curr_fcn (curr_fcn); - } - } - else if (nest_children.size ()) - for (table_iterator ti = table.begin (); ti != table.end (); ++ti) - ti->second.set_curr_fcn (curr_fcn); - - for (std::vector::iterator iter = nest_children.begin (); - iter != nest_children.end (); ++iter) - (*iter)->do_update_nest (); -} - -DEFUN (ignore_function_time_stamp, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} ignore_function_time_stamp (@var{new_val})\n\ -Query or set the internal variable that controls whether Octave checks\n\ -the time stamp on files each time it looks up functions defined in\n\ -function files. If the internal variable is set to @code{\"system\"},\n\ -Octave will not automatically recompile function files in subdirectories of\n\ -@file{@var{octave-home}/lib/@var{version}} if they have changed since\n\ -they were last compiled, but will recompile other function files in the\n\ -search path if they change. If set to @code{\"all\"}, Octave will not\n\ -recompile any function files unless their definitions are removed with\n\ -@code{clear}. If set to \"none\", Octave will always check time stamps\n\ -on files to determine whether functions defined in function files\n\ -need to recompiled.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - { - switch (Vignore_function_time_stamp) - { - case 1: - retval = "system"; - break; - - case 2: - retval = "all"; - break; - - default: - retval = "none"; - break; - } - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (sval == "all") - Vignore_function_time_stamp = 2; - else if (sval == "system") - Vignore_function_time_stamp = 1; - else if (sval == "none") - Vignore_function_time_stamp = 0; - else - error ("ignore_function_time_stamp: expecting argument to be \"all\", \"system\", or \"none\""); - } - else - error ("ignore_function_time_stamp: expecting argument to be character string"); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -/* -%!shared old_state -%! old_state = ignore_function_time_stamp (); -%!test -%! state = ignore_function_time_stamp ("all"); -%! assert (state, old_state); -%! assert (ignore_function_time_stamp (), "all"); -%! state = ignore_function_time_stamp ("system"); -%! assert (state, "all"); -%! assert (ignore_function_time_stamp (), "system"); -%! ignore_function_time_stamp (old_state); - -## Test input validation -%!error (ignore_function_time_stamp ("all", "all")) -%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) -%!error (ignore_function_time_stamp (42)) -*/ - -DEFUN (__current_scope__, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = symbol_table::current_context (); - retval(0) = symbol_table::current_scope (); - - return retval; -} - -DEFUN (__dump_symtab_info__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __dump_symtab_info__ ()\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (@var{scope})\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"scopes\")\n\ -@deftypefnx {Built-in Function} {} __dump_symtab_info__ (\"functions\")\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - { - symbol_table::dump_functions (octave_stdout); - - symbol_table::dump_global (octave_stdout); - - std::list lst = symbol_table::scopes (); - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - symbol_table::dump (octave_stdout, *p); - } - else if (nargin == 1) - { - octave_value arg = args(0); - - if (arg.is_string ()) - { - std::string s_arg = arg.string_value (); - - if (s_arg == "scopes") - { - std::list lst = symbol_table::scopes (); - - RowVector v (lst.size ()); - - octave_idx_type k = 0; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - v.xelem (k++) = *p; - - retval = v; - } - else if (s_arg == "functions") - { - symbol_table::dump_functions (octave_stdout); - } - else - error ("__dump_symtab_info__: expecting \"functions\" or \"scopes\""); - } - else - { - int s = arg.int_value (); - - if (! error_state) - symbol_table::dump (octave_stdout, s); - else - error ("__dump_symtab_info__: expecting string or scope id"); - } - } - else - print_usage (); - - return retval; -} - -#if 0 - -// FIXME -- should we have functions like this in Octave? - -DEFUN (set_variable, args, , "set_variable (NAME, VALUE)") -{ - octave_value retval; - - if (args.length () == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - symbol_table::varref (name) = args(1); - else - error ("set_variable: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} - -DEFUN (variable_value, args, , "VALUE = variable_value (NAME)") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - retval = symbol_table::varval (name); - - if (retval.is_undefined ()) - error ("variable_value: `%s' is not a variable in the current scope", - name.c_str ()); - } - else - error ("variable_value: expecting variable name as first argument"); - } - else - print_usage (); - - return retval; -} -#endif - - -/* -bug #34497: 'clear -f' does not work for command line functions - -This test relies on bar being a core function that is implemented in an m-file. -If the first assert fails, this is no longer the case and the tests need to be -updated to use some other function. - -%!assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear -f bar; -%! assert (! strcmp (which ("bar"), "")); - -%!function x = bar () -%! x = 5; -%!endfunction -%!test -%! assert (bar == 5); -%! assert (strcmp (which ("bar"), "")); -%! clear bar; -%! assert (! strcmp (which ("bar"), "")); - */ diff -r 069c552587a0 -r 959953dba519 src/symtab.h --- a/src/symtab.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2660 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_symtab_h) -#define octave_symtab_h 1 - -#include -#include -#include -#include -#include - -#include "glob-match.h" -#include "regexp.h" - -class tree_argument_list; -class octave_user_function; - -#include "oct-obj.h" -#include "oct-refcount.h" -#include "ov.h" - -class -OCTINTERP_API -symbol_table -{ -public: - - typedef int scope_id; - typedef size_t context_id; - - class - scope_id_cache - { - protected: - - typedef std::set::iterator set_iterator; - typedef std::set::const_iterator set_const_iterator; - - // We start with 2 because we allocate 0 for the global symbols - // and 1 for the top-level workspace. - - scope_id_cache (void) : next_available (2), in_use (), free_list () { } - - public: - - ~scope_id_cache (void) { } - - static scope_id alloc (void) - { - return instance_ok () ? instance->do_alloc () : -1; - } - - static void free (scope_id scope) - { - if (instance_ok ()) - return instance->do_free (scope); - } - - static std::list scopes (void) - { - return instance_ok () ? instance->do_scopes () : std::list (); - } - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create scope_id_cache object!"); - - retval = false; - } - - return retval; - } - - private: - - // No copying! - - scope_id_cache (const scope_id_cache&); - - scope_id_cache& operator = (const scope_id_cache&); - - static scope_id_cache *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - // The next available scope not in the free list. - scope_id next_available; - - // The set of scope IDs that are currently allocated. - std::set in_use; - - // The set of scope IDs that are currently available. - std::set free_list; - - scope_id do_alloc (void) - { - scope_id retval; - - set_iterator p = free_list.begin (); - - if (p != free_list.end ()) - { - retval = *p; - free_list.erase (p); - } - else - retval = next_available++; - - in_use.insert (retval); - - return retval; - } - - void do_free (scope_id scope) - { - set_iterator p = in_use.find (scope); - - if (p != in_use.end ()) - { - in_use.erase (p); - free_list.insert (scope); - } - else - error ("free_scope: scope %d not found!", scope); - } - - std::list do_scopes (void) const - { - std::list retval; - - for (set_const_iterator p = in_use.begin (); p != in_use.end (); p++) - retval.push_back (*p); - - retval.sort (); - - return retval; - } - }; - - class fcn_info; - - class - symbol_record - { - public: - - // generic variable - static const unsigned int local = 1; - - // varargin, argn, .nargin., .nargout. - // (FIXME -- is this really used now?) - static const unsigned int automatic = 2; - - // formal parameter - static const unsigned int formal = 4; - - // not listed or cleared (.nargin., .nargout.) - static const unsigned int hidden = 8; - - // inherited from parent scope; not cleared at function exit - static const unsigned int inherited = 16; - - // global (redirects to global scope) - static const unsigned int global = 32; - - // not cleared at function exit - static const unsigned int persistent = 64; - - // temporary variables forced into symbol table for parsing - static const unsigned int forced = 128; - - private: - - class - symbol_record_rep - { - public: - - symbol_record_rep (scope_id s, const std::string& nm, - const octave_value& v, unsigned int sc) - : decl_scope (s), curr_fcn (0), name (nm), value_stack (), - storage_class (sc), finfo (), valid (true), count (1) - { - value_stack.push_back (v); - } - - void force_variable (context_id context = xdefault_context) - { - if (context == xdefault_context) - context = active_context (); - - octave_value& val = varref (context); - - if (! val.is_defined ()) - mark_forced (); - } - - octave_value& varref (context_id context = xdefault_context) - { - if (is_global ()) - return symbol_table::global_varref (name); - else if (is_persistent ()) - return symbol_table::persistent_varref (name); - else - { - if (context == xdefault_context) - context = active_context (); - - context_id n = value_stack.size (); - while (n++ <= context) - value_stack.push_back (octave_value ()); - - return value_stack[context]; - } - } - - octave_value varval (context_id context = xdefault_context) const - { - if (is_global ()) - return symbol_table::global_varval (name); - else if (is_persistent ()) - return symbol_table::persistent_varval (name); - else - { - if (context == xdefault_context) - context = active_context (); - - if (context < value_stack.size ()) - return value_stack[context]; - else - return octave_value (); - } - } - - void push_context (scope_id s) - { - if (! (is_persistent () || is_global ()) - && s == scope ()) - value_stack.push_back (octave_value ()); - } - - // If pop_context returns 0, we are out of values and this element - // of the symbol table should be deleted. This can happen for - // functions like - // - // function foo (n) - // if (n > 0) - // foo (n-1); - // else - // eval ("x = 1"); - // endif - // endfunction - // - // Here, X should only exist in the final stack frame. - - size_t pop_context (scope_id s) - { - size_t retval = 1; - - if (! (is_persistent () || is_global ()) - && s == scope ()) - { - value_stack.pop_back (); - retval = value_stack.size (); - } - - return retval; - } - - void clear (void) { clear (scope ()); } - - void clear (scope_id s) - { - if (! (is_hidden () || is_inherited ()) - && s == scope ()) - { - if (is_global ()) - unmark_global (); - - if (is_persistent ()) - { - symbol_table::persistent_varref (name) - = varval (); - - unmark_persistent (); - } - - varref () = octave_value (); - } - } - - bool is_defined (context_id context = xdefault_context) const - { - if (context == xdefault_context) - context = active_context (); - - return varval (context).is_defined (); - } - - bool is_valid (void) const - { - return valid; - } - - bool is_variable (context_id context) const - { - if (context == xdefault_context) - context = active_context (); - - return (! is_local () || is_defined (context) || is_forced ()); - } - - bool is_local (void) const { return storage_class & local; } - bool is_automatic (void) const { return storage_class & automatic; } - bool is_formal (void) const { return storage_class & formal; } - bool is_hidden (void) const { return storage_class & hidden; } - bool is_inherited (void) const { return storage_class & inherited; } - bool is_global (void) const { return storage_class & global; } - bool is_persistent (void) const { return storage_class & persistent; } - bool is_forced (void) const { return storage_class & forced; } - - void mark_local (void) { storage_class |= local; } - void mark_automatic (void) { storage_class |= automatic; } - void mark_formal (void) { storage_class |= formal; } - void mark_hidden (void) { storage_class |= hidden; } - void mark_inherited (void) { storage_class |= inherited; } - void mark_global (void) - { - if (is_persistent ()) - error ("can't make persistent variable %s global", name.c_str ()); - else - storage_class |= global; - } - void mark_persistent (void) - { - if (is_global ()) - error ("can't make global variable %s persistent", name.c_str ()); - else - storage_class |= persistent; - } - void mark_forced (void) { storage_class |= forced; } - - void unmark_local (void) { storage_class &= ~local; } - void unmark_automatic (void) { storage_class &= ~automatic; } - void unmark_formal (void) { storage_class &= ~formal; } - void unmark_hidden (void) { storage_class &= ~hidden; } - void unmark_inherited (void) { storage_class &= ~inherited; } - void unmark_global (void) { storage_class &= ~global; } - void unmark_persistent (void) { storage_class &= ~persistent; } - void unmark_forced (void) { storage_class &= ~forced; } - - void init_persistent (void) - { - if (! is_defined ()) - { - mark_persistent (); - - varref () = symbol_table::persistent_varval (name); - } - // FIXME -- this causes trouble with recursive calls. - // else - // error ("unable to declare existing variable persistent"); - } - - void invalidate (void) - { - valid = false; - } - - void erase_persistent (void) - { - unmark_persistent (); - symbol_table::erase_persistent (name); - } - - context_id active_context (void) const; - - scope_id scope (void) const { return decl_scope; } - - void set_curr_fcn (octave_user_function *fcn) - { - curr_fcn = fcn; - } - - symbol_record_rep *dup (scope_id new_scope) const - { - return new symbol_record_rep (new_scope, name, varval (), - storage_class); - } - - void dump (std::ostream& os, const std::string& prefix) const; - - scope_id decl_scope; - - octave_user_function* curr_fcn; - - std::string name; - - std::deque value_stack; - - unsigned int storage_class; - - fcn_info *finfo; - - bool valid; - - octave_refcount count; - - private: - - // No copying! - - symbol_record_rep (const symbol_record_rep& ov); - - symbol_record_rep& operator = (const symbol_record_rep&); - }; - - public: - - symbol_record (scope_id s = xcurrent_scope, - const std::string& nm = std::string (), - const octave_value& v = octave_value (), - unsigned int sc = local) - : rep (new symbol_record_rep (s, nm, v, sc)) { } - - symbol_record (const symbol_record& sr) - : rep (sr.rep) - { - rep->count++; - } - - symbol_record& operator = (const symbol_record& sr) - { - if (this != &sr) - { - if (--rep->count == 0) - delete rep; - - rep = sr.rep; - rep->count++; - } - - return *this; - } - - ~symbol_record (void) - { - if (--rep->count == 0) - delete rep; - } - - symbol_record dup (scope_id new_scope) const - { - return symbol_record (rep->dup (new_scope)); - } - - const std::string& name (void) const { return rep->name; } - - octave_value - find (const octave_value_list& args = octave_value_list ()) const; - - void force_variable (context_id context = xdefault_context) - { - rep->force_variable (context); - } - - octave_value& varref (context_id context = xdefault_context) - { - return rep->varref (context); - } - - octave_value varval (context_id context = xdefault_context) const - { - return rep->varval (context); - } - - void push_context (scope_id s) { rep->push_context (s); } - - size_t pop_context (scope_id s) { return rep->pop_context (s); } - - void clear (void) { rep->clear (); } - - void clear (scope_id s) { rep->clear (s); } - - bool is_defined (context_id context = xdefault_context) const - { - return rep->is_defined (context); - } - - bool is_valid (void) const - { - return rep->is_valid (); - } - - bool is_variable (context_id context = xdefault_context) const - { - return rep->is_variable (context); - } - - bool is_local (void) const { return rep->is_local (); } - bool is_automatic (void) const { return rep->is_automatic (); } - bool is_formal (void) const { return rep->is_formal (); } - bool is_global (void) const { return rep->is_global (); } - bool is_hidden (void) const { return rep->is_hidden (); } - bool is_inherited (void) const { return rep->is_inherited (); } - bool is_persistent (void) const { return rep->is_persistent (); } - bool is_forced (void) const { return rep->is_forced (); } - - void mark_local (void) { rep->mark_local (); } - void mark_automatic (void) { rep->mark_automatic (); } - void mark_formal (void) { rep->mark_formal (); } - void mark_hidden (void) { rep->mark_hidden (); } - void mark_inherited (void) { rep->mark_inherited (); } - void mark_global (void) { rep->mark_global (); } - void mark_persistent (void) { rep->mark_persistent (); } - void mark_forced (void) { rep->mark_forced (); } - - void unmark_local (void) { rep->unmark_local (); } - void unmark_automatic (void) { rep->unmark_automatic (); } - void unmark_formal (void) { rep->unmark_formal (); } - void unmark_hidden (void) { rep->unmark_hidden (); } - void unmark_inherited (void) { rep->unmark_inherited (); } - void unmark_global (void) { rep->unmark_global (); } - void unmark_persistent (void) { rep->unmark_persistent (); } - void unmark_forced (void) { rep->unmark_forced (); } - - void init_persistent (void) { rep->init_persistent (); } - - void erase_persistent (void) { rep->erase_persistent (); } - - void invalidate (void) { rep->invalidate (); } - - context_id active_context (void) const { return rep->active_context (); } - - scope_id scope (void) const { return rep->scope (); } - - unsigned int xstorage_class (void) const { return rep->storage_class; } - - void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - symbol_record_rep *rep; - - symbol_record (symbol_record_rep *new_rep) : rep (new_rep) { } - }; - - // Always access a symbol from the current scope. - // Useful for scripts, as they may be executed in more than one scope. - class - symbol_reference - { - public: - symbol_reference (void) : scope (-1) {} - - symbol_reference (symbol_record record, - scope_id curr_scope = symbol_table::current_scope ()) - : scope (curr_scope), sym (record) - {} - - symbol_reference& operator = (const symbol_reference& ref) - { - scope = ref.scope; - sym = ref.sym; - return *this; - } - - // The name is the same regardless of scope. - const std::string& name (void) const { return sym.name (); } - - symbol_record *operator-> (void) - { - update (); - return &sym; - } - - symbol_record *operator-> (void) const - { - update (); - return &sym; - } - - // can be used to place symbol_reference in maps, we don't overload < as - // it doesn't make any sense for symbol_reference - struct comparator - { - bool operator ()(const symbol_reference& lhs, - const symbol_reference& rhs) const - { - return lhs.name () < rhs.name (); - } - }; - private: - void update (void) const - { - scope_id curr_scope = symbol_table::current_scope (); - if (scope != curr_scope || ! sym.is_valid ()) - { - scope = curr_scope; - sym = symbol_table::insert (sym.name ()); - } - } - - mutable scope_id scope; - mutable symbol_record sym; - }; - - class - fcn_info - { - public: - - typedef std::map dispatch_map_type; - - typedef std::map::const_iterator scope_val_const_iterator; - typedef std::map::iterator scope_val_iterator; - - typedef std::map::const_iterator str_val_const_iterator; - typedef std::map::iterator str_val_iterator; - - typedef dispatch_map_type::const_iterator dispatch_map_const_iterator; - typedef dispatch_map_type::iterator dispatch_map_iterator; - - private: - - class - fcn_info_rep - { - public: - - fcn_info_rep (const std::string& nm) - : name (nm), subfunctions (), private_functions (), - class_constructors (), class_methods (), dispatch_map (), - cmdline_function (), autoload_function (), function_on_path (), - built_in_function (), count (1) { } - - octave_value load_private_function (const std::string& dir_name); - - octave_value load_class_constructor (void); - - octave_value load_class_method (const std::string& dispatch_type); - - octave_value find (const octave_value_list& args, bool local_funcs); - - octave_value builtin_find (void); - - octave_value find_method (const std::string& dispatch_type); - - octave_value find_autoload (void); - - octave_value find_user_function (void); - - bool is_user_function_defined (void) const - { - return function_on_path.is_defined (); - } - - octave_value find_function (const octave_value_list& args, bool local_funcs) - { - return find (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.lock (); - } - - void unlock_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - p->second.unlock (); - } - - std::pair - subfunction_defined_in_scope (scope_id scope) const - { - scope_val_const_iterator p = subfunctions.find (scope); - - return p == subfunctions.end () - ? std::pair () - : std::pair (name, p->second); - } - - void erase_subfunction (scope_id scope) - { - scope_val_iterator p = subfunctions.find (scope); - - if (p != subfunctions.end ()) - subfunctions.erase (p); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name); - - void install_cmdline_function (const octave_value& f) - { - cmdline_function = f; - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - subfunctions[scope] = f; - } - - void install_user_function (const octave_value& f) - { - function_on_path = f; - } - - void install_built_in_function (const octave_value& f) - { - built_in_function = f; - } - - template - void - clear_unlocked (std::map& map) - { - typename std::map::iterator p = map.begin (); - - while (p != map.end ()) - { - if (p->second.islocked ()) - p++; - else - map.erase (p++); - } - } - - void clear_autoload_function (void) - { - if (! autoload_function.islocked ()) - autoload_function = octave_value (); - } - - // We also clear command line functions here, as these are both - // "user defined" - void clear_user_function (void) - { - if (! function_on_path.islocked ()) - { - function_on_path.erase_subfunctions (); - - function_on_path = octave_value (); - } - - if (! cmdline_function.islocked ()) - cmdline_function = octave_value (); - } - - void clear_mex_function (void) - { - if (function_on_path.is_mex_function ()) - clear_user_function (); - } - - void clear (void) - { - clear_unlocked (subfunctions); - clear_unlocked (private_functions); - clear_unlocked (class_constructors); - clear_unlocked (class_methods); - clear_autoload_function (); - clear_user_function (); - } - - void add_dispatch (const std::string& type, const std::string& fname) - { - dispatch_map[type] = fname; - } - - void clear_dispatch (const std::string& type) - { - dispatch_map_iterator p = dispatch_map.find (type); - - if (p != dispatch_map.end ()) - dispatch_map.erase (p); - } - - void print_dispatch (std::ostream& os) const; - - std::string help_for_dispatch (void) const; - - dispatch_map_type get_dispatch (void) const { return dispatch_map; } - - void dump (std::ostream& os, const std::string& prefix) const; - - std::string name; - - // Scope id to function object. - std::map subfunctions; - - // Directory name to function object. - std::map private_functions; - - // Class name to function object. - std::map class_constructors; - - // Dispatch type to function object. - std::map class_methods; - - // Legacy dispatch map (dispatch type name to function name). - dispatch_map_type dispatch_map; - - octave_value cmdline_function; - - octave_value autoload_function; - - octave_value function_on_path; - - octave_value built_in_function; - - octave_refcount count; - - private: - - octave_value xfind (const octave_value_list& args, bool local_funcs); - - octave_value x_builtin_find (void); - - // No copying! - - fcn_info_rep (const fcn_info_rep&); - - fcn_info_rep& operator = (const fcn_info_rep&); - }; - - public: - - fcn_info (const std::string& nm = std::string ()) - : rep (new fcn_info_rep (nm)) { } - - fcn_info (const fcn_info& fi) : rep (fi.rep) - { - rep->count++; - } - - fcn_info& operator = (const fcn_info& fi) - { - if (this != &fi) - { - if (--rep->count == 0) - delete rep; - - rep = fi.rep; - rep->count++; - } - - return *this; - } - - ~fcn_info (void) - { - if (--rep->count == 0) - delete rep; - } - - octave_value find (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find (args, local_funcs); - } - - octave_value builtin_find (void) - { - return rep->builtin_find (); - } - - octave_value find_method (const std::string& dispatch_type) const - { - return rep->find_method (dispatch_type); - } - - octave_value find_built_in_function (void) const - { - return rep->built_in_function; - } - - octave_value find_cmdline_function (void) const - { - return rep->cmdline_function; - } - - octave_value find_autoload (void) - { - return rep->find_autoload (); - } - - octave_value find_user_function (void) - { - return rep->find_user_function (); - } - - bool is_user_function_defined (void) const - { - return rep->is_user_function_defined (); - } - - octave_value find_function (const octave_value_list& args = octave_value_list (), - bool local_funcs = true) - { - return rep->find_function (args, local_funcs); - } - - void lock_subfunction (scope_id scope) - { - rep->lock_subfunction (scope); - } - - void unlock_subfunction (scope_id scope) - { - rep->unlock_subfunction (scope); - } - - std::pair - subfunction_defined_in_scope (scope_id scope = xcurrent_scope) const - { - return rep->subfunction_defined_in_scope (scope); - } - - void erase_subfunction (scope_id scope) - { - rep->erase_subfunction (scope); - } - - void mark_subfunction_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - rep->mark_subfunction_in_scope_as_private (scope, class_name); - } - - void install_cmdline_function (const octave_value& f) - { - rep->install_cmdline_function (f); - } - - void install_subfunction (const octave_value& f, scope_id scope) - { - rep->install_subfunction (f, scope); - } - - void install_user_function (const octave_value& f) - { - rep->install_user_function (f); - } - - void install_built_in_function (const octave_value& f) - { - rep->install_built_in_function (f); - } - - void clear (void) { rep->clear (); } - - void clear_user_function (void) { rep->clear_user_function (); } - - void clear_autoload_function (void) { rep->clear_autoload_function (); } - - void clear_mex_function (void) { rep->clear_mex_function (); } - - void add_dispatch (const std::string& type, const std::string& fname) - { - rep->add_dispatch (type, fname); - } - - void clear_dispatch (const std::string& type) - { - rep->clear_dispatch (type); - } - - void print_dispatch (std::ostream& os) const - { - rep->print_dispatch (os); - } - - std::string help_for_dispatch (void) const { return rep->help_for_dispatch (); } - - dispatch_map_type get_dispatch (void) const - { - return rep->get_dispatch (); - } - - void - dump (std::ostream& os, const std::string& prefix = std::string ()) const - { - rep->dump (os, prefix); - } - - private: - - fcn_info_rep *rep; - }; - - static scope_id global_scope (void) { return xglobal_scope; } - static scope_id top_scope (void) { return xtop_scope; } - - static scope_id current_scope (void) { return xcurrent_scope; } - - static context_id current_context (void) { return xcurrent_context; } - - static scope_id alloc_scope (void) { return scope_id_cache::alloc (); } - - static void set_scope (scope_id scope) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - all_instances[scope] = instance = inst; - } - else - instance = p->second; - - xcurrent_scope = scope; - xcurrent_context = 0; - } - } - - static void set_scope_and_context (scope_id scope, context_id context) - { - if (scope == xglobal_scope) - error ("can't set scope to global"); - else - { - if (scope != xcurrent_scope) - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - error ("scope not found!"); - else - { - instance = p->second; - - xcurrent_scope = scope; - - xcurrent_context = context; - } - } - else - xcurrent_context = context; - } - } - - static void erase_scope (scope_id scope) - { - assert (scope != xglobal_scope); - - all_instances_iterator p = all_instances.find (scope); - - if (p != all_instances.end ()) - { - delete p->second; - - all_instances.erase (p); - - free_scope (scope); - } - } - - static void erase_subfunctions_in_scope (scope_id scope) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.erase_subfunction (scope); - } - - static void - mark_subfunctions_in_scope_as_private (scope_id scope, - const std::string& class_name) - { - for (fcn_table_iterator q = fcn_table.begin (); - q != fcn_table.end (); q++) - q->second.mark_subfunction_in_scope_as_private (scope, class_name); - } - - static scope_id dup_scope (scope_id scope) - { - scope_id retval = -1; - - symbol_table *inst = get_instance (scope); - - if (inst) - { - scope_id new_scope = alloc_scope (); - - symbol_table *new_symbol_table = new symbol_table (scope); - - if (new_symbol_table) - { - all_instances[new_scope] = new_symbol_table; - - inst->do_dup_scope (*new_symbol_table); - - retval = new_scope; - } - } - - return retval; - } - - static std::list scopes (void) - { - return scope_id_cache::scopes (); - } - - static symbol_record - find_symbol (const std::string& name, scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_find_symbol (name) : - symbol_record (scope); - } - - static void - inherit (scope_id scope, scope_id donor_scope, context_id donor_context) - { - symbol_table *inst = get_instance (scope); - - if (inst) - { - symbol_table *donor_symbol_table = get_instance (donor_scope); - - if (donor_symbol_table) - inst->do_inherit (*donor_symbol_table, donor_context); - } - } - - static bool at_top_level (void) { return xcurrent_scope == xtop_scope; } - - // Find a value corresponding to the given name in the table. - static octave_value - find (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool skip_variables = false, - bool local_funcs = true); - - static octave_value builtin_find (const std::string& name); - - // Insert a new name in the table. - static symbol_record& insert (const std::string& name) - { - static symbol_record foobar; - - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_insert (name) : foobar; - } - - static void force_variable (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_force_variable (name, context); - } - - static octave_value& varref (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - static octave_value foobar; - - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varref (name, context) : foobar; - } - - static octave_value varval (const std::string& name, - scope_id scope = xcurrent_scope, - context_id context = xdefault_context) - { - symbol_table *inst = get_instance (scope); - - return inst ? inst->do_varval (name, context) : octave_value (); - } - - static octave_value& - global_varref (const std::string& name) - { - global_table_iterator p = global_table.find (name); - - return (p == global_table.end ()) ? global_table[name] : p->second; - } - - static octave_value - global_varval (const std::string& name) - { - global_table_const_iterator p = global_table.find (name); - - return (p != global_table.end ()) ? p->second : octave_value (); - } - - static octave_value& - top_level_varref (const std::string& name) - { - return varref (name, top_scope (), 0); - } - - static octave_value - top_level_varval (const std::string& name) - { - return varval (name, top_scope (), 0); - } - - static octave_value& persistent_varref (const std::string& name) - { - static octave_value foobar; - - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varref (name) : foobar; - } - - static octave_value persistent_varval (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_persistent_varval (name) : octave_value (); - } - - static void erase_persistent (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_erase_persistent (name); - } - - static bool is_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_variable (name) : false; - } - - static bool - is_built_in_function_name (const std::string& name) - { - octave_value val = find_built_in_function (name); - - return val.is_defined (); - } - - static octave_value - find_method (const std::string& name, const std::string& dispatch_type) - { - fcn_table_const_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - return p->second.find_method (dispatch_type); - else - { - fcn_info finfo (name); - - octave_value fcn = finfo.find_method (dispatch_type); - - if (fcn.is_defined ()) - fcn_table[name] = finfo; - - return fcn; - } - } - - static octave_value - find_built_in_function (const std::string& name) - { - fcn_table_const_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_built_in_function () : octave_value (); - } - - static octave_value - find_autoload (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_autoload () : octave_value (); - } - - static octave_value - find_function (const std::string& name, - const octave_value_list& args = octave_value_list (), - bool local_funcs = true); - - static octave_value find_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - return (p != fcn_table.end ()) - ? p->second.find_user_function () : octave_value (); - } - - static void install_cmdline_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_cmdline_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_cmdline_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void install_subfunction (const std::string& name, - const octave_value& fcn, - scope_id scope) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_subfunction (fcn, scope); - } - else - { - fcn_info finfo (name); - - finfo.install_subfunction (fcn, scope); - - fcn_table[name] = finfo; - } - } - - static void install_nestfunction (const std::string& name, - const octave_value& fcn, - scope_id parent_scope); - - static void update_nest (scope_id scope) - { - symbol_table *inst = get_instance (scope); - if (inst) - inst->do_update_nest (); - } - - static void install_user_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_user_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_user_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void install_built_in_function (const std::string& name, - const octave_value& fcn) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.install_built_in_function (fcn); - } - else - { - fcn_info finfo (name); - - finfo.install_built_in_function (fcn); - - fcn_table[name] = finfo; - } - } - - static void clear (const std::string& name) - { - clear_variable (name); - } - - static void clear_all (void) - { - clear_variables (); - - clear_global_pattern ("*"); - - clear_functions (); - } - - static void clear_variables (scope_id scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_variables (); - } - - // This is split for unwind_protect. - static void clear_variables (void) - { - clear_variables (xcurrent_scope); - } - - static void clear_objects (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_clear_objects (); - } - - static void unmark_forced_variables (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - - if (inst) - inst->do_unmark_forced_variables (); - } - - static void clear_functions (void) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - p->second.clear (); - } - - static void clear_function (const std::string& name) - { - clear_user_function (name); - } - - static void clear_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global (name); - } - - static void clear_variable (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable (name); - } - - static void clear_symbol (const std::string& name) - { - // FIXME -- are we supposed to do both here? - - clear_variable (name); - clear_function (name); - } - - static void clear_function_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - if (pattern.match (p->first)) - p->second.clear_user_function (); - } - } - - static void clear_global_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_global_pattern (pat); - } - - static void clear_variable_pattern (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_pattern (pat); - } - - static void clear_variable_regexp (const std::string& pat) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_clear_variable_regexp (pat); - } - - static void clear_symbol_pattern (const std::string& pat) - { - // FIXME -- are we supposed to do both here? - - clear_variable_pattern (pat); - clear_function_pattern (pat); - } - - static void clear_user_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_user_function (); - } - // FIXME -- is this necessary, or even useful? - // else - // error ("clear: no such function `%s'", name.c_str ()); - } - - // This clears oct and mex files, incl. autoloads. - static void clear_dld_function (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_autoload_function (); - finfo.clear_user_function (); - } - } - - static void clear_mex_functions (void) - { - for (fcn_table_iterator p = fcn_table.begin (); p != fcn_table.end (); p++) - { - fcn_info& finfo = p->second; - - finfo.clear_mex_function (); - } - } - - static bool set_class_relationship (const std::string& sup_class, - const std::string& inf_class); - - static bool is_superiorto (const std::string& a, const std::string& b); - - static void alias_built_in_function (const std::string& alias, - const std::string& name) - { - octave_value fcn = find_built_in_function (name); - - if (fcn.is_defined ()) - { - fcn_info finfo (alias); - - finfo.install_built_in_function (fcn); - - fcn_table[alias] = finfo; - } - else - panic ("alias: `%s' is undefined", name.c_str ()); - } - - static void add_dispatch (const std::string& name, const std::string& type, - const std::string& fname) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.add_dispatch (type, fname); - } - else - { - fcn_info finfo (name); - - finfo.add_dispatch (type, fname); - - fcn_table[name] = finfo; - } - } - - static void clear_dispatch (const std::string& name, const std::string& type) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.clear_dispatch (type); - } - } - - static void print_dispatch (std::ostream& os, const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - finfo.print_dispatch (os); - } - } - - static fcn_info::dispatch_map_type get_dispatch (const std::string& name) - { - fcn_info::dispatch_map_type retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.get_dispatch (); - } - - return retval; - } - - static std::string help_for_dispatch (const std::string& name) - { - std::string retval; - - fcn_table_iterator p = fcn_table.find (name); - - if (p != fcn_table.end ()) - { - fcn_info& finfo = p->second; - - retval = finfo.help_for_dispatch (); - } - - return retval; - } - - static void push_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::push_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_push_context (); - } - } - - static void pop_context (void) - { - if (xcurrent_scope == xglobal_scope || xcurrent_scope == xtop_scope) - error ("invalid call to xymtab::pop_context"); - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_pop_context (); - } - } - - // For unwind_protect. - static void pop_context (void *) { pop_context (); } - - static void mark_automatic (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_automatic (name); - } - - static void mark_hidden (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_hidden (name); - } - - static void mark_global (const std::string& name) - { - symbol_table *inst = get_instance (xcurrent_scope); - - if (inst) - inst->do_mark_global (name); - } - - static std::list - all_variables (scope_id scope = xcurrent_scope, - context_id context = xdefault_context, - bool defined_only = true) - { - symbol_table *inst = get_instance (scope); - - return inst - ? inst->do_all_variables (context, defined_only) : std::list (); - } - - static std::list glob (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern) : std::list (); - } - - static std::list regexp (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern) : std::list (); - } - - static std::list glob_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_glob (pattern, true) : std::list (); - } - - static std::list regexp_variables (const std::string& pattern) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_regexp (pattern, true) : std::list (); - } - - static std::list - glob_global_variables (const std::string& pattern) - { - std::list retval; - - glob_match pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from glob_variables and glob_global_variables - // may be handled the same way. - - if (pat.match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list - regexp_global_variables (const std::string& pattern) - { - std::list retval; - - ::regexp pat (pattern); - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - { - // We generate a list of symbol_record objects so that - // the results from regexp_variables and regexp_global_variables - // may be handled the same way. - - if (pat.is_match (p->first)) - retval.push_back (symbol_record (xglobal_scope, - p->first, p->second, - symbol_record::global)); - } - - return retval; - } - - static std::list glob_variables (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = glob_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list regexp_variables - (const string_vector& patterns) - { - std::list retval; - - size_t len = patterns.length (); - - for (size_t i = 0; i < len; i++) - { - std::list tmp = regexp_variables (patterns[i]); - - retval.insert (retval.begin (), tmp.begin (), tmp.end ()); - } - - return retval; - } - - static std::list user_function_names (void) - { - std::list retval; - - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - if (p->second.is_user_function_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list global_variable_names (void) - { - std::list retval; - - for (global_table_const_iterator p = global_table.begin (); - p != global_table.end (); p++) - retval.push_back (p->first); - - retval.sort (); - - return retval; - } - - static std::list top_level_variable_names (void) - { - symbol_table *inst = get_instance (xtop_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list variable_names (void) - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_variable_names () : std::list (); - } - - static std::list built_in_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_built_in_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static std::list cmdline_function_names (void) - { - std::list retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - octave_value fcn = p->second.find_cmdline_function (); - - if (fcn.is_defined ()) - retval.push_back (p->first); - } - - if (! retval.empty ()) - retval.sort (); - - return retval; - } - - static bool is_local_variable (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return false; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_local_variable (name) : false; - } - } - - static bool is_global (const std::string& name) - { - if (xcurrent_scope == xglobal_scope) - return true; - else - { - symbol_table *inst = get_instance (xcurrent_scope); - - return inst ? inst->do_is_global (name) : false; - } - } - - static void dump (std::ostream& os, scope_id scope = xcurrent_scope); - - static void dump_global (std::ostream& os); - - static void dump_functions (std::ostream& os); - - static void cache_name (scope_id scope, const std::string& name) - { - symbol_table *inst = get_instance (scope, false); - - if (inst) - inst->do_cache_name (name); - } - - static void lock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.lock_subfunction (scope); - } - - static void unlock_subfunctions (scope_id scope = xcurrent_scope) - { - for (fcn_table_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - p->second.unlock_subfunction (scope); - } - - static void free_scope (scope_id scope) - { - if (scope == xglobal_scope || scope == xtop_scope) - error ("can't free global or top-level scopes!"); - else - symbol_table::scope_id_cache::free (scope); - } - - static void stash_dir_name_for_subfunctions (scope_id scope, - const std::string& dir_name); - - static void add_to_parent_map (const std::string& classname, - const std::list& parent_list) - { - parent_map[classname] = parent_list; - } - - static std::list - parent_classes (const std::string& dispatch_type) - { - std::list retval; - - const_parent_map_iterator it = parent_map.find (dispatch_type); - - if (it != parent_map.end ()) - retval = it->second; - - for (std::list::const_iterator lit = retval.begin (); - lit != retval.end (); lit++) - { - // Search for parents of parents and append them to the list. - - // FIXME -- should we worry about a circular inheritance graph? - - std::list parents = parent_classes (*lit); - - if (! parents.empty ()) - retval.insert (retval.end (), parents.begin (), parents.end ()); - } - - return retval; - } - - static octave_user_function *get_curr_fcn (scope_id scope = xcurrent_scope) - { - symbol_table *inst = get_instance (scope); - return inst->curr_fcn; - } - - static void set_curr_fcn (octave_user_function *curr_fcn, - scope_id scope = xcurrent_scope) - { - assert (scope != xtop_scope && scope != xglobal_scope); - symbol_table *inst = get_instance (scope); - // FIXME: normally, functions should not usurp each other's scope. - // If for any incredible reason this is needed, call - // set_user_function (0, scope) first. This may cause problems with - // nested functions, as the curr_fcn of symbol_records must be updated. - assert (inst->curr_fcn == 0 || curr_fcn == 0); - inst->curr_fcn = curr_fcn; - } - - static void cleanup (void); - -private: - - // No copying! - - symbol_table (const symbol_table&); - - symbol_table& operator = (const symbol_table&); - - typedef std::map::const_iterator table_const_iterator; - typedef std::map::iterator table_iterator; - - typedef std::map::const_iterator global_table_const_iterator; - typedef std::map::iterator global_table_iterator; - - typedef std::map::const_iterator persistent_table_const_iterator; - typedef std::map::iterator persistent_table_iterator; - - typedef std::map::const_iterator all_instances_const_iterator; - typedef std::map::iterator all_instances_iterator; - - typedef std::map::const_iterator fcn_table_const_iterator; - typedef std::map::iterator fcn_table_iterator; - - // The scope of this symbol table. - scope_id my_scope; - - // Name for this table (usually the file name of the function - // corresponding to the scope); - std::string table_name; - - // Map from symbol names to symbol info. - std::map table; - - // Child nested functions. - std::vector nest_children; - - // Parent nested function (may be null). - symbol_table *nest_parent; - - // The associated user code (may be null). - octave_user_function *curr_fcn; - - // Map from names of global variables to values. - static std::map global_table; - - // Map from names of persistent variables to values. - std::map persistent_table; - - // Pointer to symbol table for current scope (variables only). - static symbol_table *instance; - - // Map from scope id to symbol table instances. - static std::map all_instances; - - // Map from function names to function info (subfunctions, private - // functions, class constructors, class methods, etc.) - static std::map fcn_table; - - // Mape from class names to set of classes that have lower - // precedence. - static std::map > class_precedence_table; - - typedef std::map >::const_iterator class_precedence_table_const_iterator; - typedef std::map >::iterator class_precedence_table_iterator; - - // Map from class names to parent class names. - static std::map > parent_map; - - typedef std::map >::const_iterator const_parent_map_iterator; - typedef std::map >::iterator parent_map_iterator; - - static const scope_id xglobal_scope; - static const scope_id xtop_scope; - - static scope_id xcurrent_scope; - - static context_id xcurrent_context; - - static const context_id xdefault_context = static_cast (-1); - - symbol_table (scope_id scope) - : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), - curr_fcn (0), persistent_table () { } - - ~symbol_table (void) { } - - static symbol_table *get_instance (scope_id scope, bool create = true) - { - symbol_table *retval = 0; - - bool ok = true; - - if (scope != xglobal_scope) - { - if (scope == xcurrent_scope) - { - if (! instance && create) - { - symbol_table *inst = new symbol_table (scope); - - if (inst) - { - all_instances[scope] = instance = inst; - - if (scope == xtop_scope) - instance->do_cache_name ("top-level"); - } - } - - if (! instance) - ok = false; - - retval = instance; - } - else - { - all_instances_iterator p = all_instances.find (scope); - - if (p == all_instances.end ()) - { - if (create) - { - retval = new symbol_table (scope); - - if (retval) - all_instances[scope] = retval; - else - ok = false; - } - else - ok = false; - } - else - retval = p->second; - } - } - - if (! ok) - error ("unable to %s symbol_table object for scope %d!", - create ? "create" : "find", scope); - - return retval; - } - - void add_nest_child (symbol_table& st) - { - assert (!st.nest_parent); - nest_children.push_back (&st); - st.nest_parent = this; - } - - void insert_symbol_record (const symbol_record& sr) - { - table[sr.name ()] = sr; - } - - void - do_dup_scope (symbol_table& new_symbol_table) const - { - for (table_const_iterator p = table.begin (); p != table.end (); p++) - new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); - } - - symbol_record do_find_symbol (const std::string& name) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - return do_insert (name); - else - return p->second; - } - - void do_inherit (symbol_table& donor_table, context_id donor_context) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (! (sr.is_automatic () || sr.is_formal ())) - { - std::string nm = sr.name (); - - if (nm != "__retval__") - { - octave_value val = donor_table.do_varval (nm, donor_context); - - if (val.is_defined ()) - { - sr.varref (0) = val; - - sr.mark_inherited (); - } - } - } - } - } - - static fcn_info *get_fcn_info (const std::string& name) - { - fcn_table_iterator p = fcn_table.find (name); - return p != fcn_table.end () ? &p->second : 0; - } - - octave_value - do_find (const std::string& name, const octave_value_list& args, - bool skip_variables, bool local_funcs); - - octave_value do_builtin_find (const std::string& name); - - symbol_record& do_insert (const std::string& name) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record parent_symbol; - - if (nest_parent && nest_parent->look_nonlocal (name, parent_symbol)) - return table[name] = parent_symbol; - else - return table[name] = symbol_record (my_scope, name, octave_value ()); - } - else - return p->second; - } - - void do_force_variable (const std::string& name, context_id context) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name); - - sr.force_variable (context); - } - else - p->second.force_variable (context); - } - - octave_value& do_varref (const std::string& name, context_id context) - { - table_iterator p = table.find (name); - - if (p == table.end ()) - { - symbol_record& sr = do_insert (name); - - return sr.varref (context); - } - else - return p->second.varref (context); - } - - octave_value do_varval (const std::string& name, context_id context) const - { - table_const_iterator p = table.find (name); - - return (p != table.end ()) ? p->second.varval (context) : octave_value (); - } - - octave_value& do_persistent_varref (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - return (p == persistent_table.end ()) - ? persistent_table[name] : p->second; - } - - octave_value do_persistent_varval (const std::string& name) - { - persistent_table_const_iterator p = persistent_table.find (name); - - return (p != persistent_table.end ()) ? p->second : octave_value (); - } - - void do_erase_persistent (const std::string& name) - { - persistent_table_iterator p = persistent_table.find (name); - - if (p != persistent_table.end ()) - persistent_table.erase (p); - } - - bool do_is_variable (const std::string& name) const - { - bool retval = false; - - table_const_iterator p = table.find (name); - - if (p != table.end ()) - { - const symbol_record& sr = p->second; - - retval = sr.is_variable (); - } - - return retval; - } - - void do_push_context (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.push_context (my_scope); - } - - void do_pop_context (void) - { - for (table_iterator p = table.begin (); p != table.end (); ) - { - if (p->second.pop_context (my_scope) == 0) - table.erase (p++); - else - p++; - } - } - - void do_clear_variables (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.clear (my_scope); - } - - void do_clear_objects (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - octave_value& val = sr.varref (); - if (val.is_object ()) - p->second.clear (my_scope); - } - } - - void do_unmark_forced_variables (void) - { - for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.unmark_forced (); - } - - void do_clear_global (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - { - symbol_record& sr = p->second; - - if (sr.is_global ()) - sr.unmark_global (); - } - - global_table_iterator q = global_table.find (name); - - if (q != global_table.end ()) - global_table.erase (q); - - } - - void do_clear_variable (const std::string& name) - { - table_iterator p = table.find (name); - - if (p != table.end ()) - p->second.clear (my_scope); - } - - void do_clear_global_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_global () && pattern.match (sr.name ())) - sr.unmark_global (); - } - - - for (global_table_iterator q = global_table.begin (); - q != global_table.end ();) - { - if (pattern.match (q->first)) - global_table.erase (q++); //Gotta be careful to not - //invalidate iterators - else - q++; - } - - - } - - void do_clear_variable_pattern (const std::string& pat) - { - glob_match pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_clear_variable_regexp (const std::string& pat) - { - ::regexp pattern (pat); - - for (table_iterator p = table.begin (); p != table.end (); p++) - { - symbol_record& sr = p->second; - - if (sr.is_defined () || sr.is_global ()) - { - if (pattern.is_match (sr.name ())) - sr.clear (my_scope); - } - } - } - - void do_mark_automatic (const std::string& name) - { - do_insert (name).mark_automatic (); - } - - void do_mark_hidden (const std::string& name) - { - do_insert (name).mark_hidden (); - } - - void do_mark_global (const std::string& name) - { - do_insert (name).mark_global (); - } - - std::list - do_all_variables (context_id context, bool defined_only) const - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - const symbol_record& sr = p->second; - - if (defined_only && ! sr.is_defined (context)) - continue; - - retval.push_back (sr); - } - - return retval; - } - - std::list do_glob (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - glob_match pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_regexp (const std::string& pattern, - bool vars_only = false) const - { - std::list retval; - - ::regexp pat (pattern); - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (pat.is_match (p->first)) - { - const symbol_record& sr = p->second; - - if (vars_only && ! sr.is_variable ()) - continue; - - retval.push_back (sr); - } - } - - return retval; - } - - std::list do_variable_names (void) - { - std::list retval; - - for (table_const_iterator p = table.begin (); p != table.end (); p++) - { - if (p->second.is_variable ()) - retval.push_back (p->first); - } - - retval.sort (); - - return retval; - } - - static std::map - subfunctions_defined_in_scope (scope_id scope = xcurrent_scope) - { - std::map retval; - - for (fcn_table_const_iterator p = fcn_table.begin (); - p != fcn_table.end (); p++) - { - std::pair tmp - = p->second.subfunction_defined_in_scope (scope); - - std::string nm = tmp.first; - - if (! nm.empty ()) - retval[nm] = tmp.second; - } - - return retval; - } - - bool do_is_local_variable (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return (p != table.end () - && ! p->second.is_global () - && p->second.is_defined ()); - } - - bool do_is_global (const std::string& name) const - { - table_const_iterator p = table.find (name); - - return p != table.end () && p->second.is_global (); - } - - void do_dump (std::ostream& os); - - void do_cache_name (const std::string& name) { table_name = name; } - - void do_update_nest (void); - - bool look_nonlocal (const std::string& name, symbol_record& result) - { - table_iterator p = table.find (name); - if (p == table.end ()) - { - if (nest_parent) - return nest_parent->look_nonlocal (name, result); - } - else if (! p->second.is_automatic ()) - { - result = p->second; - return true; - } - - return false; - } -}; - -extern bool out_of_date_check (octave_value& function, - const std::string& dispatch_type = std::string (), - bool check_relative = true); - -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args); -extern OCTINTERP_API std::string -get_dispatch_type (const octave_value_list& args, builtin_type_t& builtin_type); - -#endif diff -r 069c552587a0 -r 959953dba519 src/syscalls.cc --- a/src/syscalls.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1943 +0,0 @@ -/* - -Copyright (C) 1996-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -// Thomas Baier added the original versions of -// the following functions: -// -// mkfifo unlink waitpid - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include - -#include - -#include "file-ops.h" -#include "file-stat.h" -#include "oct-env.h" -#include "oct-syscalls.h" -#include "oct-uname.h" - -#include "defun.h" -#include "error.h" -#include "gripes.h" -#include "lo-utils.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "oct-stdstrm.h" -#include "oct-stream.h" -#include "sysdep.h" -#include "utils.h" -#include "variables.h" -#include "input.h" - -static octave_scalar_map -mk_stat_map (const base_file_stat& fs) -{ - octave_scalar_map m; - - m.assign ("dev", static_cast (fs.dev ())); - m.assign ("ino", fs.ino ()); - m.assign ("mode", fs.mode ()); - m.assign ("modestr", fs.mode_as_string ()); - m.assign ("nlink", fs.nlink ()); - m.assign ("uid", fs.uid ()); - m.assign ("gid", fs.gid ()); -#if defined (HAVE_STRUCT_STAT_ST_RDEV) - m.assign ("rdev", static_cast (fs.rdev ())); -#endif - m.assign ("size", fs.size ()); - m.assign ("atime", fs.atime ()); - m.assign ("mtime", fs.mtime ()); - m.assign ("ctime", fs.ctime ()); -#if defined (HAVE_STRUCT_STAT_ST_BLKSIZE) - m.assign ("blksize", fs.blksize ()); -#endif -#if defined (HAVE_STRUCT_STAT_ST_BLOCKS) - m.assign ("blocks", fs.blocks ()); -#endif - - return m; -} - -static octave_value_list -mk_stat_result (const base_file_stat& fs) -{ - octave_value_list retval; - - if (fs) - { - retval(2) = std::string (); - retval(1) = 0; - retval(0) = octave_value (mk_stat_map (fs)); - } - else - { - retval(2) = fs.error (); - retval(1) = -1; - retval(0) = Matrix (); - } - - return retval; -} - -DEFUNX ("dup2", Fdup2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{fid}, @var{msg}] =} dup2 (@var{old}, @var{new})\n\ -Duplicate a file descriptor.\n\ -\n\ -If successful, @var{fid} is greater than zero and contains the new file\n\ -ID@. Otherwise, @var{fid} is negative and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - octave_stream old_stream - = octave_stream_list::lookup (args(0), "dup2"); - - if (! error_state) - { - octave_stream new_stream - = octave_stream_list::lookup (args(1), "dup2"); - - if (! error_state) - { - int i_old = old_stream.file_number (); - int i_new = new_stream.file_number (); - - if (i_old >= 0 && i_new >= 0) - { - std::string msg; - - int status = octave_syscalls::dup2 (i_old, i_new, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("dup2: invalid stream"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("exec", Fexec, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} exec (@var{file}, @var{args})\n\ -Replace current process with a new process. Calling @code{exec} without\n\ -first calling @code{fork} will terminate your current Octave process and\n\ -replace it with the program named by @var{file}. For example,\n\ -\n\ -@example\n\ -exec (\"ls\" \"-l\")\n\ -@end example\n\ -\n\ -@noindent\n\ -will run @code{ls} and return you to your shell prompt.\n\ -\n\ -If successful, @code{exec} does not return. If @code{exec} does return,\n\ -@var{err} will be nonzero, and @var{msg} will contain a system-dependent\n\ -error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector exec_args; - - if (nargin == 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - exec_args.resize (len + 1); - - exec_args[0] = exec_file; - - for (int i = 0; i < len; i++) - exec_args[i+1] = tmp[i]; - } - else - error ("exec: arguments must be character strings"); - } - else - { - exec_args.resize (1); - - exec_args[0] = exec_file; - } - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::execvp (exec_file, exec_args, msg); - - retval(1) = msg; - retval(0) = status; - } - } - else - error ("exec: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("popen2", Fpopen2, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{in}, @var{out}, @var{pid}] =} popen2 (@var{command}, @var{args})\n\ -Start a subprocess with two-way communication. The name of the process\n\ -is given by @var{command}, and @var{args} is an array of strings\n\ -containing options for the command. The file identifiers for the input\n\ -and output streams of the subprocess are returned in @var{in} and\n\ -@var{out}. If execution of the command is successful, @var{pid}\n\ -contains the process ID of the subprocess. Otherwise, @var{pid} is\n\ -@minus{}1.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[in, out, pid] = popen2 (\"sort\", \"-r\");\n\ -fputs (in, \"these\\nare\\nsome\\nstrings\\n\");\n\ -fclose (in);\n\ -EAGAIN = errno (\"EAGAIN\");\n\ -done = false;\n\ -do\n\ - s = fgets (out);\n\ - if (ischar (s))\n\ - fputs (stdout, s);\n\ - elseif (errno () == EAGAIN)\n\ - sleep (0.1);\n\ - fclear (out);\n\ - else\n\ - done = true;\n\ - endif\n\ -until (done)\n\ -fclose (out);\n\ -waitpid (pid);\n\ -\n\ - @print{} these\n\ - @print{} strings\n\ - @print{} some\n\ - @print{} are\n\ -@end example\n\ -\n\ -Note that @code{popen2}, unlike @code{popen}, will not \"reap\" the\n\ -child process. If you don't use @code{waitpid} to check the child's\n\ -exit status, it will linger until Octave exits.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = -1; - retval(1) = Matrix (); - retval(0) = Matrix (); - - int nargin = args.length (); - - if (nargin >= 1 && nargin <= 3) - { - std::string exec_file = args(0).string_value (); - - if (! error_state) - { - string_vector arg_list; - - if (nargin >= 2) - { - string_vector tmp = args(1).all_strings (); - - if (! error_state) - { - int len = tmp.length (); - - arg_list.resize (len + 1); - - arg_list[0] = exec_file; - - for (int i = 0; i < len; i++) - arg_list[i+1] = tmp[i]; - } - else - error ("popen2: arguments must be character strings"); - } - else - { - arg_list.resize (1); - - arg_list[0] = exec_file; - } - - if (! error_state) - { - bool sync_mode = (nargin == 3 ? args(2).bool_value () : false); - - if (! error_state) - { - int fildes[2]; - std::string msg; - pid_t pid; - - pid = octave_syscalls::popen2 (exec_file, arg_list, sync_mode, fildes, msg, interactive); - if (pid >= 0) - { - FILE *ifile = fdopen (fildes[1], "r"); - FILE *ofile = fdopen (fildes[0], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - Cell file_ids (1, 2); - - retval(2) = pid; - retval(1) = octave_stream_list::insert (is); - retval(0) = octave_stream_list::insert (os); - } - else - error (msg.c_str ()); - } - } - else - error ("popen2: arguments must be character strings"); - } - else - error ("popen2: COMMAND argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! [in, out, pid] = popen2 ("sort", "-r"); -%! EAGAIN = errno ("EAGAIN"); -%! else -%! [in, out, pid] = popen2 ("sort", "/R"); -%! EAGAIN = errno ("EINVAL"); -%! endif -%! fputs (in, "these\nare\nsome\nstrings\n"); -%! fclose (in); -%! done = false; -%! str = {}; -%! idx = 0; -%! errs = 0; -%! do -%! if (!isunix ()) -%! errno (0); -%! endif -%! s = fgets (out); -%! if (ischar (s)) -%! idx++; -%! str{idx} = s; -%! elseif (errno () == EAGAIN) -%! fclear (out); -%! sleep (0.1); -%! if (++errs == 100) -%! done = true; -%! endif -%! else -%! done = true; -%! endif -%! until (done) -%! fclose (out); -%! if (isunix ()) -%! assert (str, {"these\n","strings\n","some\n","are\n"}); -%! else -%! assert (str, {"these\r\n","strings\r\n","some\r\n","are\r\n"}); -%! endif -*/ - -DEFUNX ("fcntl", Ffcntl, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} fcntl (@var{fid}, @var{request}, @var{arg})\n\ -Change the properties of the open file @var{fid}. The following values\n\ -may be passed as @var{request}:\n\ -\n\ -@vtable @code\n\ -@item F_DUPFD\n\ -Return a duplicate file descriptor.\n\ -\n\ -@item F_GETFD\n\ -Return the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_SETFD\n\ -Set the file descriptor flags for @var{fid}.\n\ -\n\ -@item F_GETFL\n\ -Return the file status flags for @var{fid}. The following codes may be\n\ -returned (some of the flags may be undefined on some systems).\n\ -\n\ -@vtable @code\n\ -@item O_RDONLY\n\ -Open for reading only.\n\ -\n\ -@item O_WRONLY\n\ -Open for writing only.\n\ -\n\ -@item O_RDWR\n\ -Open for reading and writing.\n\ -\n\ -@item O_APPEND\n\ -Append on each write.\n\ -\n\ -@item O_CREAT\n\ -Create the file if it does not exist.\n\ -\n\ -@item O_NONBLOCK\n\ -Non-blocking mode.\n\ -\n\ -@item O_SYNC\n\ -Wait for writes to complete.\n\ -\n\ -@item O_ASYNC\n\ -Asynchronous I/O.\n\ -@end vtable\n\ -\n\ -@item F_SETFL\n\ -Set the file status flags for @var{fid} to the value specified by\n\ -@var{arg}. The only flags that can be changed are @w{@code{O_APPEND}} and\n\ -@w{@code{O_NONBLOCK}}.\n\ -@end vtable\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 3) - { - octave_stream strm = octave_stream_list::lookup (args (0), "fcntl"); - - if (! error_state) - { - int fid = strm.file_number (); - - int req = args(1).int_value (true); - int arg = args(2).int_value (true); - - if (! error_state) - { - // FIXME -- Need better checking here? - if (fid < 0) - error ("fcntl: invalid file id"); - else - { - std::string msg; - - int status = octave_fcntl (fid, req, arg, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - error ("fcntl: FID, REQUEST, and ARG must be integers"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("fork", Ffork, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{msg}] =} fork ()\n\ -Create a copy of the current process.\n\ -\n\ -Fork can return one of the following values:\n\ -\n\ -@table @asis\n\ -@item > 0\n\ -You are in the parent process. The value returned from @code{fork} is\n\ -the process id of the child process. You should probably arrange to\n\ -wait for any child processes to exit.\n\ -\n\ -@item 0\n\ -You are in the child process. You can call @code{exec} to start another\n\ -process. If that fails, you should probably call @code{exit}.\n\ -\n\ -@item < 0\n\ -The call to @code{fork} failed for some reason. You must take evasive\n\ -action. A system dependent error message will be waiting in @var{msg}.\n\ -@end table\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - pid_t pid = octave_syscalls::fork (msg); - - retval(1) = msg; - retval(0) = pid; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpgrp", Fgetpgrp, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pgid =} getpgrp ()\n\ -Return the process group id of the current process.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - std::string msg; - - retval(1) = msg; - retval(0) = octave_syscalls::getpgrp (msg); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("getpid", Fgetpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getpid ()\n\ -Return the process id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getpid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getppid", Fgetppid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {pid =} getppid ()\n\ -Return the process id of the parent process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getppid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getegid", Fgetegid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {egid =} getegid ()\n\ -Return the effective group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getegid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getgid", Fgetgid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {gid =} getgid ()\n\ -Return the real group id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getgid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("geteuid", Fgeteuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {euid =} geteuid ()\n\ -Return the effective user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::geteuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("getuid", Fgetuid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {uid =} getuid ()\n\ -Return the real user id of the current process.\n\ -@end deftypefn") -{ - octave_value retval = -1; - - int nargin = args.length (); - - if (nargin == 0) - retval = octave_syscalls::getuid (); - else - print_usage (); - - return retval; -} - -DEFUNX ("kill", Fkill, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} kill (@var{pid}, @var{sig})\n\ -Send signal @var{sig} to process @var{pid}.\n\ -\n\ -If @var{pid} is positive, then signal @var{sig} is sent to @var{pid}.\n\ -\n\ -If @var{pid} is 0, then signal @var{sig} is sent to every process\n\ -in the process group of the current process.\n\ -\n\ -If @var{pid} is -1, then signal @var{sig} is sent to every process\n\ -except process 1.\n\ -\n\ -If @var{pid} is less than -1, then signal @var{sig} is sent to every\n\ -process in the process group @var{-pid}.\n\ -\n\ -If @var{sig} is 0, then no signal is sent, but error checking is still\n\ -performed.\n\ -\n\ -Return 0 if successful, otherwise return -1.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - if (args.length () == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int sig = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = octave_syscalls::kill (pid, sig, msg); - - retval(1) = msg; - retval(0) = status; - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("lstat", Flstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{symlink})\n\ -Return a structure @var{info} containing information about the symbolic link\n\ -@var{symlink}. The function outputs are described in the documentation for\n\ -@code{stat}.\n\ -@seealso{stat}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname, false); - - retval = mk_stat_result (fs); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("mkfifo", Fmkfifo, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} mkfifo (@var{name}, @var{mode})\n\ -Create a @var{fifo} special file named @var{name} with file mode @var{mode}\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 2) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - if (args(1).is_scalar_type ()) - { - long mode = args(1).long_value (); - - if (! error_state) - { - std::string msg; - - int status = octave_mkfifo (name, mode, msg); - - retval(0) = status; - - if (status < 0) - retval(1) = msg; - } - else - error ("mkfifo: invalid MODE"); - } - else - error ("mkfifo: MODE must be an integer"); - } - else - error ("mkfifo: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("pipe", Fpipe, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{read_fd}, @var{write_fd}, @var{err}, @var{msg}] =} pipe ()\n\ -Create a pipe and return the reading and writing ends of the pipe\n\ -into @var{read_fd} and @var{write_fd} respectively.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(3) = std::string (); - retval(2) = -1; - retval(1) = -1; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 0) - { - int fid[2]; - - std::string msg; - - int status = octave_syscalls::pipe (fid, msg); - - if (status < 0) - retval(3) = msg; - else - { - FILE *ifile = fdopen (fid[0], "r"); - FILE *ofile = fdopen (fid[1], "w"); - - std::string nm; - - octave_stream is = octave_stdiostream::create (nm, ifile, - std::ios::in); - - octave_stream os = octave_stdiostream::create (nm, ofile, - std::ios::out); - - retval(2) = status; - retval(1) = octave_stream_list::insert (os); - retval(0) = octave_stream_list::insert (is); - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("stat", Fstat, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} stat (@var{fid})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{file})\n\ -@deftypefnx {Built-in Function} {[@var{info}, @var{err}, @var{msg}] =} lstat (@var{fid})\n\ -Return a structure @var{info} containing the following information about\n\ -@var{file} or file identifier @var{fid}.\n\ -\n\ -@table @code\n\ -@item dev\n\ -ID of device containing a directory entry for this file.\n\ -\n\ -@item ino\n\ -File number of the file.\n\ -\n\ -@item mode\n\ -File mode, as an integer. Use the functions @w{@code{S_ISREG}},\n\ -@w{@code{S_ISDIR}}, @w{@code{S_ISCHR}}, @w{@code{S_ISBLK}}, @w{@code{S_ISFIFO}},\n\ -@w{@code{S_ISLNK}}, or @w{@code{S_ISSOCK}} to extract information from this\n\ -value.\n\ -\n\ -@item modestr\n\ -File mode, as a string of ten letters or dashes as would be returned by\n\ -@kbd{ls -l}.\n\ -\n\ -@item nlink\n\ -Number of links.\n\ -\n\ -@item uid\n\ -User ID of file's owner.\n\ -\n\ -@item gid\n\ -Group ID of file's group.\n\ -\n\ -@item rdev\n\ -ID of device for block or character special files.\n\ -\n\ -@item size\n\ -Size in bytes.\n\ -\n\ -@item atime\n\ -Time of last access in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item mtime\n\ -Time of last modification in the same form as time values returned from\n\ -@code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item ctime\n\ -Time of last file status change in the same form as time values\n\ -returned from @code{time}. @xref{Timing Utilities}.\n\ -\n\ -@item blksize\n\ -Size of blocks in the file.\n\ -\n\ -@item blocks\n\ -Number of blocks allocated for file.\n\ -@end table\n\ -\n\ -If the call is successful @var{err} is 0 and @var{msg} is an empty\n\ -string. If the file does not exist, or some other error occurs, @var{s}\n\ -is an empty matrix, @var{err} is @minus{}1, and @var{msg} contains the\n\ -corresponding system error message.\n\ -\n\ -If @var{file} is a symbolic link, @code{stat} will return information\n\ -about the actual file that is referenced by the link. Use @code{lstat}\n\ -if you want information about the symbolic link itself.\n\ -\n\ -For example:\n\ -\n\ -@example\n\ -[s, err, msg] = stat (\"/vmlinuz\")\n\ - @result{} s =\n\ - @{\n\ - atime = 855399756\n\ - rdev = 0\n\ - ctime = 847219094\n\ - uid = 0\n\ - size = 389218\n\ - blksize = 4096\n\ - mtime = 847219094\n\ - gid = 6\n\ - nlink = 1\n\ - blocks = 768\n\ - mode = -rw-r--r--\n\ - modestr = -rw-r--r--\n\ - ino = 9316\n\ - dev = 2049\n\ - @}\n\ - @result{} err = 0\n\ - @result{} msg =\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - if (args(0).is_scalar_type ()) - { - int fid = octave_stream_list::get_file_number (args(0)); - - if (! error_state) - { - file_fstat fs (fid); - - retval = mk_stat_result (fs); - } - } - else - { - std::string fname = args(0).string_value (); - - if (! error_state) - { - file_stat fs (fname); - - retval = mk_stat_result (fs); - } - } - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISREG", FS_ISREG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISREG (@var{mode})\n\ -Return true if @var{mode} corresponds to a regular file. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_reg (static_cast (mode)); - else - error ("S_ISREG: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISDIR", FS_ISDIR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISDIR (@var{mode})\n\ -Return true if @var{mode} corresponds to a directory. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_dir (static_cast (mode)); - else - error ("S_ISDIR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISCHR", FS_ISCHR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISCHR (@var{mode})\n\ -Return true if @var{mode} corresponds to a character device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_chr (static_cast (mode)); - else - error ("S_ISCHR: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISBLK", FS_ISBLK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISBLK (@var{mode})\n\ -Return true if @var{mode} corresponds to a block device. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_blk (static_cast (mode)); - else - error ("S_ISBLK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISFIFO", FS_ISFIFO, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISFIFO (@var{mode})\n\ -Return true if @var{mode} corresponds to a fifo. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_fifo (static_cast (mode)); - else - error ("S_ISFIFO: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISLNK", FS_ISLNK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISLNK (@var{mode})\n\ -Return true if @var{mode} corresponds to a symbolic link. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_lnk (static_cast (mode)); - else - error ("S_ISLNK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("S_ISSOCK", FS_ISSOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} S_ISSOCK (@var{mode})\n\ -Return true if @var{mode} corresponds to a socket. The value\n\ -of @var{mode} is assumed to be returned from a call to @code{stat}.\n\ -@seealso{stat, lstat}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - { - double mode = args(0).double_value (); - - if (! error_state) - retval = file_stat::is_sock (static_cast (mode)); - else - error ("S_ISSOCK: invalid MODE value"); - } - else - print_usage (); - - return retval; -} - -DEFUN (gethostname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} gethostname ()\n\ -Return the hostname of the system where Octave is running.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_env::get_host_name (); - else - print_usage (); - - return retval; -} - -DEFUN (uname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{uts}, @var{err}, @var{msg}] =} uname ()\n\ -Return system information in the structure. For example:\n\ -\n\ -@example\n\ -@group\n\ -uname ()\n\ - @result{} @{\n\ - sysname = x86_64\n\ - nodename = segfault\n\ - release = 2.6.15-1-amd64-k8-smp\n\ - version = Linux\n\ - machine = #2 SMP Thu Feb 23 04:57:49 UTC 2006\n\ - @}\n\ -@end group\n\ -@end example\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_uname sysinfo; - - octave_scalar_map m; - - m.assign ("sysname", sysinfo.sysname ()); - m.assign ("nodename", sysinfo.nodename ()); - m.assign ("release", sysinfo.release ()); - m.assign ("version", sysinfo.version ()); - m.assign ("machine", sysinfo.machine ()); - - retval(2) = sysinfo.message (); - retval(1) = sysinfo.error (); - retval(0) = m; - } - else - print_usage (); - - return retval; -} - -DEFUNX ("unlink", Funlink, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{err}, @var{msg}] =} unlink (@var{file})\n\ -Delete the file named @var{file}.\n\ -\n\ -If successful, @var{err} is 0 and @var{msg} is an empty string.\n\ -Otherwise, @var{err} is nonzero and @var{msg} contains a\n\ -system-dependent error message.\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(1) = std::string (); - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string name = args(0).string_value (); - - std::string msg; - - int status = octave_unlink (name, msg); - - retval(1) = msg; - retval(0) = status; - } - else - error ("unlink: FILE must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("waitpid", Fwaitpid, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{pid}, @var{status}, @var{msg}] =} waitpid (@var{pid}, @var{options})\n\ -Wait for process @var{pid} to terminate. The @var{pid} argument can be:\n\ -\n\ -@table @asis\n\ -@item @minus{}1\n\ -Wait for any child process.\n\ -\n\ -@item 0\n\ -Wait for any child process whose process group ID is equal to that of\n\ -the Octave interpreter process.\n\ -\n\ -@item > 0\n\ -Wait for termination of the child process with ID @var{pid}.\n\ -@end table\n\ -\n\ -The @var{options} argument can be a bitwise OR of zero or more of\n\ -the following constants:\n\ -\n\ -@table @code\n\ -@item 0\n\ -Wait until signal is received or a child process exits (this is the\n\ -default if the @var{options} argument is missing).\n\ -\n\ -@item WNOHANG\n\ -Do not hang if status is not immediately available.\n\ -\n\ -@item WUNTRACED\n\ -Report the status of any child processes that are stopped, and whose\n\ -status has not yet been reported since they stopped.\n\ -\n\ -@item WCONTINUE\n\ -Return if a stopped child has been resumed by delivery of @code{SIGCONT}.\n\ -This value may not be meaningful on all systems.\n\ -@end table\n\ -\n\ -If the returned value of @var{pid} is greater than 0, it is the process\n\ -ID of the child process that exited. If an error occurs, @var{pid} will\n\ -be less than zero and @var{msg} will contain a system-dependent error\n\ -message. The value of @var{status} contains additional system-dependent\n\ -information about the subprocess that exited.\n\ -@seealso{WCONTINUE, WCOREDUMP, WEXITSTATUS, WIFCONTINUED, WIFSIGNALED, WIFSTOPPED, WNOHANG, WSTOPSIG, WTERMSIG, WUNTRACED}\n\ -@end deftypefn") -{ - octave_value_list retval; - - retval(2) = std::string (); - retval(1) = 0; - retval(0) = -1; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - pid_t pid = args(0).int_value (true); - - if (! error_state) - { - int options = 0; - - if (args.length () == 2) - options = args(1).int_value (true); - - if (! error_state) - { - std::string msg; - - int status = 0; - - pid_t result = octave_syscalls::waitpid (pid, &status, options, msg); - - retval(2) = msg; - retval(1) = status; - retval(0) = result; - } - else - error ("waitpid: OPTIONS must be an integer"); - } - else - error ("waitpid: PID must be an integer value"); - } - else - print_usage (); - - return retval; -} - -DEFUNX ("WIFEXITED", FWIFEXITED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFEXITED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child terminated normally.\n\ -@seealso{waitpid, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFEXITED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFEXITED (status); - else - error ("WIFEXITED: STATUS must be an integer"); - } -#else - warning ("WIFEXITED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WEXITSTATUS", FWEXITSTATUS, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WEXITSTATUS (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the exit\n\ -status of the child. This function should only be employed if\n\ -@code{WIFEXITED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WEXITSTATUS) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WEXITSTATUS (status); - else - error ("WEXITSTATUS: STATUS must be an integer"); - } -#else - warning ("WEXITSTATUS always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSIGNALED", FWIFSIGNALED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSIGNALED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was terminated by a signal.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSIGNALED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSIGNALED (status); - else - error ("WIFSIGNALED: STATUS must be an integer"); - } -#else - warning ("WIFSIGNALED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WTERMSIG", FWTERMSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WTERMSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal that caused the child process to terminate. This function\n\ -should only be employed if @code{WIFSIGNALED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WCOREDUMP, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WTERMSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WTERMSIG (status); - else - error ("WTERMSIG: STATUS must be an integer"); - } -#else - warning ("WTERMSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WCOREDUMP", FWCOREDUMP, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCOREDUMP (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child produced a core dump. This function should only be employed if\n\ -@code{WIFSIGNALED} returned true. The macro used to implement this\n\ -function is not specified in POSIX.1-2001 and is not available on some\n\ -Unix implementations (e.g., AIX, SunOS).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WIFSTOPPED, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WCOREDUMP) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WCOREDUMP (status); - else - error ("WCOREDUMP: STATUS must be an integer"); - } -#else - warning ("WCOREDUMP always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFSTOPPED", FWIFSTOPPED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFSTOPPED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was stopped by delivery of a signal; this is only\n\ -possible if the call was done using @code{WUNTRACED} or when the child\n\ -is being traced (see ptrace(2)).\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WSTOPSIG, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFSTOPPED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFSTOPPED (status); - else - error ("WIFSTOPPED: STATUS must be an integer"); - } -#else - warning ("WIFSTOPPED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WSTOPSIG", FWSTOPSIG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WSTOPSIG (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return the number of\n\ -the signal which caused the child to stop. This function should only\n\ -be employed if @code{WIFSTOPPED} returned true.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WIFCONTINUED}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WSTOPSIG) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WSTOPSIG (status); - else - error ("WSTOPSIG: STATUS must be an integer"); - } -#else - warning ("WSTOPSIG always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("WIFCONTINUED", FWIFCONTINUED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WIFCONTINUED (@var{status})\n\ -Given @var{status} from a call to @code{waitpid}, return true if the\n\ -child process was resumed by delivery of @code{SIGCONT}.\n\ -@seealso{waitpid, WIFEXITED, WEXITSTATUS, WIFSIGNALED, WTERMSIG, WCOREDUMP, WIFSTOPPED, WSTOPSIG}\n\ -@end deftypefn") -{ - octave_value retval = 0.0; - -#if defined (WIFCONTINUED) - if (args.length () == 1) - { - int status = args(0).int_value (); - - if (! error_state) - retval = WIFCONTINUED (status); - else - error ("WIFCONTINUED: STATUS must be an integer"); - } -#else - warning ("WIFCONTINUED always returns false in this version of Octave"); -#endif - - return retval; -} - -DEFUNX ("canonicalize_file_name", Fcanonicalize_file_name, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{cname}, @var{status}, @var{msg}] =} canonicalize_file_name (@var{fname})\n\ -Return the canonical name of file @var{fname}. If the file does not exist\n\ -the empty string (\"\") is returned.\n\ -@seealso{make_absolute_filename, is_absolute_filename, is_rooted_relative_filename}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string msg; - - std::string result = octave_canonicalize_file_name (name, msg); - - retval(2) = msg; - retval(1) = msg.empty () ? 0 : -1; - retval(0) = result; - } - else - error ("canonicalize_file_name: NAME must be a character string"); - } - else - print_usage (); - - return retval; -} - -static octave_value -const_value (const octave_value_list& args, int val) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 0) - retval = val; - else - print_usage (); - - return retval; -} - -#if !defined (O_NONBLOCK) && defined (O_NDELAY) -#define O_NONBLOCK O_NDELAY -#endif - -DEFUNX ("F_DUPFD", FF_DUPFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_DUPFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return a\n\ -duplicate file descriptor.\n\ -@seealso{fcntl, F_GETFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_DUPFD) - return const_value (args, F_DUPFD); -#else - error ("F_DUPFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFD", FF_GETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFL, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFD) - return const_value (args, F_GETFD); -#else - error ("F_GETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_GETFL", FF_GETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_GETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to return the\n\ -file status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_SETFD, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_GETFL) - return const_value (args, F_GETFL); -#else - error ("F_GETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFD", FF_SETFD, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFD ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -descriptor flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFL}\n\ -@end deftypefn") -{ -#if defined (F_SETFD) - return const_value (args, F_SETFD); -#else - error ("F_SETFD: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("F_SETFL", FF_SETFL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} F_SETFL ()\n\ -Return the numerical value to pass to @code{fcntl} to set the file\n\ -status flags.\n\ -@seealso{fcntl, F_DUPFD, F_GETFD, F_GETFL, F_SETFD}\n\ -@end deftypefn") -{ -#if defined (F_SETFL) - return const_value (args, F_SETFL); -#else - error ("F_SETFL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_APPEND", FO_APPEND, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_APPEND ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate each write operation appends,\n\ -or that may be passed to @code{fcntl} to set the write mode to append.\n\ -@seealso{fcntl, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_APPEND) - return const_value (args, O_APPEND); -#else - error ("O_APPEND: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_ASYNC", FO_ASYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_ASYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate asynchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_ASYNC) - return const_value (args, O_ASYNC); -#else - error ("O_ASYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_CREAT", FO_CREAT, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_CREAT ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file should be\n\ -created if it does not exist.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_CREAT) - return const_value (args, O_CREAT); -#else - error ("O_CREAT: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_EXCL", FO_EXCL, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_EXCL ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that file locking is used.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_EXCL) - return const_value (args, O_EXCL); -#else - error ("O_EXCL: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_NONBLOCK", FO_NONBLOCK, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_NONBLOCK ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that non-blocking I/O is in use,\n\ -or that may be passsed to @code{fcntl} to set non-blocking I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_NONBLOCK) - return const_value (args, O_NONBLOCK); -#else - error ("O_NONBLOCK: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDONLY", FO_RDONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -reading only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDWR, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDONLY) - return const_value (args, O_RDONLY); -#else - error ("O_RDONLY: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_RDWR", FO_RDWR, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_RDWR ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for both\n\ -reading and writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_SYNC, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_RDWR) - return const_value (args, O_RDWR); -#else - error ("O_RDWR: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_SYNC", FO_SYNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_SYNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -synchronous I/O.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_TRUNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_SYNC) - return const_value (args, O_SYNC); -#else - error ("O_SYNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_TRUNC", FO_TRUNC, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} O_TRUNC ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that if file exists, it should\n\ -be truncated when writing.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_WRONLY}\n\ -@end deftypefn") -{ -#if defined (O_TRUNC) - return const_value (args, O_TRUNC); -#else - error ("O_TRUNC: not available on this system"); - return octave_value (); -#endif -} - -DEFUNX ("O_WRONLY", FO_WRONLY, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} O_WRONLY ()\n\ -Return the numerical value of the file status flag that may be\n\ -returned by @code{fcntl} to indicate that a file is open for\n\ -writing only.\n\ -@seealso{fcntl, O_APPEND, O_ASYNC, O_CREAT, O_EXCL, O_NONBLOCK, O_RDONLY, O_RDWR, O_SYNC, O_TRUNC}\n\ -@end deftypefn") -{ -#if defined (O_WRONLY) - return const_value (args, O_WRONLY); -#else - error ("O_WRONLY: not available on this system"); - return octave_value (); -#endif -} - -#if !defined (WNOHANG) -#define WNOHANG 0 -#endif - -DEFUNX ("WNOHANG", FWNOHANG, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WNOHANG ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should return its\n\ -status immediately instead of waiting for a process to exit.\n\ -@seealso{waitpid, WUNTRACED, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WNOHANG); -} - -#if !defined (WUNTRACED) -#define WUNTRACED 0 -#endif - -DEFUNX ("WUNTRACED", FWUNTRACED, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WUNTRACED ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if the child process has stopped but is not traced via the\n\ -@code{ptrace} system call\n\ -@seealso{waitpid, WNOHANG, WCONTINUE}\n\ -@end deftypefn") -{ - return const_value (args, WUNTRACED); -} - -#if !defined (WCONTINUE) -#define WCONTINUE 0 -#endif - -DEFUNX ("WCONTINUE", FWCONTINUE, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} WCONTINUE ()\n\ -Return the numerical value of the option argument that may be\n\ -passed to @code{waitpid} to indicate that it should also return\n\ -if a stopped child has been resumed by delivery of a @code{SIGCONT}\n\ -signal.\n\ -@seealso{waitpid, WNOHANG, WUNTRACED}\n\ -@end deftypefn") -{ - return const_value (args, WCONTINUE); -} diff -r 069c552587a0 -r 959953dba519 src/sysdep.cc --- a/src/sysdep.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,905 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include - -#if defined (HAVE_TERMIOS_H) -#include -#elif defined (HAVE_TERMIO_H) -#include -#elif defined (HAVE_SGTTY_H) -#include -#endif - -#if defined (HAVE_CONIO_H) -#include -#endif - -#if defined (HAVE_SYS_IOCTL_H) -#include -#endif - -#if defined (HAVE_FLOATINGPOINT_H) -#include -#endif - -#if defined (HAVE_IEEEFP_H) -#include -#endif - -#include "cmd-edit.h" -#include "file-ops.h" -#include "lo-mappers.h" -#include "lo-math.h" -#include "mach-info.h" -#include "oct-env.h" -#include "quit.h" - -#include "Cell.h" -#include "defun.h" -#include "error.h" -#include "input.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "toplev.h" -#include "utils.h" -#include "file-stat.h" - -#ifndef STDIN_FILENO -#define STDIN_FILENO 1 -#endif - -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) -static void -BSD_init (void) -{ -#if defined (HAVE_FLOATINGPOINT_H) - // Disable trapping on common exceptions. -#ifndef FP_X_DNML -#define FP_X_DNML 0 -#endif - fpsetmask (~(FP_X_OFL|FP_X_INV|FP_X_DZ|FP_X_DNML|FP_X_UFL|FP_X_IMP)); -#endif -} -#endif - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - -#define WIN32_LEAN_AND_MEAN -#include - -static void -w32_set_octave_home (void) -{ - std::string bin_dir; - - HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE -#ifdef TH32CS_SNAPMODULE32 - | TH32CS_SNAPMODULE32 -#endif - , 0); - - if (h != INVALID_HANDLE_VALUE) - { - MODULEENTRY32 mod_info; - - ZeroMemory (&mod_info, sizeof (mod_info)); - mod_info.dwSize = sizeof (mod_info); - - if (Module32First (h, &mod_info)) - { - do - { - std::string mod_name (mod_info.szModule); - - if (mod_name.find ("octinterp") != std::string::npos) - { - bin_dir = mod_info.szExePath; - if (bin_dir[bin_dir.length () - 1] != '\\') - bin_dir.append (1, '\\'); - break; - } - } - while (Module32Next (h, &mod_info)); - } - - CloseHandle (h); - } - - if (! bin_dir.empty ()) - { - size_t pos = bin_dir.rfind ("\\bin\\"); - - if (pos != std::string::npos) - octave_env::putenv ("OCTAVE_HOME", bin_dir.substr (0, pos)); - } -} - -void -w32_set_quiet_shutdown (void) -{ - // Let the user close the console window or shutdown without the - // pesky dialog. - // - // FIXME -- should this be user configurable? - SetProcessShutdownParameters (0x280, SHUTDOWN_NORETRY); -} - -void -MINGW_signal_cleanup (void) -{ - w32_set_quiet_shutdown (); - - w32_raise_final (); -} -#endif - -#if defined (__MINGW32__) -static void -MINGW_init (void) -{ - w32_set_octave_home (); - - // Init mutex to protect setjmp/longjmp and get main thread context - w32_sigint_init (); - - w32_set_quiet_shutdown (); -} -#endif - -#if defined (_MSC_VER) -static void -MSVC_init (void) -{ - w32_set_octave_home (); - - // Init mutex to protect setjmp/longjmp and get main thread context - w32_sigint_init (); - - w32_set_quiet_shutdown (); -} -#endif - - -// Return TRUE if FILE1 and FILE2 refer to the same (physical) file. - -bool -same_file_internal (const std::string& file1, const std::string& file2) -{ -#ifdef OCTAVE_USE_WINDOWS_API - - bool retval = false; - - // Windows native code - // Reference: http://msdn2.microsoft.com/en-us/library/aa363788.aspx - - HANDLE hfile1 = CreateFile (file1.c_str (), 0, FILE_SHARE_READ, 0, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - - if (hfile1 != INVALID_HANDLE_VALUE) - { - HANDLE hfile2 = CreateFile (file2.c_str (), 0, FILE_SHARE_READ, 0, - OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); - - if (hfile2 != INVALID_HANDLE_VALUE) - { - BY_HANDLE_FILE_INFORMATION hfi1; - BY_HANDLE_FILE_INFORMATION hfi2; - - if (GetFileInformationByHandle (hfile1, &hfi1) - && GetFileInformationByHandle (hfile2, &hfi2)) - - retval = (hfi1.dwVolumeSerialNumber == hfi2.dwVolumeSerialNumber - && hfi1.nFileIndexHigh == hfi2.nFileIndexHigh - && hfi1.nFileIndexLow == hfi2.nFileIndexLow); - - CloseHandle (hfile2); - } - - CloseHandle (hfile1); - } - - return retval; - -#else - - // POSIX Code - - file_stat fs_file1 (file1); - file_stat fs_file2 (file2); - - return (fs_file1 && fs_file2 - && fs_file1.ino () == fs_file2.ino () - && fs_file1.dev () == fs_file2.dev ()); - -#endif -} - -void -sysdep_init (void) -{ -#if defined (__386BSD__) || defined (__FreeBSD__) || defined (__NetBSD__) - BSD_init (); -#elif defined (__MINGW32__) - MINGW_init (); -#elif defined (_MSC_VER) - MSVC_init (); -#endif -} - -void -sysdep_cleanup (void) -{ - MINGW_SIGNAL_CLEANUP (); -} - -// Set terminal in raw mode. From less-177. -// -// Change terminal to "raw mode", or restore to "normal" mode. -// "Raw mode" means -// 1. An outstanding read will complete on receipt of a single keystroke. -// 2. Input is not echoed. -// 3. On output, \n is mapped to \r\n. -// 4. \t is NOT expanded into spaces. -// 5. Signal-causing characters such as ctrl-C (interrupt), -// etc. are NOT disabled. -// It doesn't matter whether an input \n is mapped to \r, or vice versa. - -void -raw_mode (bool on, bool wait) -{ - static bool curr_on = false; - - int tty_fd = STDIN_FILENO; - if (! gnulib::isatty (tty_fd)) - { - if (interactive) - error ("stdin is not a tty!"); - return; - } - - if (on == curr_on) - return; - -#if defined (HAVE_TERMIOS_H) - { - struct termios s; - static struct termios save_term; - - if (on) - { - // Get terminal modes. - - tcgetattr (tty_fd, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - s.c_cc[VTIME] = 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - tcsetattr (tty_fd, wait ? TCSAFLUSH : TCSADRAIN, &s); - } -#elif defined (HAVE_TERMIO_H) - { - struct termio s; - static struct termio save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TCGETA, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.c_cflag & CBAUD; -// erase_char = s.c_cc[VERASE]; -// kill_char = s.c_cc[VKILL]; - - // Set the modes to the way we want them. - - s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); - s.c_oflag |= (OPOST|ONLCR); -#if defined (OCRNL) - s.c_oflag &= ~(OCRNL); -#endif -#if defined (ONOCR) - s.c_oflag &= ~(ONOCR); -#endif -#if defined (ONLRET) - s.c_oflag &= ~(ONLRET); -#endif - s.c_cc[VMIN] = wait ? 1 : 0; - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TCSETAW, &s); - } -#elif defined (HAVE_SGTTY_H) - { - struct sgttyb s; - static struct sgttyb save_term; - - if (on) - { - // Get terminal modes. - - ioctl (tty_fd, TIOCGETP, &s); - - // Save modes and set certain variables dependent on modes. - - save_term = s; -// ospeed = s.sg_ospeed; -// erase_char = s.sg_erase; -// kill_char = s.sg_kill; - - // Set the modes to the way we want them. - - s.sg_flags |= CBREAK; - s.sg_flags &= ~(ECHO); - } - else - { - // Restore saved modes. - - s = save_term; - } - - ioctl (tty_fd, TIOCSETN, &s); - } -#else - warning ("no support for raw mode console I/O on this system"); - - // Make sure the current mode doesn't toggle. - on = curr_on; -#endif - - curr_on = on; -} - -FILE * -octave_popen (const char *command, const char *mode) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - if (mode && mode[0] && ! mode[1]) - { - char tmode[3]; - tmode[0] = mode[0]; - tmode[1] = 'b'; - tmode[2] = 0; - - return _popen (command, tmode); - } - else - return _popen (command, mode); -#else - return popen (command, mode); -#endif -} - -int -octave_pclose (FILE *f) -{ -#if defined (__MINGW32__) || defined (_MSC_VER) - return _pclose (f); -#else - return pclose (f); -#endif -} - -// Read one character from the terminal. - -int -octave_kbhit (bool wait) -{ -#ifdef HAVE__KBHIT - int c = (! wait && ! _kbhit ()) ? 0 : std::cin.get (); -#else - raw_mode (true, wait); - - // Get current handler. - octave_interrupt_handler saved_interrupt_handler - = octave_ignore_interrupts (); - - // Restore it, disabling system call restarts (if possible) so the - // read can be interrupted. - - octave_set_interrupt_handler (saved_interrupt_handler, false); - - int c = std::cin.get (); - - if (std::cin.fail () || std::cin.eof ()) - std::cin.clear (); - - // Restore it, enabling system call restarts (if possible). - octave_set_interrupt_handler (saved_interrupt_handler, true); - - raw_mode (false, true); -#endif - - return c; -} - -std::string -get_P_tmpdir (void) -{ -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) - - std::string retval; - -#if defined (P_tmpdir) - retval = P_tmpdir; -#endif - - // Apparently some versions of MinGW and MSVC either don't define - // P_tmpdir, or they define it to a single backslash, neither of which - // is particularly helpful. - - if (retval.empty () || retval == "\\") - { - retval = octave_env::getenv ("TEMP"); - - if (retval.empty ()) - retval = octave_env::getenv ("TMP"); - - if (retval.empty ()) - retval = "c:\\temp"; - } - - return retval; - -#elif defined (P_tmpdir) - - return P_tmpdir; - -#else - - return "/tmp"; - -#endif -} - -DEFUN (clc, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} clc ()\n\ -@deftypefnx {Built-in Function} {} home ()\n\ -Clear the terminal screen and move the cursor to the upper left corner.\n\ -@end deftypefn") -{ - command_editor::clear_screen (); - - return octave_value_list (); -} - -DEFALIAS (home, clc); - -DEFUN (getenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} getenv (@var{var})\n\ -Return the value of the environment variable @var{var}. For example,\n\ -\n\ -@example\n\ -getenv (\"PATH\")\n\ -@end example\n\ -\n\ -@noindent\n\ -returns a string containing the value of your path.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = octave_env::getenv (name); - } - else - print_usage (); - - return retval; -} - -DEFUN (putenv, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} putenv (@var{var}, @var{value})\n\ -@deftypefnx {Built-in Function} {} setenv (@var{var}, @var{value})\n\ -Set the value of the environment variable @var{var} to @var{value}.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 1) - { - std::string var = args(0).string_value (); - - if (! error_state) - { - std::string val = (nargin == 2 - ? args(1).string_value () : std::string ()); - - if (! error_state) - octave_env::putenv (var, val); - else - error ("putenv: VALUE must be a string"); - } - else - error ("putenv: VAR must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFALIAS (setenv, putenv); - -/* -%!assert (ischar (getenv ("OCTAVE_HOME"))) -%!test -%! setenv ("dummy_variable_that_cannot_matter", "foobar"); -%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); -*/ - -// FIXME -- perhaps kbhit should also be able to print a prompt? - -DEFUN (kbhit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} kbhit ()\n\ -Read a single keystroke from the keyboard. If called with one\n\ -argument, don't wait for a keypress. For example,\n\ -\n\ -@example\n\ -x = kbhit ();\n\ -@end example\n\ -\n\ -@noindent\n\ -will set @var{x} to the next character typed at the keyboard as soon as\n\ -it is typed.\n\ -\n\ -@example\n\ -x = kbhit (1);\n\ -@end example\n\ -\n\ -@noindent\n\ -identical to the above example, but don't wait for a keypress,\n\ -returning the empty string if no key is available.\n\ -@end deftypefn") -{ - octave_value retval; - - // FIXME -- add timeout and default value args? - - if (interactive || forced_interactive) - { - feval ("drawnow"); - - int c = octave_kbhit (args.length () == 0); - - if (c == -1) - c = 0; - - char *s = new char [2]; - s[0] = c; - s[1] = '\0'; - retval = s; - } - - return retval; -} - -DEFUN (pause, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} pause (@var{seconds})\n\ -Suspend the execution of the program. If invoked without any arguments,\n\ -Octave waits until you type a character. With a numeric argument, it\n\ -pauses for the given number of seconds. For example, the following\n\ -statement prints a message and then waits 5 seconds before clearing the\n\ -screen.\n\ -\n\ -@example\n\ -@group\n\ -fprintf (stderr, \"wait please...\\n\");\n\ -pause (5);\n\ -clc;\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (! (nargin == 0 || nargin == 1)) - { - print_usage (); - return retval; - } - - if (nargin == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (! xisnan (dval)) - { - feval ("drawnow"); - - if (xisinf (dval)) - { - flush_octave_stdout (); - octave_kbhit (); - } - else - octave_sleep (dval); - } - else - warning ("pause: NaN is an invalid delay"); - } - } - else - { - feval ("drawnow"); - flush_octave_stdout (); - octave_kbhit (); - } - - return retval; -} - -/* -%!test -%! pause (1); - -%!error (pause (1, 2)) -*/ - -DEFUN (sleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ -Suspend the execution of the program for the given number of seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("sleep: NaN is an invalid delay"); - else - { - feval ("drawnow"); - octave_sleep (dval); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! sleep (1); - -%!error (sleep ()) -%!error (sleep (1, 2)) -*/ - -DEFUN (usleep, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ -Suspend the execution of the program for the given number of\n\ -microseconds. On systems where it is not possible to sleep for periods\n\ -of time less than one second, @code{usleep} will pause the execution for\n\ -@code{round (@var{microseconds} / 1e6)} seconds.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - double dval = args(0).double_value (); - - if (! error_state) - { - if (xisnan (dval)) - warning ("usleep: NaN is an invalid delay"); - else - { - feval ("drawnow"); - - int delay = NINT (dval); - - if (delay > 0) - octave_usleep (delay); - } - } - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! usleep (1000); - -%!error (usleep ()) -%!error (usleep (1, 2)) -*/ - -// FIXME -- maybe this should only return 1 if IEEE floating -// point functions really work. - -DEFUN (isieee, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isieee ()\n\ -Return true if your computer @emph{claims} to conform to the IEEE standard\n\ -for floating point calculations. No actual tests are performed.\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (flt_fmt == oct_mach_info::flt_fmt_ieee_little_endian - || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); -} - -/* -%!assert (islogical (isieee ())) -*/ - -DEFUN (native_float_format, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} native_float_format ()\n\ -Return the native floating point format as a string\n\ -@end deftypefn") -{ - oct_mach_info::float_format flt_fmt = oct_mach_info::native_float_format (); - - return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); -} - -/* -%!assert (ischar (native_float_format ())) -*/ - -DEFUN (tilde_expand, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ -Perform tilde expansion on @var{string}. If @var{string} begins with a\n\ -tilde character, (@samp{~}), all of the characters preceding the first\n\ -slash (or all characters, if there is no slash) are treated as a\n\ -possible user name, and the tilde and the following characters up to the\n\ -slash are replaced by the home directory of the named user. If the\n\ -tilde is followed immediately by a slash, the tilde is replaced by the\n\ -home directory of the user running Octave. For example:\n\ -\n\ -@example\n\ -@group\n\ -tilde_expand (\"~joeuser/bin\")\n\ - @result{} \"/home/joeuser/bin\"\n\ -tilde_expand (\"~/bin\")\n\ - @result{} \"/home/jwe/bin\"\n\ -@end group\n\ -@end example\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - octave_value arg = args(0); - - string_vector sv = arg.all_strings (); - - if (! error_state) - { - sv = file_ops::tilde_expand (sv); - - if (arg.is_cellstr ()) - retval = Cell (arg.dims (), sv); - else - retval = sv; - } - else - error ("tilde_expand: expecting argument to be char or cellstr object"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isempty (getenv ("HOME"))) -%! setenv ("HOME", "foobar"); -%! endif -%! home = getenv ("HOME"); -%! assert (tilde_expand ("~/foobar"), strcat (home, "/foobar")); -%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); -%! assert (tilde_expand ("foo/bar"), "foo/bar"); -*/ diff -r 069c552587a0 -r 959953dba519 src/sysdep.h --- a/src/sysdep.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,58 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_sysdep_h) -#define octave_sysdep_h 1 - -#include - -#include - -#include "lo-ieee.h" -#include "lo-sysdep.h" - -extern void sysdep_init (void); - -extern void sysdep_cleanup (void); - -extern OCTINTERP_API void raw_mode (bool, bool wait = true); - -extern OCTINTERP_API FILE *octave_popen (const char *command, const char *mode); -extern OCTINTERP_API int octave_pclose (FILE *f); - -extern OCTINTERP_API int octave_kbhit (bool wait = true); - -extern OCTINTERP_API std::string get_P_tmpdir (void); - -extern void w32_set_quiet_shutdown (void); - -#if defined (__WIN32__) && ! defined (_POSIX_VERSION) -extern void MINGW_signal_cleanup (void); -#define USE_W32_SIGINT 1 -#define MINGW_SIGNAL_CLEANUP() MINGW_signal_cleanup () -#else -#define MINGW_SIGNAL_CLEANUP() do { } while (0) -#endif - -extern OCTINTERP_API bool same_file_internal (const std::string&, const std::string&); - -#endif diff -r 069c552587a0 -r 959953dba519 src/toplev.cc --- a/src/toplev.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1537 +0,0 @@ -/* - -Copyright (C) 1995-2012 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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include -#include -#include - -#include -#include -#include -#include - -#include -#include - -#include "cmd-edit.h" -#include "cmd-hist.h" -#include "file-ops.h" -#include "lo-error.h" -#include "lo-mappers.h" -#include "oct-env.h" -#include "oct-locbuf.h" -#include "quit.h" -#include "singleton-cleanup.h" -#include "str-vec.h" - -#include "defaults.h" -#include "defun.h" -#include "error.h" -#include "file-io.h" -#include "graphics.h" -#include "input.h" -#include "lex.h" -#include "oct-conf.h" -#include "oct-hist.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "pager.h" -#include "parse.h" -#include "pathsearch.h" -#include "procstream.h" -#include "pt-eval.h" -#include "pt-jump.h" -#include "pt-stmt.h" -#include "sighandlers.h" -#include "sysdep.h" -#include "syswait.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" -#include "version.h" - -void (*octave_exit) (int) = ::exit; - -// TRUE means the quit() call is allowed. -bool quit_allowed = true; - -// TRUE means we are exiting via the builtin exit or quit functions. -bool quitting_gracefully = false; -// This stores the exit status. -int exit_status = 0; - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -bool octave_interpreter_ready = false; - -// TRUE means we've processed all the init code and we are good to go. -bool octave_initialized = false; - -// Current command to execute. -tree_statement_list *global_command = 0; - -octave_call_stack *octave_call_stack::instance = 0; - -void -octave_call_stack::create_instance (void) -{ - instance = new octave_call_stack (); - - if (instance) - { - instance->do_push (0, symbol_table::top_scope (), 0); - - singleton_cleanup_list::add (cleanup_instance); - } -} - -int -octave_call_stack::do_current_line (void) const -{ - tree_statement *stmt = do_current_statement (); - - return stmt ? stmt->line () : -1; -} - -int -octave_call_stack::do_current_column (void) const -{ - tree_statement *stmt = do_current_statement (); - - return stmt ? stmt->column () : -1; -} - -int -octave_call_stack::do_caller_user_code_line (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - tree_statement *stmt = elt.stmt; - - if (stmt) - { - retval = stmt->line (); - break; - } - } - } - - return retval; -} - -int -octave_call_stack::do_caller_user_code_column (void) const -{ - int retval = -1; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - tree_statement *stmt = elt.stmt; - - if (stmt) - { - retval = stmt->column (); - break; - } - } - } - - return retval; -} - -size_t -octave_call_stack::do_num_user_code_frames (octave_idx_type& curr_user_frame) const -{ - size_t retval = 0; - - curr_user_frame = 0; - - // Look for the caller of dbstack. - size_t frame = cs[curr_frame].prev; - - bool found = false; - - size_t k = cs.size (); - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - octave_function *f = (*p).fcn; - - if (--k == frame) - found = true; - - if (f && f->is_user_code ()) - { - if (! found) - curr_user_frame++; - - retval++; - } - } - - // We counted how many user frames were not the one, in reverse. - // Now set curr_user_frame to be the index in the other direction. - curr_user_frame = retval - curr_user_frame - 1; - - return retval; -} - -octave_user_code * -octave_call_stack::do_caller_user_code (size_t nskip) const -{ - octave_user_code *retval = 0; - - const_iterator p = cs.end (); - - while (p != cs.begin ()) - { - const call_stack_elt& elt = *(--p); - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - retval = dynamic_cast (f); - break; - } - } - } - - return retval; -} - -// Use static fields for the best efficiency. -// NOTE: C++0x will allow these two to be merged into one. -static const char *bt_fieldnames[] = { "file", "name", "line", - "column", "scope", "context", 0 }; -static const octave_fields bt_fields (bt_fieldnames); - -octave_map -octave_call_stack::empty_backtrace (void) -{ - return octave_map (dim_vector (0, 1), bt_fields); -} - -octave_map -octave_call_stack::do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const -{ - size_t user_code_frames = do_num_user_code_frames (curr_user_frame); - - size_t nframes = nskip <= user_code_frames ? user_code_frames - nskip : 0; - - // Our list is reversed. - curr_user_frame = nframes - curr_user_frame - 1; - - octave_map retval (dim_vector (nframes, 1), bt_fields); - - Cell& file = retval.contents (0); - Cell& name = retval.contents (1); - Cell& line = retval.contents (2); - Cell& column = retval.contents (3); - Cell& scope = retval.contents (4); - Cell& context = retval.contents (5); - - if (nframes > 0) - { - int k = 0; - - for (const_reverse_iterator p = cs.rbegin (); p != cs.rend (); p++) - { - const call_stack_elt& elt = *p; - - octave_function *f = elt.fcn; - - if (f && f->is_user_code ()) - { - if (nskip > 0) - nskip--; - else - { - scope(k) = elt.scope; - context(k) = elt.context; - - file(k) = f->fcn_file_name (); - std::string parent_fcn_name = f->parent_fcn_name (); - if (parent_fcn_name == std::string ()) - name(k) = f->name (); - else - name(k) = f->parent_fcn_name () + Vfilemarker + f->name (); - - tree_statement *stmt = elt.stmt; - - if (stmt) - { - line(k) = stmt->line (); - column(k) = stmt->column (); - } - else - { - line(k) = -1; - column(k) = -1; - } - - k++; - } - } - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame (size_t n, bool verbose) -{ - bool retval = false; - - if (n < cs.size ()) - { - retval = true; - - curr_frame = n; - - const call_stack_elt& elt = cs[n]; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - octave_function *f = elt.fcn; - std::string nm = f ? f->name () : std::string (""); - - tree_statement *s = elt.stmt; - int l = -1; - int c = -1; - if (s) - { - l = s->line (); - c = s->column (); - } - - octave_stdout << "stopped in " << nm - << " at line " << l << " column " << c - << " (" << elt.scope << "[" << elt.context << "])" - << std::endl; - } - } - - return retval; -} - -bool -octave_call_stack::do_goto_frame_relative (int nskip, bool verbose) -{ - bool retval = false; - - int incr = 0; - - if (nskip < 0) - incr = -1; - else if (nskip > 0) - incr = 1; - - // Start looking with the caller of dbup/dbdown/keyboard. - size_t frame = cs[curr_frame].prev; - - while (true) - { - if ((incr < 0 && frame == 0) || (incr > 0 && frame == cs.size () - 1)) - break; - - frame += incr; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (nskip > 0) - nskip--; - else if (nskip < 0) - nskip++; - - if (nskip == 0) - { - curr_frame = frame; - cs[cs.size () - 1].prev = curr_frame; - - symbol_table::set_scope_and_context (elt.scope, elt.context); - - if (verbose) - { - std::ostringstream buf; - - if (f) - { - tree_statement *s = elt.stmt; - - int l = s ? s->line () : -1; - - buf << "stopped in " << f->name () - << " at line " << l << std::endl; - } - else - buf << "at top level" << std::endl; - - octave_stdout << buf.str (); - } - - retval = true; - break; - } - } - - // There is no need to set scope and context here. That will - // happen when the dbup/dbdown/keyboard frame is popped and we - // jump to the new "prev" frame set above. - } - - return retval; -} - -void -octave_call_stack::do_goto_caller_frame (void) -{ - size_t frame = curr_frame; - - bool skipped = false; - - while (frame != 0) - { - frame = cs[frame].prev; - - const call_stack_elt& elt = cs[frame]; - - octave_function *f = elt.fcn; - - if (frame == 0 || (f && f->is_user_code ())) - { - if (! skipped) - // We found the current user code frame, so skip it. - skipped = true; - else - { - // We found the caller user code frame. - call_stack_elt tmp (elt); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); - - break; - } - } - } -} - -void -octave_call_stack::do_goto_base_frame (void) -{ - call_stack_elt tmp (cs[0]); - tmp.prev = curr_frame; - - curr_frame = cs.size (); - - cs.push_back (tmp); - - symbol_table::set_scope_and_context (tmp.scope, tmp.context); -} - -void -octave_call_stack::do_backtrace_error_message (void) const -{ - if (error_state > 0) - { - error_state = -1; - - error ("called from:"); - } - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs.back (); - - octave_function *fcn = elt.fcn; - tree_statement *stmt = elt.stmt; - - std::string fcn_name = "?unknown?"; - - if (fcn) - { - fcn_name = fcn->fcn_file_name (); - - if (fcn_name.empty ()) - fcn_name = fcn->name (); - } - - int line = stmt ? stmt->line () : -1; - int column = stmt ? stmt->column () : -1; - - error (" %s at line %d, column %d", - fcn_name.c_str (), line, column); - } -} - -void -recover_from_exception (void) -{ - can_interrupt = true; - octave_interrupt_immediately = 0; - octave_interrupt_state = 0; - octave_signal_caught = 0; - octave_exception_state = octave_no_exception; - octave_restore_signal_mask (); - octave_catch_interrupts (); -} - -int -main_loop (void) -{ - octave_save_signal_mask (); - - can_interrupt = true; - - octave_signal_hook = octave_signal_handler; - octave_interrupt_hook = 0; - octave_bad_alloc_hook = 0; - - octave_catch_interrupts (); - - octave_initialized = true; - - // The big loop. - - int retval = 0; - do - { - try - { - unwind_protect frame; - - reset_error_handler (); - - reset_parser (); - - if (symbol_table::at_top_level ()) - tree_evaluator::reset_debug_state (); - - // Do this with an unwind-protect cleanup function so that - // the forced variables will be unmarked in the event of an - // interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - frame.protect_var (global_command); - - global_command = 0; - - // This is the same as yyparse in parse.y. - retval = octave_parse (); - - if (retval == 0) - { - if (global_command) - { - // Use an unwind-protect cleanup function so that the - // global_command list will be deleted in the event of - // an interrupt. - - frame.add_fcn (cleanup_statement_list, &global_command); - - global_command->accept (*current_evaluator); - - octave_quit (); - - if (! (interactive || forced_interactive)) - { - bool quit = (tree_return_command::returning - || tree_break_command::breaking); - - if (tree_return_command::returning) - tree_return_command::returning = 0; - - if (tree_break_command::breaking) - tree_break_command::breaking--; - - if (quit) - break; - } - - if (error_state) - { - if (! (interactive || forced_interactive)) - { - // We should exit with a non-zero status. - retval = 1; - break; - } - } - else - { - if (octave_completion_matches_called) - octave_completion_matches_called = false; - else - command_editor::increment_current_command_number (); - } - } - else if (parser_end_of_input) - break; - } - } - catch (octave_interrupt_exception) - { - recover_from_exception (); - octave_stdout << "\n"; - if (quitting_gracefully) - { - clean_up_and_exit (exit_status); - break; // If user has overriden the exit func. - } - } - catch (octave_execution_exception) - { - recover_from_exception (); - std::cerr - << "error: unhandled execution exception -- trying to return to prompt" - << std::endl; - } - catch (std::bad_alloc) - { - recover_from_exception (); - std::cerr - << "error: memory exhausted or requested size too large for range of Octave's index type -- trying to return to prompt" - << std::endl; - } - } - while (retval == 0); - - return retval; -} - -// Fix up things before exiting. - -void -clean_up_and_exit (int retval) -{ - do_octave_atexit (); - - if (octave_exit) - (*octave_exit) (retval == EOF ? 0 : retval); -} - -DEFUN (quit, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exit (@var{status})\n\ -@deftypefnx {Built-in Function} {} quit (@var{status})\n\ -Exit the current Octave session. If the optional integer value\n\ -@var{status} is supplied, pass that value to the operating system as the\n\ -Octave's exit status. The default value is zero.\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (! quit_allowed) - error ("quit: not supported in embedded mode"); - else - { - if (args.length () > 0) - { - int tmp = args(0).nint_value (); - - if (! error_state) - exit_status = tmp; - } - - if (! error_state) - { - // Instead of simply calling exit, we simulate an interrupt - // with a request to exit cleanly so that no matter where the - // call to quit occurs, we will run the unwind_protect stack, - // clear the OCTAVE_LOCAL_BUFFER allocations, etc. before - // exiting. - - quitting_gracefully = true; - - octave_interrupt_state = -1; - - octave_throw_interrupt_exception (); - } - } - - return retval; -} - -DEFALIAS (exit, quit); - -DEFUN (warranty, , , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} warranty ()\n\ -Describe the conditions for copying and distributing Octave.\n\ -@end deftypefn") -{ - octave_value_list retval; - - octave_stdout << "\n" \ - OCTAVE_NAME_VERSION_AND_COPYRIGHT "\n\ -\n\ -GNU Octave free software; you can redistribute it and/or modify\n\ -it under the terms of the GNU General Public License as published by\n\ -the Free Software Foundation; either version 3 of the License, or\n\ -(at your option) any later version.\n\ -\n\ -GNU Octave is distributed in the hope that it will be useful,\n\ -but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ -GNU General Public License for more details.\n\ -\n\ -You should have received a copy of the GNU General Public License\n\ -along with this program. If not, see .\n\ -\n"; - - return retval; -} - -// Execute a shell command. - -static int -wait_for_input (int fid) -{ - int retval = -1; - -#if defined (HAVE_SELECT) - if (fid >= 0) - { - fd_set set; - - FD_ZERO (&set); - FD_SET (fid, &set); - - retval = gnulib::select (FD_SETSIZE, &set, 0, 0, 0); - } -#else - retval = 1; -#endif - - return retval; -} - -static octave_value_list -run_command_and_return_output (const std::string& cmd_str) -{ - octave_value_list retval; - unwind_protect frame; - - iprocstream *cmd = new iprocstream (cmd_str.c_str ()); - - frame.add_delete (cmd); - frame.add_fcn (octave_child_list::remove, cmd->pid ()); - - if (*cmd) - { - int fid = cmd->file_number (); - - std::ostringstream output_buf; - - char ch; - - for (;;) - { - if (cmd->get (ch)) - output_buf.put (ch); - else - { - if (! cmd->eof () && errno == EAGAIN) - { - cmd->clear (); - - if (wait_for_input (fid) != 1) - break; - } - else - break; - } - } - - int cmd_status = cmd->close (); - - if (WIFEXITED (cmd_status)) - cmd_status = WEXITSTATUS (cmd_status); - else - cmd_status = 127; - - retval(1) = output_buf.str (); - retval(0) = cmd_status; - } - else - error ("unable to start subprocess for `%s'", cmd_str.c_str ()); - - return retval; -} - -enum system_exec_type { et_sync, et_async }; - -DEFUN (system, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} system (\"@var{string}\")\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output})\n\ -@deftypefnx {Built-in Function} {} system (\"@var{string}\", @var{return_output}, @var{type})\n\ -@deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} system (@dots{})\n\ -Execute a shell command specified by @var{string}.\n\ -If the optional argument @var{type} is \"async\", the process\n\ -is started in the background and the process ID of the child process\n\ -is returned immediately. Otherwise, the child process is started and\n\ -Octave waits until it exits. If the @var{type} argument is omitted, it\n\ -defaults to the value \"sync\".\n\ -\n\ -If @var{system} is called with one or more output arguments, or if the\n\ -optional argument @var{return_output} is true and the subprocess is started\n\ -synchronously, then the output from the command is returned as a variable. \n\ -Otherwise, if the subprocess is executed synchronously, its output is sent\n\ -to the standard output. To send the output of a command executed with\n\ -@code{system} through the pager, use a command like\n\ -\n\ -@example\n\ -@group\n\ -[output, text] = system (\"cmd\");\n\ -disp (text);\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -or\n\ -\n\ -@example\n\ -printf (\"%s\\n\", nthargout (2, \"system\", \"cmd\"));\n\ -@end example\n\ -\n\ -The @code{system} function can return two values. The first is the\n\ -exit status of the command and the second is any output from the\n\ -command that was written to the standard output stream. For example,\n\ -\n\ -@example\n\ -[status, output] = system (\"echo foo; exit 2\");\n\ -@end example\n\ -\n\ -@noindent\n\ -will set the variable @code{output} to the string @samp{foo}, and the\n\ -variable @code{status} to the integer @samp{2}.\n\ -\n\ -For commands run asynchronously, @var{status} is the process id of the\n\ -command shell that is started to run the command.\n\ -@seealso{unix, dos}\n\ -@end deftypefn") -{ - octave_value_list retval; - - unwind_protect frame; - - int nargin = args.length (); - - if (nargin > 0 && nargin < 4) - { - bool return_output = (nargin == 1 && nargout > 1); - - system_exec_type type = et_sync; - - if (nargin == 3) - { - std::string type_str = args(2).string_value (); - - if (! error_state) - { - if (type_str == "sync") - type = et_sync; - else if (type_str == "async") - type = et_async; - else - { - error ("system: TYPE must be \"sync\" or \"async\""); - return retval; - } - } - else - { - error ("system: TYPE must be a character string"); - return retval; - } - } - - if (nargin > 1) - { - return_output = args(1).is_true (); - - if (error_state) - { - error ("system: RETURN_OUTPUT must be boolean value true or false"); - return retval; - } - } - - if (return_output && type == et_async) - { - error ("system: can't return output from commands run asynchronously"); - return retval; - } - - std::string cmd_str = args(0).string_value (); - - if (! error_state) - { -#if defined (__WIN32__) && ! defined (__CYGWIN__) - // Work around weird double-quote handling on Windows systems. - if (type == et_sync) - cmd_str = "\"" + cmd_str + "\""; -#endif - - if (type == et_async) - { - // FIXME -- maybe this should go in sysdep.cc? -#ifdef HAVE_FORK - pid_t pid = fork (); - - if (pid < 0) - error ("system: fork failed -- can't create child process"); - else if (pid == 0) - { - // FIXME -- should probably replace this - // call with something portable. - - execl ("/bin/sh", "sh", "-c", cmd_str.c_str (), - static_cast (0)); - - panic_impossible (); - } - else - retval(0) = pid; -#elif defined (__WIN32__) - STARTUPINFO si; - PROCESS_INFORMATION pi; - ZeroMemory (&si, sizeof (si)); - ZeroMemory (&pi, sizeof (pi)); - OCTAVE_LOCAL_BUFFER (char, xcmd_str, cmd_str.length ()+1); - strcpy (xcmd_str, cmd_str.c_str ()); - - if (! CreateProcess (0, xcmd_str, 0, 0, FALSE, 0, 0, 0, &si, &pi)) - error ("system: CreateProcess failed -- can't create child process"); - else - { - retval(0) = pi.dwProcessId; - CloseHandle (pi.hProcess); - CloseHandle (pi.hThread); - } -#else - error ("asynchronous system calls are not supported"); -#endif - } - else if (return_output) - retval = run_command_and_return_output (cmd_str); - else - { - int status = system (cmd_str.c_str ()); - - // The value in status is as returned by waitpid. If - // the process exited normally, extract the actual exit - // status of the command. Otherwise, return 127 as a - // failure code. - - if (WIFEXITED (status)) - status = WEXITSTATUS (status); - - retval(0) = status; - } - } - else - error ("system: expecting string as first argument"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! cmd = ls_command (); -%! [status, output] = system (cmd); -%! assert (status, 0); -%! assert (ischar (output)); -%! assert (! isempty (output)); - -%!error system () -%!error system (1, 2, 3) -*/ - -// FIXME -- this should really be static, but that causes -// problems on some systems. -std::list octave_atexit_functions; - -void -do_octave_atexit (void) -{ - static bool deja_vu = false; - - while (! octave_atexit_functions.empty ()) - { - std::string fcn = octave_atexit_functions.front (); - - octave_atexit_functions.pop_front (); - - OCTAVE_SAFE_CALL (reset_error_handler, ()); - - OCTAVE_SAFE_CALL (feval, (fcn, octave_value_list (), 0)); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - if (! deja_vu) - { - deja_vu = true; - - // Do this explicitly so that destructors for mex file objects - // are called, so that functions registered with mexAtExit are - // called. - OCTAVE_SAFE_CALL (clear_mex_functions, ()); - - OCTAVE_SAFE_CALL (command_editor::restore_terminal_state, ()); - - // FIXME -- is this needed? Can it cause any trouble? - OCTAVE_SAFE_CALL (raw_mode, (0)); - - OCTAVE_SAFE_CALL (octave_history_write_timestamp, ()); - - if (! command_history::ignoring_entries ()) - OCTAVE_SAFE_CALL (command_history::clean_up_and_save, ()); - - OCTAVE_SAFE_CALL (gh_manager::close_all_figures, ()); - - OCTAVE_SAFE_CALL (gtk_manager::unload_all_toolkits, ()); - - OCTAVE_SAFE_CALL (close_files, ()); - - OCTAVE_SAFE_CALL (cleanup_tmp_files, ()); - - OCTAVE_SAFE_CALL (symbol_table::cleanup, ()); - - OCTAVE_SAFE_CALL (cleanup_parser, ()); - - OCTAVE_SAFE_CALL (sysdep_cleanup, ()); - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - - if (! quitting_gracefully && (interactive || forced_interactive)) - { - octave_stdout << "\n"; - - // Yes, we want this to be separate from the call to - // flush_octave_stdout above. - - OCTAVE_SAFE_CALL (flush_octave_stdout, ()); - } - - // Don't call singleton_cleanup_list::cleanup until we have the - // problems with registering/unregistering types worked out. For - // example, uncomment the following line, then use the make_int - // function from the examples directory to create an integer - // object and then exit Octave. Octave should crash with a - // segfault when cleaning up the typinfo singleton. We need some - // way to force new octave_value_X types that are created in - // .oct files to be unregistered when the .oct file shared library - // is unloaded. - // - // OCTAVE_SAFE_CALL (singleton_cleanup_list::cleanup, ()); - - OCTAVE_SAFE_CALL (octave_chunk_buffer::clear, ()); - } -} - -void -octave_add_atexit_function (const std::string& fname) -{ - octave_atexit_functions.push_front (fname); -} - -bool -octave_remove_atexit_function (const std::string& fname) -{ - bool found = false; - - for (std::list::iterator p = octave_atexit_functions.begin (); - p != octave_atexit_functions.end (); p++) - { - if (*p == fname) - { - octave_atexit_functions.erase (p); - found = true; - break; - } - } - - return found; -} - - -DEFUN (atexit, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} atexit (@var{fcn})\n\ -@deftypefnx {Built-in Function} {} atexit (@var{fcn}, @var{flag})\n\ -Register a function to be called when Octave exits. For example,\n\ -\n\ -@example\n\ -@group\n\ -function last_words ()\n\ - disp (\"Bye bye\");\n\ -endfunction\n\ -atexit (\"last_words\");\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -will print the message \"Bye bye\" when Octave exits.\n\ -\n\ -The additional argument @var{flag} will register or unregister\n\ -@var{fcn} from the list of functions to be called when Octave\n\ -exits. If @var{flag} is true, the function is registered, and if\n\ -@var{flag} is false, it is unregistered. For example,\n\ -after registering the function @code{last_words} above,\n\ -\n\ -@example\n\ -atexit (\"last_words\", false);\n\ -@end example\n\ -\n\ -@noindent\n\ -will remove the function from the list and Octave will not call\n\ -@code{last_words} when it exits.\n\ -\n\ -Note that @code{atexit} only removes the first occurrence of a function\n\ -from the list, so if a function was placed in the list multiple\n\ -times with @code{atexit}, it must also be removed from the list\n\ -multiple times.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - bool add_mode = true; - - if (nargin == 2) - { - add_mode = args(1).bool_value (); - - if (error_state) - error ("atexit: FLAG argument must be a logical value"); - } - - if (! error_state) - { - if (add_mode) - octave_add_atexit_function (arg); - else - { - bool found = octave_remove_atexit_function (arg); - - if (nargout > 0) - retval(0) = found; - } - } - } - else - error ("atexit: FCN argument must be a string"); - } - else - print_usage (); - - return retval; -} - -DEFUN (octave_config_info, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} octave_config_info ()\n\ -@deftypefnx {Built-in Function} {} octave_config_info (@var{option})\n\ -Return a structure containing configuration and installation\n\ -information for Octave.\n\ -\n\ -If @var{option} is a string, return the configuration information for the\n\ -specified option.\n\ -\n\ -@end deftypefn") -{ - octave_value retval; - -#if defined (ENABLE_DYNAMIC_LINKING) - bool octave_supports_dynamic_linking = true; -#else - bool octave_supports_dynamic_linking = false; -#endif - - static bool initialized = false; - static octave_scalar_map m; - - struct conf_info_struct - { - bool subst_home; - const char *key; - const char *val; - }; - - static const conf_info_struct conf_info[] = - { - { false, "ALL_CFLAGS", OCTAVE_CONF_ALL_CFLAGS }, - { false, "ALL_CXXFLAGS", OCTAVE_CONF_ALL_CXXFLAGS }, - { false, "ALL_FFLAGS", OCTAVE_CONF_ALL_FFLAGS }, - { false, "ALL_LDFLAGS", OCTAVE_CONF_ALL_LDFLAGS }, - { false, "AMD_CPPFLAGS", OCTAVE_CONF_AMD_CPPFLAGS }, - { false, "AMD_LDFLAGS", OCTAVE_CONF_AMD_LDFLAGS }, - { false, "AMD_LIBS", OCTAVE_CONF_AMD_LIBS }, - { false, "AR", OCTAVE_CONF_AR }, - { false, "ARFLAGS", OCTAVE_CONF_ARFLAGS }, - { false, "ARPACK_CPPFLAGS", OCTAVE_CONF_ARPACK_CPPFLAGS }, - { false, "ARPACK_LDFLAGS", OCTAVE_CONF_ARPACK_LDFLAGS }, - { false, "ARPACK_LIBS", OCTAVE_CONF_ARPACK_LIBS }, - { false, "BLAS_LIBS", OCTAVE_CONF_BLAS_LIBS }, - { false, "CARBON_LIBS", OCTAVE_CONF_CARBON_LIBS }, - { false, "CAMD_CPPFLAGS", OCTAVE_CONF_CAMD_CPPFLAGS }, - { false, "CAMD_LDFLAGS", OCTAVE_CONF_CAMD_LDFLAGS }, - { false, "CAMD_LIBS", OCTAVE_CONF_CAMD_LIBS }, - { false, "CC", OCTAVE_CONF_CC }, - { false, "CC_VERSION", OCTAVE_CONF_CC_VERSION }, - { false, "CCOLAMD_CPPFLAGS", OCTAVE_CONF_CCOLAMD_CPPFLAGS }, - { false, "CCOLAMD_LDFLAGS", OCTAVE_CONF_CCOLAMD_LDFLAGS }, - { false, "CCOLAMD_LIBS", OCTAVE_CONF_CCOLAMD_LIBS }, - { false, "CFLAGS", OCTAVE_CONF_CFLAGS }, - { false, "CHOLMOD_CPPFLAGS", OCTAVE_CONF_CHOLMOD_CPPFLAGS }, - { false, "CHOLMOD_LDFLAGS", OCTAVE_CONF_CHOLMOD_LDFLAGS }, - { false, "CHOLMOD_LIBS", OCTAVE_CONF_CHOLMOD_LIBS }, - { false, "COLAMD_CPPFLAGS", OCTAVE_CONF_COLAMD_CPPFLAGS }, - { false, "COLAMD_LDFLAGS", OCTAVE_CONF_COLAMD_LDFLAGS }, - { false, "COLAMD_LIBS", OCTAVE_CONF_COLAMD_LIBS }, - { false, "CPICFLAG", OCTAVE_CONF_CPICFLAG }, - { false, "CPPFLAGS", OCTAVE_CONF_CPPFLAGS }, - { false, "CURL_CPPFLAGS", OCTAVE_CONF_CURL_CPPFLAGS }, - { false, "CURL_LDFLAGS", OCTAVE_CONF_CURL_LDFLAGS }, - { false, "CURL_LIBS", OCTAVE_CONF_CURL_LIBS }, - { false, "CXSPARSE_CPPFLAGS", OCTAVE_CONF_CXSPARSE_CPPFLAGS }, - { false, "CXSPARSE_LDFLAGS", OCTAVE_CONF_CXSPARSE_LDFLAGS }, - { false, "CXSPARSE_LIBS", OCTAVE_CONF_CXSPARSE_LIBS }, - { false, "CXX", OCTAVE_CONF_CXX }, - { false, "CXXCPP", OCTAVE_CONF_CXXCPP }, - { false, "CXXFLAGS", OCTAVE_CONF_CXXFLAGS }, - { false, "CXXPICFLAG", OCTAVE_CONF_CXXPICFLAG }, - { false, "CXX_VERSION", OCTAVE_CONF_CXX_VERSION }, - { false, "DEFAULT_PAGER", OCTAVE_DEFAULT_PAGER }, - { false, "DEFS", OCTAVE_CONF_DEFS }, - { false, "DL_LD", OCTAVE_CONF_DL_LD }, - { false, "DL_LDFLAGS", OCTAVE_CONF_DL_LDFLAGS }, - { false, "DL_LIBS", OCTAVE_CONF_DL_LIBS }, - { false, "ENABLE_DYNAMIC_LINKING", OCTAVE_CONF_ENABLE_DYNAMIC_LINKING }, - { false, "EXEEXT", OCTAVE_CONF_EXEEXT }, - { false, "F77", OCTAVE_CONF_F77 }, - { false, "F77_FLOAT_STORE_FLAG", OCTAVE_CONF_F77_FLOAT_STORE_FLAG }, - { false, "F77_INTEGER_8_FLAG", OCTAVE_CONF_F77_INTEGER_8_FLAG }, - { false, "FC", OCTAVE_CONF_FC }, - { false, "FFLAGS", OCTAVE_CONF_FFLAGS }, - { false, "FFTW3_CPPFLAGS", OCTAVE_CONF_FFTW3_CPPFLAGS }, - { false, "FFTW3_LDFLAGS", OCTAVE_CONF_FFTW3_LDFLAGS }, - { false, "FFTW3_LIBS", OCTAVE_CONF_FFTW3_LIBS }, - { false, "FFTW3F_CPPFLAGS", OCTAVE_CONF_FFTW3F_CPPFLAGS }, - { false, "FFTW3F_LDFLAGS", OCTAVE_CONF_FFTW3F_LDFLAGS }, - { false, "FFTW3F_LIBS", OCTAVE_CONF_FFTW3F_LIBS }, - { false, "FLIBS", OCTAVE_CONF_FLIBS }, - { false, "FPICFLAG", OCTAVE_CONF_FPICFLAG }, - { false, "FT2_LIBS", OCTAVE_CONF_FT2_LIBS }, - { false, "GLPK_CPPFLAGS", OCTAVE_CONF_GLPK_CPPFLAGS }, - { false, "GLPK_LDFLAGS", OCTAVE_CONF_GLPK_LDFLAGS }, - { false, "GLPK_LIBS", OCTAVE_CONF_GLPK_LIBS }, - { false, "GNUPLOT", OCTAVE_CONF_GNUPLOT }, - { false, "GRAPHICS_LIBS", OCTAVE_CONF_GRAPHICS_LIBS }, - { false, "HDF5_CPPFLAGS", OCTAVE_CONF_HDF5_CPPFLAGS }, - { false, "HDF5_LDFLAGS", OCTAVE_CONF_HDF5_LDFLAGS }, - { false, "HDF5_LIBS", OCTAVE_CONF_HDF5_LIBS }, - { false, "INCFLAGS", OCTAVE_CONF_INCFLAGS }, - { false, "LAPACK_LIBS", OCTAVE_CONF_LAPACK_LIBS }, - { false, "LDFLAGS", OCTAVE_CONF_LDFLAGS }, - { false, "LD_CXX", OCTAVE_CONF_LD_CXX }, - { false, "LD_STATIC_FLAG", OCTAVE_CONF_LD_STATIC_FLAG }, - { false, "LEX", OCTAVE_CONF_LEX }, - { false, "LEXLIB", OCTAVE_CONF_LEXLIB }, - { false, "LFLAGS", OCTAVE_CONF_LFLAGS }, - { false, "LIBCRUFT", OCTAVE_CONF_LIBCRUFT }, - { false, "LIBEXT", OCTAVE_CONF_LIBEXT }, - { false, "LIBFLAGS", OCTAVE_CONF_LIBFLAGS }, - { false, "LIBOCTAVE", OCTAVE_CONF_LIBOCTAVE }, - { false, "LIBOCTINTERP", OCTAVE_CONF_LIBOCTINTERP }, - { false, "LIBS", OCTAVE_CONF_LIBS }, - { false, "LN_S", OCTAVE_CONF_LN_S }, - { false, "MAGICK_CPPFLAGS", OCTAVE_CONF_MAGICK_CPPFLAGS }, - { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, - { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, - { false, "LLVM_CPPFLAGS", OCTAVE_CONF_LLVM_CPPFLAGS }, - { false, "LLVM_LDFLAGS", OCTAVE_CONF_LLVM_LDFLAGS }, - { false, "LLVM_LIBS", OCTAVE_CONF_LLVM_LIBS }, - { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, - { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, - { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, - { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, - { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, - { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, - { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, - { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, - { false, "QHULL_CPPFLAGS", OCTAVE_CONF_QHULL_CPPFLAGS }, - { false, "QHULL_LDFLAGS", OCTAVE_CONF_QHULL_LDFLAGS }, - { false, "QHULL_LIBS", OCTAVE_CONF_QHULL_LIBS }, - { false, "QRUPDATE_CPPFLAGS", OCTAVE_CONF_QRUPDATE_CPPFLAGS }, - { false, "QRUPDATE_LDFLAGS", OCTAVE_CONF_QRUPDATE_LDFLAGS }, - { false, "QRUPDATE_LIBS", OCTAVE_CONF_QRUPDATE_LIBS }, - { false, "RANLIB", OCTAVE_CONF_RANLIB }, - { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, - { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, - { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, - { false, "SED", OCTAVE_CONF_SED }, - { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, - { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, - { false, "SHLEXT_VER", OCTAVE_CONF_SHLEXT_VER }, - { false, "SH_LD", OCTAVE_CONF_SH_LD }, - { false, "SH_LDFLAGS", OCTAVE_CONF_SH_LDFLAGS }, - { false, "SONAME_FLAGS", OCTAVE_CONF_SONAME_FLAGS }, - { false, "STATIC_LIBS", OCTAVE_CONF_STATIC_LIBS }, - { false, "TERM_LIBS", OCTAVE_CONF_TERM_LIBS }, - { false, "UGLY_DEFS", OCTAVE_CONF_UGLY_DEFS }, - { false, "UMFPACK_CPPFLAGS", OCTAVE_CONF_UMFPACK_CPPFLAGS }, - { false, "UMFPACK_LDFLAGS", OCTAVE_CONF_UMFPACK_LDFLAGS }, - { false, "UMFPACK_LIBS", OCTAVE_CONF_UMFPACK_LIBS }, - { false, "USE_64_BIT_IDX_T", OCTAVE_CONF_USE_64_BIT_IDX_T }, - { false, "X11_INCFLAGS", OCTAVE_CONF_X11_INCFLAGS }, - { false, "X11_LIBS", OCTAVE_CONF_X11_LIBS }, - { false, "XTRA_CFLAGS", OCTAVE_CONF_XTRA_CFLAGS }, - { false, "XTRA_CXXFLAGS", OCTAVE_CONF_XTRA_CXXFLAGS }, - { false, "YACC", OCTAVE_CONF_YACC }, - { false, "YFLAGS", OCTAVE_CONF_YFLAGS }, - { false, "Z_CPPFLAGS", OCTAVE_CONF_Z_CPPFLAGS }, - { false, "Z_LDFLAGS", OCTAVE_CONF_Z_LDFLAGS }, - { false, "Z_LIBS", OCTAVE_CONF_Z_LIBS }, - { false, "api_version", OCTAVE_API_VERSION }, - { true, "archlibdir", OCTAVE_ARCHLIBDIR }, - { true, "bindir", OCTAVE_BINDIR }, - { false, "canonical_host_type", OCTAVE_CANONICAL_HOST_TYPE }, - { false, "config_opts", OCTAVE_CONF_config_opts }, - { true, "datadir", OCTAVE_DATADIR }, - { true, "datarootdir", OCTAVE_DATAROOTDIR }, - { true, "exec_prefix", OCTAVE_EXEC_PREFIX }, - { true, "fcnfiledir", OCTAVE_FCNFILEDIR }, - { true, "imagedir", OCTAVE_IMAGEDIR }, - { true, "includedir", OCTAVE_INCLUDEDIR }, - { true, "infodir", OCTAVE_INFODIR }, - { true, "infofile", OCTAVE_INFOFILE }, - { true, "libdir", OCTAVE_LIBDIR }, - { true, "libexecdir", OCTAVE_LIBEXECDIR }, - { true, "localapiarchlibdir", OCTAVE_LOCALAPIARCHLIBDIR }, - { true, "localapifcnfiledir", OCTAVE_LOCALAPIFCNFILEDIR }, - { true, "localapioctfiledir", OCTAVE_LOCALAPIOCTFILEDIR }, - { true, "localarchlibdir", OCTAVE_LOCALARCHLIBDIR }, - { true, "localfcnfiledir", OCTAVE_LOCALFCNFILEDIR }, - { true, "localoctfiledir", OCTAVE_LOCALOCTFILEDIR }, - { true, "localstartupfiledir", OCTAVE_LOCALSTARTUPFILEDIR }, - { true, "localverarchlibdir", OCTAVE_LOCALVERARCHLIBDIR }, - { true, "localverfcnfiledir", OCTAVE_LOCALVERFCNFILEDIR }, - { true, "localveroctfiledir", OCTAVE_LOCALVEROCTFILEDIR }, - { true, "man1dir", OCTAVE_MAN1DIR }, - { false, "man1ext", OCTAVE_MAN1EXT }, - { true, "mandir", OCTAVE_MANDIR }, - { true, "octfiledir", OCTAVE_OCTFILEDIR }, - { true, "octetcdir", OCTAVE_OCTETCDIR }, - { true, "octincludedir", OCTAVE_OCTINCLUDEDIR }, - { true, "octlibdir", OCTAVE_OCTLIBDIR }, - { true, "prefix", OCTAVE_PREFIX }, - { true, "startupfiledir", OCTAVE_STARTUPFILEDIR }, - { false, "version", OCTAVE_VERSION }, - { false, 0, 0 } - }; - - if (! initialized) - { - m.assign ("dld", octave_value (octave_supports_dynamic_linking)); - - oct_mach_info::float_format ff = oct_mach_info::native_float_format (); - m.assign ("float_format", - octave_value (oct_mach_info::float_format_as_string (ff))); - - m.assign ("words_big_endian", - octave_value (oct_mach_info::words_big_endian ())); - - m.assign ("words_little_endian", - octave_value (oct_mach_info::words_little_endian ())); - - int i = 0; - - while (true) - { - const conf_info_struct& elt = conf_info[i++]; - - const char *key = elt.key; - - if (key) - { - if (elt.subst_home) - m.assign (key, subst_octave_home (elt.val)); - else - m.assign (key, elt.val); - } - else - break; - } - - bool unix_system = true; - bool mac_system = false; - bool windows_system = false; - -#if defined (WIN32) - windows_system = true; -#if !defined (__CYGWIN__) - unix_system = false; -#endif -#endif - -#if defined (OCTAVE_USE_OS_X_API) - mac_system = true; -#endif - - m.assign ("unix", octave_value (unix_system)); - m.assign ("mac", octave_value (mac_system)); - m.assign ("windows", octave_value (windows_system)); - - initialized = true; - } - - int nargin = args.length (); - - if (nargin == 1) - { - std::string arg = args(0).string_value (); - - if (! error_state) - { - Cell c = m.contents (arg.c_str ()); - - if (c.is_empty ()) - error ("octave_config_info: no info for `%s'", arg.c_str ()); - else - retval = c(0); - } - } - else if (nargin == 0) - retval = m; - else - print_usage (); - - return retval; -} - -/* -%!assert (ischar (octave_config_info ("version"))) -%!test -%! x = octave_config_info (); -%! assert (isstruct (x)); -%! assert (! isempty (x)); - -%!error octave_config_info (1, 2) -*/ - -#if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) - -int debug_new_delete = 0; - -typedef void (*vfp)(void); -extern vfp __new_handler; - -void * -__builtin_new (size_t sz) -{ - void *p; - - /* malloc (0) is unpredictable; avoid it. */ - if (sz == 0) - sz = 1; - p = malloc (sz); - while (p == 0) - { - (*__new_handler) (); - p = malloc (sz); - } - - if (debug_new_delete) - std::cerr << "__builtin_new: " << p << std::endl; - - return p; -} - -void -__builtin_delete (void *ptr) -{ - if (debug_new_delete) - std::cerr << "__builtin_delete: " << ptr << std::endl; - - if (ptr) - free (ptr); -} - -#endif diff -r 069c552587a0 -r 959953dba519 src/toplev.h --- a/src/toplev.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,455 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_toplev_h) -#define octave_toplev_h 1 - -#include - -#include -#include - -class octave_value; -class octave_value_list; -class octave_function; -class octave_user_script; -class tree_statement; -class tree_statement_list; -class charMatrix; - -#include "quit.h" - -#include "input.h" -#include "oct-map.h" - - -typedef void (*octave_exit_func) (int); -extern OCTINTERP_API octave_exit_func octave_exit; - -extern OCTINTERP_API bool quit_allowed; - -extern OCTINTERP_API bool quitting_gracefully; - -extern OCTINTERP_API int exit_status; - -extern OCTINTERP_API void -clean_up_and_exit (int); - -extern OCTINTERP_API void recover_from_exception (void); - -extern OCTINTERP_API int main_loop (void); - -extern OCTINTERP_API void -do_octave_atexit (void); - -extern OCTINTERP_API void -octave_add_atexit_function (const std::string& fname); - -extern OCTINTERP_API bool -octave_remove_atexit_function (const std::string& fname); - -// Current command to execute. -extern OCTINTERP_API tree_statement_list *global_command; - -// TRUE means we are ready to interpret commands, but not everything -// is ready for interactive use. -extern OCTINTERP_API bool octave_interpreter_ready; - -// TRUE means we've processed all the init code and we are good to go. -extern OCTINTERP_API bool octave_initialized; - -class -OCTINTERP_API -octave_call_stack -{ -private: - - struct call_stack_elt - { - call_stack_elt (octave_function *f, symbol_table::scope_id s, - symbol_table::context_id c, size_t p = 0) - : fcn (f), stmt (0), scope (s), context (c), prev (p) { } - - call_stack_elt (const call_stack_elt& elt) - : fcn (elt.fcn), stmt (elt.stmt), scope (elt.scope), - context (elt.context), prev (elt.prev) { } - - octave_function *fcn; - tree_statement *stmt; - symbol_table::scope_id scope; - symbol_table::context_id context; - size_t prev; - }; - -protected: - - octave_call_stack (void) : cs (), curr_frame (0) { } - -public: - - typedef std::deque::iterator iterator; - typedef std::deque::const_iterator const_iterator; - - typedef std::deque::reverse_iterator reverse_iterator; - typedef std::deque::const_reverse_iterator const_reverse_iterator; - - static void create_instance (void); - - static bool instance_ok (void) - { - bool retval = true; - - if (! instance) - create_instance (); - - if (! instance) - { - ::error ("unable to create call stack object!"); - - retval = false; - } - - return retval; - } - - // Current function (top of stack). - static octave_function *current (void) - { - return instance_ok () ? instance->do_current () : 0; - } - - // Current statement (top of stack). - static tree_statement *current_statement (void) - { - return instance_ok () ? instance->do_current_statement () : 0; - } - - // Current line in current function. - static int current_line (void) - { - return instance_ok () ? instance->do_current_line () : -1; - } - - // Current column in current function. - static int current_column (void) - { - return instance_ok () ? instance->do_current_column () : -1; - } - - // Line in user code caller. - static int caller_user_code_line (void) - { - return instance_ok () ? instance->do_caller_user_code_line () : -1; - } - - // Column in user code caller. - static int caller_user_code_column (void) - { - return instance_ok () ? instance->do_caller_user_code_column () : -1; - } - - // Caller function, may be built-in. - static octave_function *caller (void) - { - return instance_ok () ? instance->do_caller () : 0; - } - - static size_t current_frame (void) - { - return instance_ok () ? instance->do_current_frame () : 0; - } - - static size_t size (void) - { - return instance_ok () ? instance->do_size () : 0; - } - - static size_t num_user_code_frames (octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_num_user_code_frames (curr_user_frame) : 0; - } - - static symbol_table::scope_id current_scope (void) - { - return instance_ok () ? instance->do_current_scope () : 0; - } - - static symbol_table::context_id current_context (void) - { - return instance_ok () ? instance->do_current_context () : 0; - } - - // Function at location N on the call stack (N == 0 is current), may - // be built-in. - static octave_function *element (size_t n) - { - return instance_ok () ? instance->do_element (n) : 0; - } - - // First user-defined function on the stack. - static octave_user_code *caller_user_code (size_t nskip = 0) - { - return instance_ok () ? instance->do_caller_user_code (nskip) : 0; - } - - static void - push (octave_function *f, - symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (f, scope, context); - } - - static void - push (symbol_table::scope_id scope = symbol_table::current_scope (), - symbol_table::context_id context = symbol_table::current_context ()) - { - if (instance_ok ()) - instance->do_push (0, scope, context); - } - - static void set_statement (tree_statement *s) - { - if (instance_ok ()) - instance->do_set_statement (s); - } - - static bool goto_frame (size_t n = 0, bool verbose = false) - { - return instance_ok () ? instance->do_goto_frame (n, verbose) : false; - } - - static void restore_frame (size_t n) - { - goto_frame (n); - } - - static bool goto_frame_relative (int n, bool verbose = false) - { - return instance_ok () - ? instance->do_goto_frame_relative (n, verbose) : false; - } - - static void goto_caller_frame (void) - { - if (instance_ok ()) - instance->do_goto_caller_frame (); - } - - static void goto_base_frame (void) - { - if (instance_ok ()) - instance->do_goto_base_frame (); - } - - static octave_map backtrace (size_t nskip, octave_idx_type& curr_user_frame) - { - return instance_ok () - ? instance->do_backtrace (nskip, curr_user_frame) : octave_map (); - } - - static octave_map empty_backtrace (void); - - static void pop (void) - { - if (instance_ok ()) - instance->do_pop (); - } - - static void clear (void) - { - if (instance_ok ()) - instance->do_clear (); - } - - static void backtrace_error_message (void) - { - if (instance_ok ()) - instance->do_backtrace_error_message (); - } - -private: - - // The current call stack. - std::deque cs; - - size_t curr_frame; - - static octave_call_stack *instance; - - static void cleanup_instance (void) { delete instance; instance = 0; } - - int do_current_line (void) const; - - int do_current_column (void) const; - - int do_caller_user_code_line (void) const; - - int do_caller_user_code_column (void) const; - - octave_function *do_caller (void) const - { - return curr_frame > 1 ? cs[curr_frame-1].fcn : cs[0].fcn; - } - - size_t do_current_frame (void) { return curr_frame; } - - size_t do_size (void) { return cs.size (); } - - size_t do_num_user_code_frames (octave_idx_type& curr_user_frame) const; - - symbol_table::scope_id do_current_scope (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].scope : 0; - } - - symbol_table::context_id do_current_context (void) const - { - return curr_frame > 0 && curr_frame < cs.size () - ? cs[curr_frame].context : 0; - } - - octave_function *do_element (size_t n) - { - octave_function *retval = 0; - - if (cs.size () > n) - { - call_stack_elt& elt = cs[n]; - retval = elt.fcn; - } - - return retval; - } - - octave_user_code *do_caller_user_code (size_t nskip) const; - - void do_push (octave_function *f, symbol_table::scope_id scope, - symbol_table::context_id context) - { - size_t prev_frame = curr_frame; - curr_frame = cs.size (); - cs.push_back (call_stack_elt (f, scope, context, prev_frame)); - symbol_table::set_scope_and_context (scope, context); - } - - octave_function *do_current (void) const - { - octave_function *retval = 0; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.fcn; - } - - return retval; - } - - tree_statement *do_current_statement (void) const - { - tree_statement *retval = 0; - - if (! cs.empty ()) - { - const call_stack_elt& elt = cs[curr_frame]; - retval = elt.stmt; - } - - return retval; - } - - void do_set_statement (tree_statement *s) - { - if (! cs.empty ()) - { - call_stack_elt& elt = cs.back (); - elt.stmt = s; - } - } - - octave_map do_backtrace (size_t nskip, - octave_idx_type& curr_user_frame) const; - - bool do_goto_frame (size_t n, bool verbose); - - bool do_goto_frame_relative (int n, bool verbose); - - void do_goto_caller_frame (void); - - void do_goto_base_frame (void); - - void do_pop (void) - { - if (cs.size () > 1) - { - const call_stack_elt& elt = cs.back (); - curr_frame = elt.prev; - cs.pop_back (); - const call_stack_elt& new_elt = cs[curr_frame]; - symbol_table::set_scope_and_context (new_elt.scope, new_elt.context); - } - } - - void do_clear (void) { cs.clear (); } - - void do_backtrace_error_message (void) const; -}; - -// Call a function with exceptions handled to avoid problems with -// errors while shutting down. - -#define OCTAVE_IGNORE_EXCEPTION(E) \ - catch (E) \ - { \ - std::cerr << "error: ignoring " #E " while preparing to exit" << std::endl; \ - recover_from_exception (); \ - } - -#define OCTAVE_SAFE_CALL(F, ARGS) \ - do \ - { \ - try \ - { \ - unwind_protect frame; \ - \ - frame.protect_var (Vdebug_on_error); \ - frame.protect_var (Vdebug_on_warning); \ - \ - Vdebug_on_error = false; \ - Vdebug_on_warning = false; \ - \ - F ARGS; \ - } \ - OCTAVE_IGNORE_EXCEPTION (octave_interrupt_exception) \ - OCTAVE_IGNORE_EXCEPTION (octave_execution_exception) \ - OCTAVE_IGNORE_EXCEPTION (std::bad_alloc) \ - \ - if (error_state) \ - error_state = 0; \ - } \ - while (0) - -#endif diff -r 069c552587a0 -r 959953dba519 src/utils.cc --- a/src/utils.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1432 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include -#include - -#include -#include -#include - -#include -#include - -#include "vasnprintf.h" - -#include "quit.h" - -#include "dir-ops.h" -#include "file-ops.h" -#include "file-stat.h" -#include "lo-mappers.h" -#include "lo-utils.h" -#include "oct-cmplx.h" -#include "oct-env.h" -#include "pathsearch.h" -#include "str-vec.h" - -#include "Cell.h" -#include -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-errno.h" -#include "oct-hist.h" -#include "oct-obj.h" -#include "ov-range.h" -#include "pager.h" -#include "parse.h" -#include "sysdep.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Return TRUE if S is a valid identifier. - -bool -valid_identifier (const char *s) -{ - if (! s || ! (isalpha (*s) || *s == '_' || *s == '$')) - return false; - - while (*++s != '\0') - if (! (isalnum (*s) || *s == '_' || *s == '$')) - return false; - - return true; -} - -bool -valid_identifier (const std::string& s) -{ - return valid_identifier (s.c_str ()); -} - -DEFUN (isvarname, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isvarname (@var{name})\n\ -Return true if @var{name} is a valid variable name.\n\ -@seealso{iskeyword, exist, who}\n\ -@end deftypefn") -{ - octave_value retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("isvarname"); - - if (error_state) - return retval; - - if (argc == 2) - retval = valid_identifier (argv[1]) && ! is_keyword (argv[1]); - else - print_usage (); - - return retval; -} - -/* -%!assert (isvarname ("foo"), true) -%!assert (isvarname ("_foo"), true) -%!assert (isvarname ("_1"), true) -%!assert (isvarname ("1foo"), false) -%!assert (isvarname (""), false) - -%!error isvarname () -%!error isvarname ("foo", "bar"); -*/ - -// Return TRUE if F and G are both names for the same file. - -bool -same_file (const std::string& f, const std::string& g) -{ - return same_file_internal (f, g); -} - -int -almost_match (const std::string& std, const std::string& s, int min_match_len, - int case_sens) -{ - int stdlen = std.length (); - int slen = s.length (); - - return (slen <= stdlen - && slen >= min_match_len - && (case_sens - ? (strncmp (std.c_str (), s.c_str (), slen) == 0) - : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0))); -} - -// Ugh. - -int -keyword_almost_match (const char * const *std, int *min_len, const std::string& s, - int min_toks_to_match, int max_toks) -{ - int status = 0; - int tok_count = 0; - int toks_matched = 0; - - if (s.empty () || max_toks < 1) - return status; - - char *kw = strsave (s.c_str ()); - - char *t = kw; - while (*t != '\0') - { - if (*t == '\t') - *t = ' '; - t++; - } - - char *beg = kw; - while (*beg == ' ') - beg++; - - if (*beg == '\0') - return status; - - - const char **to_match = new const char * [max_toks + 1]; - const char * const *s1 = std; - const char **s2 = to_match; - - if (! s1 || ! s2) - goto done; - - s2[tok_count] = beg; - char *end; - while ((end = strchr (beg, ' ')) != 0) - { - *end = '\0'; - beg = end + 1; - - while (*beg == ' ') - beg++; - - if (*beg == '\0') - break; - - tok_count++; - if (tok_count >= max_toks) - goto done; - - s2[tok_count] = beg; - } - s2[tok_count+1] = 0; - - s2 = to_match; - - for (;;) - { - if (! almost_match (*s1, *s2, min_len[toks_matched], 0)) - goto done; - - toks_matched++; - - s1++; - s2++; - - if (! *s2) - { - status = (toks_matched >= min_toks_to_match); - goto done; - } - - if (! *s1) - goto done; - } - - done: - - delete [] kw; - delete [] to_match; - - return status; -} - -// Return non-zero if either NR or NC is zero. Return -1 if this -// should be considered fatal; return 1 if this is ok. - -int -empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc) -{ - return (nr == 0 || nc == 0); -} - -// See if the given file is in the path. - -std::string -search_path_for_file (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - return octave_env::make_absolute (p.find_first_of (names)); -} - -// Find all locations of the given file in the path. - -string_vector -search_path_for_all_files (const std::string& path, const string_vector& names) -{ - dir_path p (path); - - string_vector sv = p.find_all_first_of (names); - - octave_idx_type len = sv.length (); - - for (octave_idx_type i = 0; i < len; i++) - sv[i] = octave_env::make_absolute (sv[i]); - - return sv; -} - -static string_vector -make_absolute (const string_vector& sv) -{ - octave_idx_type len = sv.length (); - - string_vector retval (len); - - for (octave_idx_type i = 0; i < len; i++) - retval[i] = octave_env::make_absolute (sv[i]); - - return retval; -} - -DEFUN (file_in_loadpath, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\ -\n\ -Return the absolute name of @var{file} if it can be found in\n\ -the list of directories specified by @code{path}.\n\ -If no file is found, return an empty character string.\n\ -\n\ -If the first argument is a cell array of strings, search each\n\ -directory of the loadpath for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the second optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_path, path}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - string_vector names = args(0).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 1) - retval = octave_env::make_absolute (load_path::find_first_of (names)); - else if (nargin == 2) - { - std::string opt = args(1).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (load_path::find_all_first_of (names))); - else - error ("file_in_loadpath: invalid option"); - } - } - else - error ("file_in_loadpath: FILE argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_loadpath ("plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_loadpath () -%!error file_in_loadpath ("foo", "bar", 1) -*/ - -DEFUN (file_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ -@deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\ -Return the absolute name of @var{file} if it can be found in\n\ -@var{path}. The value of @var{path} should be a colon-separated list of\n\ -directories in the format described for @code{path}. If no file\n\ -is found, return an empty character string. For example:\n\ -\n\ -@example\n\ -@group\n\ -file_in_path (EXEC_PATH, \"sh\")\n\ - @result{} \"/bin/sh\"\n\ -@end group\n\ -@end example\n\ -\n\ -If the second argument is a cell array of strings, search each\n\ -directory of the path for element of the cell array and return\n\ -the first that matches.\n\ -\n\ -If the third optional argument @code{\"all\"} is supplied, return\n\ -a cell array containing the list of all files that have the same\n\ -name in the path. If no files are found, return an empty cell array.\n\ -@seealso{file_in_loadpath}\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 2 || nargin == 3) - { - std::string path = args(0).string_value (); - - if (! error_state) - { - string_vector names = args(1).all_strings (); - - if (! error_state && names.length () > 0) - { - if (nargin == 2) - retval = search_path_for_file (path, names); - else if (nargin == 3) - { - std::string opt = args(2).string_value (); - - if (! error_state && opt == "all") - retval = Cell (make_absolute - (search_path_for_all_files (path, names))); - else - error ("file_in_path: invalid option"); - } - } - else - error ("file_in_path: all arguments must be strings"); - } - else - error ("file_in_path: PATH must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! f = file_in_path (path (), "plot.m"); -%! assert (ischar (f)); -%! assert (! isempty (f)); - -%!test -%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); -%! assert (f, ""); - -%!test -%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); -%! assert (lst, {}); - -%!error file_in_path () -%!error file_in_path ("foo") -%!error file_in_path ("foo", "bar", "baz", 1) -*/ - -std::string -file_in_path (const std::string& name, const std::string& suffix) -{ - std::string nm = name; - - if (! suffix.empty ()) - nm.append (suffix); - - return octave_env::make_absolute (load_path::find_file (nm)); -} - -// See if there is an function file in the path. If so, return the -// full path to the file. - -std::string -fcn_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm') - retval = load_path::find_fcn_file (name.substr (0, len-2)); - else - { - std::string fname = name; - size_t pos = name.find_first_of (Vfilemarker); - if (pos != std::string::npos) - fname = name.substr (0, pos); - - retval = load_path::find_fcn_file (fname); - } - } - - return retval; -} - -// See if there is a directory called "name" in the path and if it -// contains a Contents.m file return the full path to this file. - -std::string -contents_file_in_path (const std::string& dir) -{ - std::string retval; - - if (dir.length () > 0) - { - std::string tcontents = file_ops::concat (load_path::find_dir (dir), - std::string ("Contents.m")); - - file_stat fs (tcontents); - - if (fs.exists ()) - retval = octave_env::make_absolute (tcontents); - } - - return retval; -} - -// See if there is a .oct file in the path. If so, return the -// full path to the file. - -std::string -oct_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o' - && name[len - 2] == 'c' && name[len - 1] == 't') - retval = load_path::find_oct_file (name.substr (0, len-4)); - else - retval = load_path::find_oct_file (name); - } - - return retval; -} - -// See if there is a .mex file in the path. If so, return the -// full path to the file. - -std::string -mex_file_in_path (const std::string& name) -{ - std::string retval; - - int len = name.length (); - - if (len > 0) - { - if (octave_env::absolute_pathname (name)) - { - file_stat fs (name); - - if (fs.exists ()) - retval = name; - } - else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm' - && name[len - 2] == 'e' && name[len - 1] == 'x') - retval = load_path::find_mex_file (name.substr (0, len-4)); - else - retval = load_path::find_mex_file (name); - } - - return retval; -} - -// Replace backslash escapes in a string with the real values. - -std::string -do_string_escapes (const std::string& s) -{ - std::string retval; - - size_t i = 0; - size_t j = 0; - size_t len = s.length (); - - retval.resize (len); - - while (j < len) - { - if (s[j] == '\\' && j+1 < len) - { - switch (s[++j]) - { - case '0': - retval[i] = '\0'; - break; - - case 'a': - retval[i] = '\a'; - break; - - case 'b': // backspace - retval[i] = '\b'; - break; - - case 'f': // formfeed - retval[i] = '\f'; - break; - - case 'n': // newline - retval[i] = '\n'; - break; - - case 'r': // carriage return - retval[i] = '\r'; - break; - - case 't': // horizontal tab - retval[i] = '\t'; - break; - - case 'v': // vertical tab - retval[i] = '\v'; - break; - - case '\\': // backslash - retval[i] = '\\'; - break; - - case '\'': // quote - retval[i] = '\''; - break; - - case '"': // double quote - retval[i] = '"'; - break; - - default: - warning ("unrecognized escape sequence `\\%c' --\ - converting to `%c'", s[j], s[j]); - retval[i] = s[j]; - break; - } - } - else - { - retval[i] = s[j]; - } - - i++; - j++; - } - - retval.resize (i); - - return retval; -} - -DEFUN (do_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\ -Convert special characters in @var{string} to their escaped forms.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = do_string_escapes (args(0).string_value ()); - else - error ("do_string_escapes: STRING argument must be of type string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (do_string_escapes ('foo\nbar'), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar") -%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]) -%!assert ("foo\nbar", ["foo", char(10), "bar"]) - -%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v") -%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), -%! char ([7, 8, 12, 10, 13, 9, 11])) -%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])) - -%!error do_string_escapes () -%!error do_string_escapes ("foo", "bar") -*/ - -const char * -undo_string_escape (char c) -{ - if (! c) - return ""; - - switch (c) - { - case '\0': - return "\\0"; - - case '\a': - return "\\a"; - - case '\b': // backspace - return "\\b"; - - case '\f': // formfeed - return "\\f"; - - case '\n': // newline - return "\\n"; - - case '\r': // carriage return - return "\\r"; - - case '\t': // horizontal tab - return "\\t"; - - case '\v': // vertical tab - return "\\v"; - - case '\\': // backslash - return "\\\\"; - - case '"': // double quote - return "\\\""; - - default: - { - static char retval[2]; - retval[0] = c; - retval[1] = '\0'; - return retval; - } - } -} - -std::string -undo_string_escapes (const std::string& s) -{ - std::string retval; - - for (size_t i = 0; i < s.length (); i++) - retval.append (undo_string_escape (s[i])); - - return retval; -} - -DEFUN (undo_string_escapes, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\ -Convert special characters in strings back to their escaped forms. For\n\ -example, the expression\n\ -\n\ -@example\n\ -bell = \"\\a\";\n\ -@end example\n\ -\n\ -@noindent\n\ -assigns the value of the alert character (control-g, ASCII code 7) to\n\ -the string variable @code{bell}. If this string is printed, the\n\ -system will ring the terminal bell (if it is possible). This is\n\ -normally the desired outcome. However, sometimes it is useful to be\n\ -able to print the original representation of the string, with the\n\ -special characters replaced by their escape sequences. For example,\n\ -\n\ -@example\n\ -@group\n\ -octave:13> undo_string_escapes (bell)\n\ -ans = \\a\n\ -@end group\n\ -@end example\n\ -\n\ -@noindent\n\ -replaces the unprintable alert character with its printable\n\ -representation.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - retval = undo_string_escapes (args(0).string_value ()); - else - error ("undo_string_escapes: S argument must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar') -%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar") -%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar") - -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v') -%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v") -%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), -%! "\\a\\b\\f\\n\\r\\t\\v") - -%!error undo_string_escapes () -%!error undo_string_escapes ("foo", "bar") -*/ - -DEFUN (is_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ -Return true if @var{file} is an absolute filename.\n\ -@seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::absolute_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_absolute_filename () -%!error is_absolute_filename ("foo", "bar") -*/ - -DEFUN (is_rooted_relative_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ -Return true if @var{file} is a rooted-relative filename.\n\ -@seealso{is_absolute_filename, make_absolute_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = false; - - if (args.length () == 1) - retval = (args(0).is_string () - && octave_env::rooted_relative_pathname (args(0).string_value ())); - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error is_rooted_relative_filename () -%!error is_rooted_relative_filename ("foo", "bar") -*/ - -DEFUN (make_absolute_filename, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ -Return the full name of @var{file} beginning from the root of the file\n\ -system. No check is done for the existence of @var{file}.\n\ -@seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - if (args.length () == 1) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_env::make_absolute (nm); - else - error ("make_absolute_filename: FILE argument must be a file name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error make_absolute_filename () -%!error make_absolute_filename ("foo", "bar") -*/ - -DEFUN (find_dir_in_path, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ -@deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\ -Return the full name of the path element matching @var{dir}. The\n\ -match is performed at the end of each path element. For example, if\n\ -@var{dir} is @code{\"foo/bar\"}, it matches the path element\n\ -@code{\"/some/dir/foo/bar\"}, but not @code{\"/some/dir/foo/bar/baz\"}\n\ -or @code{\"/some/dir/allfoo/bar\"}.\n\ -\n\ -The second argument is optional. If it is supplied, return a cell array\n\ -containing all name matches rather than just the first.\n\ -@end deftypefn") -{ - octave_value retval = std::string (); - - int nargin = args.length (); - - std::string dir; - - if (nargin == 1 || nargin == 2) - { - dir = args(0).string_value (); - - if (! error_state) - { - if (nargin == 1) - retval = load_path::find_dir (dir); - else if (nargin == 2) - retval = Cell (load_path::find_matching_dirs (dir)); - } - else - error ("find_dir_in_path: DIR must be a directory name"); - } - else - print_usage (); - - return retval; -} - -/* -## FIXME: We need system-dependent tests here. - -%!error find_dir_in_path () -%!error find_dir_in_path ("foo", "bar", 1) -*/ - -DEFUNX ("errno", Ferrno, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{err} =} errno ()\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\ -@deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\ -Return the current value of the system-dependent variable errno,\n\ -set its value to @var{val} and return the previous value, or return\n\ -the named error code given @var{name} as a character string, or -1\n\ -if @var{name} is not found.\n\ -@end deftypefn") -{ - octave_value retval; - - int nargin = args.length (); - - if (nargin == 1) - { - if (args(0).is_string ()) - { - std::string nm = args(0).string_value (); - - if (! error_state) - retval = octave_errno::lookup (nm); - else - error ("errno: expecting character string argument"); - } - else - { - int val = args(0).int_value (); - - if (! error_state) - retval = octave_errno::set (val); - else - error ("errno: expecting integer argument"); - } - } - else if (nargin == 0) - retval = octave_errno::get (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isnumeric (errno ())) - -%!test -%! lst = errno_list (); -%! fns = fieldnames (lst); -%! oldval = errno (fns{1}); -%! assert (isnumeric (oldval)); -%! errno (oldval); -%! newval = errno (); -%! assert (oldval, newval); - -%!error errno ("foo", 1) -*/ - -DEFUN (errno_list, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} errno_list ()\n\ -Return a structure containing the system-dependent errno values.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 0) - retval = octave_errno::list (); - else - print_usage (); - - return retval; -} - -/* -%!assert (isstruct (errno_list ())) - -%!error errno_list ("foo") -*/ - -static void -check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) -{ - if (nr < 0 || nc < 0) - { - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); - - nr = (nr < 0) ? 0 : nr; - nc = (nc < 0) ? 0 : nc; - } -} - -void -check_dimensions (dim_vector& dim, const char *warnfor) -{ - bool neg = false; - - for (int i = 0; i < dim.length (); i++) - { - if (dim(i) < 0) - { - dim(i) = 0; - neg = true; - } - } - - if (neg) - warning_with_id ("Octave:neg-dim-as-zero", - "%s: converting negative dimension to zero", warnfor); -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim) -{ - if (a.is_scalar_type ()) - { - dim.resize (2); - dim(0) = a.int_value (); - dim(1) = dim(0); - } - else - { - octave_idx_type nr = a.rows (); - octave_idx_type nc = a.columns (); - - if (nr == 1 || nc == 1) - { - Array v = a.vector_value (); - - if (error_state) - return; - - octave_idx_type n = v.length (); - dim.resize (n); - for (octave_idx_type i = 0; i < n; i++) - dim(i) = static_cast (fix (v(i))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (dim, warn_for); // May set error_state. -} - - -void -get_dimensions (const octave_value& a, const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc) -{ - if (a.is_scalar_type ()) - { - nr = nc = a.int_value (); - } - else - { - nr = a.rows (); - nc = a.columns (); - - if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) - { - Array v = a.vector_value (); - - if (error_state) - return; - - nr = static_cast (fix (v (0))); - nc = static_cast (fix (v (1))); - } - else - error ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - if (! error_state) - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, octave_idx_type& nc) -{ - nr = a.is_empty () ? 0 : a.int_value (); - nc = b.is_empty () ? 0 : b.int_value (); - - if (error_state) - error ("%s: expecting two scalar arguments", warn_for); - else - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx) -{ - octave_idx_type retval; - - octave_idx_type len = idx.length (); - - if (len == 0) - retval = dims.numel (); - else - { - const dim_vector dv = dims.redim (len); - retval = 1; - for (octave_idx_type i = 0; i < len; i++) - { - octave_value idxi = idx(i); - if (idxi.is_magic_colon ()) - retval *= dv(i); - else if (idxi.is_numeric_type ()) - retval *= idxi.numel (); - else - { - idx_vector jdx = idxi.index_vector (); - if (error_state) - break; - retval *= jdx.length (dv(i)); - } - } - } - - return retval; -} - -Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - Matrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc) -{ - FloatMatrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - octave_idx_type n = std::min (nr, nc); - - for (octave_idx_type i = 0; i < n; i++) - m (i, i) = 1.0; - } - - return m; -} - -size_t -octave_format (std::ostream& os, const char *fmt, ...) -{ - size_t retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vformat (os, fmt, args); - - va_end (args); - - return retval; -} - -size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args) -{ - std::string s = octave_vasprintf (fmt, args); - - os << s; - - return s.length (); -} - -std::string -octave_vasprintf (const char *fmt, va_list args) -{ - std::string retval; - - char *result; - - int status = gnulib::vasprintf (&result, fmt, args); - - if (status >= 0) - { - retval = result; - ::free (result); - } - - return retval; -} - -std::string -octave_asprintf (const char *fmt, ...) -{ - std::string retval; - - va_list args; - va_start (args, fmt); - - retval = octave_vasprintf (fmt, args); - - va_end (args); - - return retval; -} - -void -octave_sleep (double seconds) -{ - if (seconds > 0) - { - double t; - - unsigned int usec - = static_cast (modf (seconds, &t) * 1000000); - - unsigned int sec - = (t > UINT_MAX) ? UINT_MAX : static_cast (t); - - // Versions of these functions that accept unsigned int args are - // defined in cutils.c. - octave_sleep (sec); - octave_usleep (usec); - - octave_quit (); - } -} - -DEFUN (isindex, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isindex (@var{ind})\n\ -@deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\ -Return true if @var{ind} is a valid index. Valid indices are\n\ -either positive integers (although possibly of real data type), or logical\n\ -arrays. If present, @var{n} specifies the maximum extent of the dimension\n\ -to be indexed. When possible the internal result is cached so that\n\ -subsequent indexing using @var{ind} will not perform the check again.\n\ -@end deftypefn") -{ - octave_value retval; - int nargin = args.length (); - octave_idx_type n = 0; - - if (nargin == 2) - n = args(1).idx_type_value (); - else if (nargin != 1) - print_usage (); - - if (! error_state) - { - unwind_protect frame; - - frame.protect_var (Vallow_noninteger_range_as_index); - Vallow_noninteger_range_as_index = false; - - frame.protect_var (error_state); - - frame.protect_var (discard_error_messages); - discard_error_messages = true; - - try - { - idx_vector idx = args(0).index_vector (); - if (! error_state) - { - if (nargin == 2) - retval = idx.extent (n) <= n; - else - retval = true; - } - else - retval = false; - } - catch (octave_execution_exception) - { - retval = false; - } - } - - return retval; -} - -/* -%!assert (isindex ([1, 2, 3])) -%!assert (isindex (1:3)) -%!assert (isindex ([1, 2, -3]), false) - -%!error isindex () -*/ - -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout) -{ - octave_value_list new_args = args, retval; - int nargin = args.length (); - OCTAVE_LOCAL_BUFFER (bool, iscell, nargin); - OCTAVE_LOCAL_BUFFER (Cell, cells, nargin); - OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout); - - const Cell *ccells = cells; - - octave_idx_type numel = 1; - dim_vector dims (1, 1); - - for (int i = 0; i < nargin; i++) - { - octave_value arg = new_args(i); - iscell[i] = arg.is_cell (); - if (iscell[i]) - { - cells[i] = arg.cell_value (); - octave_idx_type n = ccells[i].numel (); - if (n == 1) - { - iscell[i] = false; - new_args(i) = ccells[i](0); - } - else if (numel == 1) - { - numel = n; - dims = ccells[i].dims (); - } - else if (dims != ccells[i].dims ()) - { - error ("%s: cell arguments must have matching sizes", fun_name); - break; - } - } - } - - if (! error_state) - { - for (int i = 0; i < nargout; i++) - rcells[i].clear (dims); - - for (octave_idx_type j = 0; j < numel; j++) - { - for (int i = 0; i < nargin; i++) - if (iscell[i]) - new_args(i) = ccells[i](j); - - octave_quit (); - - const octave_value_list tmp = fun (new_args, nargout); - - if (tmp.length () < nargout) - { - error ("%s: do_simple_cellfun: internal error", fun_name); - break; - } - else - { - for (int i = 0; i < nargout; i++) - rcells[i](j) = tmp(i); - } - } - } - - if (! error_state) - { - retval.resize (nargout); - for (int i = 0; i < nargout; i++) - retval(i) = rcells[i]; - } - - return retval; -} - -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args) -{ - octave_value retval; - const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1); - if (tmp.length () > 0) - retval = tmp(0); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/utils.h --- a/src/utils.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_utils_h) -#define octave_utils_h 1 - -#include - -#include -#include -#include - -#include "dMatrix.h" -#include "lo-utils.h" - -#include "cutils.h" - -class octave_value; -class octave_value_list; -class string_vector; - -extern OCTINTERP_API bool valid_identifier (const char *s); -extern OCTINTERP_API bool valid_identifier (const std::string& s); - -extern OCTINTERP_API bool -same_file (const std::string& f, const std::string& g); - -extern OCTINTERP_API int almost_match (const std::string& std, - const std::string& s, - int min_match_len = 1, - int case_sens = 1); - -extern OCTINTERP_API int -keyword_almost_match (const char * const *std, int *min_len, - const std::string& s, int min_toks_to_match, - int max_toks); - -extern OCTINTERP_API int empty_arg (const char *name, octave_idx_type nr, - octave_idx_type nc); - -extern OCTINTERP_API std::string -search_path_for_file (const std::string&, const string_vector&); - -extern OCTINTERP_API string_vector -search_path_for_all_files (const std::string&, const string_vector&); - -extern OCTINTERP_API std::string -file_in_path (const std::string&, const std::string&); - -extern OCTINTERP_API std::string contents_file_in_path (const std::string&); - -extern OCTINTERP_API std::string fcn_file_in_path (const std::string&); -extern OCTINTERP_API std::string oct_file_in_path (const std::string&); -extern OCTINTERP_API std::string mex_file_in_path (const std::string&); - -extern OCTINTERP_API std::string do_string_escapes (const std::string& s); - -extern OCTINTERP_API const char *undo_string_escape (char c); - -extern OCTINTERP_API std::string undo_string_escapes (const std::string& s); - -extern OCTINTERP_API void -check_dimensions (dim_vector& dim, const char *warnfor); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const char *warn_for, - dim_vector& dim); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a, const octave_value& b, - const char *warn_for, octave_idx_type& nr, - octave_idx_type& nc); - -extern OCTINTERP_API void -get_dimensions (const octave_value& a,const char *warn_for, - octave_idx_type& nr, octave_idx_type& nc); - -extern OCTINTERP_API octave_idx_type -dims_to_numel (const dim_vector& dims, const octave_value_list& idx); - -extern OCTINTERP_API Matrix -identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API FloatMatrix -float_identity_matrix (octave_idx_type nr, octave_idx_type nc); - -extern OCTINTERP_API size_t -octave_format (std::ostream& os, const char *fmt, ...); - -extern OCTINTERP_API size_t -octave_vformat (std::ostream& os, const char *fmt, va_list args); - -extern OCTINTERP_API std::string -octave_vasprintf (const char *fmt, va_list args); - -extern OCTINTERP_API std::string octave_asprintf (const char *fmt, ...); - -extern OCTINTERP_API void octave_sleep (double seconds); - -extern OCTINTERP_API -octave_value_list -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args, - int nargout); - -extern OCTINTERP_API -octave_value -do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), - const char *fun_name, const octave_value_list& args); - -#endif diff -r 069c552587a0 -r 959953dba519 src/variables.cc --- a/src/variables.cc Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2596 +0,0 @@ -/* - -Copyright (C) 1993-2012 John W. Eaton -Copyright (C) 2009-2010 VZLU Prague - -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 3 of the License, 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, see -. - -*/ - -#ifdef HAVE_CONFIG_H -#include -#endif - -#include -#include - -#include -#include -#include - -#include "file-stat.h" -#include "oct-env.h" -#include "file-ops.h" -#include "glob-match.h" -#include "regexp.h" -#include "str-vec.h" - -#include -#include "Cell.h" -#include "defun.h" -#include "dirfns.h" -#include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "lex.h" -#include "load-path.h" -#include "oct-map.h" -#include "oct-obj.h" -#include "ov.h" -#include "ov-class.h" -#include "ov-usr-fcn.h" -#include "pager.h" -#include "parse.h" -#include "symtab.h" -#include "toplev.h" -#include "unwind-prot.h" -#include "utils.h" -#include "variables.h" - -// Defines layout for the whos/who -long command -static std::string Vwhos_line_format - = " %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\n"; - -void -clear_mex_functions (void) -{ - symbol_table::clear_mex_functions (); -} - -void -clear_function (const std::string& nm) -{ - symbol_table::clear_function (nm); -} - -void -clear_variable (const std::string& nm) -{ - symbol_table::clear_variable (nm); -} - -void -clear_symbol (const std::string& nm) -{ - symbol_table::clear_symbol (nm); -} - -// Attributes of variables and functions. - -// Is this octave_value a valid function? - -octave_function * -is_valid_function (const std::string& fcn_name, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - if (! fcn_name.empty ()) - { - octave_value val = symbol_table::find_function (fcn_name); - - if (val.is_defined ()) - ans = val.function_value (true); - } - - if (! ans && warn) - error ("%s: the symbol `%s' is not valid as a function", - warn_for.c_str (), fcn_name.c_str ()); - - return ans; -} - -octave_function * -is_valid_function (const octave_value& arg, - const std::string& warn_for, bool warn) -{ - octave_function *ans = 0; - - std::string fcn_name; - - if (arg.is_string ()) - { - fcn_name = arg.string_value (); - - if (! error_state) - ans = is_valid_function (fcn_name, warn_for, warn); - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - } - else if (warn) - error ("%s: expecting function name as argument", warn_for.c_str ()); - - return ans; -} - -octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer) -{ - octave_function *retval = 0; - - retval = is_valid_function (arg, warn_for, 0); - - if (! retval) - { - std::string s = arg.string_value (); - - std::string cmd = header; - cmd.append (s); - cmd.append (trailer); - - if (! error_state) - { - int parse_status; - - eval_string (cmd, true, parse_status, 0); - - if (parse_status == 0) - { - retval = is_valid_function (fname, warn_for, 0); - - if (! retval) - { - error ("%s: `%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - return retval; - } - - warning ("%s: passing function body as a string is obsolete; please use anonymous functions", - warn_for.c_str ()); - } - else - error ("%s: `%s' is not valid as a function", - warn_for.c_str (), fname.c_str ()); - } - else - error ("%s: expecting first argument to be a string", - warn_for.c_str ()); - } - - return retval; -} - -string_vector -get_struct_elts (const std::string& text) -{ - int n = 1; - - size_t pos = 0; - - size_t len = text.length (); - - while ((pos = text.find ('.', pos)) != std::string::npos) - { - if (++pos == len) - break; - - n++; - } - - string_vector retval (n); - - pos = 0; - - for (int i = 0; i < n; i++) - { - len = text.find ('.', pos); - - if (len != std::string::npos) - len -= pos; - - retval[i] = text.substr (pos, len); - - if (len != std::string::npos) - pos += len + 1; - } - - return retval; -} - -static inline bool -is_variable (const std::string& name) -{ - bool retval = false; - - if (! name.empty ()) - { - octave_value val = symbol_table::varval (name); - - retval = val.is_defined (); - } - - return retval; -} - -string_vector -generate_struct_completions (const std::string& text, - std::string& prefix, std::string& hint) -{ - string_vector names; - - size_t pos = text.rfind ('.'); - - if (pos != std::string::npos) - { - if (pos == text.length ()) - hint = ""; - else - hint = text.substr (pos+1); - - prefix = text.substr (0, pos); - - std::string base_name = prefix; - - pos = base_name.find_first_of ("{(."); - - if (pos != std::string::npos) - base_name = base_name.substr (0, pos); - - if (is_variable (base_name)) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (error_state); - frame.protect_var (warning_state); - - frame.protect_var (discard_error_messages); - frame.protect_var (discard_warning_messages); - - discard_error_messages = true; - discard_warning_messages = true; - - octave_value tmp = eval_string (prefix, true, parse_status); - - frame.run (); - - if (tmp.is_defined () && tmp.is_map ()) - names = tmp.map_keys (); - } - } - - return names; -} - -// FIXME -- this will have to be much smarter to work -// "correctly". - -bool -looks_like_struct (const std::string& text) -{ - bool retval = (! text.empty () - && text != "." - && text.find_first_of (file_ops::dir_sep_chars ()) == std::string::npos - && text.find ("..") == std::string::npos - && text.rfind ('.') != std::string::npos); - -#if 0 - symbol_record *sr = curr_sym_tab->lookup (text); - - if (sr && ! sr->is_function ()) - { - int parse_status; - - unwind_protect frame; - - frame.protect_var (discard_error_messages); - frame.protect_var (error_state); - - discard_error_messages = true; - - octave_value tmp = eval_string (text, true, parse_status); - - frame.run (); - - retval = (tmp.is_defined () && tmp.is_map ()); - } -#endif - - return retval; -} - -static octave_value -do_isglobal (const octave_value_list& args) -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin != 1) - { - print_usage (); - return retval; - } - - std::string name = args(0).string_value (); - - if (error_state) - { - error ("isglobal: NAME must be a string"); - return retval; - } - - return symbol_table::is_global (name); -} - -DEFUN (isglobal, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} isglobal (@var{name})\n\ -Return true if @var{name} is a globally visible variable.\n\ -For example:\n\ -\n\ -@example\n\ -@group\n\ -global x\n\ -isglobal (\"x\")\n\ - @result{} 1\n\ -@end group\n\ -@end example\n\ -@seealso{isvarname, exist}\n\ -@end deftypefn") -{ - return do_isglobal (args); -} - -static octave_value -safe_symbol_lookup (const std::string& symbol_name) -{ - octave_value retval; - - unwind_protect frame; - interpreter_try (frame); - - retval = symbol_table::find (symbol_name); - - error_state = 0; - - return retval; -} - -int -symbol_exist (const std::string& name, const std::string& type) -{ - int retval = 0; - - std::string struct_elts; - std::string symbol_name = name; - - size_t pos = name.find ('.'); - - if (pos != std::string::npos && pos > 0) - { - struct_elts = name.substr (pos+1); - symbol_name = name.substr (0, pos); - } - - // We shouldn't need to look in the global symbol table, since any - // name that is visible in the current scope will be in the local - // symbol table. - - octave_value val = safe_symbol_lookup (symbol_name); - - if (val.is_defined ()) - { - bool not_a_struct = struct_elts.empty (); - bool var_ok = not_a_struct /* || val.is_map_element (struct_elts) */; - - if (! retval - && var_ok - && (type == "any" || type == "var") - && (val.is_constant () || val.is_object () - || val.is_function_handle () - || val.is_anonymous_function () - || val.is_inline_function ())) - { - retval = 1; - } - - if (! retval - && (type == "any" || type == "builtin")) - { - if (not_a_struct && val.is_builtin_function ()) - { - retval = 5; - } - } - - if (! retval - && not_a_struct - && (type == "any" || type == "file") - && (val.is_user_function () || val.is_dld_function ())) - { - octave_function *f = val.function_value (true); - std::string s = f ? f->fcn_file_name () : std::string (); - - retval = s.empty () ? 103 : (val.is_user_function () ? 2 : 3); - } - } - - if (! (type == "var" || type == "builtin")) - { - if (! retval) - { - std::string file_name = lookup_autoload (name); - - if (file_name.empty ()) - file_name = load_path::find_fcn (name); - - size_t len = file_name.length (); - - if (len > 0) - { - if (type == "any" || type == "file") - { - if (len > 4 && (file_name.substr (len-4) == ".oct" - || file_name.substr (len-4) == ".mex")) - retval = 3; - else - retval = 2; - } - } - } - - if (! retval) - { - std::string file_name = file_in_path (name, ""); - - if (file_name.empty ()) - file_name = name; - - file_stat fs (file_name); - - if (fs) - { - if (type == "any" || type == "file") - retval = fs.is_dir () ? 7 : 2; - else if (type == "dir" && fs.is_dir ()) - retval = 7; - } - } - } - - return retval; -} - -#define GET_IDX(LEN) \ - static_cast ((LEN-1) * static_cast (rand ()) / RAND_MAX) - -std::string -unique_symbol_name (const std::string& basename) -{ - static const std::string alpha - = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"; - - static size_t len = alpha.length (); - - std::string nm = basename + alpha[GET_IDX (len)]; - - size_t pos = nm.length (); - - if (nm.substr (0, 2) == "__") - nm.append ("__"); - - while (symbol_exist (nm, "any")) - nm.insert (pos++, 1, alpha[GET_IDX (len)]); - - return nm; -} - -DEFUN (exist, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} exist (@var{name}, @var{type})\n\ -Return 1 if the name exists as a variable, 2 if the name is an\n\ -absolute file name, an ordinary file in Octave's @code{path}, or (after\n\ -appending @samp{.m}) a function file in Octave's @code{path}, 3 if the\n\ -name is a @samp{.oct} or @samp{.mex} file in Octave's @code{path},\n\ -5 if the name is a built-in function, 7 if the name is a directory, or 103\n\ -if the name is a function not associated with a file (entered on\n\ -the command line).\n\ -\n\ -Otherwise, return 0.\n\ -\n\ -This function also returns 2 if a regular file called @var{name}\n\ -exists in Octave's search path. If you want information about\n\ -other types of files, you should use some combination of the functions\n\ -@code{file_in_path} and @code{stat} instead.\n\ -\n\ -If the optional argument @var{type} is supplied, check only for\n\ -symbols of the specified type. Valid types are\n\ -\n\ -@table @asis\n\ -@item \"var\"\n\ -Check only for variables.\n\ -\n\ -@item \"builtin\"\n\ -Check only for built-in functions.\n\ -\n\ -@item \"file\"\n\ -Check only for files.\n\ -\n\ -@item \"dir\"\n\ -Check only for directories.\n\ -@end table\n\ -\n\ -@seealso{file_in_loadpath}\n\ -@end deftypefn") -{ - octave_value retval = false; - - int nargin = args.length (); - - if (nargin == 1 || nargin == 2) - { - std::string name = args(0).string_value (); - - if (! error_state) - { - std::string type - = (nargin == 2) ? args(1).string_value () : std::string ("any"); - - if (! error_state) - retval = symbol_exist (name, type); - else - error ("exist: TYPE must be a string"); - } - else - error ("exist: NAME must be a string"); - } - else - print_usage (); - - return retval; -} - -/* -%!test -%! if (isunix ()) -%! assert (exist ("/tmp") == 7); -%! assert (exist ("/tmp", "file") == 7); -%! assert (exist ("/tmp", "dir") == 7); -%! assert (exist ("/bin/sh") == 2); -%! assert (exist ("/bin/sh", "file") == 2); -%! assert (exist ("/bin/sh", "dir") == 0); -%! assert (exist ("/dev/null") == 2); -%! assert (exist ("/dev/null", "file") == 2); -%! assert (exist ("/dev/null", "dir") == 0); -%! endif -*/ - -octave_value -lookup_function_handle (const std::string& nm) -{ - octave_value val = symbol_table::varval (nm); - - return val.is_function_handle () ? val : octave_value (); -} - -octave_value -get_global_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::global_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_global_value: undefined symbol `%s'", nm.c_str ()); - - return val; -} - -void -set_global_value (const std::string& nm, const octave_value& val) -{ - symbol_table::global_varref (nm) = val; -} - -octave_value -get_top_level_value (const std::string& nm, bool silent) -{ - octave_value val = symbol_table::top_level_varval (nm); - - if (val.is_undefined () && ! silent) - error ("get_top_level_value: undefined symbol `%s'", nm.c_str ()); - - return val; -} - -void -set_top_level_value (const std::string& nm, const octave_value& val) -{ - symbol_table::top_level_varref (nm) = val; -} - -// Variable values. - -static bool -wants_local_change (const octave_value_list& args, int& nargin) -{ - bool retval = false; - - if (nargin == 2) - { - if (args(1).is_string () && args(1).string_value () == "local") - { - nargin = 1; - retval = true; - } - else - { - error_with_cfn ("expecting second argument to be \"local\""); - nargin = 0; - } - } - - return retval; -} - -template -bool try_local_protect (T& var) -{ - octave_user_code *curr_usr_code = octave_call_stack::caller_user_code (); - octave_user_function *curr_usr_fcn = 0; - if (curr_usr_code && curr_usr_code->is_user_function ()) - curr_usr_fcn = dynamic_cast (curr_usr_code); - - if (curr_usr_fcn && curr_usr_fcn->local_protect (var)) - return true; - else - return false; -} - -octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - bool bval = args(0).bool_value (); - - if (! error_state) - var = bval; - else - error ("%s: expecting arg to be a logical value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - switch (sval.length ()) - { - case 1: - var = sval[0]; - break; - - case 0: - var = '\0'; - break; - - default: - error ("%s: argument must be a single character", nm); - break; - } - } - else - error ("%s: argument must be a single character", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval, int maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - int ival = args(0).int_value (); - - if (! error_state) - { - if (ival < minval) - error ("%s: expecting arg to be greater than %d", nm, minval); - else if (ival > maxval) - error ("%s: expecting arg to be less than or equal to %d", - nm, maxval); - else - var = ival; - } - else - error ("%s: expecting arg to be an integer value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval, double maxval) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - double dval = args(0).scalar_value (); - - if (! error_state) - { - if (dval < minval) - error ("%s: expecting arg to be greater than %g", minval); - else if (dval > maxval) - error ("%s: expecting arg to be less than or equal to %g", maxval); - else - var = dval; - } - else - error ("%s: expecting arg to be a scalar value", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok) -{ - octave_value retval; - - int nargin = args.length (); - - if (nargout > 0 || nargin == 0) - retval = var; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - if (empty_ok || ! sval.empty ()) - var = sval; - else - error ("%s: value must not be empty", nm); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices) -{ - octave_value retval; - int nchoices = 0; - while (choices[nchoices] != 0) - nchoices++; - - int nargin = args.length (); - assert (var < nchoices); - - if (nargout > 0 || nargin == 0) - retval = choices[var]; - - if (wants_local_change (args, nargin)) - { - if (! try_local_protect (var)) - warning ("\"local\" has no effect outside a function"); - } - - if (nargin == 1) - { - std::string sval = args(0).string_value (); - - if (! error_state) - { - int i = 0; - for (; i < nchoices; i++) - { - if (sval == choices[i]) - { - var = i; - break; - } - } - if (i == nchoices) - error ("%s: value not allowed (\"%s\")", nm, sval.c_str ()); - } - else - error ("%s: expecting arg to be a character string", nm); - } - else if (nargin > 1) - print_usage (); - - return retval; -} - -struct -whos_parameter -{ - char command; - char modifier; - int parameter_length; - int first_parameter_length; - int balance; - std::string text; - std::string line; -}; - -static void -print_descriptor (std::ostream& os, std::list params) -{ - // This method prints a line of information on a given symbol - std::list::iterator i = params.begin (); - std::ostringstream param_buf; - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::right) << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command != 's') - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - os << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - param_buf << std::setiosflags (std::ios::left) << std::setw (param.parameter_length); - } - - if (param.command == 's' && param.modifier == 'c') - { - int a, b; - - if (param.modifier == 'c') - { - a = param.first_parameter_length - param.balance; - a = (a < 0 ? 0 : a); - b = param.parameter_length - a - param.text . length (); - b = (b < 0 ? 0 : b); - os << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.text - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - param_buf << std::setiosflags (std::ios::left) << std::setw (a) - << "" << std::resetiosflags (std::ios::left) << param.line - << std::setiosflags (std::ios::left) - << std::setw (b) << "" - << std::resetiosflags (std::ios::left); - } - } - else - { - os << param.text; - param_buf << param.line; - } - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - param_buf << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - param_buf << param.line; - i++; - } - } - - os << param_buf.str (); -} - -// FIXME -- This is a bit of a kluge. We'd like to just use val.dims() -// and if val is an object, expect that dims will call size if it is -// overloaded by a user-defined method. But there are currently some -// unresolved const issues that prevent that solution from working. - -std::string -get_dims_str (const octave_value& val) -{ - octave_value tmp = val; - - Matrix sz = tmp.size (); - - dim_vector dv = dim_vector::alloc (sz.numel ()); - - for (octave_idx_type i = 0; i < dv.length (); i++) - dv(i) = sz(i); - - return dv.str (); -} - -class -symbol_info_list -{ -private: - struct symbol_info - { - symbol_info (const symbol_table::symbol_record& sr, - const std::string& expr_str = std::string (), - const octave_value& expr_val = octave_value ()) - : name (expr_str.empty () ? sr.name () : expr_str), - varval (expr_val.is_undefined () ? sr.varval () : expr_val), - is_automatic (sr.is_automatic ()), - is_complex (varval.is_complex_type ()), - is_formal (sr.is_formal ()), - is_global (sr.is_global ()), - is_persistent (sr.is_persistent ()) - { } - - void display_line (std::ostream& os, - const std::list& params) const - { - std::string dims_str = get_dims_str (varval); - - std::list::const_iterator i = params.begin (); - - while (i != params.end ()) - { - whos_parameter param = *i; - - if (param.command != '\0') - { - // Do the actual printing. - - switch (param.modifier) - { - case 'l': - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - break; - - case 'r': - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - break; - - case 'c': - if (param.command == 's') - { - int front = param.first_parameter_length - - dims_str.find ('x'); - int back = param.parameter_length - - dims_str.length () - - front; - front = (front > 0) ? front : 0; - back = (back > 0) ? back : 0; - - os << std::setiosflags (std::ios::left) - << std::setw (front) - << "" - << std::resetiosflags (std::ios::left) - << dims_str - << std::setiosflags (std::ios::left) - << std::setw (back) - << "" - << std::resetiosflags (std::ios::left); - } - else - { - os << std::setiosflags (std::ios::left) - << std::setw (param.parameter_length); - } - break; - - default: - error ("whos_line_format: modifier `%c' unknown", - param.modifier); - - os << std::setiosflags (std::ios::right) - << std::setw (param.parameter_length); - } - - switch (param.command) - { - case 'a': - { - char tmp[6]; - - tmp[0] = (is_automatic ? 'a' : ' '); - tmp[1] = (is_complex ? 'c' : ' '); - tmp[2] = (is_formal ? 'f' : ' '); - tmp[3] = (is_global ? 'g' : ' '); - tmp[4] = (is_persistent ? 'p' : ' '); - tmp[5] = 0; - - os << tmp; - } - break; - - case 'b': - os << varval.byte_size (); - break; - - case 'c': - os << varval.class_name (); - break; - - case 'e': - os << varval.capacity (); - break; - - case 'n': - os << name; - break; - - case 's': - if (param.modifier != 'c') - os << dims_str; - break; - - case 't': - os << varval.type_name (); - break; - - default: - error ("whos_line_format: command `%c' unknown", - param.command); - } - - os << std::resetiosflags (std::ios::left) - << std::resetiosflags (std::ios::right); - i++; - } - else - { - os << param.text; - i++; - } - } - } - - std::string name; - octave_value varval; - bool is_automatic; - bool is_complex; - bool is_formal; - bool is_global; - bool is_persistent; - }; - -public: - symbol_info_list (void) : lst () { } - - symbol_info_list (const symbol_info_list& sil) : lst (sil.lst) { } - - symbol_info_list& operator = (const symbol_info_list& sil) - { - if (this != &sil) - lst = sil.lst; - - return *this; - } - - ~symbol_info_list (void) { } - - void append (const symbol_table::symbol_record& sr) - { - lst.push_back (symbol_info (sr)); - } - - void append (const symbol_table::symbol_record& sr, - const std::string& expr_str, - const octave_value& expr_val) - { - lst.push_back (symbol_info (sr, expr_str, expr_val)); - } - - size_t size (void) const { return lst.size (); } - - bool empty (void) const { return lst.empty (); } - - octave_map - map_value (const std::string& caller_function_name, int nesting_level) const - { - size_t len = lst.size (); - - Cell name_info (len, 1); - Cell size_info (len, 1); - Cell bytes_info (len, 1); - Cell class_info (len, 1); - Cell global_info (len, 1); - Cell sparse_info (len, 1); - Cell complex_info (len, 1); - Cell nesting_info (len, 1); - Cell persistent_info (len, 1); - - std::list::const_iterator p = lst.begin (); - - for (size_t j = 0; j < len; j++) - { - const symbol_info& si = *p++; - - octave_scalar_map ni; - - ni.assign ("function", caller_function_name); - ni.assign ("level", nesting_level); - - name_info(j) = si.name; - global_info(j) = si.is_global; - persistent_info(j) = si.is_persistent; - - octave_value val = si.varval; - - size_info(j) = val.size (); - bytes_info(j) = val.byte_size (); - class_info(j) = val.class_name (); - sparse_info(j) = val.is_sparse_type (); - complex_info(j) = val.is_complex_type (); - nesting_info(j) = ni; - } - - octave_map info; - - info.assign ("name", name_info); - info.assign ("size", size_info); - info.assign ("bytes", bytes_info); - info.assign ("class", class_info); - info.assign ("global", global_info); - info.assign ("sparse", sparse_info); - info.assign ("complex", complex_info); - info.assign ("nesting", nesting_info); - info.assign ("persistent", persistent_info); - - return info; - } - - void display (std::ostream& os) - { - if (! lst.empty ()) - { - size_t bytes = 0; - size_t elements = 0; - - std::list params = parse_whos_line_format (); - - print_descriptor (os, params); - - octave_stdout << "\n"; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - p->display_line (os, params); - - octave_value val = p->varval; - - elements += val.capacity (); - bytes += val.byte_size (); - } - - os << "\nTotal is " << elements - << (elements == 1 ? " element" : " elements") - << " using " << bytes << (bytes == 1 ? " byte" : " bytes") - << "\n"; - } - } - - // Parse the string whos_line_format, and return a parameter list, - // containing all information needed to print the given - // attributtes of the symbols. - std::list parse_whos_line_format (void) - { - int idx; - size_t format_len = Vwhos_line_format.length (); - char garbage; - std::list params; - - size_t bytes1; - int elements1; - - std::string param_string = "abcenst"; - Array param_length (dim_vector (param_string.length (), 1)); - Array param_names (dim_vector (param_string.length (), 1)); - size_t pos_a, pos_b, pos_c, pos_e, pos_n, pos_s, pos_t; - - pos_a = param_string.find ('a'); // Attributes - pos_b = param_string.find ('b'); // Bytes - pos_c = param_string.find ('c'); // Class - pos_e = param_string.find ('e'); // Elements - pos_n = param_string.find ('n'); // Name - pos_s = param_string.find ('s'); // Size - pos_t = param_string.find ('t'); // Type - - param_names(pos_a) = "Attr"; - param_names(pos_b) = "Bytes"; - param_names(pos_c) = "Class"; - param_names(pos_e) = "Elements"; - param_names(pos_n) = "Name"; - param_names(pos_s) = "Size"; - param_names(pos_t) = "Type"; - - for (size_t i = 0; i < param_string.length (); i++) - param_length(i) = param_names(i).length (); - - // The attribute column needs size 5. - param_length(pos_a) = 5; - - // Calculating necessary spacing for name column, - // bytes column, elements column and class column - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - std::stringstream ss1, ss2; - std::string str; - - str = p->name; - param_length(pos_n) = ((str.length () - > static_cast (param_length(pos_n))) - ? str.length () : param_length(pos_n)); - - octave_value val = p->varval; - - str = val.type_name (); - param_length(pos_t) = ((str.length () - > static_cast (param_length(pos_t))) - ? str.length () : param_length(pos_t)); - - elements1 = val.capacity (); - ss1 << elements1; - str = ss1.str (); - param_length(pos_e) = ((str.length () - > static_cast (param_length(pos_e))) - ? str.length () : param_length(pos_e)); - - bytes1 = val.byte_size (); - ss2 << bytes1; - str = ss2.str (); - param_length(pos_b) = ((str.length () - > static_cast (param_length(pos_b))) - ? str.length () : param_length (pos_b)); - } - - idx = 0; - while (static_cast (idx) < format_len) - { - whos_parameter param; - param.command = '\0'; - - if (Vwhos_line_format[idx] == '%') - { - bool error_encountered = false; - param.modifier = 'r'; - param.parameter_length = 0; - - int a = 0, b = -1, balance = 1; - unsigned int items; - size_t pos; - std::string cmd; - - // Parse one command from whos_line_format - cmd = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = cmd.find (';'); - if (pos != std::string::npos) - cmd = cmd.substr (0, pos+1); - else - error ("parameter without ; in whos_line_format"); - - idx += cmd.length (); - - // FIXME -- use iostream functions instead of sscanf! - - if (cmd.find_first_of ("crl") != 1) - items = sscanf (cmd.c_str (), "%c%c:%d:%d:%d;", - &garbage, ¶m.command, &a, &b, &balance); - else - items = sscanf (cmd.c_str (), "%c%c%c:%d:%d:%d;", - &garbage, ¶m.modifier, ¶m.command, - &a, &b, &balance) - 1; - - if (items < 2) - { - error ("whos_line_format: parameter structure without command in whos_line_format"); - error_encountered = true; - } - - // Insert data into parameter - param.first_parameter_length = 0; - pos = param_string.find (param.command); - if (pos != std::string::npos) - { - param.parameter_length = param_length(pos); - param.text = param_names(pos); - param.line.assign (param_names(pos).length (), '='); - - param.parameter_length = (a > param.parameter_length - ? a : param.parameter_length); - if (param.command == 's' && param.modifier == 'c' && b > 0) - param.first_parameter_length = b; - } - else - { - error ("whos_line_format: '%c' is not a command", - param.command); - error_encountered = true; - } - - if (param.command == 's') - { - // Have to calculate space needed for printing - // matrix dimensions Space needed for Size column is - // hard to determine in prior, because it depends on - // dimensions to be shown. That is why it is - // recalculated for each Size-command int first, - // rest = 0, total; - int rest = 0; - int first = param.first_parameter_length; - int total = param.parameter_length; - - for (std::list::const_iterator p = lst.begin (); - p != lst.end (); p++) - { - octave_value val = p->varval; - std::string dims_str = get_dims_str (val); - int first1 = dims_str.find ('x'); - int total1 = dims_str.length (); - int rest1 = total1 - first1; - rest = (rest1 > rest ? rest1 : rest); - first = (first1 > first ? first1 : first); - total = (total1 > total ? total1 : total); - } - - if (param.modifier == 'c') - { - if (first < balance) - first += balance - first; - if (rest + balance < param.parameter_length) - rest += param.parameter_length - rest - balance; - - param.parameter_length = first + rest; - param.first_parameter_length = first; - param.balance = balance; - } - else - { - param.parameter_length = total; - param.first_parameter_length = 0; - } - } - else if (param.modifier == 'c') - { - error ("whos_line_format: modifier 'c' not available for command '%c'", - param.command); - error_encountered = true; - } - - // What happens if whos_line_format contains negative numbers - // at param_length positions? - param.balance = (b < 0 ? 0 : param.balance); - param.first_parameter_length = (b < 0 ? 0 : - param.first_parameter_length); - param.parameter_length = (a < 0 - ? 0 - : (param.parameter_length - < param_length(pos_s) - ? param_length(pos_s) - : param.parameter_length)); - - // Parameter will not be pushed into parameter list if ... - if (! error_encountered) - params.push_back (param); - } - else - { - // Text string, to be printed as it is ... - std::string text; - size_t pos; - text = Vwhos_line_format.substr (idx, Vwhos_line_format.length ()); - pos = text.find ('%'); - if (pos != std::string::npos) - text = text.substr (0, pos); - - // Push parameter into list ... - idx += text.length (); - param.text=text; - param.line.assign (text.length (), ' '); - params.push_back (param); - } - } - - return params; - } - -private: - std::list lst; - -}; - -static octave_value -do_who (int argc, const string_vector& argv, bool return_list, - bool verbose = false, std::string msg = std::string ()) -{ - octave_value retval; - - std::string my_name = argv[0]; - - bool global_only = false; - bool have_regexp = false; - - int i; - for (i = 1; i < argc; i++) - { - if (argv[i] == "-file") - { - // FIXME. This is an inefficient manner to implement this as the - // variables are loaded in to a temporary context and then treated. - // It would be better to refecat symbol_info_list to not store the - // symbol records and then use it in load-save.cc (do_load) to - // implement this option there so that the variables are never - // stored at all. - if (i == argc - 1) - error ("whos: -file argument must be followed by a file name"); - else - { - std::string nm = argv[i + 1]; - - unwind_protect frame; - - // Set up temporary scope. - - symbol_table::scope_id tmp_scope = symbol_table::alloc_scope (); - frame.add_fcn (symbol_table::erase_scope, tmp_scope); - - symbol_table::set_scope (tmp_scope); - - octave_call_stack::push (tmp_scope, 0); - frame.add_fcn (octave_call_stack::pop); - - frame.add_fcn (symbol_table::clear_variables); - - feval ("load", octave_value (nm), 0); - - if (! error_state) - { - std::string newmsg = std::string ("Variables in the file ") + - nm + ":\n\n"; - - retval = do_who (i, argv, return_list, verbose, newmsg); - } - } - - return retval; - } - else if (argv[i] == "-regexp") - have_regexp = true; - else if (argv[i] == "global") - global_only = true; - else if (argv[i][0] == '-') - warning ("%s: unrecognized option `%s'", my_name.c_str (), - argv[i].c_str ()); - else - break; - } - - int npats = argc - i; - string_vector pats; - if (npats > 0) - { - pats.resize (npats); - for (int j = 0; j < npats; j++) - pats[j] = argv[i+j]; - } - else - { - pats.resize (++npats); - pats[0] = "*"; - } - - symbol_info_list symbol_stats; - std::list symbol_names; - - for (int j = 0; j < npats; j++) - { - std::string pat = pats[j]; - - if (have_regexp) - { - std::list tmp = global_only - ? symbol_table::regexp_global_variables (pat) - : symbol_table::regexp_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - else - { - size_t pos = pat.find_first_of (".({"); - - if (pos != std::string::npos && pos > 0) - { - if (verbose) - { - // NOTE: we can only display information for - // expressions based on global values if the variable is - // global in the current scope because we currently have - // no way of looking up the base value in the global - // scope and then evaluating the arguments in the - // current scope. - - std::string base_name = pat.substr (0, pos); - - if (symbol_table::is_variable (base_name)) - { - symbol_table::symbol_record sr - = symbol_table::find_symbol (base_name); - - if (! global_only || sr.is_global ()) - { - int parse_status; - - octave_value expr_val - = eval_string (pat, true, parse_status); - - if (! error_state) - symbol_stats.append (sr, pat, expr_val); - else - return retval; - } - } - } - } - else - { - std::list tmp = global_only - ? symbol_table::glob_global_variables (pat) - : symbol_table::glob_variables (pat); - - for (std::list::const_iterator p = tmp.begin (); - p != tmp.end (); p++) - { - if (p->is_variable ()) - { - if (verbose) - symbol_stats.append (*p); - else - symbol_names.push_back (p->name ()); - } - } - } - } - } - - if (return_list) - { - if (verbose) - { - std::string caller_function_name; - octave_function *caller = octave_call_stack::caller (); - if (caller) - caller_function_name = caller->name (); - - retval = symbol_stats.map_value (caller_function_name, 1); - } - else - retval = Cell (string_vector (symbol_names)); - } - else if (! (symbol_stats.empty () && symbol_names.empty ())) - { - if (msg.length () == 0) - if (global_only) - octave_stdout << "Global variables:\n\n"; - else - octave_stdout << "Variables in the current scope:\n\n"; - else - octave_stdout << msg; - - if (verbose) - symbol_stats.display (octave_stdout); - else - { - string_vector names (symbol_names); - - names.list_in_columns (octave_stdout); - } - - octave_stdout << "\n"; - } - - return retval; -} - -DEFUN (who, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} who\n\ -@deftypefnx {Command} {} who pattern @dots{}\n\ -@deftypefnx {Command} {} who option pattern @dots{}\n\ -@deftypefnx {Command} {C =} who (\"pattern\", @dots{})\n\ -List currently defined variables matching the given patterns. Valid\n\ -pattern syntax is the same as described for the @code{clear} command.\n\ -If no patterns are supplied, all variables are listed.\n\ -By default, only variables visible in the local scope are displayed.\n\ -\n\ -The following are valid options but may not be combined.\n\ -\n\ -@table @code\n\ -@item global\n\ -List variables in the global scope rather than the current scope.\n\ -\n\ -@item -regexp\n\ -The patterns are considered to be regular expressions when matching the\n\ -variables to display. The same pattern syntax accepted by\n\ -the @code{regexp} function is used.\n\ -\n\ -@item -file\n\ -The next argument is treated as a filename. All variables found within the\n\ -specified file are listed. No patterns are accepted when reading variables\n\ -from a file.\n\ -@end table\n\ -\n\ -If called as a function, return a cell array of defined variable names\n\ -matching the given patterns.\n\ -@seealso{whos, isglobal, isvarname, exist, regexp}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("who"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1); - } - else - print_usage (); - - return retval; -} - -DEFUN (whos, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Command} {} whos\n\ -@deftypefnx {Command} {} whos pattern @dots{}\n\ -@deftypefnx {Command} {} whos option pattern @dots{}\n\ -@deftypefnx {Command} {S =} whos (\"pattern\", @dots{})\n\ -Provide detailed information on currently defined variables matching the\n\ -given patterns. Options and pattern syntax are the same as for the\n\ -@code{who} command. Extended information about each variable is\n\ -summarized in a table with the following default entries.\n\ -\n\ -@table @asis\n\ -@item Attr\n\ -Attributes of the listed variable. Possible attributes are:\n\ -\n\ -@table @asis\n\ -@item blank\n\ -Variable in local scope\n\ -\n\ -@item @code{a}\n\ -Automatic variable. An automatic variable is one created by the\n\ -interpreter, for example @code{argn}.\n\ -\n\ -@item @code{c}\n\ -Variable of complex type.\n\ -\n\ -@item @code{f}\n\ -Formal parameter (function argument).\n\ -\n\ -@item @code{g}\n\ -Variable with global scope.\n\ -\n\ -@item @code{p}\n\ -Persistent variable.\n\ -@end table\n\ -\n\ -@item Name\n\ -The name of the variable.\n\ -\n\ -@item Size\n\ -The logical size of the variable. A scalar is 1x1, a vector is\n\ -@nospell{1xN} or @nospell{Nx1}, a 2-D matrix is @nospell{MxN}.\n\ -\n\ -@item Bytes\n\ -The amount of memory currently used to store the variable.\n\ -\n\ -@item Class\n\ -The class of the variable. Examples include double, single, char, uint16,\n\ -cell, and struct.\n\ -@end table\n\ -\n\ -The table can be customized to display more or less information through\n\ -the function @code{whos_line_format}.\n\ -\n\ -If @code{whos} is called as a function, return a struct array of defined\n\ -variable names matching the given patterns. Fields in the structure\n\ -describing each variable are: name, size, bytes, class, global, sparse,\n\ -complex, nesting, persistent.\n\ -@seealso{who, whos_line_format}\n\ -@end deftypefn") -{ - octave_value retval; - - if (nargout < 2) - { - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("whos"); - - if (! error_state) - retval = do_who (argc, argv, nargout == 1, true); - } - else - print_usage (); - - return retval; -} - -// Defining variables. - -void -bind_ans (const octave_value& val, bool print) -{ - static std::string ans = "ans"; - - if (val.is_defined ()) - { - if (val.is_cs_list ()) - { - octave_value_list lst = val.list_value (); - - for (octave_idx_type i = 0; i < lst.length (); i++) - bind_ans (lst(i), print); - } - else - { - symbol_table::varref (ans) = val; - - if (print) - val.print_with_name (octave_stdout, ans); - } - } -} - -void -bind_internal_variable (const std::string& fname, const octave_value& val) -{ - octave_value_list args; - - args(0) = val; - - feval (fname, args, 0); -} - -void -mlock (void) -{ - octave_function *fcn = octave_call_stack::current (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); -} - -void -munlock (const std::string& nm) -{ - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - fcn->unlock (); - } -} - -bool -mislocked (const std::string& nm) -{ - bool retval = false; - - octave_value val = symbol_table::find_function (nm); - - if (val.is_defined ()) - { - octave_function *fcn = val.function_value (); - - if (fcn) - retval = fcn->islocked (); - } - - return retval; -} - -DEFUN (mlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mlock ()\n\ -Lock the current function into memory so that it can't be cleared.\n\ -@seealso{munlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->lock (); - else - error ("mlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -DEFUN (munlock, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} munlock ()\n\ -@deftypefnx {Built-in Function} {} munlock (@var{fcn})\n\ -Unlock the named function @var{fcn}. If no function is named\n\ -then unlock the current function.\n\ -@seealso{mlock, mislocked, persistent}\n\ -@end deftypefn") -{ - octave_value_list retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - munlock (name); - else - error ("munlock: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - fcn->unlock (); - else - error ("munlock: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - - -DEFUN (mislocked, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} mislocked ()\n\ -@deftypefnx {Built-in Function} {} mislocked (@var{fcn})\n\ -Return true if the named function @var{fcn} is locked. If no function is\n\ -named then return true if the current function is locked.\n\ -@seealso{mlock, munlock, persistent}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = mislocked (name); - else - error ("mislocked: FCN must be a string"); - } - else if (args.length () == 0) - { - octave_function *fcn = octave_call_stack::caller (); - - if (fcn) - retval = fcn->islocked (); - else - error ("mislocked: invalid use outside a function"); - } - else - print_usage (); - - return retval; -} - -// Deleting names from the symbol tables. - -static inline bool -name_matches_any_pattern (const std::string& nm, const string_vector& argv, - int argc, int idx, bool have_regexp = false) -{ - bool retval = false; - - for (int k = idx; k < argc; k++) - { - std::string patstr = argv[k]; - if (! patstr.empty ()) - { - if (have_regexp) - { - if (is_regexp_match (patstr, nm)) - { - retval = true; - break; - } - } - else - { - glob_match pattern (patstr); - - if (pattern.match (nm)) - { - retval = true; - break; - } - } - } - } - - return retval; -} - -static inline void -maybe_warn_exclusive (bool exclusive) -{ - if (exclusive) - warning ("clear: ignoring --exclusive option"); -} - -static void -do_clear_functions (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_functions (); - else - { - if (exclusive) - { - string_vector fcns = symbol_table::user_function_names (); - - int fcount = fcns.length (); - - for (int i = 0; i < fcount; i++) - { - std::string nm = fcns[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_function (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_function_pattern (argv[idx++]); - } - } -} - -static void -do_clear_globals (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - symbol_table::clear_global (gvars[i]); - } - else - { - if (exclusive) - { - string_vector gvars = symbol_table::global_variable_names (); - - int gcount = gvars.length (); - - for (int i = 0; i < gcount; i++) - { - std::string nm = gvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx)) - symbol_table::clear_global (nm); - } - } - else - { - while (idx < argc) - symbol_table::clear_global_pattern (argv[idx++]); - } - } -} - -static void -do_clear_variables (const string_vector& argv, int argc, int idx, - bool exclusive = false, bool have_regexp = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - string_vector lvars = symbol_table::variable_names (); - - int lcount = lvars.length (); - - for (int i = 0; i < lcount; i++) - { - std::string nm = lvars[i]; - - if (! name_matches_any_pattern (nm, argv, argc, idx, have_regexp)) - symbol_table::clear_variable (nm); - } - } - else - { - if (have_regexp) - while (idx < argc) - symbol_table::clear_variable_regexp (argv[idx++]); - else - while (idx < argc) - symbol_table::clear_variable_pattern (argv[idx++]); - } - } -} - -static void -do_clear_symbols (const string_vector& argv, int argc, int idx, - bool exclusive = false) -{ - if (idx == argc) - symbol_table::clear_variables (); - else - { - if (exclusive) - { - // FIXME -- is this really what we want, or do we - // somehow want to only clear the functions that are not - // shadowed by local variables? It seems that would be a - // bit harder to do. - - do_clear_variables (argv, argc, idx, exclusive); - do_clear_functions (argv, argc, idx, exclusive); - } - else - { - while (idx < argc) - symbol_table::clear_symbol_pattern (argv[idx++]); - } - } -} - -static void -do_matlab_compatible_clear (const string_vector& argv, int argc, int idx) -{ - // This is supposed to be mostly Matlab compatible. - - for (; idx < argc; idx++) - { - if (argv[idx] == "all" - && ! symbol_table::is_local_variable ("all")) - { - symbol_table::clear_all (); - } - else if (argv[idx] == "functions" - && ! symbol_table::is_local_variable ("functions")) - { - do_clear_functions (argv, argc, ++idx); - } - else if (argv[idx] == "global" - && ! symbol_table::is_local_variable ("global")) - { - do_clear_globals (argv, argc, ++idx); - } - else if (argv[idx] == "variables" - && ! symbol_table::is_local_variable ("variables")) - { - symbol_table::clear_variables (); - } - else if (argv[idx] == "classes" - && ! symbol_table::is_local_variable ("classes")) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - symbol_table::clear_symbol_pattern (argv[idx]); - } - } -} - -#define CLEAR_OPTION_ERROR(cond) \ - do \ - { \ - if (cond) \ - { \ - print_usage (); \ - return retval; \ - } \ - } \ - while (0) - -DEFUN (clear, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} clear [options] pattern @dots{}\n\ -Delete the names matching the given patterns from the symbol table. The\n\ -pattern may contain the following special characters:\n\ -\n\ -@table @code\n\ -@item ?\n\ -Match any single character.\n\ -\n\ -@item *\n\ -Match zero or more characters.\n\ -\n\ -@item [ @var{list} ]\n\ -Match the list of characters specified by @var{list}. If the first\n\ -character is @code{!} or @code{^}, match all characters except those\n\ -specified by @var{list}. For example, the pattern @samp{[a-zA-Z]} will\n\ -match all lowercase and uppercase alphabetic characters.\n\ -@end table\n\ -\n\ -For example, the command\n\ -\n\ -@example\n\ -clear foo b*r\n\ -@end example\n\ -\n\ -@noindent\n\ -clears the name @code{foo} and all names that begin with the letter\n\ -@code{b} and end with the letter @code{r}.\n\ -\n\ -If @code{clear} is called without any arguments, all user-defined\n\ -variables (local and global) are cleared from the symbol table. If\n\ -@code{clear} is called with at least one argument, only the visible\n\ -names matching the arguments are cleared. For example, suppose you have\n\ -defined a function @code{foo}, and then hidden it by performing the\n\ -assignment @code{foo = 2}. Executing the command @kbd{clear foo} once\n\ -will clear the variable definition and restore the definition of\n\ -@code{foo} as a function. Executing @kbd{clear foo} a second time will\n\ -clear the function definition.\n\ -\n\ -The following options are available in both long and short form\n\ -\n\ -@table @code\n\ -@item -all, -a\n\ -Clears all local and global user-defined variables and all functions\n\ -from the symbol table.\n\ -\n\ -@item -exclusive, -x\n\ -Clears the variables that don't match the following pattern.\n\ -\n\ -@item -functions, -f\n\ -Clears the function names and the built-in symbols names.\n\ -\n\ -@item -global, -g\n\ -Clears the global symbol names.\n\ -\n\ -@item -variables, -v\n\ -Clears the local variable names.\n\ -\n\ -@item -classes, -c\n\ -Clears the class structure table and clears all objects.\n\ -\n\ -@item -regexp, -r\n\ -The arguments are treated as regular expressions as any variables that\n\ -match will be cleared.\n\ -@end table\n\ -\n\ -With the exception of @code{exclusive}, all long options can be used\n\ -without the dash as well.\n\ -@end deftypefn") -{ - octave_value_list retval; - - int argc = args.length () + 1; - - string_vector argv = args.make_argv ("clear"); - - if (! error_state) - { - if (argc == 1) - { - do_clear_globals (argv, argc, 1); - do_clear_variables (argv, argc, 1); - } - else - { - int idx = 0; - - bool clear_all = false; - bool clear_functions = false; - bool clear_globals = false; - bool clear_variables = false; - bool clear_objects = false; - bool exclusive = false; - bool have_regexp = false; - bool have_dash_option = false; - - while (++idx < argc) - { - if (argv[idx] == "-all" || argv[idx] == "-a") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_all = true; - } - else if (argv[idx] == "-exclusive" || argv[idx] == "-x") - { - have_dash_option = true; - exclusive = true; - } - else if (argv[idx] == "-functions" || argv[idx] == "-f") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_functions = true; - } - else if (argv[idx] == "-global" || argv[idx] == "-g") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_globals = true; - } - else if (argv[idx] == "-variables" || argv[idx] == "-v") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_variables = true; - } - else if (argv[idx] == "-classes" || argv[idx] == "-c") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - clear_objects = true; - } - else if (argv[idx] == "-regexp" || argv[idx] == "-r") - { - CLEAR_OPTION_ERROR (have_dash_option && ! exclusive); - - have_dash_option = true; - have_regexp = true; - } - else - break; - } - - if (idx <= argc) - { - if (! have_dash_option) - { - do_matlab_compatible_clear (argv, argc, idx); - } - else - { - if (clear_all) - { - maybe_warn_exclusive (exclusive); - - if (++idx < argc) - warning - ("clear: ignoring extra arguments after -all"); - - symbol_table::clear_all (); - } - else if (have_regexp) - { - do_clear_variables (argv, argc, idx, exclusive, true); - } - else if (clear_functions) - { - do_clear_functions (argv, argc, idx, exclusive); - } - else if (clear_globals) - { - do_clear_globals (argv, argc, idx, exclusive); - } - else if (clear_variables) - { - do_clear_variables (argv, argc, idx, exclusive); - } - else if (clear_objects) - { - symbol_table::clear_objects (); - octave_class::clear_exemplar_map (); - } - else - { - do_clear_symbols (argv, argc, idx, exclusive); - } - } - } - } - } - - return retval; -} - -DEFUN (whos_line_format, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} whos_line_format ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} whos_line_format (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} whos_line_format (@var{new_val}, \"local\")\n\ -Query or set the format string used by the command @code{whos}.\n\ -\n\ -A full format string is:\n\ -@c Set example in small font to prevent overfull line\n\ -\n\ -@smallexample\n\ -%[modifier][:width[:left-min[:balance]]];\n\ -@end smallexample\n\ -\n\ -The following command sequences are available:\n\ -\n\ -@table @code\n\ -@item %a\n\ -Prints attributes of variables (g=global, p=persistent,\n\ -f=formal parameter, a=automatic variable).\n\ -\n\ -@item %b\n\ -Prints number of bytes occupied by variables.\n\ -\n\ -@item %c\n\ -Prints class names of variables.\n\ -\n\ -@item %e\n\ -Prints elements held by variables.\n\ -\n\ -@item %n\n\ -Prints variable names.\n\ -\n\ -@item %s\n\ -Prints dimensions of variables.\n\ -\n\ -@item %t\n\ -Prints type names of variables.\n\ -@end table\n\ -\n\ -Every command may also have an alignment modifier:\n\ -\n\ -@table @code\n\ -@item l\n\ -Left alignment.\n\ -\n\ -@item r\n\ -Right alignment (default).\n\ -\n\ -@item c\n\ -Column-aligned (only applicable to command %s).\n\ -@end table\n\ -\n\ -The @code{width} parameter is a positive integer specifying the minimum\n\ -number of columns used for printing. No maximum is needed as the field will\n\ -auto-expand as required.\n\ -\n\ -The parameters @code{left-min} and @code{balance} are only available when the\n\ -column-aligned modifier is used with the command @samp{%s}.\n\ -@code{balance} specifies the column number within the field width which will\n\ -be aligned between entries. Numbering starts from 0 which indicates the\n\ -leftmost column. @code{left-min} specifies the minimum field width to the\n\ -left of the specified balance column.\n\ -\n\ -The default format is\n\ -@code{\" %a:4; %ln:6; %cs:16:6:1; %rb:12; %lc:-1;\\n\"}.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@seealso{whos}\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (whos_line_format); -} - -static std::string Vmissing_function_hook = "unimplemented"; - -DEFUN (missing_function_hook, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {@var{val} =} missing_function_hook ()\n\ -@deftypefnx {Built-in Function} {@var{old_val} =} missing_function_hook (@var{new_val})\n\ -@deftypefnx {Built-in Function} {} missing_function_hook (@var{new_val}, \"local\")\n\ -Query or set the internal variable that specifies the function to call when\n\ -an unknown identifier is requested.\n\ -\n\ -When called from inside a function with the \"local\" option, the variable is\n\ -changed locally for the function and any subroutines it calls. The original\n\ -variable value is restored when exiting the function.\n\ -@end deftypefn") -{ - return SET_INTERNAL_VARIABLE (missing_function_hook); -} - -void maybe_missing_function_hook (const std::string& name) -{ - // Don't do this if we're handling errors. - if (buffer_error_messages == 0 && ! Vmissing_function_hook.empty ()) - { - // Ensure auto-restoration. - unwind_protect frame; - frame.protect_var (Vmissing_function_hook); - - // Clear the variable prior to calling the function. - const std::string func_name = Vmissing_function_hook; - Vmissing_function_hook.clear (); - - // Call. - feval (func_name, octave_value (name)); - } -} - -DEFUN (__varval__, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __varval__ (@var{name})\n\ -Undocumented internal function.\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 1) - { - std::string name = args(0).string_value (); - - if (! error_state) - retval = symbol_table::varval (args(0).string_value ()); - else - error ("__varval__: expecting argument to be variable name"); - } - else - print_usage (); - - return retval; -} diff -r 069c552587a0 -r 959953dba519 src/variables.h --- a/src/variables.h Tue Jul 31 09:54:19 2012 -0400 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,147 +0,0 @@ -/* - -Copyright (C) 1993-2012 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 3 of the License, 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, see -. - -*/ - -#if !defined (octave_variables_h) -#define octave_variables_h 1 - -class octave_function; -class octave_user_function; - -class tree_identifier; -class octave_value; -class octave_value_list; -class octave_builtin; -class string_vector; - -#include -#include - -#include - -#include "ov.h" -#include "ov-builtin.h" -#include "symtab.h" - -extern OCTINTERP_API void clear_mex_functions (void); - -extern OCTINTERP_API octave_function * -is_valid_function (const octave_value&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -is_valid_function (const std::string&, const std::string& = std::string (), - bool warn = false); - -extern OCTINTERP_API octave_function * -extract_function (const octave_value& arg, const std::string& warn_for, - const std::string& fname, const std::string& header, - const std::string& trailer); - -extern OCTINTERP_API string_vector -get_struct_elts (const std::string& text); - -extern OCTINTERP_API string_vector -generate_struct_completions (const std::string& text, std::string& prefix, - std::string& hint); - -extern OCTINTERP_API bool -looks_like_struct (const std::string& text); - -extern OCTINTERP_API int -symbol_exist (const std::string& name, const std::string& type = "any"); - -extern OCTINTERP_API std::string -unique_symbol_name (const std::string& basename); - -extern OCTINTERP_API octave_value lookup_function_handle (const std::string& nm); - -extern OCTINTERP_API octave_value -get_global_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_global_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -get_top_level_value (const std::string& nm, bool silent = false); - -extern OCTINTERP_API void -set_top_level_value (const std::string& nm, const octave_value& val); - -extern OCTINTERP_API octave_value -set_internal_variable (bool& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (char& var, const octave_value_list& args, - int nargout, const char *nm); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, - int minval = INT_MIN, int maxval = INT_MAX); - -extern OCTINTERP_API octave_value -set_internal_variable (double& var, const octave_value_list& args, - int nargout, const char *nm, - double minval = DBL_MIN, double maxval = DBL_MAX); - -extern OCTINTERP_API octave_value -set_internal_variable (std::string& var, const octave_value_list& args, - int nargout, const char *nm, bool empty_ok = true); - -extern OCTINTERP_API octave_value -set_internal_variable (int& var, const octave_value_list& args, - int nargout, const char *nm, const char **choices); - -#define SET_INTERNAL_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM) - -#define SET_NONEMPTY_INTERNAL_STRING_VARIABLE(NM) \ - set_internal_variable (V ## NM, args, nargout, #NM, false) - -#define SET_INTERNAL_VARIABLE_WITH_LIMITS(NM, MINVAL, MAXVAL) \ - set_internal_variable (V ## NM, args, nargout, #NM, MINVAL, MAXVAL) - -// in the following, CHOICES must be a C string array terminated by null. -#define SET_INTERNAL_VARIABLE_CHOICES(NM, CHOICES) \ - set_internal_variable (V ## NM, args, nargout, #NM, CHOICES) - -extern OCTINTERP_API std::string builtin_string_variable (const std::string&); -extern OCTINTERP_API int builtin_real_scalar_variable (const std::string&, double&); -extern OCTINTERP_API octave_value builtin_any_variable (const std::string&); - -extern OCTINTERP_API void bind_ans (const octave_value& val, bool print); - -extern OCTINTERP_API void -bind_internal_variable (const std::string& fname, const octave_value& val); - -extern OCTINTERP_API void mlock (void); -extern OCTINTERP_API void munlock (const std::string&); -extern OCTINTERP_API bool mislocked (const std::string&); - -extern OCTINTERP_API void clear_function (const std::string& nm); -extern OCTINTERP_API void clear_variable (const std::string& nm); -extern OCTINTERP_API void clear_symbol (const std::string& nm); - -extern OCTINTERP_API void maybe_missing_function_hook (const std::string& name); - -#endif diff -r 069c552587a0 -r 959953dba519 src/version.in.h --- a/src/version.in.h Tue Jul 31 09:54:19 2012 -0400 +++ b/src/version.in.h Fri Aug 03 14:35:44 2012 -0400 @@ -1,3 +1,4 @@ +// DO NOT EDIT! Generated automatically from version.in.h by configure /* Copyright (C) 1992-2012 John W. Eaton