Mercurial > octave-nkf

comparison src/variables.cc @ 605:4f65175911a6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1994-08-13 20:10:39 by jwe]
author jwe
date Sat, 13 Aug 1994 20:10:39 +0000
parents 80a8a79ea6e4
children 14b2a186a5c0
comparison
equal deleted inserted replaced
604:1acdc9e50cd2 605:4f65175911a6
23 23
24 #ifdef HAVE_CONFIG_H 24 #ifdef HAVE_CONFIG_H
25 #include "config.h" 25 #include "config.h"
26 #endif 26 #endif
27 27
28 #if 0
29 #include <ctype.h>
30 #include <iostream.h>
31
32 #include "mappers.h"
33 #endif
34
28 #include <sys/types.h> 35 #include <sys/types.h>
29 #ifdef HAVE_UNISTD_H 36 #ifdef HAVE_UNISTD_H
30 #include <unistd.h> 37 #include <unistd.h>
31 #endif 38 #endif
32 #include <ctype.h>
33 #include <float.h> 39 #include <float.h>
34 #include <string.h> 40 #include <string.h>
35 #include <fstream.h>
36 #include <iostream.h>
37 #include <strstream.h> 41 #include <strstream.h>
38 42
43 #include "defaults.h"
44 #include "version.h"
39 #include "octave-hist.h" 45 #include "octave-hist.h"
40 #include "unwind-prot.h" 46 #include "unwind-prot.h"
47 #include "variables.h"
41 #include "user-prefs.h" 48 #include "user-prefs.h"
49 #include "statdefs.h"
42 #include "tree-base.h" 50 #include "tree-base.h"
43 #include "tree-expr.h" 51 #include "tree-expr.h"
44 #include "tree-const.h" 52 #include "tree-const.h"
45 #include "variables.h" 53 #include "dirfns.h"
46 #include "statdefs.h"
47 #include "defaults.h"
48 #include "version.h"
49 #include "mappers.h"
50 #include "oct-obj.h" 54 #include "oct-obj.h"
51 #include "sysdep.h" 55 #include "sysdep.h"
52 #include "dirfns.h"
53 #include "symtab.h" 56 #include "symtab.h"
54 #include "octave.h" 57 #include "octave.h"
58 #include "pager.h"
55 #include "error.h" 59 #include "error.h"
56 #include "pager.h" 60 #include "defun.h"
57 #include "utils.h" 61 #include "utils.h"
58 #include "defun.h" 62 #include "parse.h"
59 #include "input.h" 63 #include "input.h"
60 #include "parse.h"
61 #include "help.h" 64 #include "help.h"
62 #include "lex.h" 65 #include "lex.h"
63 66
64 extern "C" 67 extern "C"
65 { 68 {
66 #include <readline/readline.h> 69 #include <readline/readline.h>
67 #include <readline/tilde.h>
68 70
69 #include "fnmatch.h" 71 #include "fnmatch.h"
70 } 72 }
71
72 #if SIZEOF_SHORT == 4
73 #define FOUR_BYTE_TYPE short
74 #elif SIZEOF_INT == 4
75 #define FOUR_BYTE_TYPE int
76 #elif SIZEOF_LONG == 4
77 #define FOUR_BYTE_TYPE long
78 #else
79 LOSE! LOSE!
80 #endif
81 73
82 // Symbol table for symbols at the top level. 74 // Symbol table for symbols at the top level.
83 symbol_table *top_level_sym_tab = 0; 75 symbol_table *top_level_sym_tab = 0;
84 76
85 // Symbol table for the current scope. 77 // Symbol table for the current scope.
125 return (sr && sr->is_text_function ()); 117 return (sr && sr->is_text_function ());
126 } 118 }
127 119
128 // Is this function globally in this scope? 120 // Is this function globally in this scope?
129 121
130 static int 122 int
131 is_globally_visible (const char *name) 123 is_globally_visible (const char *name)
132 { 124 {
133 symbol_record *sr = curr_sym_tab->lookup (name, 0, 0); 125 symbol_record *sr = curr_sym_tab->lookup (name, 0, 0);
134 return (sr && sr->is_linked_to_global ()); 126 return (sr && sr->is_linked_to_global ());
135 }
136
137 // Is this name a valid identifier?
138
139 static int
140 valid_identifier (char *s)
141 {
142 if (! s || ! (isalnum (*s) || *s == '_'))
143 return 0;
144
145 while (*++s != '\0')
146 if (! (isalnum (*s) || *s == '_'))
147 return 0;
148
149 return 1;
150 } 127 }
151 128
152 // Is this tree_constant a valid function? 129 // Is this tree_constant a valid function?
153 130
154 tree_fvc * 131 tree_fvc *
830 symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0); 807 symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0);
831 csr->alias (gsr); 808 csr->alias (gsr);
832 } 809 }
833 } 810 }
834 811
835 // Loading variables from files. 812 // Help stuff. Shouldn't this go in help.cc?
836
837 // Extract a keyword and its value from a file. Input should look
838 // something like:
839 //
840 // #[ \t]*keyword[ \t]*:[ \t]*string-value\n
841 //
842 // Returns a pointer to new storage. The caller is responsible for
843 // deleting it.
844
845 static char *
846 extract_keyword (istream& is, char *keyword)
847 {
848 ostrstream buf;
849
850 char *retval = 0;
851
852 char c;
853 while (is.get (c))
854 {
855 if (c == '#')
856 {
857 while (is.get (c) && (c == ' ' || c == '\t' || c == '#'))
858 ; // Skip whitespace and comment characters.
859
860 if (isalpha (c))
861 buf << c;
862
863 while (is.get (c) && isalpha (c))
864 buf << c;
865
866 buf << ends;
867 char *tmp = buf.str ();
868 int match = (strncmp (tmp, keyword, strlen (keyword)) == 0);
869 delete [] tmp;
870
871 if (match)
872 {
873 ostrstream value;
874 while (is.get (c) && (c == ' ' || c == '\t' || c == ':'))
875 ; // Skip whitespace and the colon.
876
877 if (c != '\n')
878 {
879 value << c;
880 while (is.get (c) && c != '\n')
881 value << c;
882 }
883 value << ends;
884 retval = value.str ();
885 break;
886 }
887 }
888 }
889 return retval;
890 }
891
892 static int
893 extract_keyword (istream& is, char *keyword, int& value)
894 {
895 ostrstream buf;
896
897 int status = 0;
898 value = 0;
899
900 char c;
901 while (is.get (c))
902 {
903 if (c == '#')
904 {
905 while (is.get (c) && (c == ' ' || c == '\t' || c == '#'))
906 ; // Skip whitespace and comment characters.
907
908 if (isalpha (c))
909 buf << c;
910
911 while (is.get (c) && isalpha (c))
912 buf << c;
913
914 buf << ends;
915 char *tmp = buf.str ();
916 int match = (strncmp (tmp, keyword, strlen (keyword)) == 0);
917 delete [] tmp;
918
919 if (match)
920 {
921 while (is.get (c) && (c == ' ' || c == '\t' || c == ':'))
922 ; // Skip whitespace and the colon.
923
924 is.putback (c);
925 if (c != '\n')
926 is >> value;
927 if (is)
928 status = 1;
929 while (is.get (c) && c != '\n')
930 ; // Skip to beginning of next line;
931 break;
932 }
933 }
934 }
935 return status;
936 }
937
938 // Skip white space and comments.
939
940 static void
941 skip_comments (istream& is)
942 {
943 char c = '\0';
944 while (is.get (c))
945 {
946 if (c == ' ' || c == '\t' || c == '\n')
947 ; // Skip whitespace on way to beginning of next line.
948 else
949 break;
950 }
951
952 for (;;)
953 {
954 if (is && c == '#')
955 while (is.get (c) && c != '\n')
956 ; // Skip to beginning of next line, ignoring everything.
957 else
958 break;
959 }
960 }
961
962 static tree_constant
963 load_variable (istream& is, int& is_global)
964 {
965 tree_constant retval;
966
967 is_global = 0;
968
969 // Look for type keyword
970
971 char *tag = extract_keyword (is, "type");
972
973 if (tag && *tag)
974 {
975 char *ptr = strchr (tag, ' ');
976 if (ptr)
977 {
978 *ptr = '\0';
979 is_global = (strncmp (tag, "global", 6) == 0);
980 *ptr = ' ';
981 if (is_global)
982 ptr++;
983 else
984 ptr = tag;
985 }
986 else
987 ptr = tag;
988
989 if (strncmp (ptr, "scalar", 6) == 0)
990 {
991 double tmp;
992 is >> tmp;
993 if (is)
994 retval = tmp;
995 else
996 error ("failed to load scalar constant");
997 }
998 else if (strncmp (ptr, "matrix", 6) == 0)
999 {
1000 int nr = 0, nc = 0;
1001
1002 if (extract_keyword (is, "rows", nr) && nr > 0
1003 && extract_keyword (is, "columns", nc) && nc > 0)
1004 {
1005 Matrix tmp (nr, nc);
1006 is >> tmp;
1007 if (is)
1008 retval = tmp;
1009 else
1010 error ("failed to load matrix constant");
1011 }
1012 else
1013 error ("failed to extract number of rows and columns");
1014 }
1015 else if (strncmp (ptr, "complex scalar", 14) == 0)
1016 {
1017 Complex tmp;
1018 is >> tmp;
1019 if (is)
1020 retval = tmp;
1021 else
1022 error ("failed to load complex scalar constant");
1023 }
1024 else if (strncmp (ptr, "complex matrix", 14) == 0)
1025 {
1026 int nr = 0, nc = 0;
1027
1028 if (extract_keyword (is, "rows", nr) && nr > 0
1029 && extract_keyword (is, "columns", nc) && nc > 0)
1030 {
1031 ComplexMatrix tmp (nr, nc);
1032 is >> tmp;
1033 if (is)
1034 retval = tmp;
1035 else
1036 error ("failed to load complex matrix constant");
1037 }
1038 else
1039 error ("failed to extract number of rows and columns");
1040 }
1041 else if (strncmp (ptr, "string", 6) == 0)
1042 {
1043 int len;
1044 if (extract_keyword (is, "length", len) && len > 0)
1045 {
1046 char *tmp = new char [len+1];
1047 is.get (tmp, len+1, EOF);
1048 if (is)
1049 retval = tmp;
1050 else
1051 error ("failed to load string constant");
1052 }
1053 else
1054 error ("failed to extract string length");
1055 }
1056 else if (strncmp (ptr, "range", 5) == 0)
1057 {
1058 skip_comments (is); // # base, limit, range comment added by save().
1059 Range tmp;
1060 is >> tmp;
1061 if (is)
1062 retval = tmp;
1063 else
1064 error ("failed to load range constant");
1065 }
1066 else
1067 error ("unknown constant type `%s'", tag);
1068 }
1069 else
1070 error ("failed to extract keyword specifying value type");
1071
1072 delete [] tag;
1073
1074 return retval;
1075 }
1076
1077 static void
1078 install_loaded_variable (int force, char *nm, const tree_constant& tc,
1079 int global)
1080 {
1081 // Is there already a symbol by this name? If so, what is it?
1082
1083 symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0);
1084
1085 int is_undefined = 1;
1086 int is_variable = 0;
1087 int is_function = 0;
1088 int is_global = 0;
1089
1090 if (lsr)
1091 {
1092 is_undefined = ! lsr->is_defined ();
1093 is_variable = lsr->is_variable ();
1094 is_function = lsr->is_function ();
1095 is_global = lsr->is_linked_to_global ();
1096 }
1097
1098 // Try to read data for this name.
1099
1100 if (tc.is_undefined ())
1101 {
1102 error ("load: unable to load variable `%s'", nm);
1103 return;
1104 }
1105
1106 symbol_record *sr = 0;
1107
1108 if (global)
1109 {
1110 if (is_global || is_undefined)
1111 {
1112 if (force || is_undefined)
1113 {
1114 lsr = curr_sym_tab->lookup (nm, 1, 0);
1115 link_to_global_variable (lsr);
1116 sr = lsr;
1117 }
1118 else
1119 {
1120 warning ("load: global variable name `%s' exists.", nm);
1121 warning ("use `load -force' to overwrite");
1122 }
1123 }
1124 else if (is_function)
1125 {
1126 if (force)
1127 {
1128 lsr = curr_sym_tab->lookup (nm, 1, 0);
1129 link_to_global_variable (lsr);
1130 sr = lsr;
1131 }
1132 else
1133 {
1134 warning ("load: `%s' is currently a function in this scope", nm);
1135 warning ("`load -force' will load variable and hide function");
1136 }
1137 }
1138 else if (is_variable)
1139 {
1140 if (force)
1141 {
1142 lsr = curr_sym_tab->lookup (nm, 1, 0);
1143 link_to_global_variable (lsr);
1144 sr = lsr;
1145 }
1146 else
1147 {
1148 warning ("load: local variable name `%s' exists.", nm);
1149 warning ("use `load -force' to overwrite");
1150 }
1151 }
1152 else
1153 panic_impossible ();
1154 }
1155 else
1156 {
1157 if (is_global)
1158 {
1159 if (force || is_undefined)
1160 {
1161 lsr = curr_sym_tab->lookup (nm, 1, 0);
1162 link_to_global_variable (lsr);
1163 sr = lsr;
1164 }
1165 else
1166 {
1167 warning ("load: global variable name `%s' exists.", nm);
1168 warning ("use `load -force' to overwrite");
1169 }
1170 }
1171 else if (is_function)
1172 {
1173 if (force)
1174 {
1175 lsr = curr_sym_tab->lookup (nm, 1, 0);
1176 link_to_global_variable (lsr);
1177 sr = lsr;
1178 }
1179 else
1180 {
1181 warning ("load: `%s' is currently a function in this scope", nm);
1182 warning ("`load -force' will load variable and hide function");
1183 }
1184 }
1185 else if (is_variable || is_undefined)
1186 {
1187 if (force || is_undefined)
1188 {
1189 lsr = curr_sym_tab->lookup (nm, 1, 0);
1190 sr = lsr;
1191 }
1192 else
1193 {
1194 warning ("load: local variable name `%s' exists.", nm);
1195 warning ("use `load -force' to overwrite");
1196 }
1197 }
1198 else
1199 panic_impossible ();
1200 }
1201
1202 if (sr)
1203 {
1204 tree_constant *tmp_tc = new tree_constant (tc);
1205 sr->define (tmp_tc);
1206 return;
1207 }
1208 else
1209 error ("load: unable to load variable `%s'", nm);
1210
1211 return;
1212 }
1213
1214 // XXX FIXME XXX -- need to check stream states in more places.
1215
1216 static char *
1217 read_ascii_data (istream& stream, const char *filename, int& global,
1218 tree_constant& tc)
1219 {
1220 // Read name for this entry or break on EOF.
1221
1222 char *nm = extract_keyword (stream, "name");
1223
1224 if (! nm)
1225 return 0;
1226
1227 if (! *nm)
1228 {
1229 error ("load: empty name keyword found in file `%s'", filename);
1230 delete [] nm;
1231 return 0;
1232 }
1233
1234
1235 if (! valid_identifier (nm))
1236 {
1237 error ("load: bogus identifier `%s' found in file `%s'", nm, filename);
1238 delete [] nm;
1239 return 0;
1240 }
1241
1242 tc = load_variable (stream, global);
1243
1244 if (error_state)
1245 {
1246 error ("reading file %s", filename);
1247 return 0;
1248 }
1249
1250 return nm;
1251 }
1252
1253 static void
1254 swap_2_bytes (char *t)
1255 {
1256 char tmp = t[0];
1257 t[0] = t[1];
1258 t[1] = tmp;
1259 }
1260
1261 static void
1262 swap_4_bytes (char *t)
1263 {
1264 char tmp = t[0];
1265 t[0] = t[3];
1266 t[3] = tmp;
1267
1268 tmp = t[1];
1269 t[1] = t[2];
1270 t[2] = tmp;
1271 }
1272
1273 static void
1274 swap_8_bytes (char *t)
1275 {
1276 char tmp = t[0];
1277 t[0] = t[7];
1278 t[7] = tmp;
1279
1280 tmp = t[1];
1281 t[1] = t[6];
1282 t[6] = tmp;
1283
1284 tmp = t[2];
1285 t[2] = t[5];
1286 t[5] = tmp;
1287
1288 tmp = t[3];
1289 t[3] = t[4];
1290 t[4] = tmp;
1291 }
1292
1293 static char *floating_point_format[] =
1294 {
1295 "IEEE little endian",
1296 "IEEE big endian",
1297 "VAX D floating",
1298 "VAX G floating",
1299 "Cray",
1300 0,
1301 };
1302
1303 static char *
1304 read_binary_data (istream& stream, const char *filename, int& global,
1305 tree_constant& tc)
1306 {
1307 global = 0;
1308
1309 FOUR_BYTE_TYPE mopt, nr, nc, imag, len;
1310
1311 int swap = 0;
1312
1313 stream.read (&mopt, 4);
1314
1315 if (mopt > 9999)
1316 {
1317 swap = 1;
1318 swap_4_bytes ((char *) &mopt);
1319 }
1320
1321 if (mopt > 9999)
1322 {
1323 error ("load: can't read binary file");
1324 return 0;
1325 }
1326
1327 stream.read (&nr, 4);
1328 stream.read (&nc, 4);
1329 stream.read (&imag, 4);
1330 stream.read (&len, 4);
1331
1332 if (swap)
1333 {
1334 swap_4_bytes ((char *) &nr);
1335 swap_4_bytes ((char *) &nc);
1336 swap_4_bytes ((char *) &imag);
1337 swap_4_bytes ((char *) &len);
1338 }
1339
1340 int type = mopt % 10; // Full, sparse, etc.
1341 mopt /= 10; // Eliminate first digit.
1342 int prec = mopt % 10; // double, float, int, etc.
1343 mopt /= 100; // Skip unused third digit too.
1344 int mach = mopt % 10; // IEEE, VAX, etc.
1345
1346 if (mach < 0 || mach > 4)
1347 {
1348 error ("load: unrecognized binary format!");
1349 return 0;
1350 }
1351
1352 #if defined (IEEE_LITTLE_ENDIAN)
1353 if (mach != 0)
1354 {
1355 error ("load: can't convert from %s to %s yet",
1356 floating_point_format [mach], floating_point_format [0]);
1357 return 0;
1358 }
1359 #elif defined (IEEE_BIG_ENDIAN)
1360 if (mach != 1)
1361 {
1362 error ("load: can't convert from %s to %s yet",
1363 floating_point_format [mach], floating_point_format [1]);
1364 return 0;
1365 }
1366 #elif defined (VAX_D_FLOAT)
1367 if (mach != 2)
1368 {
1369 error ("load: can't convert from %s to %s yet",
1370 floating_point_format [mach], floating_point_format [2]);
1371 return 0;
1372 }
1373 #elif defined (VAX_G_FLOAT)
1374 if (mach != 3)
1375 {
1376 error ("load: can't convert from %s to %s yet",
1377 floating_point_format [mach], floating_point_format [3]);
1378 return 0;
1379 }
1380 #else
1381 LOSE! LOSE!
1382 #endif
1383
1384 if (prec != 0)
1385 {
1386 error ("load: can only read binary files with data stored as doubles");
1387 return 0;
1388 }
1389
1390 if (type != 0 && type != 1)
1391 {
1392 error ("load: can't read sparse matrices");
1393 return 0;
1394 }
1395
1396 if (imag && type == 1)
1397 {
1398 error ("load: encountered complex matrix with string flag set!");
1399 return 0;
1400 }
1401
1402 char *name = new char [len];
1403 stream.read (name, len);
1404
1405 int dlen = nr * nc;
1406 if (dlen < 0)
1407 {
1408 error ("load: matrix with negative size!");
1409 return 0;
1410 }
1411
1412 // This could probably be faster...
1413
1414 // XXX FIXME XXX -- 8 is magic here!
1415
1416 Matrix re (nr, nc);
1417 stream.read (re.fortran_vec (), dlen * 8);
1418
1419 if (imag)
1420 {
1421 Matrix im (nr, nc);
1422 stream.read (im.fortran_vec (), dlen * 8);
1423
1424 ComplexMatrix ctmp (nr, nc);
1425
1426 for (int j = 0; j < nc; j++)
1427 for (int i = 0; i < nr; i++)
1428 ctmp.elem (i, j) = Complex (re.elem (i, j), im.elem (i, j));
1429
1430 tc = ctmp;
1431 }
1432 else
1433 tc = re;
1434
1435 // If we were going to do it, this is probably where we would convert
1436 // the raw data to the proper floating point format.
1437
1438 if (type == 1)
1439 tc = tc.convert_to_str ();
1440
1441 return name;
1442 }
1443
1444 DEFUN_TEXT ("load", Fload, Sload, -1, 1,
1445 "load [-force] [-binary] file\n
1446 \n\
1447 load variables from a file")
1448 {
1449 Octave_object retval;
1450
1451 DEFINE_ARGV("load");
1452
1453 argc--;
1454 argv++;
1455
1456 int force = 0;
1457 int binary = 0;
1458
1459 while (argc > 0)
1460 {
1461 if (strcmp (*argv, "-force") == 0)
1462 {
1463 force++;
1464 argc--;
1465 argv++;
1466 }
1467 else if (strcmp (*argv, "-binary") == 0)
1468 {
1469 binary++;
1470 argc--;
1471 argv++;
1472 }
1473 else
1474 break;
1475 }
1476
1477 if (argc < 1)
1478 {
1479 error ("load: you must specify a single file to read");
1480 DELETE_ARGV;
1481 return retval;
1482 }
1483
1484 static istream stream;
1485 static ifstream file;
1486 if (strcmp (*argv, "-") == 0)
1487 {
1488 stream = cin;
1489 }
1490 else
1491 {
1492 char *fname = tilde_expand (*argv);
1493
1494 unsigned mode = ios::in;
1495 if (binary)
1496 mode |= ios::bin;
1497
1498 file.open (fname, mode);
1499
1500 if (! file)
1501 {
1502 error ("load: couldn't open input file `%s'", *argv);
1503 DELETE_ARGV;
1504 return retval;
1505 }
1506 stream = file;
1507 }
1508
1509 int count = 0;
1510 for (;;)
1511 {
1512 int global = 0;
1513 tree_constant tc;
1514
1515 char *name = 0;
1516 delete [] name;
1517
1518
1519 if (binary)
1520 name = read_binary_data (stream, *argv, global, tc);
1521 else
1522 name = read_ascii_data (stream, *argv, global, tc);
1523
1524 if (! error_state && name && tc.is_defined ())
1525 {
1526 count++;
1527 install_loaded_variable (force, name, tc, global);
1528 }
1529 else
1530 {
1531 if (count == 0)
1532 error ("load: are you sure `%s' is an Octave data file?", *argv);
1533
1534 break;
1535 }
1536 }
1537
1538 if (file);
1539 file.close ();
1540
1541 DELETE_ARGV;
1542
1543 return retval;
1544 }
1545
1546 // Return nonzero if PATTERN has any special globbing chars in it.
1547
1548 static int
1549 glob_pattern_p (char *pattern)
1550 {
1551 char *p = pattern;
1552 char c;
1553 int open = 0;
1554
1555 while ((c = *p++) != '\0')
1556 {
1557 switch (c)
1558 {
1559 case '?':
1560 case '*':
1561 return 1;
1562
1563 case '[': // Only accept an open brace if there is a close
1564 open++; // brace to match it. Bracket expressions must be
1565 continue; // complete, according to Posix.2
1566
1567 case ']':
1568 if (open)
1569 return 1;
1570 continue;
1571
1572 case '\\':
1573 if (*p++ == '\0')
1574 return 0;
1575
1576 default:
1577 continue;
1578 }
1579 }
1580
1581 return 0;
1582 }
1583
1584 DEFUN_TEXT ("save", Fsave, Ssave, -1, 1,
1585 "save file [var ...]\n\
1586 \n\
1587 save variables in a file")
1588 {
1589 Octave_object retval;
1590
1591 DEFINE_ARGV("save");
1592
1593 if (argc < 2)
1594 {
1595 print_usage ("save");
1596 DELETE_ARGV;
1597 return retval;
1598 }
1599
1600 argc--;
1601 argv++;
1602
1603 static ostream stream;
1604 static ofstream file;
1605 if (strcmp (*argv, "-") == 0)
1606 {
1607 // XXX FIXME XXX -- should things intended for the screen end up in a
1608 // tree_constant (string)?
1609 stream = cout;
1610 }
1611 else if (argc == 1 && glob_pattern_p (*argv)) // Guard against things
1612 { // like `save a*',
1613 print_usage ("save"); // which are probably
1614 DELETE_ARGV; // mistakes...
1615 return retval;
1616 }
1617 else
1618 {
1619 char *fname = tilde_expand (*argv);
1620 file.open (fname);
1621 if (! file)
1622 {
1623 error ("save: couldn't open output file `%s'", *argv);
1624 DELETE_ARGV;
1625 return retval;
1626 }
1627 stream = file;
1628
1629 }
1630
1631 int prec = user_pref.save_precision;
1632
1633 if (argc == 1)
1634 {
1635 int count;
1636 char **vars = curr_sym_tab->list (count, 0,
1637 symbol_def::USER_VARIABLE,
1638 SYMTAB_ALL_SCOPES);
1639
1640 for (int i = 0; i < count; i++)
1641 curr_sym_tab->save (stream, vars[i],
1642 is_globally_visible (vars[i]), prec);
1643
1644 delete [] vars;
1645 }
1646 else
1647 {
1648 while (--argc > 0)
1649 {
1650 argv++;
1651
1652 int count;
1653 char **lvars = curr_sym_tab->list (count, 0,
1654 symbol_def::USER_VARIABLE);
1655
1656 int saved_or_error = 0;
1657 int i;
1658 for (i = 0; i < count; i++)
1659 {
1660 if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0
1661 && curr_sym_tab->save (stream, lvars[i],
1662 is_globally_visible (lvars[i]),
1663 prec) != 0)
1664 saved_or_error++;
1665 }
1666
1667 char **bvars = global_sym_tab->list (count, 0,
1668 symbol_def::BUILTIN_VARIABLE);
1669
1670 for (i = 0; i < count; i++)
1671 {
1672 if (fnmatch (*argv, bvars[i], __FNM_FLAGS) == 0
1673 && global_sym_tab->save (stream, bvars[i], 0, prec) != 0)
1674 saved_or_error++;
1675 }
1676
1677 delete [] lvars;
1678 delete [] bvars;
1679
1680 if (! saved_or_error)
1681 warning ("save: no such variable `%s'", *argv);
1682 }
1683 }
1684
1685 if (file);
1686 file.close ();
1687
1688 DELETE_ARGV;
1689
1690 return retval;
1691 }
1692
1693 // Help stuff.
1694 813
1695 // It's not likely that this does the right thing now. XXX FIXME XXX 814 // It's not likely that this does the right thing now. XXX FIXME XXX
1696 815
1697 char ** 816 char **
1698 make_name_list (void) 817 make_name_list (void)
1888 { 1007 {
1889 show_builtins++; 1008 show_builtins++;
1890 show_functions++; 1009 show_functions++;
1891 show_variables++; 1010 show_variables++;
1892 } 1011 }
1893 else if (strcmp (*argv, "-builtins") == 0 1012 else if (strcmp (*argv, "-builtins") == 0 || strcmp (*argv, "-b") == 0)
1894 || strcmp (*argv, "-b") == 0)
1895 show_builtins++; 1013 show_builtins++;
1896 else if (strcmp (*argv, "-functions") == 0 1014 else if (strcmp (*argv, "-functions") == 0 || strcmp (*argv, "-f") == 0)
1897 || strcmp (*argv, "-f") == 0)
1898 show_functions++; 1015 show_functions++;
1899 else if (strcmp (*argv, "-long") == 0 1016 else if (strcmp (*argv, "-long") == 0 || strcmp (*argv, "-l") == 0)
1900 || strcmp (*argv, "-l") == 0) 1017 show_verbose++;
1901 show_verbose++; 1018 else if (strcmp (*argv, "-variables") == 0 || strcmp (*argv, "-v") == 0)
1902 else if (strcmp (*argv, "-variables") == 0
1903 || strcmp (*argv, "-v") == 0)
1904 show_variables++; 1019 show_variables++;
1905 else 1020 else
1906 warning ("%s: unrecognized option `%s'", my_name, *argv); 1021 warning ("%s: unrecognized option `%s'", my_name, *argv);
1907 } 1022 }
1908 1023
2209 ""); 1324 "");
2210 1325
2211 DEFVAR ("commas_in_literal_matrix", SBV_commas_in_literal_matrix, "", 1326 DEFVAR ("commas_in_literal_matrix", SBV_commas_in_literal_matrix, "",
2212 0, 0, 1, commas_in_literal_matrix, 1327 0, 0, 1, commas_in_literal_matrix,
2213 "control auto-insertion of commas in literal matrices"); 1328 "control auto-insertion of commas in literal matrices");
1329
1330 DEFVAR ("default_save_format", SBV_default_save_format, "ascii",
1331 0, 0, 1, sv_default_save_format,
1332 "default format for files created with save, may be either\n\
1333 \"binary\" or \"text\"");
2214 1334
2215 DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0, 1335 DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0,
2216 1, do_fortran_indexing, 1336 1, do_fortran_indexing,
2217 "allow single indices for matrices"); 1337 "allow single indices for matrices");
2218 1338