the 3.3~rc1-2 / usr / share / THE / config.the

/*
 * THE GUI configuration utility
 *
 * This macro requires version 1.2 of Rexx/Tk to function properly.
 *
 * This macro is incomplete - not all settings have been impelemented and it is a bit
 * slow to load.  Might need to load each tab as it is activated.
 */
If RxFuncQuery( 'TkLoadFuncs' ) = 1 Then
   Do
      Call RxFuncAdd 'TkLoadFuncs','rexxtk','TkLoadFuncs'
      If TkLoadFuncs() \= 0 Then Return 1
   End
Signal on Syntax
/*
 * Descriptions of color areas
 */
color_desc.1 = 'File Area'
color_desc.2 = 'Current Line'
color_desc.3 = 'Marked Block'
color_desc.4 = 'Current Line Block'
color_desc.5 = 'Command Line'
color_desc.6 = 'ID Line'
color_desc.7 = 'Message Lines'
color_desc.8 = 'Arrow'
color_desc.9 = 'Prefix Area'
color_desc.10 = 'Current Prefix Area'
color_desc.11 = 'Pending Prefix'
color_desc.12 = 'Scale Line'
color_desc.13 = 'TOF/EOF Lines'
color_desc.14 = 'Current TOF/EOF Lines'
color_desc.15 = 'Tab Line'
color_desc.16 = 'Shadow Lines'
color_desc.17 = 'Status Line'
color_desc.18 = 'Divider'
color_desc.19 = 'Reserved Lines'
color_desc.20 = 'Non-display Chars'
color_desc.21 = 'Highlight'
color_desc.22 = 'Current Highlight'
color_desc.23 = 'Text Highlight'
color_desc.24 = 'Soft Label Keys'
color_desc.25 = 'Prefix Gap'
color_desc.26 = 'Current Prefix Gap'
color_desc.27 = 'Alert Box'
color_desc.28 = 'Dialog Box'
color_desc.29 = 'Boundmarkers'
/*
 * Descriptions of syntax colors
 */
ecolor_desc.1 = 'A Comments'
ecolor_desc.2 = 'B Strings'
ecolor_desc.3 = 'C Numbers'
ecolor_desc.4 = 'D Keywords'
ecolor_desc.5 = 'E Labels'
ecolor_desc.6 = 'F Preprocessor'
ecolor_desc.7 = 'G Header Lines'
ecolor_desc.8 = 'H N/A'
ecolor_desc.9 = 'I Level 1 Paren'
ecolor_desc.10 = 'J N/A'
ecolor_desc.11 = 'K N/A'
ecolor_desc.12 = 'L N/A'
ecolor_desc.13 = 'M N/A'
ecolor_desc.14 = 'N N/A'
ecolor_desc.15 = 'O N/A'
ecolor_desc.16 = 'P N/A'
ecolor_desc.17 = 'Q N/A'
ecolor_desc.18 = 'R N/A'
ecolor_desc.19 = 'S Incomplete String'
ecolor_desc.20 = 'T HTML Tags'
ecolor_desc.21 = 'U HTML References'
ecolor_desc.22 = 'V Builtin Functions'
ecolor_desc.23 = 'W N/A'
ecolor_desc.24 = 'X N/A'
ecolor_desc.25 = 'Y N/A'
ecolor_desc.26 = 'Z N/A'
ecolor_desc.27 = '1 Alt Keyword 1'
ecolor_desc.28 = '2 Alt Keyword 2'
ecolor_desc.29 = '3 Alt Keyword 3'
ecolor_desc.30 = '4 Alt Keyword 4'
ecolor_desc.31 = '5 Alt Keyword 5'
ecolor_desc.32 = '6 Alt Keyword 6'
ecolor_desc.33 = '7 Alt Keyword 7'
ecolor_desc.34 = '8 Alt Keyword 8'
ecolor_desc.35 = '9 Alt Keyword 9'

colors = 'black blue green cyan red magenta brown grey'
colors_normal = 'Black  blue3 green3 cyan3 red3 magenta3 yellow3 grey'
colors_bold   = 'grey40 blue1 green1 cyan1 red1 magenta1 yellow1 White'

value_font = 'Helvetica 10'

index_inverses = '8 7 6 5 4 3 2 1'

dummy_tab = 4
layout_tab = 1
color_tab = 2
ecolor_tab = 3
tab_names = 'Layout Color EColor test'

layout_commands.dummy_tab = 'alt arbchar autosave autoscroll'
layout_commands.layout_tab = 'cmdline compat curline hexdisplay hexshow idline msgline number prefix scale screen statusline tabline tofeof'

Call TkWm 'geometry', '.', '600x550'
Call TkWm 'title', '.', 'THE Configurator'
f = TkFrame( '.f', )
Call TkPack f, '-side', 'top', '-fill', 'both', '-expand', 1
nb = TkNotebook( f'.nb', '-borderwidth', 2, '-tabs', tab_names, '-rexx', 'RaiseTab')
Call TkPack nb, '-side', 'top', '-fill', 'both', '-expand', 1

Call CreateDummyPage dummy_tab
Call CreateLayoutPage layout_tab
Call CreateColorPage 'color' color_tab
Call CreateColorPage 'ecolor' ecolor_tab

Call TkNotebookRaise nb, 1

Do Forever
   Interpret 'Call' TkWait()
End

Return 0

