GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
utils.cc
Go to the documentation of this file.
1 /*
2 
3 Copyright (C) 1993-2013 John W. Eaton
4 Copyright (C) 2010 VZLU Prague
5 
6 This file is part of Octave.
7 
8 Octave is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 3 of the License, or (at your
11 option) any later version.
12 
13 Octave is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
17 
18 You should have received a copy of the GNU General Public License
19 along with Octave; see the file COPYING. If not, see
20 <http://www.gnu.org/licenses/>.
21 
22 */
23 
24 #ifdef HAVE_CONFIG_H
25 #include <config.h>
26 #endif
27 
28 #include <cerrno>
29 #include <cstring>
30 
31 #include <fstream>
32 #include <iostream>
33 #include <limits>
34 #include <string>
35 
36 #include <sys/types.h>
37 #include <unistd.h>
38 
39 #include "vasnprintf.h"
40 
41 #include "quit.h"
42 
43 #include "dir-ops.h"
44 #include "file-ops.h"
45 #include "file-stat.h"
46 #include "lo-mappers.h"
47 #include "lo-utils.h"
48 #include "oct-cmplx.h"
49 #include "oct-env.h"
50 #include "pathsearch.h"
51 #include "str-vec.h"
52 
53 #include "Cell.h"
54 #include <defaults.h>
55 #include "defun.h"
56 #include "dirfns.h"
57 #include "error.h"
58 #include "gripes.h"
59 #include "input.h"
60 #include "lex.h"
61 #include "load-path.h"
62 #include "oct-errno.h"
63 #include "oct-hist.h"
64 #include "oct-obj.h"
65 #include "ov-range.h"
66 #include "pager.h"
67 #include "parse.h"
68 #include "sysdep.h"
69 #include "toplev.h"
70 #include "unwind-prot.h"
71 #include "utils.h"
72 #include "variables.h"
73 
74 // Return TRUE if S is a valid identifier.
75 
76 bool
77 valid_identifier (const char *s)
78 {
79  if (! s || ! (isalpha (*s) || *s == '_' || *s == '$'))
80  return false;
81 
82  while (*++s != '\0')
83  if (! (isalnum (*s) || *s == '_' || *s == '$'))
84  return false;
85 
86  return true;
87 }
88 
89 bool
90 valid_identifier (const std::string& s)
91 {
92  return valid_identifier (s.c_str ());
93 }
94 
95 DEFUN (isvarname, args, ,
96  "-*- texinfo -*-\n\
97 @deftypefn {Built-in Function} {} isvarname (@var{name})\n\
98 Return true if @var{name} is a valid variable name.\n\
99 @seealso{iskeyword, exist, who}\n\
100 @end deftypefn")
101 {
102  octave_value retval = false;
103 
104  int nargin = args.length ();
105 
106  if (nargin != 1)
107  print_usage ();
108  else if (args(0).is_string ())
109  {
110  std::string varname = args(0).string_value ();
111  retval = valid_identifier (varname) && ! is_keyword (varname);
112  }
113 
114  return retval;
115 }
116 
117 /*
118 %!assert (isvarname ("foo"), true)
119 %!assert (isvarname ("_foo"), true)
120 %!assert (isvarname ("_1"), true)
121 %!assert (isvarname ("1foo"), false)
122 %!assert (isvarname (""), false)
123 %!assert (isvarname (12), false)
124 
125 %!error isvarname ()
126 %!error isvarname ("foo", "bar");
127 */
128 
129 // Return TRUE if F and G are both names for the same file.
130 
131 bool
132 same_file (const std::string& f, const std::string& g)
133 {
134  return same_file_internal (f, g);
135 }
136 
137 int
138 almost_match (const std::string& std, const std::string& s, int min_match_len,
139  int case_sens)
140 {
141  int stdlen = std.length ();
142  int slen = s.length ();
143 
144  return (slen <= stdlen
145  && slen >= min_match_len
146  && (case_sens
147  ? (strncmp (std.c_str (), s.c_str (), slen) == 0)
148  : (octave_strncasecmp (std.c_str (), s.c_str (), slen) == 0)));
149 }
150 
151 // Ugh.
152 
153 int
154 keyword_almost_match (const char * const *std, int *min_len,
155  const std::string& s,
156  int min_toks_to_match, int max_toks)
157 {
158  int status = 0;
159  int tok_count = 0;
160  int toks_matched = 0;
161 
162  if (s.empty () || max_toks < 1)
163  return status;
164 
165  char *kw = strsave (s.c_str ());
166 
167  char *t = kw;
168  while (*t != '\0')
169  {
170  if (*t == '\t')
171  *t = ' ';
172  t++;
173  }
174 
175  char *beg = kw;
176  while (*beg == ' ')
177  beg++;
178 
179  if (*beg == '\0')
180  return status;
181 
182 
183  const char **to_match = new const char * [max_toks + 1];
184  const char * const *s1 = std;
185  const char **s2 = to_match;
186 
187  if (! s1 || ! s2)
188  goto done;
189 
190  s2[tok_count] = beg;
191  char *end;
192  while ((end = strchr (beg, ' ')) != 0)
193  {
194  *end = '\0';
195  beg = end + 1;
196 
197  while (*beg == ' ')
198  beg++;
199 
200  if (*beg == '\0')
201  break;
202 
203  tok_count++;
204  if (tok_count >= max_toks)
205  goto done;
206 
207  s2[tok_count] = beg;
208  }
209  s2[tok_count+1] = 0;
210 
211  s2 = to_match;
212 
213  for (;;)
214  {
215  if (! almost_match (*s1, *s2, min_len[toks_matched], 0))
216  goto done;
217 
218  toks_matched++;
219 
220  s1++;
221  s2++;
222 
223  if (! *s2)
224  {
225  status = (toks_matched >= min_toks_to_match);
226  goto done;
227  }
228 
229  if (! *s1)
230  goto done;
231  }
232 
233 done:
234 
235  delete [] kw;
236  delete [] to_match;
237 
238  return status;
239 }
240 
241 // Return non-zero if either NR or NC is zero. Return -1 if this
242 // should be considered fatal; return 1 if this is ok.
243 
244 int
245 empty_arg (const char * /* name */, octave_idx_type nr, octave_idx_type nc)
246 {
247  return (nr == 0 || nc == 0);
248 }
249 
250 // See if the given file is in the path.
251 
252 std::string
253 search_path_for_file (const std::string& path, const string_vector& names)
254 {
255  dir_path p (path);
256 
257  return octave_env::make_absolute (p.find_first_of (names));
258 }
259 
260 // Find all locations of the given file in the path.
261 
263 search_path_for_all_files (const std::string& path, const string_vector& names)
264 {
265  dir_path p (path);
266 
267  string_vector sv = p.find_all_first_of (names);
268 
269  octave_idx_type len = sv.length ();
270 
271  for (octave_idx_type i = 0; i < len; i++)
272  sv[i] = octave_env::make_absolute (sv[i]);
273 
274  return sv;
275 }
276 
277 static string_vector
279 {
280  octave_idx_type len = sv.length ();
281 
282  string_vector retval (len);
283 
284  for (octave_idx_type i = 0; i < len; i++)
285  retval[i] = octave_env::make_absolute (sv[i]);
286 
287  return retval;
288 }
289 
290 DEFUN (file_in_loadpath, args, ,
291  "-*- texinfo -*-\n\
292 @deftypefn {Built-in Function} {} file_in_loadpath (@var{file})\n\
293 @deftypefnx {Built-in Function} {} file_in_loadpath (@var{file}, \"all\")\n\
294 \n\
295 Return the absolute name of @var{file} if it can be found in\n\
296 the list of directories specified by @code{path}.\n\
297 If no file is found, return an empty character string.\n\
298 \n\
299 If the first argument is a cell array of strings, search each\n\
300 directory of the loadpath for element of the cell array and return\n\
301 the first that matches.\n\
302 \n\
303 If the second optional argument @qcode{\"all\"} is supplied, return\n\
304 a cell array containing the list of all files that have the same\n\
305 name in the path. If no files are found, return an empty cell array.\n\
306 @seealso{file_in_path, find_dir_in_path, path}\n\
307 @end deftypefn")
308 {
309  octave_value retval;
310 
311  int nargin = args.length ();
312 
313  if (nargin == 1 || nargin == 2)
314  {
315  string_vector names = args(0).all_strings ();
316 
317  if (! error_state && names.length () > 0)
318  {
319  if (nargin == 1)
320  retval =
322  else if (nargin == 2)
323  {
324  std::string opt = args(1).string_value ();
325 
326  if (! error_state && opt == "all")
327  retval = Cell (make_absolute
328  (load_path::find_all_first_of (names)));
329  else
330  error ("file_in_loadpath: invalid option");
331  }
332  }
333  else
334  error ("file_in_loadpath: FILE argument must be a string");
335  }
336  else
337  print_usage ();
338 
339  return retval;
340 }
341 
342 /*
343 %!test
344 %! f = file_in_loadpath ("plot.m");
345 %! assert (ischar (f));
346 %! assert (! isempty (f));
347 
348 %!test
349 %! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$");
350 %! assert (f, "");
351 
352 %!test
353 %! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all");
354 %! assert (lst, {});
355 
356 %!error file_in_loadpath ()
357 %!error file_in_loadpath ("foo", "bar", 1)
358 */
359 
360 DEFUN (file_in_path, args, ,
361  "-*- texinfo -*-\n\
362 @deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\
363 @deftypefnx {Built-in Function} {} file_in_path (@var{path}, @var{file}, \"all\")\n\
364 Return the absolute name of @var{file} if it can be found in\n\
365 @var{path}. The value of @var{path} should be a colon-separated list of\n\
366 directories in the format described for @code{path}. If no file\n\
367 is found, return an empty character string. For example:\n\
368 \n\
369 @example\n\
370 @group\n\
371 file_in_path (EXEC_PATH, \"sh\")\n\
372  @result{} \"/bin/sh\"\n\
373 @end group\n\
374 @end example\n\
375 \n\
376 If the second argument is a cell array of strings, search each\n\
377 directory of the path for element of the cell array and return\n\
378 the first that matches.\n\
379 \n\
380 If the third optional argument @qcode{\"all\"} is supplied, return\n\
381 a cell array containing the list of all files that have the same\n\
382 name in the path. If no files are found, return an empty cell array.\n\
383 @seealso{file_in_loadpath, find_dir_in_path, path}\n\
384 @end deftypefn")
385 {
386  octave_value retval;
387 
388  int nargin = args.length ();
389 
390  if (nargin == 2 || nargin == 3)
391  {
392  std::string path = args(0).string_value ();
393 
394  if (! error_state)
395  {
396  string_vector names = args(1).all_strings ();
397 
398  if (! error_state && names.length () > 0)
399  {
400  if (nargin == 2)
401  retval = search_path_for_file (path, names);
402  else if (nargin == 3)
403  {
404  std::string opt = args(2).string_value ();
405 
406  if (! error_state && opt == "all")
407  retval = Cell (make_absolute
408  (search_path_for_all_files (path, names)));
409  else
410  error ("file_in_path: invalid option");
411  }
412  }
413  else
414  error ("file_in_path: all arguments must be strings");
415  }
416  else
417  error ("file_in_path: PATH must be a string");
418  }
419  else
420  print_usage ();
421 
422  return retval;
423 }
424 
425 /*
426 %!test
427 %! f = file_in_path (path (), "plot.m");
428 %! assert (ischar (f));
429 %! assert (! isempty (f));
430 
431 %!test
432 %! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$");
433 %! assert (f, "");
434 
435 %!test
436 %! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all");
437 %! assert (lst, {});
438 
439 %!error file_in_path ()
440 %!error file_in_path ("foo")
441 %!error file_in_path ("foo", "bar", "baz", 1)
442 */
443 
444 std::string
445 file_in_path (const std::string& name, const std::string& suffix)
446 {
447  std::string nm = name;
448 
449  if (! suffix.empty ())
450  nm.append (suffix);
451 
453 }
454 
455 // See if there is an function file in the path. If so, return the
456 // full path to the file.
457 
458 std::string
459 fcn_file_in_path (const std::string& name)
460 {
461  std::string retval;
462 
463  int len = name.length ();
464 
465  if (len > 0)
466  {
468  {
469  file_stat fs (name);
470 
471  if (fs.exists () && ! fs.is_dir ())
472  retval = name;
473  }
474  else if (len > 2 && name[len - 2] == '.' && name[len - 1] == 'm')
475  retval = load_path::find_fcn_file (name.substr (0, len-2));
476  else
477  {
478  std::string fname = name;
479  size_t pos = name.find_first_of (Vfilemarker);
480  if (pos != std::string::npos)
481  fname = name.substr (0, pos);
482 
483  retval = load_path::find_fcn_file (fname);
484  }
485  }
486 
487  return retval;
488 }
489 
490 // See if there is a directory called "name" in the path and if it
491 // contains a Contents.m file return the full path to this file.
492 
493 std::string
494 contents_file_in_path (const std::string& dir)
495 {
496  std::string retval;
497 
498  if (dir.length () > 0)
499  {
500  std::string tcontents = file_ops::concat (load_path::find_dir (dir),
501  std::string ("Contents.m"));
502 
503  file_stat fs (tcontents);
504 
505  if (fs.exists ())
506  retval = octave_env::make_absolute (tcontents);
507  }
508 
509  return retval;
510 }
511 
512 // See if there is a .oct file in the path. If so, return the
513 // full path to the file.
514 
515 std::string
516 oct_file_in_path (const std::string& name)
517 {
518  std::string retval;
519 
520  int len = name.length ();
521 
522  if (len > 0)
523  {
525  {
526  file_stat fs (name);
527 
528  if (fs.exists ())
529  retval = name;
530  }
531  else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'o'
532  && name[len - 2] == 'c' && name[len - 1] == 't')
533  retval = load_path::find_oct_file (name.substr (0, len-4));
534  else
535  retval = load_path::find_oct_file (name);
536  }
537 
538  return retval;
539 }
540 
541 // See if there is a .mex file in the path. If so, return the
542 // full path to the file.
543 
544 std::string
545 mex_file_in_path (const std::string& name)
546 {
547  std::string retval;
548 
549  int len = name.length ();
550 
551  if (len > 0)
552  {
554  {
555  file_stat fs (name);
556 
557  if (fs.exists ())
558  retval = name;
559  }
560  else if (len > 4 && name[len - 4] == '.' && name[len - 3] == 'm'
561  && name[len - 2] == 'e' && name[len - 1] == 'x')
562  retval = load_path::find_mex_file (name.substr (0, len-4));
563  else
564  retval = load_path::find_mex_file (name);
565  }
566 
567  return retval;
568 }
569 
570 // Replace backslash escapes in a string with the real values.
571 
572 std::string
573 do_string_escapes (const std::string& s)
574 {
575  std::string retval;
576 
577  size_t i = 0;
578  size_t j = 0;
579  size_t len = s.length ();
580 
581  retval.resize (len);
582 
583  while (j < len)
584  {
585  if (s[j] == '\\' && j+1 < len)
586  {
587  switch (s[++j])
588  {
589  case '0':
590  retval[i] = '\0';
591  break;
592 
593  case 'a':
594  retval[i] = '\a';
595  break;
596 
597  case 'b': // backspace
598  retval[i] = '\b';
599  break;
600 
601  case 'f': // formfeed
602  retval[i] = '\f';
603  break;
604 
605  case 'n': // newline
606  retval[i] = '\n';
607  break;
608 
609  case 'r': // carriage return
610  retval[i] = '\r';
611  break;
612 
613  case 't': // horizontal tab
614  retval[i] = '\t';
615  break;
616 
617  case 'v': // vertical tab
618  retval[i] = '\v';
619  break;
620 
621  case '\\': // backslash
622  retval[i] = '\\';
623  break;
624 
625  case '\'': // quote
626  retval[i] = '\'';
627  break;
628 
629  case '"': // double quote
630  retval[i] = '"';
631  break;
632 
633  default:
634  warning ("unrecognized escape sequence '\\%c' --\
635  converting to '%c'", s[j], s[j]);
636  retval[i] = s[j];
637  break;
638  }
639  }
640  else
641  {
642  retval[i] = s[j];
643  }
644 
645  i++;
646  j++;
647  }
648 
649  retval.resize (i);
650 
651  return retval;
652 }
653 
654 DEFUN (do_string_escapes, args, ,
655  "-*- texinfo -*-\n\
656 @deftypefn {Built-in Function} {} do_string_escapes (@var{string})\n\
657 Convert special characters in @var{string} to their escaped forms.\n\
658 @end deftypefn")
659 {
660  octave_value retval;
661 
662  int nargin = args.length ();
663 
664  if (nargin == 1)
665  {
666  if (args(0).is_string ())
667  retval = do_string_escapes (args(0).string_value ());
668  else
669  error ("do_string_escapes: STRING argument must be of type string");
670  }
671  else
672  print_usage ();
673 
674  return retval;
675 }
676 
677 /*
678 %!assert (do_string_escapes ('foo\nbar'), "foo\nbar")
679 %!assert (do_string_escapes ("foo\\nbar"), "foo\nbar")
680 %!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"])
681 %!assert ("foo\nbar", ["foo", char(10), "bar"])
682 
683 %!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v")
684 %!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v")
685 %!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"),
686 %! char ([7, 8, 12, 10, 13, 9, 11]))
687 %!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11]))
688 
689 %!error do_string_escapes ()
690 %!error do_string_escapes ("foo", "bar")
691 */
692 
693 const char *
695 {
696  if (! c)
697  return "";
698 
699  switch (c)
700  {
701  case '\0':
702  return "\\0";
703 
704  case '\a':
705  return "\\a";
706 
707  case '\b': // backspace
708  return "\\b";
709 
710  case '\f': // formfeed
711  return "\\f";
712 
713  case '\n': // newline
714  return "\\n";
715 
716  case '\r': // carriage return
717  return "\\r";
718 
719  case '\t': // horizontal tab
720  return "\\t";
721 
722  case '\v': // vertical tab
723  return "\\v";
724 
725  case '\\': // backslash
726  return "\\\\";
727 
728  case '"': // double quote
729  return "\\\"";
730 
731  default:
732  {
733  static char retval[2];
734  retval[0] = c;
735  retval[1] = '\0';
736  return retval;
737  }
738  }
739 }
740 
741 std::string
742 undo_string_escapes (const std::string& s)
743 {
744  std::string retval;
745 
746  for (size_t i = 0; i < s.length (); i++)
747  retval.append (undo_string_escape (s[i]));
748 
749  return retval;
750 }
751 
752 DEFUN (undo_string_escapes, args, ,
753  "-*- texinfo -*-\n\
754 @deftypefn {Built-in Function} {} undo_string_escapes (@var{s})\n\
755 Convert special characters in strings back to their escaped forms. For\n\
756 example, the expression\n\
757 \n\
758 @example\n\
759 bell = \"\\a\";\n\
760 @end example\n\
761 \n\
762 @noindent\n\
763 assigns the value of the alert character (control-g, ASCII code 7) to\n\
764 the string variable @code{bell}. If this string is printed, the\n\
765 system will ring the terminal bell (if it is possible). This is\n\
766 normally the desired outcome. However, sometimes it is useful to be\n\
767 able to print the original representation of the string, with the\n\
768 special characters replaced by their escape sequences. For example,\n\
769 \n\
770 @example\n\
771 @group\n\
772 octave:13> undo_string_escapes (bell)\n\
773 ans = \\a\n\
774 @end group\n\
775 @end example\n\
776 \n\
777 @noindent\n\
778 replaces the unprintable alert character with its printable\n\
779 representation.\n\
780 @end deftypefn")
781 {
782  octave_value retval;
783 
784  int nargin = args.length ();
785 
786  if (nargin == 1)
787  {
788  if (args(0).is_string ())
789  retval = undo_string_escapes (args(0).string_value ());
790  else
791  error ("undo_string_escapes: S argument must be a string");
792  }
793  else
794  print_usage ();
795 
796  return retval;
797 }
798 
799 /*
800 %!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar')
801 %!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar")
802 %!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar")
803 
804 %!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v')
805 %!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v")
806 %!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])),
807 %! "\\a\\b\\f\\n\\r\\t\\v")
808 
809 %!error undo_string_escapes ()
810 %!error undo_string_escapes ("foo", "bar")
811 */
812 
813 DEFUN (is_absolute_filename, args, ,
814  "-*- texinfo -*-\n\
815 @deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\
816 Return true if @var{file} is an absolute filename.\n\
817 @seealso{is_rooted_relative_filename, make_absolute_filename, isdir}\n\
818 @end deftypefn")
819 {
820  octave_value retval = false;
821 
822  if (args.length () == 1)
823  retval = (args(0).is_string ()
824  && octave_env::absolute_pathname (args(0).string_value ()));
825  else
826  print_usage ();
827 
828  return retval;
829 }
830 
831 /*
832 ## FIXME: We need system-dependent tests here.
833 
834 %!error is_absolute_filename ()
835 %!error is_absolute_filename ("foo", "bar")
836 */
837 
838 DEFUN (is_rooted_relative_filename, args, ,
839  "-*- texinfo -*-\n\
840 @deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\
841 Return true if @var{file} is a rooted-relative filename.\n\
842 @seealso{is_absolute_filename, make_absolute_filename, isdir}\n\
843 @end deftypefn")
844 {
845  octave_value retval = false;
846 
847  if (args.length () == 1)
848  retval = (args(0).is_string ()
849  && octave_env::rooted_relative_pathname (args(0).string_value ()));
850  else
851  print_usage ();
852 
853  return retval;
854 }
855 
856 /*
857 ## FIXME: We need system-dependent tests here.
858 
859 %!error is_rooted_relative_filename ()
860 %!error is_rooted_relative_filename ("foo", "bar")
861 */
862 
863 DEFUN (make_absolute_filename, args, ,
864  "-*- texinfo -*-\n\
865 @deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\
866 Return the full name of @var{file} beginning from the root of the file\n\
867 system. No check is done for the existence of @var{file}.\n\
868 @seealso{canonicalize_file_name, is_absolute_filename, is_rooted_relative_filename, isdir}\n\
869 @end deftypefn")
870 {
871  octave_value retval = std::string ();
872 
873  if (args.length () == 1)
874  {
875  std::string nm = args(0).string_value ();
876 
877  if (! error_state)
878  retval = octave_env::make_absolute (nm);
879  else
880  error ("make_absolute_filename: FILE argument must be a file name");
881  }
882  else
883  print_usage ();
884 
885  return retval;
886 }
887 
888 /*
889 ## FIXME: We need system-dependent tests here.
890 
891 %!error make_absolute_filename ()
892 %!error make_absolute_filename ("foo", "bar")
893 */
894 
895 DEFUN (find_dir_in_path, args, ,
896  "-*- texinfo -*-\n\
897 @deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\
898 @deftypefnx {Built-in Function} {} find_dir_in_path (@var{dir}, \"all\")\n\
899 Return the full name of the path element matching @var{dir}. The\n\
900 match is performed at the end of each path element. For example, if\n\
901 @var{dir} is @qcode{\"foo/bar\"}, it matches the path element\n\
902 @nospell{@qcode{\"/some/dir/foo/bar\"}}, but not\n\
903 @nospell{@qcode{\"/some/dir/foo/bar/baz\"}}\n\
904 @nospell{@qcode{\"/some/dir/allfoo/bar\"}}.\n\
905 \n\
906 The second argument is optional. If it is supplied, return a cell array\n\
907 containing all name matches rather than just the first.\n\
908 @seealso{file_in_path, file_in_loadpath, path}\n\
909 @end deftypefn")
910 {
911  octave_value retval = std::string ();
912 
913  int nargin = args.length ();
914 
915  std::string dir;
916 
917  if (nargin == 1 || nargin == 2)
918  {
919  dir = args(0).string_value ();
920 
921  if (! error_state)
922  {
923  if (nargin == 1)
924  retval = load_path::find_dir (dir);
925  else if (nargin == 2)
926  retval = Cell (load_path::find_matching_dirs (dir));
927  }
928  else
929  error ("find_dir_in_path: DIR must be a directory name");
930  }
931  else
932  print_usage ();
933 
934  return retval;
935 }
936 
937 /*
938 ## FIXME: We need system-dependent tests here.
939 
940 %!error find_dir_in_path ()
941 %!error find_dir_in_path ("foo", "bar", 1)
942 */
943 
944 DEFUNX ("errno", Ferrno, args, ,
945  "-*- texinfo -*-\n\
946 @deftypefn {Built-in Function} {@var{err} =} errno ()\n\
947 @deftypefnx {Built-in Function} {@var{err} =} errno (@var{val})\n\
948 @deftypefnx {Built-in Function} {@var{err} =} errno (@var{name})\n\
949 Return the current value of the system-dependent variable errno,\n\
950 set its value to @var{val} and return the previous value, or return\n\
951 the named error code given @var{name} as a character string, or -1\n\
952 if @var{name} is not found.\n\
953 @end deftypefn")
954 {
955  octave_value retval;
956 
957  int nargin = args.length ();
958 
959  if (nargin == 1)
960  {
961  if (args(0).is_string ())
962  {
963  std::string nm = args(0).string_value ();
964 
965  if (! error_state)
966  retval = octave_errno::lookup (nm);
967  else
968  error ("errno: expecting character string argument");
969  }
970  else
971  {
972  int val = args(0).int_value ();
973 
974  if (! error_state)
975  retval = octave_errno::set (val);
976  else
977  error ("errno: expecting integer argument");
978  }
979  }
980  else if (nargin == 0)
981  retval = octave_errno::get ();
982  else
983  print_usage ();
984 
985  return retval;
986 }
987 
988 /*
989 %!assert (isnumeric (errno ()))
990 
991 %!test
992 %! lst = errno_list ();
993 %! fns = fieldnames (lst);
994 %! oldval = errno (fns{1});
995 %! assert (isnumeric (oldval));
996 %! errno (oldval);
997 %! newval = errno ();
998 %! assert (oldval, newval);
999 
1000 %!error errno ("foo", 1)
1001 */
1002 
1003 DEFUN (errno_list, args, ,
1004  "-*- texinfo -*-\n\
1005 @deftypefn {Built-in Function} {} errno_list ()\n\
1006 Return a structure containing the system-dependent errno values.\n\
1007 @end deftypefn")
1008 {
1009  octave_value retval;
1010 
1011  if (args.length () == 0)
1012  retval = octave_errno::list ();
1013  else
1014  print_usage ();
1015 
1016  return retval;
1017 }
1018 
1019 /*
1020 %!assert (isstruct (errno_list ()))
1021 
1022 %!error errno_list ("foo")
1023 */
1024 
1025 static void
1026 check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor)
1027 {
1028  if (nr < 0 || nc < 0)
1029  {
1030  warning_with_id ("Octave:neg-dim-as-zero",
1031  "%s: converting negative dimension to zero", warnfor);
1032 
1033  nr = (nr < 0) ? 0 : nr;
1034  nc = (nc < 0) ? 0 : nc;
1035  }
1036 }
1037 
1038 void
1039 check_dimensions (dim_vector& dim, const char *warnfor)
1040 {
1041  bool neg = false;
1042 
1043  for (int i = 0; i < dim.length (); i++)
1044  {
1045  if (dim(i) < 0)
1046  {
1047  dim(i) = 0;
1048  neg = true;
1049  }
1050  }
1051 
1052  if (neg)
1053  warning_with_id ("Octave:neg-dim-as-zero",
1054  "%s: converting negative dimension to zero", warnfor);
1055 }
1056 
1057 
1058 void
1059 get_dimensions (const octave_value& a, const char *warn_for,
1060  dim_vector& dim)
1061 {
1062  if (a.is_scalar_type ())
1063  {
1064  dim.resize (2);
1065  dim(0) = a.int_value ();
1066  dim(1) = dim(0);
1067  }
1068  else
1069  {
1070  octave_idx_type nr = a.rows ();
1071  octave_idx_type nc = a.columns ();
1072 
1073  if (nr == 1 || nc == 1)
1074  {
1075  Array<double> v = a.vector_value ();
1076 
1077  if (error_state)
1078  return;
1079 
1080  octave_idx_type n = v.length ();
1081  dim.resize (n);
1082  for (octave_idx_type i = 0; i < n; i++)
1083  dim(i) = static_cast<int> (fix (v(i)));
1084  }
1085  else
1086  error ("%s (A): use %s (size (A)) instead", warn_for, warn_for);
1087  }
1088 
1089  if (! error_state)
1090  check_dimensions (dim, warn_for); // May set error_state.
1091 }
1092 
1093 
1094 void
1095 get_dimensions (const octave_value& a, const char *warn_for,
1097 {
1098  if (a.is_scalar_type ())
1099  {
1100  nr = nc = a.int_value ();
1101  }
1102  else
1103  {
1104  nr = a.rows ();
1105  nc = a.columns ();
1106 
1107  if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1))
1108  {
1109  Array<double> v = a.vector_value ();
1110 
1111  if (error_state)
1112  return;
1113 
1114  nr = static_cast<octave_idx_type> (fix (v (0)));
1115  nc = static_cast<octave_idx_type> (fix (v (1)));
1116  }
1117  else
1118  error ("%s (A): use %s (size (A)) instead", warn_for, warn_for);
1119  }
1120 
1121  if (! error_state)
1122  check_dimensions (nr, nc, warn_for); // May set error_state.
1123 }
1124 
1125 void
1127  const char *warn_for, octave_idx_type& nr, octave_idx_type& nc)
1128 {
1129  nr = a.is_empty () ? 0 : a.int_value ();
1130  nc = b.is_empty () ? 0 : b.int_value ();
1131 
1132  if (error_state)
1133  error ("%s: expecting two scalar arguments", warn_for);
1134  else
1135  check_dimensions (nr, nc, warn_for); // May set error_state.
1136 }
1137 
1139 dims_to_numel (const dim_vector& dims, const octave_value_list& idx)
1140 {
1141  octave_idx_type retval;
1142 
1143  octave_idx_type len = idx.length ();
1144 
1145  if (len == 0)
1146  retval = dims.numel ();
1147  else
1148  {
1149  const dim_vector dv = dims.redim (len);
1150  retval = 1;
1151  for (octave_idx_type i = 0; i < len; i++)
1152  {
1153  octave_value idxi = idx(i);
1154  if (idxi.is_magic_colon ())
1155  retval *= dv(i);
1156  else if (idxi.is_numeric_type ())
1157  retval *= idxi.numel ();
1158  else
1159  {
1160  idx_vector jdx = idxi.index_vector ();
1161  if (error_state)
1162  break;
1163  retval *= jdx.length (dv(i));
1164  }
1165  }
1166  }
1167 
1168  return retval;
1169 }
1170 
1171 Matrix
1173 {
1174  Matrix m (nr, nc, 0.0);
1175 
1176  if (nr > 0 && nc > 0)
1177  {
1178  octave_idx_type n = std::min (nr, nc);
1179 
1180  for (octave_idx_type i = 0; i < n; i++)
1181  m (i, i) = 1.0;
1182  }
1183 
1184  return m;
1185 }
1186 
1189 {
1190  FloatMatrix m (nr, nc, 0.0);
1191 
1192  if (nr > 0 && nc > 0)
1193  {
1194  octave_idx_type n = std::min (nr, nc);
1195 
1196  for (octave_idx_type i = 0; i < n; i++)
1197  m (i, i) = 1.0;
1198  }
1199 
1200  return m;
1201 }
1202 
1203 size_t
1204 octave_format (std::ostream& os, const char *fmt, ...)
1205 {
1206  size_t retval;
1207 
1208  va_list args;
1209  va_start (args, fmt);
1210 
1211  retval = octave_vformat (os, fmt, args);
1212 
1213  va_end (args);
1214 
1215  return retval;
1216 }
1217 
1218 size_t
1219 octave_vformat (std::ostream& os, const char *fmt, va_list args)
1220 {
1221  std::string s = octave_vasprintf (fmt, args);
1222 
1223  os << s;
1224 
1225  return s.length ();
1226 }
1227 
1228 std::string
1229 octave_vasprintf (const char *fmt, va_list args)
1230 {
1231  std::string retval;
1232 
1233  char *result;
1234 
1235  int status = gnulib::vasprintf (&result, fmt, args);
1236 
1237  if (status >= 0)
1238  {
1239  retval = result;
1240  ::free (result);
1241  }
1242 
1243  return retval;
1244 }
1245 
1246 std::string
1247 octave_asprintf (const char *fmt, ...)
1248 {
1249  std::string retval;
1250 
1251  va_list args;
1252  va_start (args, fmt);
1253 
1254  retval = octave_vasprintf (fmt, args);
1255 
1256  va_end (args);
1257 
1258  return retval;
1259 }
1260 
1261 void
1262 octave_sleep (double seconds)
1263 {
1264  if (seconds > 0)
1265  {
1266  double t;
1267 
1268  unsigned int usec
1269  = static_cast<unsigned int> (modf (seconds, &t) * 1000000);
1270 
1271  unsigned int sec
1274  : static_cast<unsigned int> (t));
1275 
1276  // Versions of these functions that accept unsigned int args are
1277  // defined in cutils.c.
1278  octave_sleep (sec);
1279  octave_usleep (usec);
1280 
1281  octave_quit ();
1282  }
1283 }
1284 
1285 DEFUN (isindex, args, ,
1286  "-*- texinfo -*-\n\
1287 @deftypefn {Built-in Function} {} isindex (@var{ind})\n\
1288 @deftypefnx {Built-in Function} {} isindex (@var{ind}, @var{n})\n\
1289 Return true if @var{ind} is a valid index. Valid indices are\n\
1290 either positive integers (although possibly of real data type), or logical\n\
1291 arrays. If present, @var{n} specifies the maximum extent of the dimension\n\
1292 to be indexed. When possible the internal result is cached so that\n\
1293 subsequent indexing using @var{ind} will not perform the check again.\n\
1294 @end deftypefn")
1295 {
1296  octave_value retval;
1297  int nargin = args.length ();
1298  octave_idx_type n = 0;
1299 
1300  if (nargin == 2)
1301  n = args(1).idx_type_value ();
1302  else if (nargin != 1)
1303  print_usage ();
1304 
1305  if (! error_state)
1306  {
1307  unwind_protect frame;
1308 
1311 
1312  frame.protect_var (error_state);
1313 
1315  discard_error_messages = true;
1316 
1317  try
1318  {
1319  idx_vector idx = args(0).index_vector ();
1320  if (! error_state)
1321  {
1322  if (nargin == 2)
1323  retval = idx.extent (n) <= n;
1324  else
1325  retval = true;
1326  }
1327  else
1328  retval = false;
1329  }
1330  catch (octave_execution_exception)
1331  {
1332  retval = false;
1333  }
1334  }
1335 
1336  return retval;
1337 }
1338 
1339 /*
1340 %!assert (isindex ([1, 2, 3]))
1341 %!assert (isindex (1:3))
1342 %!assert (isindex ([1, 2, -3]), false)
1343 
1344 %!error isindex ()
1345 */
1346 
1349  const char *fun_name, const octave_value_list& args,
1350  int nargout)
1351 {
1352  octave_value_list new_args = args, retval;
1353  int nargin = args.length ();
1354  OCTAVE_LOCAL_BUFFER (bool, iscell, nargin);
1355  OCTAVE_LOCAL_BUFFER (Cell, cells, nargin);
1356  OCTAVE_LOCAL_BUFFER (Cell, rcells, nargout);
1357 
1358  const Cell *ccells = cells;
1359 
1360  octave_idx_type numel = 1;
1361  dim_vector dims (1, 1);
1362 
1363  for (int i = 0; i < nargin; i++)
1364  {
1365  octave_value arg = new_args(i);
1366  iscell[i] = arg.is_cell ();
1367  if (iscell[i])
1368  {
1369  cells[i] = arg.cell_value ();
1370  octave_idx_type n = ccells[i].numel ();
1371  if (n == 1)
1372  {
1373  iscell[i] = false;
1374  new_args(i) = ccells[i](0);
1375  }
1376  else if (numel == 1)
1377  {
1378  numel = n;
1379  dims = ccells[i].dims ();
1380  }
1381  else if (dims != ccells[i].dims ())
1382  {
1383  error ("%s: cell arguments must have matching sizes", fun_name);
1384  break;
1385  }
1386  }
1387  }
1388 
1389  if (! error_state)
1390  {
1391  for (int i = 0; i < nargout; i++)
1392  rcells[i].clear (dims);
1393 
1394  for (octave_idx_type j = 0; j < numel; j++)
1395  {
1396  for (int i = 0; i < nargin; i++)
1397  if (iscell[i])
1398  new_args(i) = ccells[i](j);
1399 
1400  octave_quit ();
1401 
1402  const octave_value_list tmp = fun (new_args, nargout);
1403 
1404  if (tmp.length () < nargout)
1405  {
1406  error ("%s: do_simple_cellfun: internal error", fun_name);
1407  break;
1408  }
1409  else
1410  {
1411  for (int i = 0; i < nargout; i++)
1412  rcells[i](j) = tmp(i);
1413  }
1414  }
1415  }
1416 
1417  if (! error_state)
1418  {
1419  retval.resize (nargout);
1420  for (int i = 0; i < nargout; i++)
1421  retval(i) = rcells[i];
1422  }
1423 
1424  return retval;
1425 }
1426 
1429  const char *fun_name, const octave_value_list& args)
1430 {
1431  octave_value retval;
1432  const octave_value_list tmp = do_simple_cellfun (fun, fun_name, args, 1);
1433  if (tmp.length () > 0)
1434  retval = tmp(0);
1435 
1436  return retval;
1437 }
1438 
1440 {
1441  stream.flags (oflags);
1442  stream.precision (oprecision);
1443  stream.width (owidth);
1444  stream.fill (ofill);
1445 }