625 lines
18 KiB
Forth
625 lines
18 KiB
Forth
\ Copyright (c) 2012 Devin Teske <dteske@FreeBSD.org>
|
|
\ All rights reserved.
|
|
\
|
|
\ Redistribution and use in source and binary forms, with or without
|
|
\ modification, are permitted provided that the following conditions
|
|
\ are met:
|
|
\ 1. Redistributions of source code must retain the above copyright
|
|
\ notice, this list of conditions and the following disclaimer.
|
|
\ 2. Redistributions in binary form must reproduce the above copyright
|
|
\ notice, this list of conditions and the following disclaimer in the
|
|
\ documentation and/or other materials provided with the distribution.
|
|
\
|
|
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
|
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
|
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
\ SUCH DAMAGE.
|
|
\
|
|
\ $FreeBSD$
|
|
|
|
marker task-menusets.4th
|
|
|
|
vocabulary menusets-infrastructure
|
|
only forth also menusets-infrastructure definitions
|
|
|
|
variable menuset_use_name
|
|
|
|
create menuset_affixbuf 255 allot
|
|
create menuset_x 1 allot
|
|
create menuset_y 1 allot
|
|
|
|
: menuset-loadvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
s" set cmdbuf='set ${type}_${var}=\$'" evaluate
|
|
s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
|
|
menuset_use_name @ true = if
|
|
s" set cmdbuf=${cmdbuf}${affix}${type}_${var}"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
else
|
|
s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
then
|
|
evaluate ( u1 c-addr2 u2 -- u1 )
|
|
s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
|
|
rot 2 pick 2 pick over + -rot + tuck -
|
|
( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
|
|
\ Generate a string representing rvalue inheritance var
|
|
getenv dup -1 = if
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
|
|
\ NOT set -- clean up the stack
|
|
drop ( c-addr2 u2 -1 -- c-addr2 u2 )
|
|
2drop ( c-addr2 u2 -- )
|
|
else
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
|
|
\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
|
|
2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
|
|
evaluate ( c-addr2 u2 -- )
|
|
then
|
|
|
|
s" cmdbuf" unsetenv
|
|
;
|
|
|
|
: menuset-unloadvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
menuset_use_name @ true = if
|
|
s" set buf=${affix}${type}_${var}"
|
|
else
|
|
s" set buf=${type}set${affix}_${var}"
|
|
then
|
|
evaluate
|
|
s" buf" getenv unsetenv
|
|
s" buf" unsetenv
|
|
;
|
|
|
|
: menuset-loadmenuvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-loadvar
|
|
;
|
|
|
|
: menuset-unloadmenuvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-unloadvar
|
|
;
|
|
|
|
: menuset-loadxvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $x is "1" through "8"
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
s" set cmdbuf='set ${type}_${var}[${x}]=\$'" evaluate
|
|
s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
|
|
menuset_use_name @ true = if
|
|
s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}]"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
else
|
|
s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}]"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
then
|
|
evaluate ( u1 c-addr2 u2 -- u1 )
|
|
s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
|
|
rot 2 pick 2 pick over + -rot + tuck -
|
|
( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
|
|
\ Generate a string representing rvalue inheritance var
|
|
getenv dup -1 = if
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
|
|
\ NOT set -- clean up the stack
|
|
drop ( c-addr2 u2 -1 -- c-addr2 u2 )
|
|
2drop ( c-addr2 u2 -- )
|
|
else
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
|
|
\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
|
|
2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
|
|
evaluate ( c-addr2 u2 -- )
|
|
then
|
|
|
|
s" cmdbuf" unsetenv
|
|
;
|
|
|
|
: menuset-unloadxvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $x is "1" through "8"
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
menuset_use_name @ true = if
|
|
s" set buf=${affix}${type}_${var}[${x}]"
|
|
else
|
|
s" set buf=${type}set${affix}_${var}[${x}]"
|
|
then
|
|
evaluate
|
|
s" buf" getenv unsetenv
|
|
s" buf" unsetenv
|
|
;
|
|
|
|
: menuset-loadansixvar ( -- )
|
|
s" set type=ansi" evaluate
|
|
menuset-loadxvar
|
|
;
|
|
|
|
: menuset-unloadansixvar ( -- )
|
|
s" set type=ansi" evaluate
|
|
menuset-unloadxvar
|
|
;
|
|
|
|
: menuset-loadmenuxvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-loadxvar
|
|
;
|
|
|
|
: menuset-unloadmenuxvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-unloadxvar
|
|
;
|
|
|
|
: menuset-loadtoggledxvar ( -- )
|
|
s" set type=toggled" evaluate
|
|
menuset-loadxvar
|
|
;
|
|
|
|
: menuset-unloadtoggledxvar ( -- )
|
|
s" set type=toggled" evaluate
|
|
menuset-unloadxvar
|
|
;
|
|
|
|
: menuset-loadxyvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $x is "1" through "8"
|
|
\ $y is "0" through "9"
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
s" set cmdbuf='set ${type}_${var}[${x}][${y}]=\$'" evaluate
|
|
s" cmdbuf" getenv swap drop ( -- u1 ) \ get string length
|
|
menuset_use_name @ true = if
|
|
s" set cmdbuf=${cmdbuf}${affix}${type}_${var}[${x}][${y}]"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
else
|
|
s" set cmdbuf=${cmdbuf}${type}set${affix}_${var}[${x}][${y}]"
|
|
( u1 -- u1 c-addr2 u2 )
|
|
then
|
|
evaluate ( u1 c-addr2 u2 -- u1 )
|
|
s" cmdbuf" getenv ( u1 -- u1 c-addr2 u2 )
|
|
rot 2 pick 2 pick over + -rot + tuck -
|
|
( u1 c-addr2 u2 -- c-addr2 u2 c-addr1 u1 )
|
|
\ Generate a string representing rvalue inheritance var
|
|
getenv dup -1 = if
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 -1 )
|
|
\ NOT set -- clean up the stack
|
|
drop ( c-addr2 u2 -1 -- c-addr2 u2 )
|
|
2drop ( c-addr2 u2 -- )
|
|
else
|
|
( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 c-addr1 u1 )
|
|
\ SET -- execute cmdbuf (c-addr2/u2) to inherit value
|
|
2drop ( c-addr2 u2 c-addr1 u1 -- c-addr2 u2 )
|
|
evaluate ( c-addr2 u2 -- )
|
|
then
|
|
|
|
s" cmdbuf" unsetenv
|
|
;
|
|
|
|
: menuset-unloadxyvar ( -- )
|
|
|
|
\ menuset_use_name is true or false
|
|
\ $type should be set to one of:
|
|
\ menu toggled ansi
|
|
\ $var should be set to one of:
|
|
\ caption command keycode text ...
|
|
\ $x is "1" through "8"
|
|
\ $y is "0" through "9"
|
|
\ $affix is either prefix (menuset_use_name is true)
|
|
\ or infix (menuset_use_name is false)
|
|
|
|
menuset_use_name @ true = if
|
|
s" set buf=${affix}${type}_${var}[${x}][${y}]"
|
|
else
|
|
s" set buf=${type}set${affix}_${var}[${x}][${y}]"
|
|
then
|
|
evaluate
|
|
s" buf" getenv unsetenv
|
|
s" buf" unsetenv
|
|
;
|
|
|
|
: menuset-loadansixyvar ( -- )
|
|
s" set type=ansi" evaluate
|
|
menuset-loadxyvar
|
|
;
|
|
|
|
: menuset-unloadansixyvar ( -- )
|
|
s" set type=ansi" evaluate
|
|
menuset-unloadxyvar
|
|
;
|
|
|
|
: menuset-loadmenuxyvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-loadxyvar
|
|
;
|
|
|
|
: menuset-unloadmenuxyvar ( -- )
|
|
s" set type=menu" evaluate
|
|
menuset-unloadxyvar
|
|
;
|
|
|
|
: menuset-setnum-namevar ( N -- C-Addr/U )
|
|
|
|
s" menuset_nameNNNNN" ( n -- n c-addr1 u1 ) \ variable basename
|
|
drop 12 ( n c-addr1 u1 -- n c-addr1 12 ) \ remove "NNNNN"
|
|
rot ( n c-addr1 12 -- c-addr1 12 n ) \ move number on top
|
|
|
|
\ convert to string
|
|
s>d <# #s #> ( c-addr1 12 n -- c-addr1 12 c-addr2 u2 )
|
|
|
|
\ Combine strings
|
|
begin ( using u2 in c-addr2/u2 pair as countdown to zero )
|
|
over ( c-addr1 u1 c-addr2 u2 -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 c-addr2 ) \ copy src-addr
|
|
c@ ( c-addr1 u1 c-addr2 u2 c-addr2 -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 c ) \ get next src-addr byte
|
|
4 pick 4 pick
|
|
( c-addr1 u1 c-addr2 u2 c -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
|
|
\ get destination c-addr1/u1 pair
|
|
+ ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- cont. below )
|
|
( c-addr1 u1 c-addr2 u2 c c-addr3 )
|
|
\ combine dest-c-addr to get dest-addr for byte
|
|
c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 )
|
|
\ store the current src-addr byte into dest-addr
|
|
|
|
2swap 1+ 2swap \ increment u1 in destination c-addr1/u1 pair
|
|
swap 1+ swap \ increment c-addr2 in source c-addr2/u2 pair
|
|
1- \ decrement u2 in the source c-addr2/u2 pair
|
|
|
|
dup 0= \ time to break?
|
|
until
|
|
|
|
2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 )
|
|
\ drop temporary number-format conversion c-addr2/u2
|
|
;
|
|
|
|
: menuset-checksetnum ( N -- )
|
|
|
|
\
|
|
\ adjust input to be both positive and no-higher than 65535
|
|
\
|
|
abs dup 65535 > if drop 65535 then ( n -- n )
|
|
|
|
\
|
|
\ The next few blocks will determine if we should use the default
|
|
\ methodology (referencing the original numeric stack-input), or if-
|
|
\ instead $menuset_name{N} has been defined wherein we would then
|
|
\ use the value thereof as the prefix to every menu variable.
|
|
\
|
|
|
|
false menuset_use_name ! \ assume name is not set
|
|
|
|
menuset-setnum-namevar
|
|
\
|
|
\ We now have a string that is the assembled variable name to check
|
|
\ for... $menuset_name{N}. Let's check for it.
|
|
\
|
|
2dup ( c-addr1 u1 -- c-addr1 u1 c-addr1 u1 ) \ save a copy
|
|
getenv dup -1 <> if ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 c-addr2 u2 )
|
|
\ The variable is set. Let's clean up the stack leaving only
|
|
\ its value for later use.
|
|
|
|
true menuset_use_name !
|
|
2swap 2drop ( c-addr1 u1 c-addr2 u2 -- c-addr2 u2 )
|
|
\ drop assembled variable name, leave the value
|
|
else ( c-addr1 u1 c-addr1 u1 -- c-addr1 u1 -1 ) \ no such variable
|
|
\ The variable is not set. Let's clean up the stack leaving the
|
|
\ string [portion] representing the original numeric input.
|
|
|
|
drop ( c-addr1 u1 -1 -- c-addr1 u1 ) \ drop -1 result
|
|
12 - swap 12 + swap ( c-addr1 u1 -- c-addr2 u2 )
|
|
\ truncate to original numeric stack-input
|
|
then
|
|
|
|
\
|
|
\ Now, depending on whether $menuset_name{N} has been set, we have
|
|
\ either the value thereof to be used as a prefix to all menu_*
|
|
\ variables or we have a string representing the numeric stack-input
|
|
\ to be used as a "set{N}" infix to the same menu_* variables.
|
|
\
|
|
\ For example, if the stack-input is 1 and menuset_name1 is NOT set
|
|
\ the following variables will be referenced:
|
|
\ ansiset1_caption[x] -> ansi_caption[x]
|
|
\ ansiset1_caption[x][y] -> ansi_caption[x][y]
|
|
\ menuset1_acpi -> menu_acpi
|
|
\ menuset1_caption[x] -> menu_caption[x]
|
|
\ menuset1_caption[x][y] -> menu_caption[x][y]
|
|
\ menuset1_command[x] -> menu_command[x]
|
|
\ menuset1_init -> ``evaluated''
|
|
\ menuset1_init[x] -> menu_init[x]
|
|
\ menuset1_kernel -> menu_kernel
|
|
\ menuset1_keycode[x] -> menu_keycode[x]
|
|
\ menuset1_options -> menu_options
|
|
\ menuset1_optionstext -> menu_optionstext
|
|
\ menuset1_reboot -> menu_reboot
|
|
\ toggledset1_ansi[x] -> toggled_ansi[x]
|
|
\ toggledset1_text[x] -> toggled_text[x]
|
|
\ otherwise, the following variables are referenced (where {name}
|
|
\ represents the value of $menuset_name1 (given 1 as stack-input):
|
|
\ {name}ansi_caption[x] -> ansi_caption[x]
|
|
\ {name}ansi_caption[x][y] -> ansi_caption[x][y]
|
|
\ {name}menu_acpi -> menu_acpi
|
|
\ {name}menu_caption[x] -> menu_caption[x]
|
|
\ {name}menu_caption[x][y] -> menu_caption[x][y]
|
|
\ {name}menu_command[x] -> menu_command[x]
|
|
\ {name}menu_init -> ``evaluated''
|
|
\ {name}menu_init[x] -> menu_init[x]
|
|
\ {name}menu_kernel -> menu_kernel
|
|
\ {name}menu_keycode[x] -> menu_keycode[x]
|
|
\ {name}menu_options -> menu_options
|
|
\ {name}menu_optionstext -> menu_optionstext
|
|
\ {name}menu_reboot -> menu_reboot
|
|
\ {name}toggled_ansi[x] -> toggled_ansi[x]
|
|
\ {name}toggled_text[x] -> toggled_text[x]
|
|
\
|
|
\ Note that menuset{N}_init and {name}menu_init are the initializers
|
|
\ for the entire menu (for wholly dynamic menus) opposed to the per-
|
|
\ menuitem initializers (with [x] afterward). The whole-menu init
|
|
\ routine is evaluated and not passed down to $menu_init (which
|
|
\ would result in double evaluation). By doing this, the initializer
|
|
\ can initialize the menuset before we transfer it to active-duty.
|
|
\
|
|
|
|
\
|
|
\ Copy our affixation (prefix or infix depending on menuset_use_name)
|
|
\ to our buffer so that we can safely use the s-quote (s") buf again.
|
|
\
|
|
menuset_affixbuf 0 2swap ( c-addr2 u2 -- c-addr1 0 c-addr2 u2 )
|
|
begin ( using u2 in c-addr2/u2 pair as countdown to zero )
|
|
over ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c-addr2 )
|
|
c@ ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 c-addr2 u2 c )
|
|
4 pick 4 pick
|
|
( c-addr1 u1 c-addr2 u2 c -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 c c-addr1 u1 )
|
|
+ ( c-addr1 u1 c-addr2 u2 c c-addr1 u1 -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 c c-addr3 )
|
|
c! ( c-addr1 u1 c-addr2 u2 c c-addr3 -- continued below )
|
|
( c-addr1 u1 c-addr2 u2 )
|
|
2swap 1+ 2swap \ increment affixbuf byte position/count
|
|
swap 1+ swap \ increment strbuf pointer (source c-addr2)
|
|
1- \ decrement strbuf byte count (source u2)
|
|
dup 0= \ time to break?
|
|
until
|
|
2drop ( c-addr1 u1 c-addr2 u2 -- c-addr1 u1 ) \ drop strbuf c-addr2/u2
|
|
|
|
\
|
|
\ Create a variable for referencing our affix data (prefix or infix
|
|
\ depending on menuset_use_name as described above). This variable will
|
|
\ be temporary and only used to simplify cmdbuf assembly.
|
|
\
|
|
s" affix" setenv ( c-addr1 u1 -- )
|
|
;
|
|
|
|
: menuset-cleanup ( -- )
|
|
s" type" unsetenv
|
|
s" var" unsetenv
|
|
s" x" unsetenv
|
|
s" y" unsetenv
|
|
s" affix" unsetenv
|
|
;
|
|
|
|
only forth definitions also menusets-infrastructure
|
|
|
|
: menuset-loadsetnum ( N -- )
|
|
|
|
menuset-checksetnum ( n -- )
|
|
|
|
\
|
|
\ From here out, we use temporary environment variables to make
|
|
\ dealing with variable-length strings easier.
|
|
\
|
|
\ menuset_use_name is true or false
|
|
\ $affix should be used appropriately w/respect to menuset_use_name
|
|
\
|
|
|
|
\ ... menu_init ...
|
|
s" set var=init" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
\ If menu_init was set by the above, evaluate it here-and-now
|
|
\ so that the remaining variables are influenced by its actions
|
|
s" menu_init" 2dup getenv dup -1 <> if
|
|
2swap unsetenv \ don't want later menu-create to re-call this
|
|
evaluate
|
|
else
|
|
drop 2drop ( n c-addr u -1 -- n )
|
|
then
|
|
|
|
[char] 1 ( -- x ) \ Loop range ASCII '1' (49) to '8' (56)
|
|
begin
|
|
dup menuset_x tuck c! 1 s" x" setenv \ set loop iterator and $x
|
|
|
|
s" set var=caption" evaluate
|
|
|
|
\ ... menu_caption[x] ...
|
|
menuset-loadmenuxvar
|
|
|
|
\ ... ansi_caption[x] ...
|
|
menuset-loadansixvar
|
|
|
|
[char] 0 ( x -- x y ) \ Inner Loop ASCII '1' (48) to '9' (57)
|
|
begin
|
|
dup menuset_y tuck c! 1 s" y" setenv
|
|
\ set inner loop iterator and $y
|
|
|
|
\ ... menu_caption[x][y] ...
|
|
menuset-loadmenuxyvar
|
|
|
|
\ ... ansi_caption[x][y] ...
|
|
menuset-loadansixyvar
|
|
|
|
1+ dup 57 > ( x y -- y' 0|-1 ) \ increment and test
|
|
until
|
|
drop ( x y -- x )
|
|
|
|
\ ... menu_command[x] ...
|
|
s" set var=command" evaluate
|
|
menuset-loadmenuxvar
|
|
|
|
\ ... menu_init[x] ...
|
|
s" set var=init" evaluate
|
|
menuset-loadmenuxvar
|
|
|
|
\ ... menu_keycode[x] ...
|
|
s" set var=keycode" evaluate
|
|
menuset-loadmenuxvar
|
|
|
|
\ ... toggled_text[x] ...
|
|
s" set var=text" evaluate
|
|
menuset-loadtoggledxvar
|
|
|
|
\ ... toggled_ansi[x] ...
|
|
s" set var=ansi" evaluate
|
|
menuset-loadtoggledxvar
|
|
|
|
1+ dup 56 > ( x -- x' 0|-1 ) \ increment iterator
|
|
\ continue if less than 57
|
|
until
|
|
drop ( x -- ) \ loop iterator
|
|
|
|
\ ... menu_reboot ...
|
|
s" set var=reboot" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
\ ... menu_acpi ...
|
|
s" set var=acpi" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
\ ... menu_kernel ...
|
|
s" set var=kernel" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
\ ... menu_options ...
|
|
s" set var=options" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
\ ... menu_optionstext ...
|
|
s" set var=optionstext" evaluate
|
|
menuset-loadmenuvar
|
|
|
|
menuset-cleanup
|
|
;
|
|
|
|
: menusets-unset ( -- )
|
|
|
|
s" menuset_initial" unsetenv
|
|
|
|
1 begin
|
|
dup menuset-checksetnum ( n n -- n )
|
|
|
|
dup menuset-setnum-namevar ( n n -- n )
|
|
unsetenv
|
|
|
|
\ If the current menuset does not populate the first menuitem,
|
|
\ we stop completely.
|
|
|
|
menuset_use_name @ true = if
|
|
s" set buf=${affix}menu_caption[1]"
|
|
else
|
|
s" set buf=menuset${affix}_caption[1]"
|
|
then
|
|
evaluate s" buf" getenv getenv -1 = if
|
|
drop ( n -- )
|
|
s" buf" unsetenv
|
|
menuset-cleanup
|
|
exit
|
|
else
|
|
drop ( n c-addr2 -- n ) \ unused
|
|
then
|
|
|
|
[char] 1 ( n -- n x ) \ Loop range ASCII '1' (49) to '8' (56)
|
|
begin
|
|
dup menuset_x tuck c! 1 s" x" setenv \ set $x to x
|
|
|
|
s" set var=caption" evaluate
|
|
menuset-unloadmenuxvar
|
|
menuset-unloadmenuxvar
|
|
menuset-unloadansixvar
|
|
[char] 0 ( n x -- n x y ) \ Inner loop '0' to '9'
|
|
begin
|
|
dup menuset_y tuck c! 1 s" y" setenv
|
|
\ sets $y to y
|
|
menuset-unloadmenuxyvar
|
|
menuset-unloadansixyvar
|
|
1+ dup 57 > ( n x y -- n x y' 0|-1 )
|
|
until
|
|
drop ( n x y -- n x )
|
|
s" set var=command" evaluate menuset-unloadmenuxvar
|
|
s" set var=init" evaluate menuset-unloadmenuxvar
|
|
s" set var=keycode" evaluate menuset-unloadmenuxvar
|
|
s" set var=text" evaluate menuset-unloadtoggledxvar
|
|
s" set var=ansi" evaluate menuset-unloadtoggledxvar
|
|
|
|
1+ dup 56 > ( x -- x' 0|-1 ) \ increment and test
|
|
until
|
|
drop ( n x -- n ) \ loop iterator
|
|
|
|
s" set var=acpi" evaluate menuset-unloadmenuvar
|
|
s" set var=init" evaluate menuset-unloadmenuvar
|
|
s" set var=kernel" evaluate menuset-unloadmenuvar
|
|
s" set var=options" evaluate menuset-unloadmenuvar
|
|
s" set var=optionstext" evaluate menuset-unloadmenuvar
|
|
s" set var=reboot" evaluate menuset-unloadmenuvar
|
|
|
|
1+ dup 65535 > ( n -- n' 0|-1 ) \ increment and test
|
|
until
|
|
drop ( n' -- ) \ loop iterator
|
|
|
|
s" buf" unsetenv
|
|
menuset-cleanup
|
|
;
|
|
|
|
only forth definitions
|
|
|
|
: menuset-loadinitial ( -- )
|
|
s" menuset_initial" getenv dup -1 <> if
|
|
?number 0<> if
|
|
menuset-loadsetnum
|
|
then
|
|
else
|
|
drop \ cruft
|
|
then
|
|
;
|