set_commands = 'alt arbchar autocolor autosave autoscroll backup beep boundmark case clearerrorkey clearscreen clock cmdarrows coloring ctlchar cursorstay defsort dirinclude display eolout equivchar etmode fext filename fname fpath ftype fullfname header hex highlight impmacro impos inputmode insertmode interface lineflag linend macro macroext macropath margins mouse msgmode newlines nondisp parser pending point position printer pscreen readonly reprofile rexxoutput scope select shadow slk statopt stay synonym tabkey tabs tabsin tabsout timecheck tofeof typeahead undoing untaa verify width word wordwrap wrap zone'
/*              f   v       g         f        v          f      g    v?        v    g             g           g     g         f        g       g          g       g          v       g      g         g      f    f        f     f     f     f         v      g   v         v        v     v         g          g?        f        v      v     g        g         v       g     v       v        g       g      v?      v?    g        g       g?      g        g         g          v     v?     v      g?  g?      v    v       g      g    g      g       f         v      */
/*

*/
CreateDummyPage:
Parse Arg tabno

combobox_size = 13
state. = 'normal'
state.on  = 'normal'
state.off = 'disabled'
state.nulls = 'normal'
scale_size = 80
scale_middle_size = 40

tf3 = TkNotebookFrame( nb, tabno )

bf3 = TkFrame( tf3'.bf3'ctype, '-relief', 'raised', '-borderwidth', 3 )
b1 = TkButton(bf3'.b1', '-text', 'Quit', '-rexx', 'Ended')
b2 = TkButton(bf3'.b2', '-text', 'Test Selected', '-rexx', 'TestSet' tabno )
b3 = TkButton(bf3'.b3', '-text', 'Reset Selected', '-rexx', 'ResetSet' tabno )
Call TkPack b1, b2, b3, '-side', 'left', '-padx', 20, '-pady', 5
Call TkPack bf3, '-side', 'bottom', '-padx', 5, '-pady', 5

f3 = TkFrame( tf3'.layout', '-relief', 'raised', '-borderwidth', 3 )
Call TkPack f3,  '-side', 'top', '-padx', 5, '-pady', 5

max_width = 0
Do i = 1 To Words( layout_commands.tabno )
   wl =  Length( Word( layout_commands.tabno, i ) )
   If wl > max_width Then max_width = wl
End
/*
 * Extract anything here that is needed for resolution
 */
'extract /lscreen/'Translate( layout_commands.tabno, '/', ' ' )
/*
 * SET ALT - file
 */
$alt. = ''
$alt.$frame = f3
$alt.$state = alt.1
$alt.$layout.0 = 2
$alt.$layout.1 = 'scale'
$alt.$layout.2 = 'scale'
$alt.$scale.$default.1 = alt.1
$alt.$scale.$from_limit.1 = 0
$alt.$scale.$to_limit.1 = 99
$alt.$scale.$default.2 = alt.2
$alt.$scale.$from_limit.2 = 0
$alt.$scale.$to_limit.2 = 99
/*
 * SET ARBCHAR - view
 */
$arbchar. = ''
$arbchar.$frame = f3
$arbchar.$state = arbchar.1
$arbchar.$layout.0 = 3
$arbchar.$layout.1 = 'combo'
$arbchar.$layout.2 = 'entry'
$arbchar.$layout.3 = 'entry'
$arbchar.$combo.$values.1 = 'ON OFF'
$arbchar.$combo.$default.1 = arbchar.1
$arbchar.$entry.$limit.2 = 1
$arbchar.$entry.$default.2 = arbchar.2
$arbchar.$entry.$limit.3 = 1
$arbchar.$entry.$default.3 = arbchar.3
$arbchar.$control_item = 1
$arbchar.$controlled_items = '2 3'
/*
 * SET AUTOCOLOR - global ( inappropriate )
 */
/*
 * SET AUTOSAVE - file
 */
$autosave. = ''
$autosave.$frame = f3
$autosave.$state = autosave.1
$autosave.$layout.0 = 1
$autosave.$layout.1 = 'combo'
$autosave.$combo.$values.1 = 'OFF'
$autosave.$combo.$editable.1 = 1
$autosave.$combo.$default.1 = autosave.1
/*
 * SET AUTOSCROLL - view
 */
$autoscroll. = ''
$autoscroll.$frame = f3
$autoscroll.$state = autoscroll.1
$autoscroll.$layout.0 = 1
$autoscroll.$layout.1 = 'combo'
$autoscroll.$combo.$values.1 = 'HALF OFF'
$autoscroll.$combo.$editable.1 = 1
$autoscroll.$combo.$default.1 = autoscroll.1

layout_row = 0
Do i = 1 To Words( layout_commands.tabno )
   layout_row = layout_row + 1
   Call CreateLine tabno f3 Word( layout_commands.tabno, i )
End
/*
 * Add the Select/Deselect button
 */
Call CreateSelectButton tabno frame
Return

CreateLayoutPage:
Parse Arg tabno

combobox_size = 13
state. = 'normal'
state.on  = 'normal'
state.off = 'disabled'
state.nulls = 'normal'
scale_size = 80
scale_middle_size = 40

tf3 = TkNotebookFrame( nb, tabno )

