sys/boot/forth/menusets.4th

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