Mercurial > octave-nkf
annotate mk-opts.pl @ 7948:af10baa63915 ss-3-1-50
3.1.50 snapshot
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Fri, 18 Jul 2008 17:42:48 -0400 |
| parents | edc25a3fb2bc |
| children | cf59d542f33e |
| rev | line source |
|---|---|
| 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 } |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
641 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
642 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
643 print " float val = $static_object_name.$opt[$i] ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
644 print " os << val << \"\\n\";\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
645 } |
| 5275 | 646 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 647 { |
| 648 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
| 6755 | 649 print " os << val << \"\\n\";\n"; |
| 3998 | 650 } |
| 651 elsif ($type[$i] eq "std::string") | |
| 652 { | |
| 6755 | 653 print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; |
| 3998 | 654 } |
| 5275 | 655 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 656 { |
| 5275 | 657 if ($type[$i] eq "Array<int>") |
| 658 { | |
| 659 $elt_type = "int"; | |
| 660 } | |
| 661 else | |
| 662 { | |
| 663 $elt_type = "octave_idx_type"; | |
| 664 } | |
| 665 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 4044 | 666 print " if (val.length () == 1) |
| 667 { | |
| 6755 | 668 os << val(0) << \"\\n\"; |
| 4044 | 669 } |
| 670 else | |
| 671 { | |
| 6755 | 672 os << \"\\n\\n\"; |
| 5275 | 673 octave_idx_type len = val.length (); |
| 4044 | 674 Matrix tmp (len, 1); |
| 5275 | 675 for (octave_idx_type i = 0; i < len; i++) |
| 4044 | 676 tmp(i,0) = val(i); |
| 6755 | 677 octave_print_internal (os, tmp, false, 2); |
| 678 os << \"\\n\\n\"; | |
| 4044 | 679 }\n"; |
| 680 } | |
| 3998 | 681 elsif ($type[$i] eq "Array<double>") |
| 682 { | |
| 683 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 684 print " if (val.length () == 1) | |
| 685 { | |
| 6755 | 686 os << val(0) << \"\\n\"; |
| 3998 | 687 } |
| 688 else | |
| 689 { | |
| 6755 | 690 os << \"\\n\\n\"; |
| 3998 | 691 Matrix tmp = Matrix (ColumnVector (val)); |
| 6755 | 692 octave_print_internal (os, tmp, false, 2); |
| 693 os << \"\\n\\n\"; | |
| 3998 | 694 }\n"; |
| 695 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
696 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
697 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
698 print " Array<float> val = $static_object_name.$opt[$i] ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
699 print " if (val.length () == 1) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
700 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
701 os << val(0) << \"\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
702 } |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
703 else |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
704 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
705 os << \"\\n\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
706 FloatMatrix tmp = FloatMatrix (FloatColumnVector (val)); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
707 octave_print_internal (os, tmp, false, 2); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
708 os << \"\\n\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
709 }\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
710 } |
| 3998 | 711 else |
| 712 { | |
| 713 die ("unknown type $type[$i]"); | |
| 714 } | |
| 715 | |
| 716 print " }\n\n"; | |
| 717 } | |
| 718 | |
| 6755 | 719 print " os << \"\\n\";\n}\n\n"; |
| 3998 | 720 } |
| 721 | |
| 722 sub emit_set_functions | |
| 723 { | |
| 724 print "static void | |
| 725 set_${class_name} (const std::string& keyword, const octave_value& val) | |
| 726 { | |
| 727 $struct_name *list = $static_table_name;\n\n"; | |
| 728 | |
| 729 $iftok = "if"; | |
| 730 | |
| 731 for ($i = 0; $i < $opt_num; $i++) | |
| 732 { | |
| 733 $iftok = "else if" if ($i > 0); | |
| 734 | |
| 735 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
| 736 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
| 737 {\n"; | |
| 738 | |
| 739 if ($type[$i] eq "double") | |
| 740 { | |
| 741 print " double tmp = val.double_value ();\n\n"; | |
| 742 print " if (! error_state) | |
| 743 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 744 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
745 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
746 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
747 print " float tmp = val.float_value ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
748 print " if (! error_state) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
749 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
750 } |
| 5275 | 751 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 752 { |
| 753 print " int tmp = val.int_value ();\n\n"; | |
| 754 print " if (! error_state) | |
| 755 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 756 } | |
| 757 elsif ($type[$i] eq "std::string") | |
| 758 { | |
| 759 print " std::string tmp = val.string_value ();\n\n"; | |
| 760 print " if (! error_state) | |
| 761 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 762 } | |
| 5275 | 763 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 764 { |
| 765 print " Array<int> tmp = val.int_vector_value ();\n\n"; | |
| 766 print " if (! error_state) | |
| 767 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 768 } | |
| 3998 | 769 elsif ($type[$i] eq "Array<double>") |
| 770 { | |
| 771 print " Array<double> tmp = val.vector_value ();\n\n"; | |
| 772 print " if (! error_state) | |
| 773 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 774 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
775 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
776 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
777 print " Array<float> tmp = val.float_vector_value ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
778 print " if (! error_state) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
779 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
780 } |
| 3998 | 781 else |
| 782 { | |
| 783 die ("unknown type $type[$i]"); | |
| 784 } | |
| 785 | |
| 786 print " }\n"; | |
| 787 } | |
| 788 | |
| 789 print " else | |
| 790 { | |
| 791 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
| 792 } | |
| 793 }\n\n"; | |
| 794 } | |
| 795 | |
| 796 sub emit_show_function | |
| 797 { | |
| 798 local ($i, $iftok); | |
| 799 | |
| 800 print "static octave_value_list | |
| 801 show_${class_name} (const std::string& keyword) | |
| 802 { | |
| 803 octave_value retval; | |
| 804 | |
| 805 $struct_name *list = $static_table_name;\n\n"; | |
| 806 | |
| 807 $iftok = "if"; | |
| 808 | |
| 809 for ($i = 0; $i < $opt_num; $i++) | |
| 810 { | |
| 811 $iftok = "else if" if ($i > 0); | |
| 812 | |
| 813 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
| 814 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
| 815 {\n"; | |
| 816 | |
| 817 if ($type[$i] eq "double") | |
| 818 { | |
| 819 print " double val = $static_object_name.$opt[$i] ();\n\n"; | |
| 820 print " retval = val;\n"; | |
| 821 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
822 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
823 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
824 print " float val = $static_object_name.$opt[$i] ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
825 print " retval = val;\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
826 } |
| 5275 | 827 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 828 { |
| 829 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
| 830 print " retval = static_cast<double> (val);\n"; | |
| 831 } | |
| 832 elsif ($type[$i] eq "std::string") | |
| 833 { | |
| 834 print " retval = $static_object_name.$opt[$i] ();\n"; | |
| 835 } | |
| 5275 | 836 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 837 { |
| 5275 | 838 if ($type[$i] eq "Array<int>") |
| 839 { | |
| 840 $elt_type = "int"; | |
| 841 } | |
| 842 else | |
| 843 { | |
| 844 $elt_type = "octave_idx_type"; | |
| 845 } | |
| 846 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 4044 | 847 print " if (val.length () == 1) |
| 848 { | |
| 849 retval = static_cast<double> (val(0)); | |
| 850 } | |
| 851 else | |
| 852 { | |
| 5275 | 853 octave_idx_type len = val.length (); |
| 4044 | 854 ColumnVector tmp (len); |
| 5275 | 855 for (octave_idx_type i = 0; i < len; i++) |
| 4044 | 856 tmp(i) = val(i); |
| 857 retval = tmp; | |
| 858 }\n"; | |
| 859 } | |
| 3998 | 860 elsif ($type[$i] eq "Array<double>") |
| 861 { | |
| 862 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 863 print " if (val.length () == 1) | |
| 864 { | |
| 865 retval = val(0); | |
| 866 } | |
| 867 else | |
| 868 { | |
| 869 retval = ColumnVector (val); | |
| 870 }\n"; | |
| 871 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
872 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
873 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
874 print " Array<float> val = $static_object_name.$opt[$i] ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
875 print " if (val.length () == 1) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
876 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
877 retval = val(0); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
878 } |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
879 else |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
880 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
881 retval = FloatColumnVector (val); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
882 }\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
883 } |
| 3998 | 884 else |
| 885 { | |
| 886 die ("unknown type $type[$i]"); | |
| 887 } | |
| 888 | |
| 889 print " }\n"; | |
| 890 } | |
| 891 | |
| 892 print " else | |
| 893 { | |
| 894 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
| 895 } | |
| 896 | |
| 897 return retval;\n}\n\n"; | |
| 898 } | |
| 899 | |
| 900 sub emit_options_function | |
| 901 { | |
| 902 print "DEFUN_DLD ($opt_fcn_name, args, , | |
| 903 \"-*- texinfo -*-\\n\\ | |
| 904 \@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ | |
| 4050 | 905 $doc_string\\n\\ |
| 906 Options include\\n\\ | |
| 907 \\n\\ | |
| 908 \@table \@code\\n\\\n"; | |
| 909 | |
| 910 for ($i = 0; $i < $opt_num; $i++) | |
| 911 { | |
| 912 print "\@item \\\"$name[$i]\\\"\\n\\\n"; | |
| 913 if ($doc_item[$i] ne "") | |
| 914 { | |
| 915 print "$doc_item[$i]"; | |
| 916 } | |
| 917 } | |
| 918 | |
| 919 print "\@end table\\n\\\n\@end deftypefn\") | |
| 3998 | 920 { |
| 921 octave_value_list retval; | |
| 922 | |
| 923 int nargin = args.length (); | |
| 924 | |
| 925 if (nargin == 0) | |
| 926 { | |
| 6755 | 927 print_${class_name} (octave_stdout); |
| 3998 | 928 } |
| 929 else if (nargin == 1 || nargin == 2) | |
| 930 { | |
| 931 std::string keyword = args(0).string_value (); | |
| 932 | |
| 933 if (! error_state) | |
| 934 { | |
| 935 if (nargin == 1) | |
| 936 retval = show_${class_name} (keyword); | |
| 937 else | |
| 938 set_${class_name} (keyword, args(1)); | |
| 939 } | |
| 940 else | |
| 941 error (\"$opt_fcn_name: expecting keyword as first argument\"); | |
| 942 } | |
| 943 else | |
| 5823 | 944 print_usage (); |
| 3998 | 945 |
| 946 return retval; | |
| 4035 | 947 }\n"; |
| 3998 | 948 } |
| 949 | |
| 950 sub emit_options_debug | |
| 951 { | |
| 952 print "CLASS = \"$class\"\n"; | |
| 953 | |
| 954 for ($i = 0; $i < $opt_num; $i++) | |
| 955 { | |
| 956 $NAME = $name[$i]; | |
| 957 ($OPT = $NAME) =~ s/\s+/_/g; | |
| 958 $OPTVAR = "x_$OPT"; | |
| 959 $TYPE = $type[$i]; | |
| 960 print "\n"; | |
| 961 print "OPTION\n"; | |
| 962 print " NAME = \"$NAME\"\n"; | |
| 963 print " TYPE = \"$TYPE\"\n"; | |
| 964 if ($set_arg_type[$i]) | |
| 965 { | |
| 966 print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; | |
| 967 } | |
| 968 if ($init_value[$i]) | |
| 969 { | |
| 970 print " INIT_VALUE = \"$init_value[$i]\"\n"; | |
| 971 } | |
| 972 if ($init_body[$i]) | |
| 973 { | |
| 974 print " INIT_BODY\n"; | |
| 975 print &substopt ($init_body[$i]); | |
| 976 print " END_INIT_BODY\n"; | |
| 977 } | |
| 978 if ($set_expr[$i]) | |
| 979 { | |
| 980 print " SET_EXPR = \"$set_expr[$i]\"\n"; | |
| 981 } | |
| 982 if ($set_body[$i]) | |
| 983 { | |
| 984 print " SET_BODY\n"; | |
| 985 print &substopt ($set_body[$i]); | |
| 986 print " END_SET_BODY\n"; | |
| 987 } | |
| 988 if ($set_code[$i]) | |
| 989 { | |
| 990 print " SET_CODE\n"; | |
| 991 print &substopt ($set_code[$i]); | |
| 992 print " END_SET_CODE\n"; | |
| 993 } | |
| 994 print "END_OPTION\n"; | |
| 995 } | |
| 996 } | |
| 997 | |
| 998 sub substopt | |
| 999 { | |
| 1000 local ($string, $OPTVAR, $OPT, $TYPE) = @_; | |
| 1001 | |
| 1002 $string =~ s/\$OPTVAR/$OPTVAR/g; | |
| 1003 $string =~ s/\$OPT/$OPT/g; | |
| 1004 $string =~ s/\$TYPE/$TYPE/g; | |
| 1005 | |
| 1006 $string; | |
| 1007 } | |
| 1008 | |
| 1009 sub print_assoc_array | |
| 1010 { | |
| 1011 local (%t) = @_; | |
| 1012 | |
| 1013 local ($k); | |
| 1014 | |
| 1015 foreach $k (keys (%t)) | |
| 1016 { | |
| 1017 print "$k: $t{$k}\n"; | |
| 1018 } | |
| 1019 } | |
| 1020 | |
| 1021 sub max | |
| 1022 { | |
| 1023 local ($max) = shift; | |
| 1024 | |
| 1025 foreach (@_) | |
| 1026 { | |
| 1027 $max = $_ if $max < $_; | |
| 1028 } | |
| 1029 | |
| 1030 $max; | |
| 1031 } |