bf3 = TkFrame( tf3'.bf3'ctype, '-relief', 'raised', '-borderwidth', 3 )
b1 = TkButton(bf3'.b1', '-text', 'Quit', '-rexx', 'Ended')
b2 = TkButton(bf3'.b2', '-text', 'Test Selected', '-rexx', 'TestSet' tabno )
b3 = TkButton(bf3'.b3', '-text', 'Reset Selected', '-rexx', 'ResetSet' tabno )
Call TkPack b1, b2, b3, '-side', 'left', '-padx', 20, '-pady', 5
Call TkPack bf3, '-side', 'bottom', '-padx', 5, '-pady', 5

f3 = TkFrame( tf3'.layout', '-relief', 'raised', '-borderwidth', 3 )
Call TkPack f3,  '-side', 'top', '-padx', 5, '-pady', 5

max_width = 0
Do i = 1 To Words( layout_commands.tabno )
   wl =  Length( Word( layout_commands.tabno, i ) )
   If wl > max_width Then max_width = wl
End
/*
 * Extract anything here that is needed for resolution
 */
'extract /lscreen/'Translate( layout_commands.tabno, '/', ' ' )
/*
 * SET COMPAT
 */
$compat. = ''
$compat.$frame = f3
$compat.$layout.0 = 3
$compat.$layout.1 = 'combo'
$compat.$layout.2 = 'combo'
$compat.$layout.3 = 'combo'
$compat.$combo.$values.1 = 'THE XEDIT KEDIT KEDITW ISPF'
$compat.$combo.$values.2 = 'THE XEDIT KEDIT KEDITW ISPF'
$compat.$combo.$values.3 = 'THE XEDIT KEDIT KEDITW ISPF'
$compat.$combo.$default.1 = compat.1
$compat.$combo.$default.2 = compat.2
$compat.$combo.$default.3 = compat.3
/*
 * SET CMDLINE
 */
$cmdline. = ''
$cmdline.$frame = f3
$cmdline.$layout.0 = 1
$cmdline.$layout.1 = 'combo'
$cmdline.$combo.$values.1 = 'ON OFF TOP BOTTOM'
$cmdline.$combo.$default.1 = cmdline.1
/*
 * SET CURLINE
 */
$curline. = ''
$curline.$frame = f3
$curline.$layout.0 = 1
$curline.$layout.1 = 'middle'
$curline.$middle.$default.1 = curline.1
$curline.$middle.$from_limit.1 = -lscreen.1
$curline.$middle.$to_limit.1 = lscreen.1
/*
 * SET HEXDISPLAY
 */
$hexdisplay. = ''
$hexdisplay.$frame = f3
$hexdisplay.$layout.0 = 1
$hexdisplay.$layout.1 = 'combo'
$hexdisplay.$combo.$values.1 = 'ON OFF'
$hexdisplay.$combo.$default.1 = hexdisplay.1
/*
 * SET HEXSHOW
 */
$hexshow. = ''
$hexshow.$frame = f3
$hexshow.$state = 'hexshow.1'
$hexshow.$layout.0 = 2
$hexshow.$layout.1 = 'combo'
$hexshow.$layout.2 = 'middle'
$hexshow.$combo.$values.1 = 'ON OFF'
$hexshow.$combo.$default.1 = hexshow.1
$hexshow.$middle.$default.2 = hexshow.2
$hexshow.$middle.$from_limit.2 = lscreen.1 * -1
$hexshow.$middle.$to_limit.2 = lscreen.1
$hexshow.$control_item = 1
$hexshow.$controlled_items = 2
/*
 * SET IDLINE
 */
$idline.$frame = f3
$idline.$layout.0 = 1
$idline.$layout.1 = 'combo'
$idline.$combo.$values.1 = 'ON OFF'
$idline.$combo.$default.1 = idline.1
/*
 * SET MSGLINE
 */
$msgline. = ''
$msgline.$frame = f3
$msgline.$state = msgline.1
$msgline.$layout.0 = 4
$msgline.$layout.1 = 'combo'
$msgline.$layout.2 = 'middle'
$msgline.$layout.3 = 'scale'
$msgline.$layout.4 = 'combo'
$msgline.$combo.$values.1 = 'ON OFF'
$msgline.$combo.$default.1 = msgline.1
$msgline.$middle.$default.2 = msgline.2
$msgline.$middle.$from_limit.2 = lscreen.1 * -1
$msgline.$middle.$to_limit.2 = lscreen.1
$msgline.$scale.$default.3 = msgline.3
$msgline.$scale.$from_limit.3 = 1
$msgline.$scale.$to_limit.3 = lscreen.1
$msgline.$combo.$values.4 = 'OVERLAY'
$msgline.$combo.$default.4 = msgline.4
$msgline.$control_item = 1
$msgline.$controlled_items = '2 3 4'
/*
 * SET NUMBER
 */
$number. = ''
$number.$frame = f3
$number.$layout.0 = 1
$number.$layout.1 = 'combo'
$number.$combo.$values.1 = 'ON OFF'
$number.$combo.$default.1 = number.1
/*
 * SET PREFIX
 */
