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