Skip to content

Commit b656b6c

Browse files
xdelaruellexdelaruelle
committed
Add parseEqualListConfValue helper proc
Signed-off-by: Xavier Delaruelle <xavier.delaruelle@cea.fr>
1 parent eb81f7a commit b656b6c

4 files changed

Lines changed: 42 additions & 106 deletions

File tree

‎tcl/init.tcl.in‎

Lines changed: 38 additions & 102 deletions
Original file line numberDiff line numberDiff line change
@@ -629,53 +629,58 @@ proc __initStateClockSeconds {} {
629629
return [clock seconds]
630630
}
631631

632-
# Initialize Select Graphic Rendition table
633-
proc initConfColors {envvar value validvallist intvallist} {
632+
proc parseEqualListConfValue {option envvar value {level Warning}} {
634633
# overridden value coming from environment
635634
if {[isEnvVarDefined $envvar]} {
636-
set colors_list $::env($envvar)
637635
if {[catch {
638-
# test overridden value could be set to a dummy array variable
639-
array set test_colors [split $colors_list {:=}]
636+
# try to set the variable init value mapping table
637+
array set test_arr [split $::env($envvar) {:=}]
638+
set value $::env($envvar)
639+
set setfromenv 1
640640
} errMsg ]} {
641-
# report issue as a debug message rather warning to avoid
642-
# disturbing user with a warning message in the middle of a
643-
# useful output as this table will be initialized at first use
644-
reportDebug "Ignore invalid value set in $envvar ($colors_list)"
645-
unset colors_list
641+
report$level "Ignore invalid value set in $envvar ($::env($envvar))"
646642
}
647643
}
648644

649-
# if no valid override set use default color theme for terminal
650-
# background color kind (light or dark)
651-
if {![info exists colors_list]} {
652-
if {[getConf term_background] eq {light}} {
653-
##nagelfar ignore Too long line
654-
set colors_list {@lightbgcolors@}
655-
} else {
656-
##nagelfar ignore Too long line
657-
set colors_list {@darkbgcolors@}
658-
}
645+
# test default value
646+
if {![info exists setfromenv]} {
659647
if {[catch {
660-
array set test_colors [split $colors_list {:=}]
648+
array set test_arr [split $value {:=}]
661649
} errMsg ]} {
662-
reportDebug "Ignore invalid default [getConf term_background]\
663-
background colors ($colors_list)"
650+
report$level "Ignore invalid default value for '$option' config\
651+
($value)"
664652
# define an empty list if no valid value set
665-
set colors_list {}
653+
set value {}
666654
}
667655
}
668656

657+
return $value
658+
}
659+
660+
# Initialize Select Graphic Rendition table
661+
proc initConfColors {envvar value validvallist intvallist} {
662+
# default color theme depends on terminal background color kind
663+
if {[getConf term_background] eq {light}} {
664+
##nagelfar ignore Too long line
665+
set value {@lightbgcolors@}
666+
set option light-background-colors
667+
} else {
668+
##nagelfar ignore Too long line
669+
set value {@darkbgcolors@}
670+
set option dark-background-colors
671+
}
672+
set value [parseEqualListConfValue $option $envvar $value Debug]
673+
669674
# check each color defined and unset invalid codes
670-
set value {}
671-
foreach {elt col} [split $colors_list {:=}] {
675+
set colors_list {}
676+
foreach {elt col} [split $value {:=}] {
672677
if {![regexp {^[\d;]+$} $col]} {
673678
reportDebug "Ignore invalid color code for '$elt' ($col)"
674679
} else {
675-
lappend value $elt=$col
680+
lappend colors_list $elt=$col
676681
}
677682
}
678-
set value [join $value :]
683+
set value [join $colors_list :]
679684

680685
# set SGR table as an array to easily access rendition for each key
681686
array unset ::g_colors
@@ -762,30 +767,8 @@ proc initConfTclExtLib {envvar value validvallist intvallist} {
762767

763768
# Initialize module tag abbreviation table
764769
proc initConfTagAbbrev {envvar value validvallist intvallist} {
765-
# overridden value coming from environment
766-
if {[isEnvVarDefined $envvar]} {
767-
if {[catch {
768-
# try to set the tag-abbreviation mapping table
769-
array set ::g_tagAbbrev [split $::env($envvar) {:=}]
770-
set value $::env($envvar)
771-
} errMsg ]} {
772-
reportWarning "Ignore invalid value set in $envvar ($::env($envvar))"
773-
array unset ::g_tagAbbrev
774-
}
775-
}
776-
777-
# test default value
778-
if {![array exists ::g_tagAbbrev]} {
779-
if {[catch {
780-
array set ::g_tagAbbrev [split $value {:=}]
781-
} errMsg ]} {
782-
reportWarning "Ignore invalid default value for 'tag_abbrev' config\
783-
($value)"
784-
array unset ::g_tagAbbrev
785-
# define an empty list if no valid value set
786-
set value {}
787-
}
788-
}
770+
set value [parseEqualListConfValue tag_abbrev $envvar $value]
771+
array set ::g_tagAbbrev [split $value {:=}]
789772

790773
# build abbrev:tagname array
791774
foreach {tag abbrev} [array get ::g_tagAbbrev] {
@@ -828,33 +811,8 @@ proc initConfTagColorName {envvar value validvallist intvallist} {
828811

829812
# Initialize env variable initial value array
830813
proc initConfInitEnvvars {envvar value validvallist intvallist} {
831-
# overridden value coming from environment
832-
if {[isEnvVarDefined $envvar]} {
833-
if {[catch {
834-
# try to set the variable init value mapping table
835-
array set testarr [split $::env($envvar) {:=}]
836-
set value $::env($envvar)
837-
set setfromenv 1
838-
} errMsg ]} {
839-
reportWarning "Ignore invalid value set in $envvar ($::env($envvar))"
840-
}
841-
}
842-
843-
# test default value
844-
if {![info exists setfromenv]} {
845-
if {[catch {
846-
array set testarr [split $value {:=}]
847-
} errMsg ]} {
848-
reportWarning "Ignore invalid default value for 'init_envvars'\
849-
config ($value)"
850-
# define an empty list if no valid value set
851-
set value {}
852-
}
853-
}
854-
855-
foreach {envvar init_value} [split $value {:=}] {
856-
set ::g_initEnvvars($envvar) $init_value
857-
}
814+
set value [parseEqualListConfValue init_envvars $envvar $value]
815+
array set ::g_initEnvvars [split $value {:=}]
858816

859817
return $value
860818
}
@@ -896,29 +854,7 @@ proc initConfEditor {envvar value validvallist intvallist} {
896854

897855
# Initialize variant shortcut table
898856
proc initConfVariantShortcut {envvar value validvallist intvallist} {
899-
# overridden value coming from environment
900-
if {[isEnvVarDefined $envvar]} {
901-
if {[catch {
902-
# try to set the variant-shortcut mapping table
903-
array set testarr [split $::env($envvar) {:=}]
904-
set value $::env($envvar)
905-
set setfromenv 1
906-
} errMsg ]} {
907-
reportWarning "Ignore invalid value set in $envvar ($::env($envvar))"
908-
}
909-
}
910-
911-
# test default value
912-
if {![info exists setfromenv]} {
913-
if {[catch {
914-
array set testarr [split $value {:=}]
915-
} errMsg ]} {
916-
reportWarning "Ignore invalid default value for 'variant_shortcut'\
917-
config ($value)"
918-
# define an empty list if no valid value set
919-
set value {}
920-
}
921-
}
857+
set value [parseEqualListConfValue variant_shortcut $envvar $value]
922858

923859
# ignore shortcut if not equal to one character or if set on alphanum char
924860
# or on char with special meaning

‎testsuite/modules.00-init/100-pager.exp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ proc pager_test_case {modarg use paginate cmd opts {shell sh}} {
6969
lappend ans "DEBUG setState: init_error_report set to '1'"
7070
lappend ans "DEBUG setConf: verbosity set to 'debug'"
7171
lappend ans "DEBUG setConf: term_background set to '$install_termbg'"
72-
lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
72+
lappend ans "(DEBUG parseEqualListConfValue: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
7373
lappend ans "DEBUG setConf: color set to '0'"
7474
lappend ans "DEBUG setConf: paginate set to '$paginate'"
7575
if {$paginate} {

‎testsuite/modules.00-init/120-siteconfig.exp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ proc test_getSiteConfig {siteconfig isvalid islocked} {
5757
lappend ans "DEBUG setState: init_error_report set to '1'"
5858
lappend ans "DEBUG setConf: verbosity set to 'debug'"
5959
lappend ans "DEBUG setConf: term_background set to '$::install_termbg'"
60-
lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
60+
lappend ans "(DEBUG parseEqualListConfValue: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
6161
lappend ans "DEBUG setConf: color set to '0'"
6262
lappend ans "DEBUG setConf: paginate set to '0'"
6363
lappend ans "DEBUG setState: paginate set to '0'"
@@ -101,7 +101,7 @@ lappend ans "DEBUG setState: subcmd_args set to ''"
101101
lappend ans "DEBUG setState: init_error_report set to '1'"
102102
lappend ans "DEBUG setConf: verbosity set to 'debug'"
103103
lappend ans "DEBUG setConf: term_background set to '$install_termbg'"
104-
lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
104+
lappend ans "(DEBUG parseEqualListConfValue: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
105105
lappend ans "DEBUG setConf: color set to '0'"
106106
lappend ans "DEBUG setConf: paginate set to '1'"
107107
lappend ans "DEBUG setConf: pager set to '$install_pagercmd'"

‎testsuite/modules.00-init/150-access-init.exp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ if {[info exists tclextlib_file]} {
5151
lappend ans "DEBUG setState: init_error_report set to '1'"
5252
lappend ans "DEBUG setConf: verbosity set to 'debug'"
5353
lappend ans "DEBUG setConf: term_background set to '$install_termbg'"
54-
lappend ans "(DEBUG initConfColors: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
54+
lappend ans "(DEBUG parseEqualListConfValue: Ignore invalid default.*\\n)?DEBUG setConf: colors set to '.*'"
5555
lappend ans "DEBUG setConf: color set to '0'"
5656
lappend ans "DEBUG setConf: paginate set to '0'"
5757
lappend ans "DEBUG setState: paginate set to '0'"

0 commit comments

Comments
 (0)