$prefix. = ''
$prefix.$frame = f3
$prefix.$state = prefix.1
$prefix.$layout.0 = 4
$prefix.$layout.1 = 'combo'
$prefix.$layout.2 = 'combo'
$prefix.$layout.3 = 'scale'
$prefix.$layout.4 = 'scale'
$prefix.$combo.$values.1 = 'ON OFF'
$prefix.$combo.$default.1 = prefix.1
$prefix.$combo.$values.2 = 'LEFT RIGHT'
$prefix.$combo.$default.2 = prefix.2
$prefix.$scale.$default.3 = prefix.3
$prefix.$scale.$from_limit.3 = 2
$prefix.$scale.$to_limit.3 = 20
$prefix.$scale.$default.4 = prefix.4
$prefix.$scale.$from_limit.4 = 0
$prefix.$scale.$to_limit.4 = 19
$prefix.$control_item = 1
$prefix.$controlled_items = '2 3 4'
/*
 * SET SCALE
 */
$scale. = ''
$scale.$frame = f3
$scale.$state = scale.1
$scale.$layout.0 = 2
$scale.$layout.1 = 'combo'
$scale.$layout.2 = 'middle'
$scale.$combo.$values.1 = 'ON OFF'
$scale.$combo.$default.1 = scale.1
$scale.$middle.$default.2 = scale.2
$scale.$middle.$from_limit.2 = lscreen.1 * -1
$scale.$middle.$to_limit.2 = lscreen.1
$scale.$control_item = 1
$scale.$controlled_items = 2
/*
 * SET SCREEN
 */
$screen. = ''
$screen.$frame = f3
$screen.$state = screen.1
$screen.$layout.0 = 2
$screen.$layout.1 = 'scale'
$screen.$layout.2 = 'combo'
$screen.$scale.$default.1 = screen.1
$screen.$scale.$from_limit.1 = 1
$screen.$scale.$to_limit.1 = 2
$screen.$combo.$values.2 = 'HORIZONTAL VERTICAL'
$screen.$combo.$default.2 = screen.2
/*
 * SET STATUSLINE
 */
$statusline. = ''
$statusline.$frame = f3
$statusline.$layout.0 = 1
$statusline.$layout.1 = 'combo'
$statusline.$combo.$values.1 = 'TOP BOTTOM OFF'
$statusline.$combo.$default.1 = statusline.1
/*
 * SET TABLINE
 */
$tabline. = ''                   
$tabline.$frame = f3
$tabline.$state = tabline.1
$tabline.$layout.0 = 2
$tabline.$layout.1 = 'combo'
$tabline.$layout.2 = 'middle'
$tabline.$combo.$values.1 = 'ON OFF'
$tabline.$combo.$default.1 = tabline.1
$tabline.$middle.$default.2 = tabline.2
$tabline.$middle.$from_limit.2 = lscreen.1 * -1
$tabline.$middle.$to_limit.2 = lscreen.1
$tabline.$control_item = 1
$tabline.$controlled_items = 2
/*
 * SET TOFEOF
 */
$tofeof. = ''
$tofeof.$frame = f3
$tofeof.$layout.0 = 1
$tofeof.$layout.1 = 'combo'
$tofeof.$combo.$values.1 = 'ON OFF'
$tofeof.$combo.$default.1 = tofeof.1

layout_row = 0
Do i = 1 To Words( layout_commands.tabno )
   layout_row = layout_row + 1
   Call CreateLine tabno f3 Word( layout_commands.tabno, i )
End
/*
 * Add the Select/Deselect button
 */
Call CreateSelectButton tabno frame

Return

CreateLine:
Parse Arg tabno frame cmd
this_checkbutton_variable = cmd'_checkbutton_variable'
Call TkVar this_checkbutton_variable, 0
this_checkbutton = TkCheckButton( frame'.'cmd'_checkbutton', '-text', '', '-variable', this_checkbutton_variable, '-relief', 'flat', '-takefocus', 0, '-font', value_font  )
Call TkGrid this_checkbutton, '-in', frame, '-row', layout_row, '-column', 0
this_label = TkLabel( frame'.'cmd'_label', '-text', cmd, '-width', max_width )
Call TkGrid this_label, '-in', frame, '-row', layout_row, '-column', 1, '-sticky', 'ew'
num_widgets = Value( '$'cmd'.$layout.0' )
Do cwi = 1 To num_widgets
   wt = Value( '$'cmd'.$layout.cwi' )
   Select
      When wt = 'combo' Then Call CreateCombo frame cmd cwi
      When wt = 'middle' Then Call CreateMiddle frame cmd cwi
      When wt = 'scale' Then Call CreateScale frame cmd cwi
      When wt = 'entry' Then Call CreateEntry frame cmd cwi
      Otherwise Nop
   End
End
/*
 * Now configure the control widget to update the status for each controlled
 * widget.
 */
Call CreateControl cmd
Return

CreateControl:
Parse Arg cmd
If Datatype( Value( '$'cmd'.$control_item' ) ) = 'NUM' Then
   Do
      this_controlled_items = Value( '$'cmd'.$controlled_items' )
      this_control_item = Value( '$'cmd'.$control_item' )
      this_control_widget = Value( '$'cmd'.$widget.'this_control_item )
      this_controlled_widgets = ''
      Do cwi = 1 To Words( this_controlled_items )
         this_controlled_item = Word( this_controlled_items, cwi )
         this_controlled_widgets = this_controlled_widgets Value( '$'cmd'.$widget.'this_controlled_item )
      End
      Call TkConfig this_control_widget, '-rexx', 'LayoutConfig' this_control_widget this_controlled_widgets
   End
Return

/*
 * Creates a combobox widget
 */
CreateCombo:
Parse Arg frame cmd item
this_values = Value( '$'cmd'.$combo.$values.'item )
/*
 * Determine initial state of widget.  If we are the controlling widget
 * leave our state 'normal'
 */
