3998
|
1 #! /usr/bin/perl |
7019
|
2 # |
|
3 # Copyright (C) 2002, 2005, 2006, 2007 John W. Eaton |
|
4 # |
|
5 # This file is part of Octave. |
|
6 # |
|
7 # Octave is free software; you can redistribute it and/or modify it |
|
8 # under the terms of the GNU General Public License as published by the |
|
9 # Free Software Foundation; either version 3 of the License, or (at |
|
10 # your option) any later version. |
|
11 # |
|
12 # Octave is distributed in the hope that it will be useful, but WITHOUT |
|
13 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
14 # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
15 # for more details. |
|
16 # |
|
17 # You should have received a copy of the GNU General Public License |
|
18 # along with Octave; see the file COPYING. If not, see |
|
19 # <http://www.gnu.org/licenses/>. |
3998
|
20 |
|
21 # Generate option handling code from a simpler input files for |
|
22 # Octave's functions like lsode, dassl, etc. |
|
23 |
3999
|
24 # TODO: |
|
25 # |
|
26 # * Improve default documentation and/or individual documentation |
|
27 # in data files. |
|
28 # |
|
29 # * Fix print/show code to display/return something more informative |
|
30 # for special values (for example, -1 ==> infinite in some cases). |
|
31 # Probably need more information in the data files for this. |
|
32 |
3998
|
33 # Input file format: |
|
34 # |
|
35 # CLASS = string |
|
36 # FCN_NAME = string |
4044
|
37 # INCLUDE = file |
3998
|
38 # DOC_STRING doc END_DOC_STRING |
|
39 # OPTION |
|
40 # NAME = string |
4050
|
41 # DOC_ITEM doc END_DOC_ITEM |
3998
|
42 # TYPE = string |
|
43 # SET_ARG_TYPE = string (optional, defaults to TYPE) |
|
44 # INIT_VALUE = string | INIT_BODY code END_INIT_BODY |
|
45 # SET_EXPR = string | SET_BODY code END_SET_BODY | SET_CODE code END_SET_CODE |
|
46 # END_OPTION |
|
47 # |
|
48 # END_* must appear at beginning of line (whitespace ignored). |
|
49 |
|
50 use Getopt::Long; |
|
51 |
|
52 $opt_emit_opt_class_header = 0; |
|
53 $opt_emit_opt_handler_fcns = 0; |
|
54 $opt_debug = 0; |
|
55 |
|
56 GetOptions ("opt-class-header" => \$opt_emit_opt_class_header, |
|
57 "opt-handler-fcns" => \$opt_emit_opt_handler_fcns, |
|
58 "debug" => \$opt_debug); |
|
59 |
|
60 if (@ARGV == 1) |
|
61 { |
|
62 $INFILE = shift @ARGV; |
|
63 open (INFILE) || die "unable to open input file $INFILE"; |
|
64 } |
|
65 else |
|
66 { |
|
67 die "usage: mk-opts.pl [options] FILE"; |
|
68 } |
|
69 |
|
70 $opt_num = 0; |
|
71 |
|
72 &parse_input; |
|
73 |
|
74 &process_data; |
|
75 |
|
76 FOO: |
|
77 { |
|
78 $opt_emit_opt_class_header && do { &emit_opt_class_header; last FOO; }; |
|
79 |
|
80 $opt_emit_opt_handler_fcns && do { &emit_opt_handler_fcns; last FOO; }; |
|
81 |
|
82 $opt_debug && do { &emit_options_debug; last FOO; }; |
|
83 } |
|
84 |
|
85 sub parse_input |
|
86 { |
|
87 local ($have_doc_string); |
|
88 |
|
89 while (<INFILE>) |
|
90 { |
|
91 next if (/^\s*$/); |
7017
|
92 next if (/^\s*#.*$/); |
3998
|
93 |
|
94 if (/^\s*OPTION\s*$/) |
|
95 { |
|
96 &parse_option_block; |
|
97 } |
|
98 elsif (/^\s*CLASS\s*=\s*"(\w+)"\s*$/) |
|
99 { |
|
100 die "duplicate CLASS" if ($class ne ""); |
|
101 $CLASS = $1; |
|
102 $class_name = "${CLASS}_options"; |
|
103 $struct_name = "${class_name}_struct"; |
|
104 $static_table_name = "${class_name}_table"; |
|
105 } |
|
106 elsif (/^\s*FCN_NAME\s*=\s*"(\w+)"\s*$/) |
|
107 { |
|
108 die "duplicate FCN_NAME" if ($fcn_name ne ""); |
|
109 $fcn_name = $1; |
|
110 } |
4044
|
111 elsif (/^\s*INCLUDE\s*=\s*"(\S+)"\s*$/) |
|
112 { |
|
113 $include = "${include}#include <$1>\n"; |
|
114 } |
3998
|
115 elsif (/^\s*DOC_STRING\s*$/) |
|
116 { |
|
117 die "duplicate DOC_STRING" if ($have_doc_string); |
|
118 &parse_doc_string; |
|
119 $have_doc_string = 1; |
|
120 } |
4044
|
121 else |
|
122 { |
|
123 die "mk-opts.pl: unknown command: $_\n" |
|
124 } |
3998
|
125 } |
|
126 } |
|
127 |
|
128 sub parse_option_block |
|
129 { |
4050
|
130 local ($have_doc_item, $have_init_body, $have_set_body, $have_set_code); |
3998
|
131 |
|
132 while (<INFILE>) |
|
133 { |
|
134 next if (/^\s*$/); |
|
135 |
|
136 die "missing END_OPTION" if (/^\s*OPTION\s*$/); |
|
137 |
|
138 last if (/^\s*END_OPTION\s*$/); |
|
139 |
|
140 if (/^\s*NAME\s*=\s*"(.*)"\s*$/) |
|
141 { |
|
142 die "duplicate NAME" if ($name[$opt_num] ne ""); |
|
143 $name[$opt_num] = $1; |
|
144 ($opt[$opt_num] = $name[$opt_num]) =~ s/\s+/_/g; |
|
145 $optvar[$opt_num] = "x_$opt[$opt_num]"; |
|
146 $kw_tok[$opt_num] = [ split (/\s+/, $name[$opt_num]) ]; |
|
147 $n_toks[$opt_num] = @{$kw_tok[$opt_num]}; |
|
148 } |
4050
|
149 elsif (/^\s*DOC_ITEM\s*$/) |
|
150 { |
|
151 die "duplicate DOC_ITEM" if ($have_doc_item); |
|
152 &parse_doc_item; |
|
153 $have_doc_item = 1; |
|
154 } |
3998
|
155 elsif (/^\s*TYPE\s*=\s*"(.*)"\s*$/) |
|
156 { |
|
157 die "duplicate TYPE" if ($type[$opt_num] ne ""); |
|
158 $type[$opt_num] = $1; |
|
159 } |
|
160 elsif (/^\s*SET_ARG_TYPE\s*=\s*"(.*)"\s*$/) |
|
161 { |
|
162 die "duplicate SET_ARG_TYPE" if ($set_arg_type[$opt_num] ne ""); |
|
163 $set_arg_type[$opt_num] = $1; |
|
164 } |
|
165 elsif (/^\s*INIT_VALUE\s*=\s*"(.*)"\s*$/) |
|
166 { |
|
167 die "duplicate INIT_VALUE" if ($init_value[$opt_num] ne ""); |
|
168 $init_value[$opt_num] = $1; |
|
169 } |
|
170 elsif (/^\s*SET_EXPR\s*=\s*"(.*)"\s*$/) |
|
171 { |
|
172 die "duplicate SET_EXPR" if ($set_expr[$opt_num] ne ""); |
|
173 $set_expr[$opt_num] = $1; |
|
174 } |
|
175 elsif (/^\s*INIT_BODY\s*$/) |
|
176 { |
|
177 die "duplicate INIT_BODY" if ($have_init_body); |
|
178 &parse_init_body; |
|
179 $have_init_body = 1; |
|
180 } |
|
181 elsif (/^\s*SET_BODY\s*$/) |
|
182 { |
|
183 die "duplicate SET_BODY" if ($have_set_body); |
|
184 &parse_set_body; |
|
185 $have_set_body = 1; |
|
186 } |
|
187 elsif (/^\s*SET_CODE\s*$/) |
|
188 { |
|
189 die "duplicate SET_CODE" if ($have_set_code); |
|
190 &parse_set_code; |
|
191 $have_set_code = 1; |
|
192 } |
|
193 } |
|
194 |
|
195 if ($set_arg_type[$opt_num] eq "") |
|
196 { |
|
197 $set_arg_type[$opt_num] = $type[$opt_num] |
|
198 } |
|
199 else |
|
200 { |
|
201 $set_arg_type[$opt_num] |
|
202 = &substopt ($set_arg_type[$opt_num], $optvar[$opt_num], |
|
203 $opt[$opt_num], $type[$opt_num]); |
|
204 } |
|
205 |
|
206 $opt_num++; |
|
207 } |
|
208 |
|
209 sub process_data |
|
210 { |
|
211 $max_tokens = &max (@n_toks); |
|
212 |
|
213 &get_min_match_len_info ($max_tokens); |
|
214 |
|
215 $fcn_name = lc ($CLASS) if ($fcn_name eq ""); |
|
216 |
|
217 $opt_fcn_name = "${fcn_name}_options" if ($opt_fcn_name eq ""); |
|
218 |
|
219 $static_object_name = "${fcn_name}_opts"; |
|
220 |
|
221 if ($doc_string eq "") |
|
222 { |
|
223 $doc_string = "When called with two arguments, this function\\n\\ |
|
224 allows you set options parameters for the function \@code{$fcn_name}.\\n\\ |
|
225 Given one argument, \@code{$opt_fcn_name} returns the value of the\\n\\ |
|
226 corresponding option. If no arguments are supplied, the names of all\\n\\ |
|
227 the available options and their current values are displayed.\\n\\\n"; |
|
228 } |
|
229 } |
|
230 |
|
231 sub get_min_match_len_info |
|
232 { |
|
233 local ($max_tokens) = @_; |
|
234 |
|
235 local ($i, $j, $k); |
|
236 |
|
237 for ($i = 0; $i < $opt_num; $i++) |
|
238 { |
|
239 for ($j = 0; $j < $max_tokens; $j++) |
|
240 { |
|
241 $min_tok_len_to_match[$i][$j] = 0; |
|
242 } |
|
243 |
|
244 $min_toks_to_match[$i] = 1; |
|
245 |
|
246 L1: for ($k = 0; $k < $opt_num; $k++) |
|
247 { |
|
248 local ($duplicate) = 1; |
|
249 |
|
250 if ($i != $k) |
|
251 { |
|
252 L2: for ($j = 0; $j < $max_tokens; $j++) |
|
253 { |
|
254 if ($j < $n_toks[$i]) |
|
255 { |
|
256 if ($kw_tok[$i][$j] eq $kw_tok[$k][$j]) |
|
257 { |
|
258 if ($min_tok_len_to_match[$i][$j] == 0) |
|
259 { |
|
260 $min_tok_len_to_match[$i][$j] = 1; |
|
261 } |
|
262 |
|
263 $min_toks_to_match[$i]++; |
|
264 } |
|
265 else |
|
266 { |
|
267 $duplicate = 0; |
|
268 |
|
269 if ($min_tok_len_to_match[$i][$j] == 0) |
|
270 { |
|
271 $min_tok_len_to_match[$i][$j] = 1; |
|
272 } |
|
273 |
|
274 local (@s) = split (//, $kw_tok[$i][$j]); |
|
275 local (@t) = split (//, $kw_tok[$k][$j]); |
|
276 |
|
277 local ($n, $ii); |
|
278 $n = scalar (@s); |
|
279 $n = scalar (@t) if (@t < $n); |
|
280 |
|
281 for ($ii = 0; $ii < $n; $ii++) |
|
282 { |
|
283 if ("$s[$ii]" eq "$t[$ii]") |
|
284 { |
|
285 if ($ii + 2 > $min_tok_len_to_match[$i][$j]) |
|
286 { |
|
287 $min_tok_len_to_match[$i][$j]++; |
|
288 } |
|
289 } |
|
290 else |
|
291 { |
|
292 last L2; |
|
293 } |
|
294 } |
|
295 |
|
296 last L1; |
|
297 } |
|
298 } |
|
299 else |
|
300 { |
|
301 die "ambiguous options \"$name[$i]\" and \"$name[$k]\"" if ($duplicate); |
|
302 } |
|
303 } |
|
304 } |
|
305 } |
|
306 } |
|
307 } |
|
308 |
|
309 sub parse_doc_string |
|
310 { |
|
311 while (<INFILE>) |
|
312 { |
|
313 last if (/^\s*END_DOC_STRING\s*$/); |
|
314 |
|
315 $doc_string .= $_; |
|
316 } |
|
317 |
|
318 $doc_string =~ s/\n/\\n\\\n/g; |
|
319 } |
|
320 |
4050
|
321 sub parse_doc_item |
|
322 { |
|
323 while (<INFILE>) |
|
324 { |
|
325 last if (/^\s*END_DOC_ITEM\s*$/); |
|
326 |
|
327 $doc_item[$opt_num] .= $_; |
|
328 } |
|
329 |
|
330 $doc_item[$opt_num] =~ s/\n/\\n\\\n/g; |
|
331 } |
|
332 |
3998
|
333 sub parse_init_body |
|
334 { |
|
335 while (<INFILE>) |
|
336 { |
|
337 last if (/^\s*END_INIT_BODY\s*$/); |
|
338 |
|
339 $init_body[$opt_num] .= $_; |
|
340 } |
|
341 } |
|
342 |
|
343 sub parse_set_body |
|
344 { |
|
345 while (<INFILE>) |
|
346 { |
|
347 last if (/^\s*END_SET_BODY\s*$/); |
|
348 |
|
349 $set_body[$opt_num] .= $_; |
|
350 } |
|
351 } |
|
352 |
|
353 sub parse_set_code |
|
354 { |
|
355 while (<INFILE>) |
|
356 { |
|
357 last if (/^\s*END_SET_CODE\s*$/); |
|
358 |
|
359 $set_code[$opt_num] .= $_; |
|
360 } |
|
361 } |
|
362 |
|
363 sub emit_opt_class_header |
|
364 { |
|
365 local ($i, $s); |
|
366 |
|
367 print "// DO NOT EDIT! |
|
368 // Generated automatically from $INFILE. |
|
369 |
|
370 #if !defined (octave_${class_name}_h) |
|
371 #define octave_${class_name}_h 1 |
|
372 |
|
373 #include <cfloat> |
|
374 #include <cmath> |
|
375 |
4044
|
376 ${include} |
|
377 |
3998
|
378 class |
|
379 ${class_name} |
|
380 { |
|
381 public: |
|
382 |
|
383 ${class_name} (void) { init (); } |
|
384 |
|
385 ${class_name} (const ${class_name}& opt) { copy (opt); } |
|
386 |
|
387 ${class_name}& operator = (const ${class_name}& opt) |
|
388 { |
|
389 if (this != &opt) |
|
390 copy (opt); |
|
391 |
|
392 return *this; |
|
393 } |
|
394 |
|
395 ~${class_name} (void) { }\n"; |
|
396 |
|
397 print "\n void init (void)\n {\n"; |
|
398 |
|
399 for ($i = 0; $i < $opt_num; $i++) |
|
400 { |
|
401 if ($init_value[$i]) |
|
402 { |
|
403 print " $optvar[$i] = $init_value[$i];\n"; |
|
404 } |
|
405 elsif ($init_body[$i]) |
|
406 { |
|
407 $s = &substopt ($init_body[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
408 chop ($s); |
|
409 $s =~ s/^\s*/ /g; |
|
410 $s =~ s/\n\s*/\n /g; |
|
411 print "$s\n"; |
|
412 } |
|
413 } |
|
414 |
4049
|
415 print " reset = true; |
|
416 }\n"; |
3998
|
417 |
|
418 print "\n void copy (const ${class_name}& opt)\n {\n"; |
|
419 |
|
420 for ($i = 0; $i < $opt_num; $i++) |
|
421 { |
|
422 print " $optvar[$i] = opt.$optvar[$i];\n"; |
|
423 } |
|
424 |
4049
|
425 print " reset = opt.reset; |
|
426 }\n"; |
3998
|
427 |
4122
|
428 ## For backward compatibility and because set_options is probably |
|
429 ## a better name in some contexts: |
|
430 |
|
431 print "\n void set_options (const ${class_name}& opt) { copy (opt); }\n"; |
|
432 |
3998
|
433 print "\n void set_default_options (void) { init (); }\n"; |
|
434 |
|
435 for ($i = 0; $i < $opt_num; $i++) |
|
436 { |
|
437 if ($set_expr[$i]) |
|
438 { |
|
439 &emit_set_decl ($i); |
|
440 |
4049
|
441 print "\n { $optvar[$i] = $set_expr[$i]; reset = true; }\n"; |
3998
|
442 } |
|
443 elsif ($set_body[$i]) |
|
444 { |
|
445 &emit_set_decl ($i); |
|
446 |
|
447 $s = &substopt ($set_body[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
448 chop ($s); |
|
449 $s =~ s/^/ /g; |
|
450 $s =~ s/\n/\n /g; |
4049
|
451 print "\n {\n$s\n reset = true;\n }\n"; |
3998
|
452 } |
|
453 elsif ($set_code[$i]) |
|
454 { |
|
455 $s = &substopt ($set_code[$i], $optvar[$i], $opt[$i], $type[$i]); |
|
456 chop ($s); |
|
457 $s =~ s/^ //g; |
|
458 $s =~ s/\n /\n/g; |
|
459 print "\n$s\n"; |
|
460 } |
|
461 } |
|
462 |
|
463 for ($i = 0; $i < $opt_num; $i++) |
|
464 { |
|
465 print " $type[$i] $opt[$i] (void) const\n { return $optvar[$i]; }\n\n"; |
|
466 } |
|
467 |
|
468 print "private:\n\n"; |
|
469 |
|
470 for ($i = 0; $i < $opt_num; $i++) |
|
471 { |
|
472 print " $type[$i] $optvar[$i];\n"; |
|
473 } |
|
474 |
4049
|
475 print "\nprotected:\n\n bool reset;\n};\n\n#endif\n"; |
3998
|
476 } |
|
477 |
|
478 sub emit_set_decl |
|
479 { |
|
480 local ($i) = @_; |
|
481 |
|
482 print " |
|
483 void set_$opt[$i] ($set_arg_type[$i] val)"; |
|
484 } |
|
485 |
|
486 sub emit_opt_handler_fcns |
|
487 { |
|
488 local ($i); |
4044
|
489 my $header = $INFILE; |
|
490 $header =~ s/[.]\w*$/.h/; # replace .in with .h |
|
491 $header =~ s|^.*/([^/]*)$|$1|; # strip directory part |
3998
|
492 |
|
493 print "// DO NOT EDIT!\n// Generated automatically from $INFILE.\n\n"; |
|
494 |
|
495 print "#ifdef HAVE_CONFIG_H |
|
496 #include <config.h> |
|
497 #endif |
|
498 |
|
499 #include <iomanip> |
|
500 #include <iostream> |
|
501 |
4044
|
502 #include \"$header\" |
|
503 |
3998
|
504 #include \"defun-dld.h\" |
|
505 #include \"pr-output.h\" |
|
506 |
4044
|
507 #include \"oct-obj.h\" |
|
508 #include \"utils.h\" |
|
509 #include \"pager.h\" |
|
510 |
3998
|
511 static ${class_name} ${static_object_name};\n\n"; |
|
512 |
|
513 &emit_struct_decl; |
|
514 |
|
515 &emit_struct_def; |
|
516 |
|
517 &emit_print_function; |
|
518 |
|
519 &emit_set_functions; |
|
520 |
|
521 &emit_show_function; |
|
522 |
|
523 &emit_options_function; |
|
524 } |
|
525 |
|
526 sub emit_struct_decl |
|
527 { |
|
528 local ($i); |
|
529 |
|
530 print "#define MAX_TOKENS $max_tokens\n\n"; |
|
531 |
|
532 print "struct ${struct_name}\n{\n"; |
|
533 |
|
534 print " const char *keyword;\n"; |
|
535 print " const char *kw_tok[MAX_TOKENS + 1];\n"; |
|
536 print " int min_len[MAX_TOKENS + 1];\n"; |
|
537 print " int min_toks_to_match;\n"; |
|
538 |
|
539 print "};\n\n"; |
|
540 } |
|
541 |
|
542 sub emit_struct_def |
|
543 { |
|
544 local ($i); |
|
545 |
|
546 print "#define NUM_OPTIONS $opt_num\n\n"; |
|
547 |
|
548 print "static ${struct_name} ${static_table_name} [] =\n{\n"; |
|
549 |
|
550 for ($i = 0; $i < $opt_num; $i++) |
|
551 { |
|
552 &emit_option_table_entry ($i, 0); |
|
553 |
|
554 if ($i < $opt_num - 1) |
|
555 { |
|
556 print "\n"; |
|
557 } |
|
558 } |
|
559 |
|
560 print "};\n\n"; |
|
561 } |
|
562 |
|
563 sub emit_option_table_entry |
|
564 { |
|
565 local ($i, $empty) = @_; |
|
566 |
|
567 local ($k); |
|
568 |
|
569 if ($empty) |
|
570 { |
|
571 print " { 0,\n"; |
|
572 } |
|
573 else |
|
574 { |
|
575 print " { \"$name[$i]\",\n"; |
|
576 } |
|
577 |
|
578 local ($n) = scalar $#{$kw_tok[$i]}; |
|
579 print " {"; |
|
580 for $k (0 .. $max_tokens) |
|
581 { |
|
582 if ($empty || $k > $n) |
|
583 { |
|
584 print " 0,"; |
|
585 } |
|
586 else |
|
587 { |
|
588 print " \"$kw_tok[$i][$k]\","; |
|
589 } |
|
590 } |
|
591 print " },\n"; |
|
592 |
|
593 print " {"; |
|
594 for $k (0 .. $max_tokens) |
|
595 { |
|
596 if ($empty || $k > $n) |
|
597 { |
|
598 print " 0,"; |
|
599 } |
|
600 else |
|
601 { |
|
602 print " $min_tok_len_to_match[$i][$k],"; |
|
603 } |
|
604 } |
|
605 print " }, $min_toks_to_match[$i], "; |
|
606 |
|
607 print "},\n"; |
|
608 } |
|
609 |
|
610 sub emit_print_function |
|
611 { |
|
612 local ($i); |
|
613 |
5775
|
614 ## FIXME -- determine the width of the table automatically. |
4047
|
615 |
3998
|
616 print "static void |
6755
|
617 print_${class_name} (std::ostream& os) |
3998
|
618 { |
5765
|
619 std::ostringstream buf; |
3998
|
620 |
6755
|
621 os << \"\\n\" |
|
622 << \"Options for $CLASS include:\\n\\n\" |
|
623 << \" keyword value\\n\" |
|
624 << \" ------- -----\\n\"; |
3998
|
625 |
|
626 $struct_name *list = $static_table_name;\n\n"; |
|
627 |
|
628 for ($i = 0; $i < $opt_num; $i++) |
|
629 { |
6755
|
630 print " {\n os << \" \" |
5667
|
631 << std::setiosflags (std::ios::left) << std::setw (50) |
|
632 << list[$i].keyword |
|
633 << std::resetiosflags (std::ios::left) |
|
634 << \" \";\n\n"; |
3998
|
635 |
|
636 if ($type[$i] eq "double") |
|
637 { |
|
638 print " double val = $static_object_name.$opt[$i] ();\n\n"; |
6755
|
639 print " os << val << \"\\n\";\n"; |
3998
|
640 } |
5275
|
641 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998
|
642 { |
|
643 print " int val = $static_object_name.$opt[$i] ();\n\n"; |
6755
|
644 print " os << val << \"\\n\";\n"; |
3998
|
645 } |
|
646 elsif ($type[$i] eq "std::string") |
|
647 { |
6755
|
648 print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; |
3998
|
649 } |
5275
|
650 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044
|
651 { |
5275
|
652 if ($type[$i] eq "Array<int>") |
|
653 { |
|
654 $elt_type = "int"; |
|
655 } |
|
656 else |
|
657 { |
|
658 $elt_type = "octave_idx_type"; |
|
659 } |
|
660 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; |
4044
|
661 print " if (val.length () == 1) |
|
662 { |
6755
|
663 os << val(0) << \"\\n\"; |
4044
|
664 } |
|
665 else |
|
666 { |
6755
|
667 os << \"\\n\\n\"; |
5275
|
668 octave_idx_type len = val.length (); |
4044
|
669 Matrix tmp (len, 1); |
5275
|
670 for (octave_idx_type i = 0; i < len; i++) |
4044
|
671 tmp(i,0) = val(i); |
6755
|
672 octave_print_internal (os, tmp, false, 2); |
|
673 os << \"\\n\\n\"; |
4044
|
674 }\n"; |
|
675 } |
3998
|
676 elsif ($type[$i] eq "Array<double>") |
|
677 { |
|
678 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; |
|
679 print " if (val.length () == 1) |
|
680 { |
6755
|
681 os << val(0) << \"\\n\"; |
3998
|
682 } |
|
683 else |
|
684 { |
6755
|
685 os << \"\\n\\n\"; |
3998
|
686 Matrix tmp = Matrix (ColumnVector (val)); |
6755
|
687 octave_print_internal (os, tmp, false, 2); |
|
688 os << \"\\n\\n\"; |
3998
|
689 }\n"; |
|
690 } |
|
691 else |
|
692 { |
|
693 die ("unknown type $type[$i]"); |
|
694 } |
|
695 |
|
696 print " }\n\n"; |
|
697 } |
|
698 |
6755
|
699 print " os << \"\\n\";\n}\n\n"; |
3998
|
700 } |
|
701 |
|
702 sub emit_set_functions |
|
703 { |
|
704 print "static void |
|
705 set_${class_name} (const std::string& keyword, const octave_value& val) |
|
706 { |
|
707 $struct_name *list = $static_table_name;\n\n"; |
|
708 |
|
709 $iftok = "if"; |
|
710 |
|
711 for ($i = 0; $i < $opt_num; $i++) |
|
712 { |
|
713 $iftok = "else if" if ($i > 0); |
|
714 |
|
715 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, |
|
716 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) |
|
717 {\n"; |
|
718 |
|
719 if ($type[$i] eq "double") |
|
720 { |
|
721 print " double tmp = val.double_value ();\n\n"; |
|
722 print " if (! error_state) |
|
723 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
724 } |
5275
|
725 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998
|
726 { |
|
727 print " int tmp = val.int_value ();\n\n"; |
|
728 print " if (! error_state) |
|
729 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
730 } |
|
731 elsif ($type[$i] eq "std::string") |
|
732 { |
|
733 print " std::string tmp = val.string_value ();\n\n"; |
|
734 print " if (! error_state) |
|
735 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
736 } |
5275
|
737 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044
|
738 { |
|
739 print " Array<int> tmp = val.int_vector_value ();\n\n"; |
|
740 print " if (! error_state) |
|
741 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
742 } |
3998
|
743 elsif ($type[$i] eq "Array<double>") |
|
744 { |
|
745 print " Array<double> tmp = val.vector_value ();\n\n"; |
|
746 print " if (! error_state) |
|
747 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
748 } |
|
749 else |
|
750 { |
|
751 die ("unknown type $type[$i]"); |
|
752 } |
|
753 |
|
754 print " }\n"; |
|
755 } |
|
756 |
|
757 print " else |
|
758 { |
|
759 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); |
|
760 } |
|
761 }\n\n"; |
|
762 } |
|
763 |
|
764 sub emit_show_function |
|
765 { |
|
766 local ($i, $iftok); |
|
767 |
|
768 print "static octave_value_list |
|
769 show_${class_name} (const std::string& keyword) |
|
770 { |
|
771 octave_value retval; |
|
772 |
|
773 $struct_name *list = $static_table_name;\n\n"; |
|
774 |
|
775 $iftok = "if"; |
|
776 |
|
777 for ($i = 0; $i < $opt_num; $i++) |
|
778 { |
|
779 $iftok = "else if" if ($i > 0); |
|
780 |
|
781 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, |
|
782 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) |
|
783 {\n"; |
|
784 |
|
785 if ($type[$i] eq "double") |
|
786 { |
|
787 print " double val = $static_object_name.$opt[$i] ();\n\n"; |
|
788 print " retval = val;\n"; |
|
789 } |
5275
|
790 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
3998
|
791 { |
|
792 print " int val = $static_object_name.$opt[$i] ();\n\n"; |
|
793 print " retval = static_cast<double> (val);\n"; |
|
794 } |
|
795 elsif ($type[$i] eq "std::string") |
|
796 { |
|
797 print " retval = $static_object_name.$opt[$i] ();\n"; |
|
798 } |
5275
|
799 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
4044
|
800 { |
5275
|
801 if ($type[$i] eq "Array<int>") |
|
802 { |
|
803 $elt_type = "int"; |
|
804 } |
|
805 else |
|
806 { |
|
807 $elt_type = "octave_idx_type"; |
|
808 } |
|
809 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; |
4044
|
810 print " if (val.length () == 1) |
|
811 { |
|
812 retval = static_cast<double> (val(0)); |
|
813 } |
|
814 else |
|
815 { |
5275
|
816 octave_idx_type len = val.length (); |
4044
|
817 ColumnVector tmp (len); |
5275
|
818 for (octave_idx_type i = 0; i < len; i++) |
4044
|
819 tmp(i) = val(i); |
|
820 retval = tmp; |
|
821 }\n"; |
|
822 } |
3998
|
823 elsif ($type[$i] eq "Array<double>") |
|
824 { |
|
825 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; |
|
826 print " if (val.length () == 1) |
|
827 { |
|
828 retval = val(0); |
|
829 } |
|
830 else |
|
831 { |
|
832 retval = ColumnVector (val); |
|
833 }\n"; |
|
834 } |
|
835 else |
|
836 { |
|
837 die ("unknown type $type[$i]"); |
|
838 } |
|
839 |
|
840 print " }\n"; |
|
841 } |
|
842 |
|
843 print " else |
|
844 { |
|
845 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); |
|
846 } |
|
847 |
|
848 return retval;\n}\n\n"; |
|
849 } |
|
850 |
|
851 sub emit_options_function |
|
852 { |
|
853 print "DEFUN_DLD ($opt_fcn_name, args, , |
|
854 \"-*- texinfo -*-\\n\\ |
|
855 \@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ |
4050
|
856 $doc_string\\n\\ |
|
857 Options include\\n\\ |
|
858 \\n\\ |
|
859 \@table \@code\\n\\\n"; |
|
860 |
|
861 for ($i = 0; $i < $opt_num; $i++) |
|
862 { |
|
863 print "\@item \\\"$name[$i]\\\"\\n\\\n"; |
|
864 if ($doc_item[$i] ne "") |
|
865 { |
|
866 print "$doc_item[$i]"; |
|
867 } |
|
868 } |
|
869 |
|
870 print "\@end table\\n\\\n\@end deftypefn\") |
3998
|
871 { |
|
872 octave_value_list retval; |
|
873 |
|
874 int nargin = args.length (); |
|
875 |
|
876 if (nargin == 0) |
|
877 { |
6755
|
878 print_${class_name} (octave_stdout); |
3998
|
879 } |
|
880 else if (nargin == 1 || nargin == 2) |
|
881 { |
|
882 std::string keyword = args(0).string_value (); |
|
883 |
|
884 if (! error_state) |
|
885 { |
|
886 if (nargin == 1) |
|
887 retval = show_${class_name} (keyword); |
|
888 else |
|
889 set_${class_name} (keyword, args(1)); |
|
890 } |
|
891 else |
|
892 error (\"$opt_fcn_name: expecting keyword as first argument\"); |
|
893 } |
|
894 else |
5823
|
895 print_usage (); |
3998
|
896 |
|
897 return retval; |
4035
|
898 }\n"; |
3998
|
899 } |
|
900 |
|
901 sub emit_options_debug |
|
902 { |
|
903 print "CLASS = \"$class\"\n"; |
|
904 |
|
905 for ($i = 0; $i < $opt_num; $i++) |
|
906 { |
|
907 $NAME = $name[$i]; |
|
908 ($OPT = $NAME) =~ s/\s+/_/g; |
|
909 $OPTVAR = "x_$OPT"; |
|
910 $TYPE = $type[$i]; |
|
911 print "\n"; |
|
912 print "OPTION\n"; |
|
913 print " NAME = \"$NAME\"\n"; |
|
914 print " TYPE = \"$TYPE\"\n"; |
|
915 if ($set_arg_type[$i]) |
|
916 { |
|
917 print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; |
|
918 } |
|
919 if ($init_value[$i]) |
|
920 { |
|
921 print " INIT_VALUE = \"$init_value[$i]\"\n"; |
|
922 } |
|
923 if ($init_body[$i]) |
|
924 { |
|
925 print " INIT_BODY\n"; |
|
926 print &substopt ($init_body[$i]); |
|
927 print " END_INIT_BODY\n"; |
|
928 } |
|
929 if ($set_expr[$i]) |
|
930 { |
|
931 print " SET_EXPR = \"$set_expr[$i]\"\n"; |
|
932 } |
|
933 if ($set_body[$i]) |
|
934 { |
|
935 print " SET_BODY\n"; |
|
936 print &substopt ($set_body[$i]); |
|
937 print " END_SET_BODY\n"; |
|
938 } |
|
939 if ($set_code[$i]) |
|
940 { |
|
941 print " SET_CODE\n"; |
|
942 print &substopt ($set_code[$i]); |
|
943 print " END_SET_CODE\n"; |
|
944 } |
|
945 print "END_OPTION\n"; |
|
946 } |
|
947 } |
|
948 |
|
949 sub substopt |
|
950 { |
|
951 local ($string, $OPTVAR, $OPT, $TYPE) = @_; |
|
952 |
|
953 $string =~ s/\$OPTVAR/$OPTVAR/g; |
|
954 $string =~ s/\$OPT/$OPT/g; |
|
955 $string =~ s/\$TYPE/$TYPE/g; |
|
956 |
|
957 $string; |
|
958 } |
|
959 |
|
960 sub print_assoc_array |
|
961 { |
|
962 local (%t) = @_; |
|
963 |
|
964 local ($k); |
|
965 |
|
966 foreach $k (keys (%t)) |
|
967 { |
|
968 print "$k: $t{$k}\n"; |
|
969 } |
|
970 } |
|
971 |
|
972 sub max |
|
973 { |
|
974 local ($max) = shift; |
|
975 |
|
976 foreach (@_) |
|
977 { |
|
978 $max = $_ if $max < $_; |
|
979 } |
|
980 |
|
981 $max; |
|
982 } |