Mercurial > hg > octave-nkf
annotate mk-opts.pl @ 12134:6c54ad0fde04 release-3-4-x ss-3-3-90
update copyright and version info for release branch
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Sat, 22 Jan 2011 13:50:32 -0500 |
| parents | fd0a3ac60b0e |
| children | db1f49eaba6b |
| rev | line source |
|---|---|
| 3998 | 1 #! /usr/bin/perl |
| 7019 | 2 # |
| 11523 | 3 # Copyright (C) 2002-2011 John W. Eaton |
| 7019 | 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 | |
|
8202
cf59d542f33e
replace all TODOs and XXXs with FIXMEs
Jaroslav Hajek <highegg@gmail.com>
parents:
7806
diff
changeset
|
24 # FIXME: |
| 3999 | 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 | |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
363 sub emit_copy_body |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
364 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
365 local ($pfx, $var) = @_; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
366 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
367 for ($i = 0; $i < $opt_num; $i++) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
368 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
369 print "${pfx}$optvar[$i] = ${var}.$optvar[$i];\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
370 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
371 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
372 print "${pfx}reset = ${var}.reset;\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
373 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
374 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
375 ## To silence GCC warnings, we create an initialization list even |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
376 ## though the init function actually does the work of initialization. |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
377 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
378 sub emit_default_init_list |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
379 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
380 local ($prefix) = @_; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
381 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
382 for ($i = 0; $i < $opt_num; $i++) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
383 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
384 if ($i == 0) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
385 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
386 $pfx = ""; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
387 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
388 else |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
389 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
390 $pfx = $prefix; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
391 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
392 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
393 print "${pfx}$optvar[$i] (),\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
394 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
395 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
396 print "${prefix}reset ()\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
397 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
398 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
399 sub emit_copy_ctor_init_list |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
400 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
401 local ($prefix, $var) = @_; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
402 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
403 for ($i = 0; $i < $opt_num; $i++) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
404 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
405 if ($i == 0) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
406 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
407 $pfx = ""; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
408 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
409 else |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
410 { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
411 $pfx = $prefix; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
412 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
413 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
414 print "${pfx}$optvar[$i] ($var.$optvar[$i]),\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
415 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
416 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
417 print "${prefix}reset ($var.reset)\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
418 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
419 |
| 3998 | 420 sub emit_opt_class_header |
| 421 { | |
| 422 local ($i, $s); | |
| 423 | |
| 424 print "// DO NOT EDIT! | |
| 425 // Generated automatically from $INFILE. | |
| 426 | |
| 427 #if !defined (octave_${class_name}_h) | |
| 428 #define octave_${class_name}_h 1 | |
| 429 | |
| 430 #include <cfloat> | |
| 431 #include <cmath> | |
| 432 | |
| 4044 | 433 ${include} |
| 434 | |
| 3998 | 435 class |
| 436 ${class_name} | |
| 437 { | |
| 438 public: | |
| 439 | |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
440 ${class_name} (void) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
441 : "; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
442 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
443 &emit_default_init_list (" "); |
| 3998 | 444 |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
445 print " { |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
446 init (); |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
447 } |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
448 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
449 ${class_name} (const ${class_name}& opt) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
450 : "; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
451 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
452 &emit_copy_ctor_init_list (" ", "opt"); |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
453 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
454 print " { } |
| 3998 | 455 |
| 456 ${class_name}& operator = (const ${class_name}& opt) | |
| 457 { | |
| 458 if (this != &opt) | |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
459 {\n"; |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
460 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
461 &emit_copy_body (" ", "opt"); |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
462 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
463 print " } |
| 3998 | 464 |
| 465 return *this; | |
| 466 } | |
| 467 | |
| 468 ~${class_name} (void) { }\n"; | |
| 469 | |
| 470 print "\n void init (void)\n {\n"; | |
| 471 | |
| 472 for ($i = 0; $i < $opt_num; $i++) | |
| 473 { | |
| 474 if ($init_value[$i]) | |
| 475 { | |
| 476 print " $optvar[$i] = $init_value[$i];\n"; | |
| 477 } | |
| 478 elsif ($init_body[$i]) | |
| 479 { | |
| 480 $s = &substopt ($init_body[$i], $optvar[$i], $opt[$i], $type[$i]); | |
| 481 chop ($s); | |
| 482 $s =~ s/^\s*/ /g; | |
| 483 $s =~ s/\n\s*/\n /g; | |
| 484 print "$s\n"; | |
| 485 } | |
| 486 } | |
| 487 | |
| 4049 | 488 print " reset = true; |
| 489 }\n"; | |
| 3998 | 490 |
| 4122 | 491 ## For backward compatibility and because set_options is probably |
| 492 ## a better name in some contexts: | |
| 493 | |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
494 print "\n void set_options (const ${class_name}& opt) |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
495 {\n"; |
| 4122 | 496 |
|
11497
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
497 &emit_copy_body (" ", "opt"); |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
498 |
|
7bddd70bc838
mk-opts.pl: generate initialization lists and in-line code for copy method
John W. Eaton <jwe@octave.org>
parents:
8920
diff
changeset
|
499 print " }\n\n void set_default_options (void) { init (); }\n"; |
| 3998 | 500 |
| 501 for ($i = 0; $i < $opt_num; $i++) | |
| 502 { | |
| 503 if ($set_expr[$i]) | |
| 504 { | |
| 505 &emit_set_decl ($i); | |
| 506 | |
| 4049 | 507 print "\n { $optvar[$i] = $set_expr[$i]; reset = true; }\n"; |
| 3998 | 508 } |
| 509 elsif ($set_body[$i]) | |
| 510 { | |
| 511 &emit_set_decl ($i); | |
| 512 | |
| 513 $s = &substopt ($set_body[$i], $optvar[$i], $opt[$i], $type[$i]); | |
| 514 chop ($s); | |
| 515 $s =~ s/^/ /g; | |
| 516 $s =~ s/\n/\n /g; | |
| 4049 | 517 print "\n {\n$s\n reset = true;\n }\n"; |
| 3998 | 518 } |
| 519 elsif ($set_code[$i]) | |
| 520 { | |
| 521 $s = &substopt ($set_code[$i], $optvar[$i], $opt[$i], $type[$i]); | |
| 522 chop ($s); | |
| 523 $s =~ s/^ //g; | |
| 524 $s =~ s/\n /\n/g; | |
| 525 print "\n$s\n"; | |
| 526 } | |
| 527 } | |
| 528 | |
| 529 for ($i = 0; $i < $opt_num; $i++) | |
| 530 { | |
| 531 print " $type[$i] $opt[$i] (void) const\n { return $optvar[$i]; }\n\n"; | |
| 532 } | |
| 533 | |
| 534 print "private:\n\n"; | |
| 535 | |
| 536 for ($i = 0; $i < $opt_num; $i++) | |
| 537 { | |
| 538 print " $type[$i] $optvar[$i];\n"; | |
| 539 } | |
| 540 | |
| 4049 | 541 print "\nprotected:\n\n bool reset;\n};\n\n#endif\n"; |
| 3998 | 542 } |
| 543 | |
| 544 sub emit_set_decl | |
| 545 { | |
| 546 local ($i) = @_; | |
| 547 | |
| 548 print " | |
| 549 void set_$opt[$i] ($set_arg_type[$i] val)"; | |
| 550 } | |
| 551 | |
| 552 sub emit_opt_handler_fcns | |
| 553 { | |
| 554 local ($i); | |
| 4044 | 555 my $header = $INFILE; |
| 556 $header =~ s/[.]\w*$/.h/; # replace .in with .h | |
| 557 $header =~ s|^.*/([^/]*)$|$1|; # strip directory part | |
| 3998 | 558 |
| 559 print "// DO NOT EDIT!\n// Generated automatically from $INFILE.\n\n"; | |
| 560 | |
| 561 print "#ifdef HAVE_CONFIG_H | |
| 562 #include <config.h> | |
| 563 #endif | |
| 564 | |
| 565 #include <iomanip> | |
| 566 #include <iostream> | |
| 567 | |
| 4044 | 568 #include \"$header\" |
| 569 | |
| 3998 | 570 #include \"defun-dld.h\" |
| 571 #include \"pr-output.h\" | |
| 572 | |
| 4044 | 573 #include \"oct-obj.h\" |
| 574 #include \"utils.h\" | |
| 575 #include \"pager.h\" | |
| 576 | |
| 3998 | 577 static ${class_name} ${static_object_name};\n\n"; |
| 578 | |
| 579 &emit_struct_decl; | |
| 580 | |
| 581 &emit_struct_def; | |
| 582 | |
| 583 &emit_print_function; | |
| 584 | |
| 585 &emit_set_functions; | |
| 586 | |
| 587 &emit_show_function; | |
| 588 | |
| 589 &emit_options_function; | |
| 590 } | |
| 591 | |
| 592 sub emit_struct_decl | |
| 593 { | |
| 594 local ($i); | |
| 595 | |
| 596 print "#define MAX_TOKENS $max_tokens\n\n"; | |
| 597 | |
| 598 print "struct ${struct_name}\n{\n"; | |
| 599 | |
| 600 print " const char *keyword;\n"; | |
| 601 print " const char *kw_tok[MAX_TOKENS + 1];\n"; | |
| 602 print " int min_len[MAX_TOKENS + 1];\n"; | |
| 603 print " int min_toks_to_match;\n"; | |
| 604 | |
| 605 print "};\n\n"; | |
| 606 } | |
| 607 | |
| 608 sub emit_struct_def | |
| 609 { | |
| 610 local ($i); | |
| 611 | |
| 612 print "#define NUM_OPTIONS $opt_num\n\n"; | |
| 613 | |
| 614 print "static ${struct_name} ${static_table_name} [] =\n{\n"; | |
| 615 | |
| 616 for ($i = 0; $i < $opt_num; $i++) | |
| 617 { | |
| 618 &emit_option_table_entry ($i, 0); | |
| 619 | |
| 620 if ($i < $opt_num - 1) | |
| 621 { | |
| 622 print "\n"; | |
| 623 } | |
| 624 } | |
| 625 | |
| 626 print "};\n\n"; | |
| 627 } | |
| 628 | |
| 629 sub emit_option_table_entry | |
| 630 { | |
| 631 local ($i, $empty) = @_; | |
| 632 | |
| 633 local ($k); | |
| 634 | |
| 635 if ($empty) | |
| 636 { | |
| 637 print " { 0,\n"; | |
| 638 } | |
| 639 else | |
| 640 { | |
| 641 print " { \"$name[$i]\",\n"; | |
| 642 } | |
| 643 | |
| 644 local ($n) = scalar $#{$kw_tok[$i]}; | |
| 645 print " {"; | |
| 646 for $k (0 .. $max_tokens) | |
| 647 { | |
| 648 if ($empty || $k > $n) | |
| 649 { | |
| 650 print " 0,"; | |
| 651 } | |
| 652 else | |
| 653 { | |
| 654 print " \"$kw_tok[$i][$k]\","; | |
| 655 } | |
| 656 } | |
| 657 print " },\n"; | |
| 658 | |
| 659 print " {"; | |
| 660 for $k (0 .. $max_tokens) | |
| 661 { | |
| 662 if ($empty || $k > $n) | |
| 663 { | |
| 664 print " 0,"; | |
| 665 } | |
| 666 else | |
| 667 { | |
| 668 print " $min_tok_len_to_match[$i][$k],"; | |
| 669 } | |
| 670 } | |
| 671 print " }, $min_toks_to_match[$i], "; | |
| 672 | |
| 673 print "},\n"; | |
| 674 } | |
| 675 | |
| 676 sub emit_print_function | |
| 677 { | |
| 678 local ($i); | |
| 679 | |
| 5775 | 680 ## FIXME -- determine the width of the table automatically. |
| 4047 | 681 |
| 3998 | 682 print "static void |
| 6755 | 683 print_${class_name} (std::ostream& os) |
| 3998 | 684 { |
| 5765 | 685 std::ostringstream buf; |
| 3998 | 686 |
| 6755 | 687 os << \"\\n\" |
| 688 << \"Options for $CLASS include:\\n\\n\" | |
| 689 << \" keyword value\\n\" | |
| 690 << \" ------- -----\\n\"; | |
| 3998 | 691 |
| 692 $struct_name *list = $static_table_name;\n\n"; | |
| 693 | |
| 694 for ($i = 0; $i < $opt_num; $i++) | |
| 695 { | |
| 6755 | 696 print " {\n os << \" \" |
| 5667 | 697 << std::setiosflags (std::ios::left) << std::setw (50) |
| 698 << list[$i].keyword | |
| 699 << std::resetiosflags (std::ios::left) | |
| 700 << \" \";\n\n"; | |
| 3998 | 701 |
| 702 if ($type[$i] eq "double") | |
| 703 { | |
| 704 print " double val = $static_object_name.$opt[$i] ();\n\n"; | |
| 6755 | 705 print " os << val << \"\\n\";\n"; |
| 3998 | 706 } |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
707 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
708 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
709 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
|
710 print " os << val << \"\\n\";\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
711 } |
| 5275 | 712 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 713 { |
| 714 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
| 6755 | 715 print " os << val << \"\\n\";\n"; |
| 3998 | 716 } |
| 717 elsif ($type[$i] eq "std::string") | |
| 718 { | |
| 6755 | 719 print " os << $static_object_name.$opt[$i] () << \"\\n\";\n"; |
| 3998 | 720 } |
| 5275 | 721 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 722 { |
| 5275 | 723 if ($type[$i] eq "Array<int>") |
| 724 { | |
| 725 $elt_type = "int"; | |
| 726 } | |
| 727 else | |
| 728 { | |
| 729 $elt_type = "octave_idx_type"; | |
| 730 } | |
| 731 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 4044 | 732 print " if (val.length () == 1) |
| 733 { | |
| 6755 | 734 os << val(0) << \"\\n\"; |
| 4044 | 735 } |
| 736 else | |
| 737 { | |
| 6755 | 738 os << \"\\n\\n\"; |
| 5275 | 739 octave_idx_type len = val.length (); |
| 4044 | 740 Matrix tmp (len, 1); |
| 5275 | 741 for (octave_idx_type i = 0; i < len; i++) |
| 4044 | 742 tmp(i,0) = val(i); |
| 6755 | 743 octave_print_internal (os, tmp, false, 2); |
| 744 os << \"\\n\\n\"; | |
| 4044 | 745 }\n"; |
| 746 } | |
| 3998 | 747 elsif ($type[$i] eq "Array<double>") |
| 748 { | |
| 749 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 750 print " if (val.length () == 1) | |
| 751 { | |
| 6755 | 752 os << val(0) << \"\\n\"; |
| 3998 | 753 } |
| 754 else | |
| 755 { | |
| 6755 | 756 os << \"\\n\\n\"; |
| 3998 | 757 Matrix tmp = Matrix (ColumnVector (val)); |
| 6755 | 758 octave_print_internal (os, tmp, false, 2); |
| 759 os << \"\\n\\n\"; | |
| 3998 | 760 }\n"; |
| 761 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
762 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
763 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
764 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
|
765 print " if (val.length () == 1) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
766 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
767 os << val(0) << \"\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
768 } |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
769 else |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
770 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
771 os << \"\\n\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
772 FloatMatrix tmp = FloatMatrix (FloatColumnVector (val)); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
773 octave_print_internal (os, tmp, false, 2); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
774 os << \"\\n\\n\"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
775 }\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
776 } |
| 3998 | 777 else |
| 778 { | |
| 779 die ("unknown type $type[$i]"); | |
| 780 } | |
| 781 | |
| 782 print " }\n\n"; | |
| 783 } | |
| 784 | |
| 6755 | 785 print " os << \"\\n\";\n}\n\n"; |
| 3998 | 786 } |
| 787 | |
| 788 sub emit_set_functions | |
| 789 { | |
| 790 print "static void | |
| 791 set_${class_name} (const std::string& keyword, const octave_value& val) | |
| 792 { | |
| 793 $struct_name *list = $static_table_name;\n\n"; | |
| 794 | |
| 795 $iftok = "if"; | |
| 796 | |
| 797 for ($i = 0; $i < $opt_num; $i++) | |
| 798 { | |
| 799 $iftok = "else if" if ($i > 0); | |
| 800 | |
| 801 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
| 802 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
| 803 {\n"; | |
| 804 | |
| 805 if ($type[$i] eq "double") | |
| 806 { | |
| 807 print " double tmp = val.double_value ();\n\n"; | |
| 808 print " if (! error_state) | |
| 809 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 810 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
811 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
812 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
813 print " float tmp = val.float_value ();\n\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
814 print " if (! error_state) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
815 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
816 } |
| 5275 | 817 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 818 { |
| 819 print " int tmp = val.int_value ();\n\n"; | |
| 820 print " if (! error_state) | |
| 821 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 822 } | |
| 823 elsif ($type[$i] eq "std::string") | |
| 824 { | |
| 825 print " std::string tmp = val.string_value ();\n\n"; | |
| 826 print " if (! error_state) | |
| 827 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 828 } | |
| 5275 | 829 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 830 { |
| 831 print " Array<int> tmp = val.int_vector_value ();\n\n"; | |
| 832 print " if (! error_state) | |
| 833 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 834 } | |
| 3998 | 835 elsif ($type[$i] eq "Array<double>") |
| 836 { | |
| 837 print " Array<double> tmp = val.vector_value ();\n\n"; | |
| 838 print " if (! error_state) | |
| 839 $static_object_name.set_$opt[$i] (tmp);\n"; | |
| 840 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
841 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
842 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
843 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
|
844 print " if (! error_state) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
845 $static_object_name.set_$opt[$i] (tmp);\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
846 } |
| 3998 | 847 else |
| 848 { | |
| 849 die ("unknown type $type[$i]"); | |
| 850 } | |
| 851 | |
| 852 print " }\n"; | |
| 853 } | |
| 854 | |
| 855 print " else | |
| 856 { | |
| 857 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
| 858 } | |
| 859 }\n\n"; | |
| 860 } | |
| 861 | |
| 862 sub emit_show_function | |
| 863 { | |
| 864 local ($i, $iftok); | |
| 865 | |
| 866 print "static octave_value_list | |
| 867 show_${class_name} (const std::string& keyword) | |
| 868 { | |
| 869 octave_value retval; | |
| 870 | |
| 871 $struct_name *list = $static_table_name;\n\n"; | |
| 872 | |
| 873 $iftok = "if"; | |
| 874 | |
| 875 for ($i = 0; $i < $opt_num; $i++) | |
| 876 { | |
| 877 $iftok = "else if" if ($i > 0); | |
| 878 | |
| 879 print " $iftok (keyword_almost_match (list[$i].kw_tok, list[$i].min_len, | |
| 880 keyword, list[$i].min_toks_to_match, MAX_TOKENS)) | |
| 881 {\n"; | |
| 882 | |
| 883 if ($type[$i] eq "double") | |
| 884 { | |
| 885 print " double val = $static_object_name.$opt[$i] ();\n\n"; | |
| 886 print " retval = val;\n"; | |
| 887 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
888 elsif ($type[$i] eq "float") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
889 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
890 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
|
891 print " retval = val;\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
892 } |
| 5275 | 893 elsif ($type[$i] eq "int" || $type[$i] eq "octave_idx_type") |
| 3998 | 894 { |
| 895 print " int val = $static_object_name.$opt[$i] ();\n\n"; | |
| 896 print " retval = static_cast<double> (val);\n"; | |
| 897 } | |
| 898 elsif ($type[$i] eq "std::string") | |
| 899 { | |
| 900 print " retval = $static_object_name.$opt[$i] ();\n"; | |
| 901 } | |
| 5275 | 902 elsif ($type[$i] eq "Array<int>" || $type[$i] eq "Array<octave_idx_type>") |
| 4044 | 903 { |
| 5275 | 904 if ($type[$i] eq "Array<int>") |
| 905 { | |
| 906 $elt_type = "int"; | |
| 907 } | |
| 908 else | |
| 909 { | |
| 910 $elt_type = "octave_idx_type"; | |
| 911 } | |
| 912 print " Array<$elt_type> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 4044 | 913 print " if (val.length () == 1) |
| 914 { | |
| 915 retval = static_cast<double> (val(0)); | |
| 916 } | |
| 917 else | |
| 918 { | |
| 5275 | 919 octave_idx_type len = val.length (); |
| 4044 | 920 ColumnVector tmp (len); |
| 5275 | 921 for (octave_idx_type i = 0; i < len; i++) |
| 4044 | 922 tmp(i) = val(i); |
| 923 retval = tmp; | |
| 924 }\n"; | |
| 925 } | |
| 3998 | 926 elsif ($type[$i] eq "Array<double>") |
| 927 { | |
| 928 print " Array<double> val = $static_object_name.$opt[$i] ();\n\n"; | |
| 929 print " if (val.length () == 1) | |
| 930 { | |
| 931 retval = val(0); | |
| 932 } | |
| 933 else | |
| 934 { | |
| 935 retval = ColumnVector (val); | |
| 936 }\n"; | |
| 937 } | |
|
7806
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
938 elsif ($type[$i] eq "Array<float>") |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
939 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
940 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
|
941 print " if (val.length () == 1) |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
942 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
943 retval = val(0); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
944 } |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
945 else |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
946 { |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
947 retval = FloatColumnVector (val); |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
948 }\n"; |
|
edc25a3fb2bc
handle floats in mk-opts.pl
Jaroslav Hajek <highegg@gmail.com>
parents:
7019
diff
changeset
|
949 } |
| 3998 | 950 else |
| 951 { | |
| 952 die ("unknown type $type[$i]"); | |
| 953 } | |
| 954 | |
| 955 print " }\n"; | |
| 956 } | |
| 957 | |
| 958 print " else | |
| 959 { | |
| 960 warning (\"$opt_fcn_name: no match for `%s'\", keyword.c_str ()); | |
| 961 } | |
| 962 | |
| 963 return retval;\n}\n\n"; | |
| 964 } | |
| 965 | |
| 966 sub emit_options_function | |
| 967 { | |
| 968 print "DEFUN_DLD ($opt_fcn_name, args, , | |
| 969 \"-*- texinfo -*-\\n\\ | |
| 970 \@deftypefn {Loadable Function} {} $opt_fcn_name (\@var{opt}, \@var{val})\\n\\ | |
| 4050 | 971 $doc_string\\n\\ |
| 972 Options include\\n\\ | |
| 973 \\n\\ | |
| 974 \@table \@code\\n\\\n"; | |
| 975 | |
| 976 for ($i = 0; $i < $opt_num; $i++) | |
| 977 { | |
| 978 print "\@item \\\"$name[$i]\\\"\\n\\\n"; | |
| 979 if ($doc_item[$i] ne "") | |
| 980 { | |
| 981 print "$doc_item[$i]"; | |
| 982 } | |
| 983 } | |
| 984 | |
| 985 print "\@end table\\n\\\n\@end deftypefn\") | |
| 3998 | 986 { |
| 987 octave_value_list retval; | |
| 988 | |
| 989 int nargin = args.length (); | |
| 990 | |
| 991 if (nargin == 0) | |
| 992 { | |
| 6755 | 993 print_${class_name} (octave_stdout); |
| 3998 | 994 } |
| 995 else if (nargin == 1 || nargin == 2) | |
| 996 { | |
| 997 std::string keyword = args(0).string_value (); | |
| 998 | |
| 999 if (! error_state) | |
| 1000 { | |
| 1001 if (nargin == 1) | |
| 1002 retval = show_${class_name} (keyword); | |
| 1003 else | |
| 1004 set_${class_name} (keyword, args(1)); | |
| 1005 } | |
| 1006 else | |
| 1007 error (\"$opt_fcn_name: expecting keyword as first argument\"); | |
| 1008 } | |
| 1009 else | |
| 5823 | 1010 print_usage (); |
| 3998 | 1011 |
| 1012 return retval; | |
| 4035 | 1013 }\n"; |
| 3998 | 1014 } |
| 1015 | |
| 1016 sub emit_options_debug | |
| 1017 { | |
| 1018 print "CLASS = \"$class\"\n"; | |
| 1019 | |
| 1020 for ($i = 0; $i < $opt_num; $i++) | |
| 1021 { | |
| 1022 $NAME = $name[$i]; | |
| 1023 ($OPT = $NAME) =~ s/\s+/_/g; | |
| 1024 $OPTVAR = "x_$OPT"; | |
| 1025 $TYPE = $type[$i]; | |
| 1026 print "\n"; | |
| 1027 print "OPTION\n"; | |
| 1028 print " NAME = \"$NAME\"\n"; | |
| 1029 print " TYPE = \"$TYPE\"\n"; | |
| 1030 if ($set_arg_type[$i]) | |
| 1031 { | |
| 1032 print eval ("\" SET_ARG_TYPE = \\\"$set_arg_type[$i]\\\"\"") . "\n"; | |
| 1033 } | |
| 1034 if ($init_value[$i]) | |
| 1035 { | |
| 1036 print " INIT_VALUE = \"$init_value[$i]\"\n"; | |
| 1037 } | |
| 1038 if ($init_body[$i]) | |
| 1039 { | |
| 1040 print " INIT_BODY\n"; | |
| 1041 print &substopt ($init_body[$i]); | |
| 1042 print " END_INIT_BODY\n"; | |
| 1043 } | |
| 1044 if ($set_expr[$i]) | |
| 1045 { | |
| 1046 print " SET_EXPR = \"$set_expr[$i]\"\n"; | |
| 1047 } | |
| 1048 if ($set_body[$i]) | |
| 1049 { | |
| 1050 print " SET_BODY\n"; | |
| 1051 print &substopt ($set_body[$i]); | |
| 1052 print " END_SET_BODY\n"; | |
| 1053 } | |
| 1054 if ($set_code[$i]) | |
| 1055 { | |
| 1056 print " SET_CODE\n"; | |
| 1057 print &substopt ($set_code[$i]); | |
| 1058 print " END_SET_CODE\n"; | |
| 1059 } | |
| 1060 print "END_OPTION\n"; | |
| 1061 } | |
| 1062 } | |
| 1063 | |
| 1064 sub substopt | |
| 1065 { | |
| 1066 local ($string, $OPTVAR, $OPT, $TYPE) = @_; | |
| 1067 | |
| 1068 $string =~ s/\$OPTVAR/$OPTVAR/g; | |
| 1069 $string =~ s/\$OPT/$OPT/g; | |
| 1070 $string =~ s/\$TYPE/$TYPE/g; | |
| 1071 | |
| 1072 $string; | |
| 1073 } | |
| 1074 | |
| 1075 sub print_assoc_array | |
| 1076 { | |
| 1077 local (%t) = @_; | |
| 1078 | |
| 1079 local ($k); | |
| 1080 | |
| 1081 foreach $k (keys (%t)) | |
| 1082 { | |
| 1083 print "$k: $t{$k}\n"; | |
| 1084 } | |
| 1085 } | |
| 1086 | |
| 1087 sub max | |
| 1088 { | |
| 1089 local ($max) = shift; | |
| 1090 | |
| 1091 foreach (@_) | |
| 1092 { | |
| 1093 $max = $_ if $max < $_; | |
| 1094 } | |
| 1095 | |
| 1096 $max; | |
| 1097 } |