If Value( '$'cmd'.$control_item' ) \= item Then this_state = Value( Value( '$'cmd'.$state' ) )
Else this_state = ''
this_state = state.this_state
/*
 * Determine if we want to be able to edit the contents of the combobox
 */
If Value( '$'cmd'.$combo.$editable.'item ) = 1 Then this_editable = 'true'
Else this_editable = 'false'
/*
 * Get the default value of the combobox
 */
this_default_val = Value( '$'cmd'.$combo.$default.'item )
this_combobox_variable = cmd'_combo_variable'item
Call TkSet this_combobox_variable, this_default_val
this_combobox = TkCombobox( frame'.'cmd'_cb'item, '-editable', this_editable, '-width', combobox_size, '-textvariable', this_combobox_variable, '-value', this_default_val, '-font', value_font, '-state', this_state )
Do cci = 1 To Words( this_values )
   Call TkComboboxListInsert this_combobox, 'end', Word( this_values, cci )
End
Call TkGrid this_combobox, '-in', frame, '-row', layout_row, '-column', item+1, '-sticky', 'ew'
Interpret '$'cmd'.$widget.'item "= this_combobox"
Interpret '$'cmd'.$variables.'item "= this_combobox_variable"
Return

/*
 * Creates a widget containing a "middle" checkbutton, a scale and
 * a label that changes value with the scale
 */
CreateMiddle:
Parse Arg frame cmd item
this_frame = TkFrame( frame'.'cmd'_frame'item, '-borderwidth', 0 )
this_checkbutton_variable = cmd'_checkbutton_variable'item
this_scale_variable = cmd'_scale_variable'item
/*
 * Determine initial state of widget.  If we are the controlling widget
 * leave our state 'normal'
 */
If Value( '$'cmd'.$control_item' ) \= item Then this_state = Value( Value( '$'cmd'.$state' ) )
Else this_state = ''
this_state = state.this_state
this_value = Value( '$'cmd'.$middle.$default.'item )
val = GetRowValue( this_checkbutton_variable this_value )
Call TkVar this_scale_variable, val
this_checkbutton = TkCheckButton( this_frame'.'cmd'_checkbutton'item, '-text', 'Middle', '-variable', this_checkbutton_variable, '-relief', 'flat', '-takefocus', 0, '-state', this_state, '-font', value_font  )
/*
 * Create the label that represents the value of the scale
 */
this_label_variable = cmd'_label_variable'item
Call TkVar this_label_variable, val
this_label = TkLabel( this_frame'.'cmd'_label'item, '-width', 3, '-textvariable', this_label_variable, '-font', value_font, '-state', this_state )
/*
 * Determine scale limits
 */
this_from_limit = Value( '$'cmd'.$middle.$from_limit.'item )
this_to_limit = Value( '$'cmd'.$middle.$to_limit.'item )
/*
 * Create the Scale widget
 */
this_scale = TkScale( this_frame'.'cmd'_scale'item, '-from', this_from_limit, '-to', this_to_limit, '-orient', 'horiz', '-tickinterval', 0, '-length', scale_middle_size, '-label', '', '-sliderlength', 10, '-variable', this_scale_variable, '-state', this_state, '-showvalue', 0, '-command', 'set' this_label_variable  )
Call TkPack this_scale, '-side', 'right', '-anchor', 'e', '-fill', 'x'
Call TkPack this_checkbutton, this_label, '-side', 'left', '-anchor', 'w'
Call TkGrid this_frame, '-in', frame, '-row', layout_row, '-column', item+1, '-sticky', 'ew'
Interpret '$'cmd'.$widget.'item "= this_checkbutton this_label this_scale"
Interpret '$'cmd'.$variables.'item "= this_checkbutton_variable this_label_variable this_scale_variable"
Return

/*
 * Creates a scale widget with a label that changes with the value
 * of the scale
 */
CreateScale:
Parse Arg frame cmd item
this_frame = TkFrame( frame'.'cmd'_frame'item, '-borderwidth', 0 )
this_scale_variable = cmd'_scale_variable'item
/*
 * Determine initial state of widget.  If we are the controlling widget
 * leave our state 'normal'
 */
If Value( '$'cmd'.$control_item' ) \= item Then this_state = Value( Value( '$'cmd'.$state' ) )
Else this_state = ''
this_state = state.this_state
/*
 * Create the label that represents the value of the scale
 */
val = Value( '$'cmd'.$scale.$default.'item )
this_label_variable = cmd'_label_variable'item
Call TkVar this_label_variable, val
this_label = TkLabel( this_frame'.'cmd'_label'item, '-width', 3, '-textvariable', this_label_variable, '-font', value_font, '-state', this_state )
/*
 * Determine scale limits
 */
this_from_limit = Value( '$'cmd'.$scale.$from_limit.'item )
this_to_limit = Value( '$'cmd'.$scale.$to_limit.'item )

