1\ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org> 2\ All rights reserved. 3\ 4\ Redistribution and use in source and binary forms, with or without 5\ modification, are permitted provided that the following conditions 6\ are met: 7\ 1. Redistributions of source code must retain the above copyright 8\ notice, this list of conditions and the following disclaimer. 9\ 2. Redistributions in binary form must reproduce the above copyright 10\ notice, this list of conditions and the following disclaimer in the 11\ documentation and/or other materials provided with the distribution. 12\ 13\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23\ SUCH DAMAGE. 24\ 25 26marker task-menusets.4th 27 28vocabulary menusets-infrastructure 29only forth also menusets-infrastructure definitions 30 31variable menuset_use_name 32 33create menuset_affixbuf 255 allot 34create menuset_x 1 allot 35create menuset_y 1 allot 36 37: menuset-loadvar ( -- ) 38 39 \ menuset_use_name is true or false 40 \ $type should be set to one of: 41 \ menu toggled ansi 42 \ $var should be set to one of: 43 \ caption command keycode text ... 44 \ $affix is either prefix (menuset_use_name is true) 45 \ or infix (menuset_use_name is false) 46 47 s" set cmdbuf='set ${type}_${var}=\$'" evaluate 48 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 49 menuset_use_name @ true = if 50 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}" 51 ( u1 -- u1 c-addr2 u2 ) 52 else 53 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}" 54 ( u1 -- u1 c-addr2 u2 ) 55 then 56 evaluate ( u1 c-addr2 u2 -- u1 ) 57 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 58 rot 2 pick 2 pick over + -rot + tuck - 59 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 60 \ Generate a string representing rvalue inheritance var 61 getenv dup -1 = if 62 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 63 \ NOT set -- clean up the stack 64 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 65 2drop ( c-addr2 u2 -- ) 66 else 67 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 68 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 69 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 70 evaluate ( c-addr2 u2 -- ) 71 then 72 73 s" cmdbuf" unsetenv 74; 75 76: menuset-unloadvar ( -- ) 77 78 \ menuset_use_name is true or false 79 \ $type should be set to one of: 80 \ menu toggled ansi 81 \ $var should be set to one of: 82 \ caption command keycode text ... 83 \ $affix is either prefix (menuset_use_name is true) 84 \ or infix (menuset_use_name is false) 85 86 menuset_use_name @ true = if 87 s" set buf=${affix}${type}_${var}" 88 else 89 s" set buf=${type}set${affix}_${var}" 90 then 91 evaluate 92 s" buf" getenv unsetenv 93 s" buf" unsetenv 94; 95 96: menuset-loadmenuvar ( -- ) 97 s" set type=menu" evaluate 98 menuset-loadvar 99; 100 101: menuset-unloadmenuvar ( -- ) 102 s" set type=menu" evaluate 103 menuset-unloadvar 104; 105 106: menuset-loadxvar ( -- ) 107 108 \ menuset_use_name is true or false 109 \ $type should be set to one of: 110 \ menu toggled ansi 111 \ $var should be set to one of: 112 \ caption command keycode text ... 113 \ $x is "1" through "8" 114 \ $affix is either prefix (menuset_use_name is true) 115 \ or infix (menuset_use_name is false) 116 117 s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate 118 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 119 menuset_use_name @ true = if 120 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]" 121 ( u1 -- u1 c-addr2 u2 ) 122 else 123 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]" 124 ( u1 -- u1 c-addr2 u2 ) 125 then 126 evaluate ( u1 c-addr2 u2 -- u1 ) 127 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 128 rot 2 pick 2 pick over + -rot + tuck - 129 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 130 \ Generate a string representing rvalue inheritance var 131 getenv dup -1 = if 132 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 133 \ NOT set -- clean up the stack 134 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 135 2drop ( c-addr2 u2 -- ) 136 else 137 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 138 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 139 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 140 evaluate ( c-addr2 u2 -- ) 141 then 142 143 s" cmdbuf" unsetenv 144; 145 146: menuset-unloadxvar ( -- ) 147 148 \ menuset_use_name is true or false 149 \ $type should be set to one of: 150 \ menu toggled ansi 151 \ $var should be set to one of: 152 \ caption command keycode text ... 153 \ $x is "1" through "8" 154 \ $affix is either prefix (menuset_use_name is true) 155 \ or infix (menuset_use_name is false) 156 157 menuset_use_name @ true = if 158 s" set buf=${affix}${type}_${var}[${x}]" 159 else 160 s" set buf=${type}set${affix}_${var}[${x}]" 161 then 162 evaluate 163 s" buf" getenv unsetenv 164 s" buf" unsetenv 165; 166 167: menuset-loadansixvar ( -- ) 168 s" set type=ansi" evaluate 169 menuset-loadxvar 170; 171 172: menuset-unloadansixvar ( -- ) 173 s" set type=ansi" evaluate 174 menuset-unloadxvar 175; 176 177: menuset-loadmenuxvar ( -- ) 178 s" set type=menu" evaluate 179 menuset-loadxvar 180; 181 182: menuset-unloadmenuxvar ( -- ) 183 s" set type=menu" evaluate 184 menuset-unloadxvar 185; 186 187: menuset-unloadtypelessxvar ( -- ) 188 s" set type=" evaluate 189 menuset-unloadxvar 190; 191 192: menuset-loadtoggledxvar ( -- ) 193 s" set type=toggled" evaluate 194 menuset-loadxvar 195; 196 197: menuset-unloadtoggledxvar ( -- ) 198 s" set type=toggled" evaluate 199 menuset-unloadxvar 200; 201 202: menuset-loadxyvar ( -- ) 203 204 \ menuset_use_name is true or false 205 \ $type should be set to one of: 206 \ menu toggled ansi 207 \ $var should be set to one of: 208 \ caption command keycode text ... 209 \ $x is "1" through "8" 210 \ $y is "0" through "9" 211 \ $affix is either prefix (menuset_use_name is true) 212 \ or infix (menuset_use_name is false) 213 214 s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate 215 s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length 216 menuset_use_name @ true = if 217 s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]" 218 ( u1 -- u1 c-addr2 u2 ) 219 else 220 s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]" 221 ( u1 -- u1 c-addr2 u2 ) 222 then 223 evaluate ( u1 c-addr2 u2 -- u1 ) 224 s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 ) 225 rot 2 pick 2 pick over + -rot + tuck - 226 ( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 ) 227 \ Generate a string representing rvalue inheritance var 228 getenv dup -1 = if 229 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 ) 230 \ NOT set -- clean up the stack 231 drop ( c-addr2 u2 -1 -- c-addr2 u2 ) 232 2drop ( c-addr2 u2 -- ) 233 else 234 ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 ) 235 \ SET -- execute cmdbuf (c-addr2/u2) to inherit value 236 2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 ) 237 evaluate ( c-addr2 u2 -- ) 238 then 239 240 s" cmdbuf" unsetenv 241; 242 243: menuset-unloadxyvar ( -- ) 244 245 \ menuset_use_name is true or false 246 \ $type should be set to one of: 247 \ menu toggled ansi 248 \ $var should be set to one of: 249 \ caption command keycode text ... 250 \ $x is "1" through "8" 251 \ $y is "0" through "9" 252 \ $affix is either prefix (menuset_use_name is true) 253 \ or infix (menuset_use_name is false) 254 255 menuset_use_name @ true = if 256 s" set buf=${affix}${type}_${var}[${x}][${y}]" 257 else 258 s" set buf=${type}set${affix}_${var}[${x}][${y}]" 259 then 260 evaluate 261 s" buf" getenv unsetenv 262 s" buf" unsetenv 263; 264 265: menuset-loadansixyvar ( -- ) 266 s" set type=ansi" evaluate 267 menuset-loadxyvar 268; 269 270: menuset-unloadansixyvar ( -- ) 271 s" set type=ansi" evaluate 272 menuset-unloadxyvar 273; 274 275: menuset-loadmenuxyvar ( -- ) 276 s" set type=menu" evaluate 277 menuset-loadxyvar 278; 279 280: menuset-unloadmenuxyvar ( -- ) 281 s" set type=menu" evaluate 282 menuset-unloadxyvar 283; 284 285: menuset-setnum-namevar ( N -- C-Addr/U ) 286 287 s" menuset_nameNNNNN" ( n -- n c-addr1 u1 ) \ variable basename 288 drop 12 ( n c-addr1 u1 -- n c-addr1 12 ) \ remove "NNNNN" 289 rot ( n c-addr1 12 -- c-addr1 12 n ) \ move number on top 290 291 \ convert to string 292 s>d <# #s #> ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 ) 293 294 \ Combine strings 295 begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 296 over ( c-addr1 u1 c-addr2 u2 -- continued below ) 297 ( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr 298 c@ ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below ) 299 ( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte 300 4 pick 4 pick 301 ( c-addr1 u1 c-addr2 u2 c -- continued below ) 302 ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 303 \ get destination c-addr1/u1 pair 304 + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below ) 305 ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 306 \ combine dest-c-addr to get dest-addr for byte 307 c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 308 ( c-addr1 u1 c-addr2 u2 ) 309 \ store the current src-addr byte into dest-addr 310 311 2swap 1+ 2swap \ increment u1 in destination c-addr1/u1 pair 312 swap 1+ swap \ increment c-addr2 in source c-addr2/u2 pair 313 1- \ decrement u2 in the source c-addr2/u2 pair 314 315 dup 0= \ time to break? 316 until 317 318 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) 319 \ drop temporary number-format conversion c-addr2/u2 320; 321 322: menuset-checksetnum ( N -- ) 323 324 \ 325 \ adjust input to be both positive and no-higher than 65535 326 \ 327 abs dup 65535 > if drop 65535 then ( n -- n ) 328 329 \ 330 \ The next few blocks will determine if we should use the default 331 \ methodology (referencing the original numeric stack-input), or if- 332 \ instead $menuset_name{N} has been defined wherein we would then 333 \ use the value thereof as the prefix to every menu variable. 334 \ 335 336 false menuset_use_name ! \ assume name is not set 337 338 menuset-setnum-namevar 339 \ 340 \ We now have a string that is the assembled variable name to check 341 \ for... $menuset_name{N}. Let's check for it. 342 \ 343 2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy 344 getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 ) 345 \ The variable is set. Let's clean up the stack leaving only 346 \ its value for later use. 347 348 true menuset_use_name ! 349 2swap 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 ) 350 \ drop assembled variable name, leave the value 351 else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable 352 \ The variable is not set. Let's clean up the stack leaving the 353 \ string [portion] representing the original numeric input. 354 355 drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result 356 12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 ) 357 \ truncate to original numeric stack-input 358 then 359 360 \ 361 \ Now, depending on whether $menuset_name{N} has been set, we have 362 \ either the value thereof to be used as a prefix to all menu_* 363 \ variables or we have a string representing the numeric stack-input 364 \ to be used as a "set{N}" infix to the same menu_* variables. 365 \ 366 \ For example, if the stack-input is 1 and menuset_name1 is NOT set 367 \ the following variables will be referenced: 368 \ ansiset1_caption[x] -> ansi_caption[x] 369 \ ansiset1_caption[x][y] -> ansi_caption[x][y] 370 \ menuset1_acpi -> menu_acpi 371 \ menuset1_osconsole -> menu_osconsole 372 \ menuset1_caption[x] -> menu_caption[x] 373 \ menuset1_caption[x][y] -> menu_caption[x][y] 374 \ menuset1_command[x] -> menu_command[x] 375 \ menuset1_init -> ``evaluated'' 376 \ menuset1_init[x] -> menu_init[x] 377 \ menuset1_kernel -> menu_kernel 378 \ menuset1_keycode[x] -> menu_keycode[x] 379 \ menuset1_options -> menu_options 380 \ menuset1_optionstext -> menu_optionstext 381 \ menuset1_reboot -> menu_reboot 382 \ toggledset1_ansi[x] -> toggled_ansi[x] 383 \ toggledset1_text[x] -> toggled_text[x] 384 \ otherwise, the following variables are referenced (where {name} 385 \ represents the value of $menuset_name1 (given 1 as stack-input): 386 \ {name}ansi_caption[x] -> ansi_caption[x] 387 \ {name}ansi_caption[x][y] -> ansi_caption[x][y] 388 \ {name}menu_acpi -> menu_acpi 389 \ {name}menu_caption[x] -> menu_caption[x] 390 \ {name}menu_caption[x][y] -> menu_caption[x][y] 391 \ {name}menu_command[x] -> menu_command[x] 392 \ {name}menu_init -> ``evaluated'' 393 \ {name}menu_init[x] -> menu_init[x] 394 \ {name}menu_kernel -> menu_kernel 395 \ {name}menu_keycode[x] -> menu_keycode[x] 396 \ {name}menu_options -> menu_options 397 \ {name}menu_optionstext -> menu_optionstext 398 \ {name}menu_reboot -> menu_reboot 399 \ {name}toggled_ansi[x] -> toggled_ansi[x] 400 \ {name}toggled_text[x] -> toggled_text[x] 401 \ 402 \ Note that menuset{N}_init and {name}menu_init are the initializers 403 \ for the entire menu (for wholly dynamic menus) opposed to the per- 404 \ menuitem initializers (with [x] afterward). The whole-menu init 405 \ routine is evaluated and not passed down to $menu_init (which 406 \ would result in double evaluation). By doing this, the initializer 407 \ can initialize the menuset before we transfer it to active-duty. 408 \ 409 410 \ 411 \ Copy our affixation (prefix or infix depending on menuset_use_name) 412 \ to our buffer so that we can safely use the s-quote (s") buf again. 413 \ 414 menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 ) 415 begin ( using u2 in c-addr2/u2 pair as countdown to zero ) 416 over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 ) 417 c@ ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c ) 418 4 pick 4 pick 419 ( c-addr1 u1 c-addr2 u2 c -- continued below ) 420 ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 ) 421 + ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below ) 422 ( c-addr1 u1 c-addr2 u2 c c-addr3 ) 423 c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below ) 424 ( c-addr1 u1 c-addr2 u2 ) 425 2swap 1+ 2swap \ increment affixbuf byte position/count 426 swap 1+ swap \ increment strbuf pointer (source c-addr2) 427 1- \ decrement strbuf byte count (source u2) 428 dup 0= \ time to break? 429 until 430 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2 431 432 \ 433 \ Create a variable for referencing our affix data (prefix or infix 434 \ depending on menuset_use_name as described above). This variable will 435 \ be temporary and only used to simplify cmdbuf assembly. 436 \ 437 s" affix" setenv ( c-addr1 u1 -- ) 438; 439 440: menuset-cleanup ( -- ) 441 s" type" unsetenv 442 s" var" unsetenv 443 s" x" unsetenv 444 s" y" unsetenv 445 s" affix" unsetenv 446; 447 448only forth definitions also menusets-infrastructure 449 450: menuset-loadsetnum ( N -- ) 451 452 menuset-checksetnum ( n -- ) 453 454 \ 455 \ From here out, we use temporary environment variables to make 456 \ dealing with variable-length strings easier. 457 \ 458 \ menuset_use_name is true or false 459 \ $affix should be used appropriately w/respect to menuset_use_name 460 \ 461 462 \ ... menu_init ... 463 s" set var=init" evaluate 464 menuset-loadmenuvar 465 466 \ If menu_init was set by the above, evaluate it here-and-now 467 \ so that the remaining variables are influenced by its actions 468 s" menu_init" 2dup getenv dup -1 <> if 469 2swap unsetenv \ don't want later menu-create to re-call this 470 evaluate 471 else 472 drop 2drop ( n c-addr u -1 -- n ) 473 then 474 475 [char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56) 476 begin 477 dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x 478 479 s" set var=caption" evaluate 480 481 \ ... menu_caption[x] ... 482 menuset-loadmenuxvar 483 484 \ ... ansi_caption[x] ... 485 menuset-loadansixvar 486 487 [char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57) 488 begin 489 dup menuset_y tuck c! 1 s" y" setenv 490 \ set inner loop iterator and $y 491 492 \ ... menu_caption[x][y] ... 493 menuset-loadmenuxyvar 494 495 \ ... ansi_caption[x][y] ... 496 menuset-loadansixyvar 497 498 1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test 499 until 500 drop ( x y -- x ) 501 502 \ ... menu_command[x] ... 503 s" set var=command" evaluate 504 menuset-loadmenuxvar 505 506 \ ... menu_init[x] ... 507 s" set var=init" evaluate 508 menuset-loadmenuxvar 509 510 \ ... menu_keycode[x] ... 511 s" set var=keycode" evaluate 512 menuset-loadmenuxvar 513 514 \ ... toggled_text[x] ... 515 s" set var=text" evaluate 516 menuset-loadtoggledxvar 517 518 \ ... toggled_ansi[x] ... 519 s" set var=ansi" evaluate 520 menuset-loadtoggledxvar 521 522 1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator 523 \ continue if less than 57 524 until 525 drop ( x -- ) \ loop iterator 526 527 \ ... menu_reboot ... 528 s" set var=reboot" evaluate 529 menuset-loadmenuvar 530 531 \ ... menu_acpi ... 532 s" set var=acpi" evaluate 533 menuset-loadmenuvar 534 535 \ ... menu_osconsole ... 536 s" set var=osconsole" evaluate 537 menuset-loadmenuvar 538 539 \ ... menu_kernel ... 540 s" set var=kernel" evaluate 541 menuset-loadmenuvar 542 543 \ ... menu_options ... 544 s" set var=options" evaluate 545 menuset-loadmenuvar 546 547 \ ... menu_optionstext ... 548 s" set var=optionstext" evaluate 549 menuset-loadmenuvar 550 551 menuset-cleanup 552; 553 554: menusets-unset ( -- ) 555 556 \ clean up BE menu internal variables 557 s" beansi_bootfs" unsetenv 558 s" beansi_current" unsetenv 559 s" beansi_page" unsetenv 560 s" beansi_pageof" unsetenv 561 s" bemenu_bootfs" unsetenv 562 s" bemenu_current" unsetenv 563 s" bemenu_page" unsetenv 564 s" bemenu_pageof" unsetenv 565 s" zfs_be_active" unsetenv 566 s" zfs_be_currpage" unsetenv 567 s" zfs_be_pages" unsetenv 568 569 s" menuset_initial" unsetenv 570 571 1 begin 572 dup menuset-checksetnum ( n n -- n ) 573 574 dup menuset-setnum-namevar ( n n -- n ) 575 unsetenv 576 577 \ If the current menuset does not populate the first menuitem, 578 \ we stop completely. 579 580 menuset_use_name @ true = if 581 s" set buf=${affix}menu_command[1]" 582 else 583 s" set buf=menuset${affix}_command[1]" 584 then 585 evaluate s" buf" getenv getenv -1 = if 586 drop ( n -- ) 587 s" buf" unsetenv 588 menuset-cleanup 589 exit 590 else 591 drop ( n c-addr2 -- n ) \ unused 592 then 593 594 [char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56) 595 begin 596 dup menuset_x tuck c! 1 s" x" setenv \ set $x to x 597 598 s" set var=caption" evaluate 599 menuset-unloadmenuxvar 600 menuset-unloadmenuxvar 601 menuset-unloadansixvar 602 [char] 0 ( n x -- n x y ) \ Inner loop '0' to '9' 603 begin 604 dup menuset_y tuck c! 1 s" y" setenv 605 \ sets $y to y 606 menuset-unloadmenuxyvar 607 menuset-unloadansixyvar 608 1+ dup 57 > ( n x y -- n x y' 0|-1 ) 609 until 610 drop ( n x y -- n x ) 611 s" set var=command" evaluate menuset-unloadmenuxvar 612 s" set var=init" evaluate menuset-unloadmenuxvar 613 s" set var=keycode" evaluate menuset-unloadmenuxvar 614 s" set var=root" evaluate menuset-unloadtypelessxvar 615 s" set var=text" evaluate menuset-unloadtoggledxvar 616 s" set var=ansi" evaluate menuset-unloadtoggledxvar 617 618 1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test 619 until 620 drop ( n x -- n ) \ loop iterator 621 622 s" set var=acpi" evaluate menuset-unloadmenuvar 623 s" set var=osconsole" evaluate menuset-unloadmenuvar 624 s" set var=init" evaluate menuset-unloadmenuvar 625 s" set var=kernel" evaluate menuset-unloadmenuvar 626 s" set var=options" evaluate menuset-unloadmenuvar 627 s" set var=optionstext" evaluate menuset-unloadmenuvar 628 s" set var=reboot" evaluate menuset-unloadmenuvar 629 630 1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test 631 until 632 drop ( n' -- ) \ loop iterator 633 634 s" buf" unsetenv 635 menuset-cleanup 636; 637 638only forth definitions 639 640: menuset-loadinitial ( -- ) 641 s" menuset_initial" getenv dup -1 <> if 642 ?number 0<> if 643 menuset-loadsetnum 644 then 645 else 646 drop \ cruft 647 then 648; 649