Call TkVar this_scale_variable, val
this_scale = TkScale( this_frame'.'cmd'_scale'item, '-from', this_from_limit, '-to', this_to_limit, '-orient', 'horiz', '-tickinterval', 0, '-length', scale_size, '-label', '', '-sliderlength', 10, '-variable', this_scale_variable, '-state', this_state, '-showvalue', 0, '-command', 'set' this_label_variable  )
Call TkPack this_scale, '-side', 'right', '-anchor', 'e', '-fill', 'x'
Call TkPack this_label, '-side', 'left', '-anchor', 'w'
Call TkGrid this_frame, '-in', frame, '-row', layout_row, '-column', item+1, '-sticky', 'ew'
Interpret '$'cmd'.$widget.'item "= this_label this_scale"
Interpret '$'cmd'.$variables.'item "= this_label_variable this_scale_variable"
Return

/*
 * Creates an entry widget
 */
CreateEntry:
Parse Arg frame cmd item
/*
 * Determine initial state of widget.  If we are the controlling widget
 * leave our state 'normal'
 */
If Value( '$'cmd'.$control_item' ) \= item Then this_state = Value( Value( '$'cmd'.$state' ) )
Else this_state = ''
this_state = state.this_state
this_limit = Value( '$'cmd'.$entry.$limit.'item )
this_default_val = Value( '$'cmd'.$entry.$default.'item )
this_entry_variable = cmd'_combo_entry'item
Call TkSet this_entry_variable, this_default_val
this_entry = TkEntry( frame'.'cmd'_ent'item, '-width', this_limit, '-textvariable', this_entry_variable, '-font', value_font )
Call TkInsert this_entry, 'end', this_default_val
Call TkConfig this_entry, '-state', this_state
Call TkGrid this_entry, '-in', frame, '-row', layout_row, '-column', item+1
Interpret '$'cmd'.$widget.'item "= this_entry"
Interpret '$'cmd'.$variables.'item "= this_entry_variable"
Return

LayoutConfig:
Parse Arg base_widget dependent_widgets
status = TkGet( base_widget )
Do i = 1 To Words( dependent_widgets ) - 2
   Call TkConfig Word( dependent_widgets, i ), '-state', state.status
End
Return

TestSet:
Parse Arg tabno
Do i = 1 To Words( layout_commands.tabno )
   cmd = Word( layout_commands.tabno, i )
   If TkVar( cmd'_checkbutton_variable' ) Then
      Do
         num_widgets = Value( '$'cmd'.$layout.0' )
         setcmd = 'set' cmd
         Do tli = 1 To num_widgets
            wt = Value( '$'cmd'.$layout.tli' )
            Select
               When wt = 'combo' Then setcmd = setcmd TkVar( Value( '$'cmd'.$variables.'tli ) )
               When wt = 'middle' Then setcmd = setcmd SetRowValue( Value( '$'cmd'.$variables.'tli ) )
               When wt = 'scale' Then setcmd = setcmd TkVar( Word( Value( '$'cmd'.$variables.'tli ), 2 ) )
               Otherwise Nop
            End
         End
         setcmd
         'refresh'
      End
End
Return

ResetSet:
Parse Arg tabno
Do i = 1 To Words( layout_commands.tabno )
   cmd = Word( layout_commands.tabno, i )
   If TkVar( cmd'_checkbutton_variable' ) Then
      Do
         num_widgets = Value( '$'cmd'.$layout.0' )
         setcmd = 'set' cmd
         Do tli = 1 To num_widgets
            wt = Value( '$'cmd'.$layout.tli' )
            Select
               When wt = 'combo' Then 
                  Do
                     Call TkVar Value( '$'cmd'.$variables.'tli ), Value( '$'cmd'.$combo.$default.'tli )
                  End
               When wt = 'middle' Then 
                  Do
                     vars = Value( '$'cmd'.$variables.'tli )
                     val = GetRowValue( Word( vars, 1 ) Value( '$'cmd'.$middle.$default.'tli ) )
                     Call TkVar Word( vars, 2 ), val
                     Call TkVar Word( vars, 3 ), val
                  End
               When wt = 'scale' Then 
                  Do
                     vars = Value( '$'cmd'.$variables.'tli )
                     val = Value( '$'cmd'.$scale.$default.'tli )
                     Call TkVar Word( vars, 1 ), val
                     Call TkVar Word( vars, 2 ), val
                  End
               Otherwise Nop
            End
         End
/*       Call TestSet tabno */
         Call CreateControl cmd
      End
End
Return

CreateSelectButton:
Parse Arg tabno frame
select_button.tabno = TkButton(frame'.select_button'tabno, '-text', 'Select All', '-rexx', 'SwitchSelect' tabno )
select_button_variable.tabno = 'select_button_variable'tabno
Call TkVar select_button_variable.tabno, 1
layout_row = layout_row + 1
Call TkGrid select_button.tabno, '-in', frame, '-row', layout_row, '-column', 0, '-columnspan', 2, '-sticky', 'ew'
Return

SwitchSelect:
Parse Arg tabno
this_status = TkVar( select_button_variable.tabno )
Do i = 1 To Words( layout_commands.tabno )
   cmd = Word( layout_commands.tabno, i )
   If this_status Then
      Do
         Call TkVar cmd'_checkbutton_variable', 1
      End
   Else
      Do
         Call TkVar cmd'_checkbutton_variable', 0
      End
End
If this_status Then
   Do
      Call TkConfig select_button.tabno, '-text', 'Deselect All'
      Call TkVar select_button_variable.tabno, 0
   End
Else
   Do
      Call TkConfig select_button.tabno, '-text', 'Select All'
      Call TkVar select_button_variable.tabno, 1
   End
Return

GetRowValue: Procedure
Parse Arg var input
If Left( input, 1 ) = 'M' Then
   Do
      If Substr( input, 2, 1 ) = '+' Then val = Substr( input, 3 )
      Else val = Substr( input, 2 )
      If val = '' Then val = 0
      Call TkVar var, 1
   End
Else 
   Do
      val = input
      Call TkVar var, 0
   End
Return val

SetRowValue: Procedure
Parse Arg var1 var2 .
middle = TkVar( var1 )
val = TkVar( var2 )
Select
   When middle & val = 0 Then retval = 'M'
   When middle & val > 0 Then retval = 'M+'val
   When middle & val < 0 Then retval = 'M'val
   Otherwise retval = val
End
Return retval

/*
 * Creates and manipluates color and ecolor pages
 */
CreateColorPage:
Parse Arg ctype tabno

tf3 = TkNotebookFrame( nb, tabno )

bf3 = TkFrame( tf3'.bf3'ctype, '-relief', 'raised', '-borderwidth', 3 )
b1 = TkButton(bf3'.b1', '-text', 'Quit', '-rexx', 'Ended')
b2 = TkButton(bf3'.b2', '-text', 'Test', '-rexx', 'TestColor' ctype )
b3 = TkButton(bf3'.b3', '-text', 'Reset', '-rexx', 'ResetColor' ctype )
Call TkPack b1, b2, b3, '-side', 'left', '-padx', 20, '-pady', 5
Call TkPack bf3, '-side', 'bottom', '-padx', 5, '-pady', 5

f3 = TkFrame( tf3'.f3'ctype, '-relief', 'raised', '-borderwidth', 3 )
Call TkPack f3,  '-side', 'top', '-padx', 5, '-pady', 5

areaf = TkFrame( f3'.areaf', '-borderwidth', 3  )
'extract /'ctype'/'
If ctype = 'color' Then num_colors = color.0
Else num_colors = ecolor.0
max_width = 0
Do i = 1 To num_colors
   If ctype = 'color' Then desc = color_desc.i
   Else desc = ecolor_desc.i
   wl =  Length( desc )
   If wl > max_width Then max_width = wl
End
max_width = max_width + 0
Do i = 1 To num_colors
   col = 2* ((i-1) // 2 )
   row = (i-1) % 2
   If ctype = 'color' Then 
      Do
         color = color.i
         desc = color_desc.i
      End
   Else 
      Do
         color = ecolor.i
         desc = ecolor_desc.i
      End
   arearb.i = TkRadioButton( areaf'.rb'i, '-value', i, '-rexx', 'Area' i, '-variable', 'arearb_'ctype )
   Call TkGrid arearb.i, '-in', areaf, '-row', row, '-column', 0+col, '-pad', 0
/* areala.ctype.i = TkLabel(areaf'.la'ctype||i, '-text', desc, '-width', max_width ) */
   areala.ctype.i = TkText( areaf'.la'ctype||i, '-width', max_width, '-height', 1, '-exportselection', 0 )
   Call TkInsert areala.ctype.i, 'end', desc
   Call TkConfig areala.ctype.i, '-state', 'disabled'
   Call TkGrid areala.ctype.i, '-in', areaf, '-row', row, '-column', 1+col, '-pad', 0
   Call SetColor i color
   Call DrawLabel i ctype
End

allf = TkFrame( f3'.allf', '-relief', 'sunken', '-borderwidth', 3 )
Call TkPack areaf, allf, '-side', 'left', '-padx', 5, '-pady', 5

attrf = TkFrame( allf'.attrf', )
attrs = 'bold reverse italic blink underline'
Do i = 1 To Words( attrs )
   la = TkLabel(attrf'.la'i, '-text', Word( attrs, i ) )
   Call TkGrid la, '-in', attrf, '-row', i, '-column', 0
   chb.i = TkCheckButton(attrf'.chb'i, '-rexx', 'Attr' i, '-variable', 'attr'||Word( attrs, i ) )
   Call TkGrid chb.i, '-in', attrf, '-row', i, '-column', 1
End

foref = TkFrame( allf'.foref', )
backf = TkFrame( allf'.backf', )
forelab = TkLabel( foref'.lab', '-font', 'Helvetica 10', '-text', 'Fore')
Call TkGrid forelab, '-in', foref, '-row', 0, '-column', 0
backlab = TkLabel( backf'.lab', '-font', 'Helvetica 10', '-text', 'Back')
Call TkGrid backlab, '-in', backf, '-row', 0, '-column', 0
Do i = 1 To Words( colors_normal )
   inv = Word( index_inverses, i )
   fb.ctype.i = TkButton(foref'.fore'i, '-text', ' ', '-background', Word( colors_normal, i ), '-activebackground', Word( colors_bold, i ),'-foreground', Word( colors_normal, inv ),'-rexx', 'Fore' i )
   bb.ctype.i = TkButton(backf'.back'i, '-text', ' ', '-background', Word( colors_normal, i ), '-activebackground', Word( colors_bold, i ),'-foreground', Word( colors_normal, inv ),'-rexx', 'Back' i )
   Call TkGrid fb.ctype.i, '-in', foref, '-row', i, '-column', 0
   Call TkGrid bb.ctype.i, '-in', backf, '-row', i, '-column', 0
End

Call TkPack attrf, foref, backf, '-side', 'left'

Call Area 1
Call TkVar 'arearb_'ctype, 1
Return

TestColor:
Parse Arg ctype
/*
'set color' current_area current_fore 'on' current_back
*/
If ctype = 'color' Then num_colors = color.0
Else num_colors = ecolor.0
Do i = 1 To num_colors
   If ctype = 'color' Then color = color.i
   Else color = ecolor.i
   'set' ctype Word( color, 1 ) current_attr.ctype.i current_fore.ctype.i 'on' current_back.ctype.i
End
'refresh'
Return

Fore:
Parse Arg idx
this_fore = Word( colors, idx )
Call TkConfig areala.ctype.current_index, '-foreground', this_fore
current_fore.ctype.current_index = this_fore
Call DrawLabel current_index ctype
Call SetAttrCheckButtons current_index
Return

Back:
Parse Arg idx
this_back = Word( colors, idx )
Call TkConfig areala.ctype.current_index, '-background', this_back
current_back.ctype.current_index = this_back
Call DrawLabel current_index ctype
Call SetAttrCheckButtons current_index
Return

Attr:
Parse Arg idx
this_attr = Word( attrs, idx )
If TkVar( 'attr'||this_attr ) Then
   Do
      /*
       * This attribute turned on, add it to the current area's attributes
       */
      current_attr.ctype.current_index = current_attr.ctype.current_index this_attr
   End
Else
   Do
      /*
       * This attribute turned off, remove it from the current area's attributes
       */
      this_pos = Wordpos( this_attr, current_attr.ctype.current_index )
      current_attr.ctype.current_index = DelWord( current_attr.ctype.current_index, this_pos, 1 )
   End
Call DrawLabel current_index ctype
Return

Area:
Parse Arg val
current_index = val
current_index.ctype = val
Call SetAttrCheckButtons current_index
Return

SetAttrCheckButtons:
Parse Arg idx
color_attrs = GetAttrs( current_attr.ctype.idx )
/*
 * Set all attribute check buttons to off
 */
Do i = 1 To Words( attrs )
   Call TkVar 'attr'||Word( attrs, i ), 0
End
/*
 * Turn on those checkbuttons for the current attributes
 */
Do i = 1 To Words( color_attrs )
   ca = Word( color_attrs, i )
   Call TkVar 'attr'||Word( attrs, ca ), 1
End
Parse Value DrawLabel( idx ctype ) With foreidx backidx
/*
 * Show a big X on the fore/back labels...
 */
Do i = 1 To 8
   Call TkConfig fb.ctype.i, '-text', ' '
   Call TkConfig bb.ctype.i, '-text', ' '
End
Call TkConfig fb.ctype.foreidx, '-text', 'X'
Call TkConfig bb.ctype.backidx, '-text', 'X'
Return

GetAttrs: Procedure Expose attrs
Parse Arg attr
all_wp = ''
Do i = 1 To Words( attr )
   wp = Wordpos( Word( attr, i ), attrs )
   If wp \= 0 Then all_wp = all_wp wp
End
Return all_wp

ResetColor:
Parse Arg ctype
If ctype = 'color' Then num_colors = color.0
Else num_colors = ecolor.0
Do i = 1 To num_colors
   If ctype = 'color' Then Call SetColor i color.i
   Else Call SetColor i ecolor.i
   Call DrawLabel i ctype
End
Call SetAttrCheckButtons current_index
/* Call TestColor ctype */
Return

SetColor:
Parse Arg idx color
tot = Words( color )
current_attr.ctype.idx = Subword( color, 2, tot-4 )
current_fore.ctype.idx = Word( color, tot-2)
current_back.ctype.idx = Word( color, tot)
Return

DrawLabel:
Parse Arg idx ctype
backidx = Wordpos( current_back.ctype.idx, colors )
If Wordpos( 'blink', current_attr.ctype.idx ) \= 0 Then back = Word( colors_bold, backidx )
Else back = Word( colors_normal, backidx )
foreidx = Wordpos( current_fore.ctype.idx, colors )
If Wordpos( 'bold', current_attr.ctype.idx ) \= 0 Then fore = Word( colors_bold, foreidx )
Else fore = Word( colors_normal, foreidx )
font = 'Helvetica 12 bold'
If Wordpos( 'italic', current_attr.ctype.idx ) \= 0 Then font = font 'italic'
If Wordpos( 'underline', current_attr.ctype.idx ) \= 0 Then Nop
Call TkConfig areala.ctype.idx, '-font', font, '-foreground', fore, '-background', back, '-selectforeground', fore, '-selectbackground', back
Return foreidx backidx

RaiseTab:
Parse Arg bn
Select
   When bn = color_tab Then
      Do
         ctype = 'color'
         current_index = current_index.ctype
      End
   When bn = ecolor_tab Then
      Do
         ctype = 'ecolor'
         current_index = current_index.ctype
      End
   Otherwise Nop
End
Return

/*
 * Common routines
 */

Ended:
Call Quit

Syntax:
'msg' 'Syntax error at line:' sigl
'msg' '>>>' Sourceline( sigl )
'msg' Errortext( rc )
If Countstr( '.', Condition( 'E' ) ) \= 0 Then 'msg' Condition( 'D' )
/*
 * Fall through
 */
Quit:
Exit:
Call TkComboboxDropFuncs( 'UNLOAD' )
Call TkNotebookDropFuncs( 'UNLOAD' )
Call TkDropFuncs( 'UNLOAD' )
Exit 0