diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm index 25b01d81..91f29aa5 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.1.0.tm @@ -331,26 +331,26 @@ tcl::namespace::eval punk::args { parsing and help display. directives include: %B%@id%N% ?opt val...? - options: -id + spec-options: -id %B%@cmd%N% ?opt val...? - options: -name -help + spec-options: -name -help %B%@leaders%N% ?opt val...? - options: -min -max + spec-options: -min -max (used for leading args that come before switches/opts) %B%@opts%N% ?opt val...? - options: -any + spec-options: -any %B%@values%N% ?opt val...? - options: -min -max + spec-options: -min -max (used for trailing args that come after switches/opts) %B%@argdisplay%N% ?opt val...? - options: -header (text for header row of table) - -body (text to replace autogenerated arg info) + spec-options: -header (text for header row of table) + -body (text to replace autogenerated arg info) %B%@doc%N% ?opt val...? - options: -name -url + spec-options: -name -url %B%@seealso%N% ?opt val...? - options: -name -url (for footer - unimplemented) + spec-options: -name -url (for footer - unimplemented) - Some other options normally present on custom arguments are available + Some other spec-options normally present on custom arguments are available to use with the @leaders @opts @values directives to set defaults for subsequent lines that represent your custom arguments. These directives should occur in exactly this order - but can be @@ -361,7 +361,12 @@ tcl::namespace::eval punk::args { or using the i .. function - an @id with -id is needed. All directives can be omitted, in which case every line represents - a custom value or option. + a custom leader, value or option. + All will be leaders by default if no options defined. + If options are defined (by naming with leading dash, or explicitly + specifying @opts) then the definitions prior to the options will be + categorised as leaders, and those following the options will be + categorised as values. Custom arguments are defined by using any word at the start of a line that doesn't begin with @ or - @@ -369,7 +374,7 @@ tcl::namespace::eval punk::args { that @@somearg becomes an argument named @somearg) custom leading args, switches/options (names starting with -) - and trailing values also take options: + and trailing values also take spec-options: -type defaults to string. If no other restrictions @@ -397,12 +402,22 @@ tcl::namespace::eval punk::args { -optional (defaults to true for flags/switches false otherwise) + For non flag/switch arguments - all arguments with + -optional true must sit consecutively within their group. + ie all optional leader arguments must be together, and all + optional value arguments must be together. Furthermore, + specifying both optional leaders and optional values will + often lead to ambiguous parsing results. Currently, all + optional non-flg/switch arguments should be either at the + trailing end of leaders or the trailing end of values. + Further unambiguous arrangements of optional args may be + made in future - but are currently considered 'unsupported' -default -multiple (for leaders & values defines whether - subsequent received values are stored agains the same - argument name - only applies to final leader or value) + subsequent received values are stored against the same + argument name - only applies to final leader OR final value) (for options/flags this allows the opt-val pair or solo - flag to appear multiple times - no necessarily contiguously) + flag to appear multiple times - not necessarily contiguously) -choices {} A list of allowable values for an argument. The -default value doesn't have to be in the list. @@ -438,7 +453,7 @@ tcl::namespace::eval punk::args { Max of -1 represents no upper limit. If allows more than one choice the value is a list consisting of items in the choices made available through - entries in -choices/-choicegrups. + entries in -choices/-choicegroups. -minsize (type dependant) -maxsize (type dependant) -range (type dependant) @@ -1667,6 +1682,7 @@ tcl::namespace::eval punk::args { " @leaders -min 0 -max 0 @opts + -return -default text -choices {text dict} -form -default 0 -help\ "Ordinal index or name of command form" @@ -1694,7 +1710,7 @@ tcl::namespace::eval punk::args { (directives are lines beginning with @ e.g @id, @cmd etc) - if -type is @leaders,@opts or @values matches from that type + if -type is leaders,opts or values matches from that type will be returned. if -type is another directive such as @id, @doc etc the @@ -1706,8 +1722,10 @@ tcl::namespace::eval punk::args { proc resolved_def {args} { + #not eating our own dogfood here as far as argument parsing. -id ::punk::args::resolved_def is for documentation/errors only. set opts [dict create\ - -types {}\ + -return text\ + -types {}\ -form 0\ -antiglobs {}\ -override {}\ @@ -1743,7 +1761,7 @@ tcl::namespace::eval punk::args { } dict for {k v} $opts { switch -- $k { - -form - -types - -antiglobs - -override {} + -return - -form - -types - -antiglobs - -override {} default { punk::args::parse $args withid ::punk::args::resolved_def return @@ -1764,163 +1782,185 @@ tcl::namespace::eval punk::args { variable id_cache_rawdef set realid [real_id $id] + if {$realid eq ""} { + return + } - if {$realid ne ""} { - set deflist [tcl::dict::get $id_cache_rawdef $realid] - set result "" - set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] + set deflist [tcl::dict::get $id_cache_rawdef $realid] + set specdict [uplevel 1 [list ::punk::args::resolve {*}$deflist]] - set opt_form [dict get $opts -form] - if {[string is integer -strict $opt_form]} { - set formname [lindex [dict get $specdict form_names] $opt_form] - } else { - set formname $opt_form - } - set opt_override [dict get $opts -override] - - #set arg_info [dict get $specdict ARG_INFO] - set arg_info [dict get $specdict FORMS $formname ARG_INFO] - set argtypes [dict create leaders leader opts option values value] - - set opt_antiglobs [dict get $opts -antiglobs] - set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] - set suppressed_directives [list] - set suppressed_args [list] - foreach ag $opt_antiglobs { - foreach d $directives { - if {[string match $ag $d]} { - lappend suppressed_directives $d - } + set opt_form [dict get $opts -form] + if {[string is integer -strict $opt_form]} { + set formname [lindex [dict get $specdict form_names] $opt_form] + } else { + set formname $opt_form + } + set opt_override [dict get $opts -override] + set opt_return [dict get $opts -return] + + #set arg_info [dict get $specdict ARG_INFO] + set arg_info [dict get $specdict FORMS $formname ARG_INFO] + set argtypes [dict create leaders leader opts option values value] + + set opt_antiglobs [dict get $opts -antiglobs] + set directives [lsearch -all -inline -exact -not $::punk::args::argdoc::resolved_def_TYPE_CHOICES *] + set suppressed_directives [list] + set suppressed_args [list] + foreach ag $opt_antiglobs { + foreach d $directives { + if {[string match $ag $d]} { + lappend suppressed_directives $d } - foreach argname [dict keys $arg_info] { - if {[string match $ag $argname]} { - lappend suppressed_args $argname - } + } + foreach argname [dict keys $arg_info] { + if {[string match $ag $argname]} { + lappend suppressed_args $argname } } - set suppressed_directives [lsort -unique $suppressed_directives] - set suppressed_args [lsort -unique $suppressed_args] + } + set suppressed_directives [lsort -unique $suppressed_directives] + set suppressed_args [lsort -unique $suppressed_args] - set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] + set included_directives [punk::args::system::punklib_ldiff $directives $suppressed_directives] - set globbed [list] - foreach pat $patterns { - set matches [dict keys $arg_info $pat] - lappend globbed {*}$matches - } - set globbed [lsort -unique $globbed] - set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] - - foreach type $typelist { - switch -exact -- $type { - * { - if {"@id" in $included_directives} { - if {[dict exists $opt_override @id]} { - append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" - } else { - append result \n "@id -id [dict get $specdict id]" - } - } - foreach directive {@package @cmd @doc @seealso @argdisplay} { - set dshort [string range $directive 1 end] - if {"$directive" in $included_directives} { - if {[dict exists $opt_override $directive]} { - append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" - } else { - append result \n "$directive [dict get $specdict ${dshort}_info]" - } - } - } - #output ordered by leader, option, value - foreach pseudodirective {leaders opts values} tp {leader option value} { - set directive "@$pseudodirective" - switch -- $directive { - @leaders {set defaults_key leaderspec_defaults} - @opts {set defaults_key optspec_defaults} - @values {set defaults_key valspec_defaults} - } - - if {"$directive" in $included_directives} { - if {[dict exists $opt_override "$directive"]} { - append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" - } else { - append result \n "$directive [dict get $specdict $defaults_key]" - } - } + set globbed [list] + foreach pat $patterns { + set matches [dict keys $arg_info $pat] + lappend globbed {*}$matches + } + set globbed [lsort -unique $globbed] + set included_args [punk::args::system::punklib_ldiff $globbed $suppressed_args] - if {$pseudodirective in $included_directives} { - foreach m $included_args { - set argspec [dict get $arg_info $m] - if {[dict get $argspec -ARGTYPE] eq $tp} { - set argspec [dict remove $argspec -ARGTYPE] - if {[dict exists $opt_override $m]} { - append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" - } else { - append result \n "$m $argspec" - } - } - } - } + set result "" + set resultdict [dict create] + foreach type $typelist { + switch -exact -- $type { + * { + if {"@id" in $included_directives} { + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + dict set resultdict @id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]] + } else { + append result \n "@id -id [dict get $specdict id]" + dict set resultdict @id [list -id [dict get $specdict id]] } - } - @id { - if {"@id" in $included_directives} { - #only a single id record can exist - if {[dict exists $opt_override @id]} { - append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + foreach directive {@package @cmd @doc @seealso @argdisplay} { + set dshort [string range $directive 1 end] + if {"$directive" in $included_directives} { + if {[dict exists $opt_override $directive]} { + append result \n "$directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]]" + dict set resultdict $directive [dict merge [dict get $specdict ${dshort}_info] [dict get $opt_override $directive]] } else { - append result \n "@id -id [dict get $specdict id]" + append result \n "$directive [dict get $specdict ${dshort}_info]" + dict set resultdict $directive [dict get $specdict ${dshort}_info] } } } - @package - @cmd - @doc - @seealso - @argdisplay { - if {"$type" in $included_directives} { - set tp [string range $type 1 end] ;# @package -> package - if {[dict exists $opt_override $type]} { - append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" - } else { - append result \n "$type [dict get $specdict ${tp}_info]" - } + #output ordered by leader, option, value + foreach pseudodirective {leaders opts values} tp {leader option value} { + set directive "@$pseudodirective" + switch -- $directive { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} } - } - @leaders - @opts - @values { - #these are the active defaults for further arguments - if {"$type" in $included_directives} { - switch -- $type { - @leaders {set defaults_key leaderspec_defaults} - @opts {set defaults_key optspec_defaults} - @values {set defaults_key valspec_defaults} - } - if {[dict exists $opt_override $type]} { - append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + + if {"$directive" in $included_directives} { + if {[dict exists $opt_override "$directive"]} { + append result \n "$directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]]" + dict set resultdict $directive [dict merge [dict get $specdict $defaults_key] [dict get $opt_override $directive]] } else { - append result \n "$type [dict get $specdict leaderspec_defaults]" + append result \n "$directive [dict get $specdict $defaults_key]" + dict set resultdict $directive [dict get $specdict $defaults_key] } } - } - leaders - opts - values { - #pseudo-directives - if {$type in $included_directives} { + + if {$pseudodirective in $included_directives} { foreach m $included_args { set argspec [dict get $arg_info $m] - if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + if {[dict get $argspec -ARGTYPE] eq $tp} { set argspec [dict remove $argspec -ARGTYPE] if {[dict exists $opt_override $m]} { append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + dict set resultdict $m [dict merge $argspec [dict get $opt_override $m]] } else { append result \n "$m $argspec" + dict set resultdict $m $argspec } } } } } - default { + + } + @id { + if {"@id" in $included_directives} { + #only a single id record can exist + if {[dict exists $opt_override @id]} { + append result \n "@id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]]" + dict set resultdict @id [dict merge [dict create -id [dict get $specdict id]] [dict get $opt_override @id]] + } else { + append result \n "@id -id [dict get $specdict id]" + dict set resultdict @id [list -id [dict get $specdict id]] + } } } + @package - @cmd - @doc - @seealso - @argdisplay { + if {"$type" in $included_directives} { + set tp [string range $type 1 end] ;# @package -> package + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]]" + dict set resultdict $type [dict merge [dict get $specdict ${tp}_info] [dict get $opt_override $type]] + } else { + append result \n "$type [dict get $specdict ${tp}_info]" + dict set resultdict $type [dict get $specdict ${tp}_info] + } + } + } + @leaders - @opts - @values { + #these are the active defaults for further arguments + if {"$type" in $included_directives} { + switch -- $type { + @leaders {set defaults_key leaderspec_defaults} + @opts {set defaults_key optspec_defaults} + @values {set defaults_key valspec_defaults} + } + if {[dict exists $opt_override $type]} { + append result \n "$type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]]" + dict set resultdict $type [dict merge [dict get $specdict leaderspec_defaults] [dict get $opt_override $type]] + } else { + append result \n "$type [dict get $specdict leaderspec_defaults]" + dict set resultdict $type [dict get $specdict leaderspec_defaults] + } + } + } + leaders - opts - values { + #pseudo-directives + if {$type in $included_directives} { + foreach m $included_args { + set argspec [dict get $arg_info $m] + if {[dict get $argspec -ARGTYPE] eq [dict get $argtypes $type]} { + set argspec [dict remove $argspec -ARGTYPE] + if {[dict exists $opt_override $m]} { + append result \n "$m [dict merge $argspec [dict get $opt_override $m]]" + dict set resultdict $m [dict merge $argspec [dict get $opt_override $m]] + } else { + append result \n "$m $argspec" + dict set resultdict $m $argspec + } + } + } + } + } + default { + } + } + if {$opt_return eq "text"} { + return $result + } else { + return $resultdict } - - return $result } } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm b/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm index 3cd3dfc6..0c8b848b 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/imap4-0.9.tm @@ -75,6 +75,17 @@ # showlog command to see cli/svr conversation - todo! - disable by default and limit storage. # Addition of AUTH_PLAIN SASL authentication mechanism # change isableto -> has_capability (to better reflect capabilities such as LOGINDISABLED) +# 202503 J. Noble - API changes, add more argument parsing/documentation +# Change IMAP API commands that take msgid or range to accept IMAP protocol style sequence-sets +# composed of seq-ranges. +# ie - no longer accept tcllib IMAP4 style range consisting of incomplete colon based ranges such as : :x x: +# Instead we accept the full comma delimited sequence sets and require use of the special * operator in ranges +# e.g 1:* 3,4,10:* etc +# The equivalent of tcllib IMAP's : would be 1:* +# Added GETACL,SETACL,MYRIGHTS,LISTRIGHTS commands. +# Added initial RETURN handling for SEARCH (not yet handling ESEARCH responses) +# Changed OPEN to CONNECT +# (slightly better clarity for API because the IMAP CLOSE command is not the opposite of OPEN) # # @@ Meta Begin @@ -253,13 +264,95 @@ tcl::namespace::eval punk::imap4::system { } } +tcl::namespace::eval punk::imap4::stringprep { + #https://core.tcl-lang.org/tcllib/doc/tcllib-1-18/embedded/www/tcllib/files/modules/stringprep/stringprep.html#3 + + #RFC3454 - table definitions + + #IMAP stringprep Profiles for Usernames RFC4314 RFC5738 + #IMAP stringprep Profiles for Passwords RFC5738 + + #RFC4013 SASLprep: Stringprep Profile for User Names and Passwords + #Prohibited Output + # - Non-ASCII space characters [StringPrep, C.1.2] + # - ASCII control characters [StringPrep, C.2.1] + # - Non-ASCII control characters [StringPrep, C.2.2] + # - Private Use characters [StringPrep, C.3] + # - Non-character code points [StringPrep, C.4] + # - Surrogate code points [StringPrep, C.5] + # - Inappropriate for plain text characters [StringPrep, C.6] + # - Inappropriate for canonical representation characters + # [StringPrep, C.7] + # - Change display properties or deprecated characters + # [StringPrep, C.8] + # - Tagging characters [StringPrep, C.9] + set prohibited_sets {A.1 C.1.2 C.2.1 C.2.2 C.3 C.4 C.5 C.6 C.7 C.8 C.9} + + #This profile specifies: + # - non-ASCII space characters [StringPrep, C.1.2] that can be + # mapped to SPACE (U+0020), and + # - the "commonly mapped to nothing" characters [StringPrep, B.1] + # that can be mapped to nothing. + + #Unassigned Code points - [STRINGPREP, A.1] + + package require stringprep + #Mapping C.1.2 ?? + #we only have it in -prohibited - but it seems to be mapped to space, which is what we want - but why? + ::stringprep::register saslprep -mapping {B.1} -prohibited $prohibited_sets -normalization KC -prohibitedBidi 1 + + proc normal_userpass {input} { + #set input [map_to_space $input] ;#C.1.2 non-ascii spaces mapped to space + set normalised [::stringprep::stringprep saslprep $input] + } + + #probably unneeded - see command above re mapping C.1.2 + proc map_to_space {input} { + #C.1.2 Non-ASCII space characters + #----- Start Table C.1.2 ----- + #00A0; NO-BREAK SPACE + #1680; OGHAM SPACE MARK + #2000; EN QUAD + #2001; EM QUAD + #2002; EN SPACE + #2003; EM SPACE + #2004; THREE-PER-EM SPACE + #2005; FOUR-PER-EM SPACE + #2006; SIX-PER-EM SPACE + #2007; FIGURE SPACE + #2008; PUNCTUATION SPACE + #2009; THIN SPACE + #200A; HAIR SPACE + #200B; ZERO WIDTH SPACE + #202F; NARROW NO-BREAK SPACE + #205F; MEDIUM MATHEMATICAL SPACE + #3000; IDEOGRAPHIC SPACE + #----- End Table C.1.2 ----- + set map [list \u00A0 " " \u1680 " " \u2000 " " \u2001 " " \u2002 " " \u2003 " " \u2004 " " \u2005 " " \u2006 " " \u2007 " "\ + \u2007 " " \u2008 " " \u2009 " " \u200A " " \u200b " " \u202F " " \u205F " " \u3000 " "\ + ] + return [string map $map $input] + } +} tcl::namespace::eval punk::imap4::proto { variable PUNKARGS - variable info variable coninfo namespace export {[a-z]*} + proc is_imap_number {n} { + return [expr {[string is integer -strict $n] && $n >= 0 && $n <= 4294967296}] + } + proc is_imap_number64 {n} { + return [expr {[string is integer -strict $n] && $n >= 0 && $n <= 9223372036854775807}] + } + proc is_imap_nznumber {n} { + return [expr {[string is integer -strict $n] && $n > 0 && $n <= 4294967296}] + } + proc is_imap_nznumber64 {n} { + return [expr {[string is integer -strict $n] && $n > 0 && $n <= 9223372036854775807}] + } + #JMN 2025 - rename to pop0 to make clear distinction between this and tcl9 builtin lpop # Pop an element from the list inside the named variable and return it. # If a list is empty, raise an error. The error is specific for the @@ -345,6 +438,49 @@ tcl::namespace::eval punk::imap4::proto { #we aren't assuming all request formats are valid Tcl lists return [punk::imap4::lib::firstword $lastrequest] } + + #experimental + proc resync_tag {chan} { + set last_request_tag [lastrequesttag $chan] + set last_line [lastline $chan] + #word0 + set last_response_tag [punk::imap4::lib::firstword $last_line] + puts stderr "last request tag: $last_request_tag" + puts stderr "last response tag: $last_response_tag" + if {$last_response_tag < $last_request_tag} { + set diff [expr {$last_request_tag - $last_response_tag}] + puts stderr "Reading $diff responses to catch up.." + set servertag $last_response_tag + for {set i 0} {$i < $diff} {incr i} { + #JMN + set is_err [catch {getresponse $chan [incr servertag]} getresponse_result] + if {!$is_err} { + if {$getresponse_result == 0} { + puts stderr "READ read number: $i result: $getresponse_result" + } else { + puts stderr "READPROBLEM read number: $i result: $getresponse_result" + } + } else { + puts stderr "READERROR read number: $i" + puts stderr " error: $getresponse_result" + } + } + #todo retest? + puts stderr "Done - view log using 'showlog $chan'" + } elseif {$last_response_tag > $last_request_tag} { + set synctag [expr {$last_response_tag + 1}] + puts stderr "Updating client curtag to $synctag" + upvar ::punk::imap4::proto::info info + set info($chan,curtag) $synctag + puts stderr "calling NOOP" + punk::imap4::NOOP $chan + #todo - retest? + puts stderr "Done" + } else { + puts stderr "resync_tag - OK No difference detected" + } + } + # Get the current state proc state {chan} { variable info @@ -430,11 +566,54 @@ tcl::namespace::eval punk::imap4::proto { # This a general implementation for a simple implementation # of an IMAP command that just requires to call ::imap4::request # and ::imap4::getresponse. - proc simplecmd {chan command validstates args} { + lappend PUNKARGS [list { + @id -id ::punk::imap4::proto::simplecmd + @cmd -name punk::imap4::proto::simplecmd -help\ + "This is a general implementation for a simple + implementation of an IMAP command that is + composed of a a ::punk::imap4::request followed + by a punk::imap4::response" + + @leaders -min 1 -max 1 + chan -optional 0 -help\ + "existing channel for an open IMAP connection" + @opts + -validstates -default * -help\ + "A list of valid states from which this + command can be called" + @values -min 1 -max -1 + command -type string + arg -multiple 1 -optional 1 -help\ + {Each argument for the command must be + supplied in a way that preserved the form + expected by an IMAP server. + For example, if an argument has spaces it + may need to be in double quotes and so need + to be explicitly specified with quotes and a + protecting set of braces. + e.g + simplecmd EXAMINE {"mailbox name with spaces"} + If Tcl variable substitution is required, escapes + within a quoted string could be used, or string map. + e.g + simplecmd $ch SETMETADATA $b "($ann \"$val\")" + } + }] + proc simplecmd {args} { + set argd [punk::args::parse $args withid ::punk::imap4::proto::simplecmd] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set validstates [dict get $opts -validstates] + set command [dict get $values command] + set arglist [list] + if {[dict exists $received arg]} { + set arglist [dict get $values arg] + } + requirestate $chan $validstates set req "$command" - foreach arg $args { + foreach arg $arglist { append req " $arg" } @@ -516,7 +695,7 @@ tcl::namespace::eval punk::imap4::proto { } - # Process an IMAP response line. + # Process an IMAP response 'logical' line. # This function trades simplicity in IMAP commands # implementation with monolithic handling of responses. # However note that the IMAP server can reply to a command @@ -543,7 +722,7 @@ tcl::namespace::eval punk::imap4::proto { set literals {} set line "" while {1} { - # Read a line + # Read a physical line - which may be only part of the logical line if there is a 'literal' specifier if {[gets $chan buf] == -1} { error "([dict get $coninfo $chan hostname])IMAP unexpected EOF from server." } @@ -571,7 +750,7 @@ tcl::namespace::eval punk::imap4::proto { } } else { #We are at the end of a single line, - #or a sequence of 1 or more lines which had trailing literal specifiers {nnn} followed by data we have read. + #or a sequence of 1 or more physical lines which had trailing literal specifiers {nnn} followed by data we have read. break } } @@ -602,8 +781,11 @@ tcl::namespace::eval punk::imap4::proto { set info($chan,lastcode) $code } + set dirty 0 ;#review - naming as 'dirty' seems odd + #This seems to just indicate we've already matched a result as the implementation + #splits the scanning into two switch statements. + # Extract information from the line - set dirty 0 switch -glob -- $line { {*\[READ-ONLY\]*} {::punk::imap4::_set_mboxinfo $chan perm READ-ONLY; incr dirty} {*\[READ-WRITE\]*} {::punk::imap4::_set_mboxinfo $chan perm READ-WRITE; incr dirty} @@ -655,7 +837,12 @@ tcl::namespace::eval punk::imap4::proto { #cli> 1 LOGIN user pass #svr> 1 OK [CAPABILITY IMAP4rev1 ... ] User logged in SESSIONID= regexp {.*\[CAPABILITY\s+(.*)\]\s*(.*)$} $line => capstring tailstring - set info($chan,capability) [split [string toupper $capstring]] + #consider the capability: RIGHTS=kxten + #Probably inappropriate to convert to uppercase, standard rights are defined as lowercase. + #(no uppercase rights currently allowed - but perhaps that may change?) + # Unknown if there are other capabilities with lowercase values. + #set info($chan,capability) [split [string toupper $capstring]] + set info($chan,capability) [split $capstring] incr dirty if {$tailstring ne ""} { if {[dict get $coninfo $chan debug]} { @@ -671,26 +858,37 @@ tcl::namespace::eval punk::imap4::proto { if {!$dirty && $tag eq {*}} { switch -regexp -nocase -- $line { {^[0-9]+\s+EXISTS} { - regexp {^([0-9]+)\s+EXISTS} $line => mboxinfo($chan,exists) + #regexp {^([0-9]+)\s+EXISTS} $line => mboxinfo($chan,exists) + regexp {^([0-9]+)\s+EXISTS} $line => val + punk::imap4::_set_mboxinfo $chan exists $val incr dirty } {^[0-9]+\s+RECENT} { - regexp {^([0-9]+)\s+RECENT} $line => mboxinfo($chan,recent) + #DEPRECATED response for imaprev2 - should ignore? + #regexp {^([0-9]+)\s+RECENT} $line => mboxinfo($chan,recent) + regexp {^([0-9]+)\s+RECENT} $line => val + punk::imap4::_set_mboxinfo $chan recent $val incr dirty } {.*?\[UIDVALIDITY\s+[0-9]+?\]} { - regexp {.*?\[UIDVALIDITY\s+([0-9]+?)\]} $line => \ - mboxinfo($chan,uidval) + #regexp {.*?\[UIDVALIDITY\s+([0-9]+?)\]} $line => \ + # mboxinfo($chan,uidval) + regexp {.*?\[UIDVALIDITY\s+([0-9]+?)\]} $line => val + punk::imap4::_set_mboxinfo $chan uidval $val incr dirty } {.*?\[UNSEEN\s+[0-9]+?\]} { - regexp {.*?\[UNSEEN\s+([0-9]+?)\]} $line => \ - mboxinfo($chan,unseen) + #regexp {.*?\[UNSEEN\s+([0-9]+?)\]} $line => \ + # mboxinfo($chan,unseen) + regexp {.*?\[UNSEEN\s+([0-9]+?)\]} $line => val + punk::imap4::_set_mboxinfo $chan unseen $val incr dirty } {.*?\[UIDNEXT\s+[0-9]+?\]} { - regexp {.*?\[UIDNEXT\s+([0-9]+?)\]} $line => \ - mboxinfo($chan,uidnext) + #regexp {.*?\[UIDNEXT\s+([0-9]+?)\]} $line => \ + # mboxinfo($chan,uidnext) + regexp {.*?\[UIDNEXT\s+([0-9]+?)\]} $line => val + punk::imap4::_set_mboxinfo $chan uidnext $val incr dirty } {^[0-9]+\s+FETCH} { @@ -707,6 +905,19 @@ tcl::namespace::eval punk::imap4::proto { processmetadataline $chan $request_tag $line $literals #incr dirty ;#??? review } + {^MYRIGHTS\s+} { + #line eg: MYRIGHTS INBOX lrswipkxtecdan + #puts stderr "line: $line" + set words [punk::imap4::lib::imapwords $line 3] + if {[dict size $words] == 3} { + set mbox [dict get $words 1 value] + set myrights [dict get $words 2 value] + #set folderinfo($chan,myrights) + } else { + puts stderr "processline unable to make sense of MYRIGHTS response: $line" + puts stderr "words:$words" + } + } {^CAPABILITY\s+.*} { #direct response to a CAPABILITY request #e.g @@ -731,7 +942,9 @@ tcl::namespace::eval punk::imap4::proto { } } {^LIST\s*$} { - regexp {^([0-9]+)\s+EXISTS} $line => mboxinfo($chan,exists) + #regexp {^([0-9]+)\s+EXISTS} $line => mboxinfo($chan,exists) + regexp {^([0-9]+)\s+EXISTS} $line => val + punk::imap4::_set_mboxinfo $chan exists $val incr dirty } {^SEARCH\s*$} { @@ -766,7 +979,7 @@ tcl::namespace::eval punk::imap4::proto { #our lines here have had the literals separated out #so we get complete lines where the literal acts as a placeholder #e.g METADATA Junk ("/private/specialuse" {5}) - puts stderr "processmetadataline: $line" + #puts stderr "processmetadataline: $line" set words [punk::imap4::lib::imapwords $line] set msgbox [dict get $words 1 value] set resultlist [dict get $words 2 value] @@ -775,6 +988,7 @@ tcl::namespace::eval punk::imap4::proto { } set itemwords [punk::imap4::lib::imapwords [string range $resultlist 1 end-1]] ;#strip () and process contents set items [list] + #use lib::imapwords_resolved? dict for {w wordinfo} $itemwords { if {[dict get $wordinfo type] eq "literal"} { set lit [dict get $wordinfo value] @@ -888,7 +1102,7 @@ tcl::namespace::eval punk::imap4::proto { # Write a multiline request. The 'request' list must contain - # parts of command and literals interleaved. Literals are ad odd + # parts of command and literals interleaved. Literals are at odd # list positions (1, 3, ...). proc multiline_request {chan request} { variable info @@ -903,6 +1117,10 @@ tcl::namespace::eval punk::imap4::proto { } puts -nonewline $chan "$line\r\n" flush $chan + + set info($chan,lastrequest) "$line" + ::punk::imap4::system::add_conlog $chan c $request_tag line [list $line] + incr items -1 if {!$items} break @@ -918,8 +1136,10 @@ tcl::namespace::eval punk::imap4::proto { puts -nonewline $chan $literal flush $chan incr items -1 + + #REVIEW + ::punk::imap4::system::add_conlog $chan c $request_tag chunk [list [list length [string length $literal] chunk $literal]] } - set info($chan,lastrequest) $request } @@ -1064,7 +1284,9 @@ tcl::namespace::eval punk::imap4::proto { lappend req {} } - lset req 0 " $cmd[lindex $req 0]" + #Extra space between tag and command can cause NULL command error on at least some servers (cyrus) + #lset req 0 " $cmd[lindex $req 0]" + lset req 0 "$cmd[lindex $req 0]" } # Concat an already created search expression to a multiline request. @@ -1087,8 +1309,10 @@ tcl::namespace::eval punk::imap4::proto { ANSWERED - DELETED - DRAFT - FLAGGED - RECENT - SEEN - NEW - OLD - UNANSWERED - UNDELETED - - UNDRAFT - UNFLAGGED - UNSEEN - - ALL {multiline_append_command result [string toupper $token]} + UNDRAFT - UNFLAGGED - + UNSEEN { + multiline_append_command result [string toupper $token] + } BODY - CC - FROM - SUBJECT - TEXT - KEYWORD - BCC { @@ -1104,7 +1328,25 @@ tcl::namespace::eval punk::imap4::proto { multiline_concat_expr result $first multiline_concat_expr result $second } - + ALL { + #ALL messages in the mailbox: the default inital key for ANDing + #also RETURN ALL - trigger ESEARCH response code? + multiline_append_command result [string toupper $token] + } + FUZZY { + #RFC6203 + set argset [convert_search_expr [pop0 expr]] + multiline_append_command result "FUZZY" + multiline_concat_expr result $argset + } + RETURN { + set options [convert_search_expr [pop0 expr]] + multiline_append_command result "RETURN" + multiline_concat_expr result $options + } + COUNT - MIN - MAX - SAVE { + multiline_append_command result [string toupper $token] + } NOT { set e [convert_search_expr [pop0 expr]] multiline_append_command result "NOT" @@ -1114,7 +1356,6 @@ tcl::namespace::eval punk::imap4::proto { SMALLER - LARGER { set len [pop0 expr] - ##nagelfar ignore if {![string is integer $len]} { error "Invalid integer follows '$token' in IMAP search" } @@ -1142,6 +1383,64 @@ tcl::namespace::eval punk::imap4::proto { } + # ------------------------------------------------------------------------------------------------------ + #RFC2086 + set rights_2086 [dict create\ + l "lookup (mailbox i- s visible to LIST/LSUB commands)"\ + r "read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, SEARCH, COPY from mailbox)"\ + s "keep seen/unseen information across sessions (STORE SEEN flag)"\ + w "write (STORE flags other than SEEN and DELETED)"\ + i "insert (perform APPEND, COPY into mailbox)"\ + p "post (send mail to submission address for mailbox, not enforced by IMAP4 itself)"\ + c "create (CREATE new sub-mailboxes in any implementation-defined hierarchy)"\ + d "delete (STORE DELETED flag, perform EXPUNGE)"\ + a "administer (perform SETACL)"\ + ] + #c and d in 2086 have ambiguity + #RFC4314 'obsoleted' them but reclassified them as 'virtual rights' + #For backwards compatibility with clients - more modern servers MUST still include c and d in ACL/MYRIGHTS responses when appropriate. + + + #RFC4314 + set rights_4314 [dict create\ + l {lookup (mailbox is visible to LIST/LSUB commands, SUBSCRIBE mailbox)}\ + r {read (SELECT the mailbox, perform STATUS)}\ + s {keep seen/unseen information across sessions (set or clear \SEEN flag via STORE, also set \SEEN during APPEND/COPY/FETCH BODY[...])}\ + w {write (set or clear flags other than \SEEN and \DELETED via STORE, also set them during APPEND/COPY)}\ + i {insert (perform APPEND, COPY into mailbox)}\ + p {post (send mail to submission address for mailbox, not enforced by IMAP4 itself)}\ + k {create mailboxes (CREATE new sub-mailboxes in any implementation-defined hierarchy, parent mailbox for the new mailbox name in RENAME)}\ + x {delete mailbox (DELETE mailbox, old mailbox name in RENAME)}\ + t {delete messages (set or clear \DELETED flag via STORE, set \DELETED flag during APPEND/COPY)}\ + e {perform EXPUNGE and expunge as a part of CLOSE}\ + a {administer (perform SETACL/DELETEACL/GETACL/LISTRIGHTS)}\ + ] + + #some servers chose 2086 "c" to control the DELETE command + set rights_1 [dict create\ + create {k x}\ + delete {e t}\ + ] + #some servers chose 2086 "d" to control the DELETE command + set rights_2 [dict create\ + create {k}\ + delete {e t x}\ + ] + + # "n" right? RFC? + + set virtual_rights [dict create\ + d delete\ + c create\ + ] + + #TODO + proc rights_info {} { + } + + # ------------------------------------------------------------------------------------------------------ + + # Protocol error! Enter the debug mode if ::imap4::debug is true. # Otherwise just raise the error. @@ -1207,13 +1506,24 @@ tcl::namespace::eval punk::imap4 { lappend PUNKARGS [list { - @id -id ::punk::imap4::OPEN - @cmd -name punk::imap4::OPEN -help\ + @id -id ::punk::imap4::CONNECT + @cmd -name punk::imap4::CONNECT -help\ "Open a new IMAP connection and initialise the handler. Returns the Tcl channel to use in subsequent calls to - the API." + the API. Other API commands will return zero on success. + e.g + % set chan [CONNECT mail.example.com] + sock123aaa456789 + % AUTH_PLAIN $chan user pass + 0 + ... EXAMINE/CLOSE mailboxes, SEARCH, FETCH etc ... + % LOGOUT $chan + 0" @leaders -min 0 -max 0 - -debug -type boolean -default 0 + -debug -type boolean -default 0 -help\ + "Display some of the cli/server interaction on stdout + during commands. This can be set or queried using + the 'debugchan $chan ?bool?' command." -security -nocase 1 -choices {None TLS/SSL STARTTLS} -help\ "Connection security. TLS/SSL is recommended (implicit TLS). @@ -1228,8 +1538,8 @@ tcl::namespace::eval punk::imap4 { hostname -optional 0 -help\ "Host/IP Address of server. port may optionally be specified at tail of hostname - after a colon, but not if the following port argument - is also supplied and is non-zero. + after a colon, but not if the following optional port + argument to the command is also supplied and is non-zero. e.g server.example.com:143 [::1]::993 @@ -1240,8 +1550,8 @@ tcl::namespace::eval punk::imap4 { defaults to 143 when -security None or STARTTLS defaults to 993 when -security TLS/SSL or -security is omitted." }] - proc OPEN {args} { - set argd [punk::args::parse $args withid ::punk::imap4::OPEN] + proc CONNECT {args} { + set argd [punk::args::parse $args withid ::punk::imap4::CONNECT] lassign [dict values $argd] leaders opts values received set hostname [dict get $values hostname] if {[dict exists $received -security]} { @@ -1255,7 +1565,7 @@ tcl::namespace::eval punk::imap4 { } if {$arg_port != 0 && $addrport != 0} { puts stderr "Cannot specify port both in port argument as well as in hostname" - puts stderr [punk::args::usage -scheme error ::punk::imap4::OPEN] + puts stderr [punk::args::usage -scheme error ::punk::imap4::CONNECT] return } if {$addrport != 0} { @@ -1517,8 +1827,9 @@ tcl::namespace::eval punk::imap4 { #protocol callbacks to api cache namespace #msginfo #we need request_tag to determine when we have multiple values for a field - versus subsequent requests which will overwrite - #msgnum is sequence. todo UIDs separate variable? - #some headers have multipl values (SMTP traces) + #msgnum is sequence-set? + # todo UIDs separate variable? + #some headers have multiple values (SMTP traces) #also consider the somewhat contrived use of partials: # FETCH (BODY[]<0.100> BODY[]<0.10>) #These are returned in the FETCH response as "BODY[]<0> {100}" and "BODY[]<0> {10}" @@ -1625,7 +1936,9 @@ tcl::namespace::eval punk::imap4 { set opt_ignorestate [dict exists $received -ignorestate] set opt_ignorelogindisabled [dict exists $received -ignorelogindisabled] set username [dict get $values username] + set username [punk::imap4::stringprep::normal_userpass $username] set password [dict get $values password] + set password [punk::imap4::stringprep::normal_userpass $password] if {!$opt_ignorelogindisabled} { if {[punk::imap4::proto::has_capability $chan LOGINDISABLED]} { @@ -1635,7 +1948,7 @@ tcl::namespace::eval punk::imap4 { if {!$opt_ignorestate} { punk::imap4::proto::requirestate $chan NOAUTH } - set rtag [punk::imap4::proto::request $chan "LOGIN $username $password"] + set rtag [punk::imap4::proto::request $chan [list LOGIN $username $password]] if {[punk::imap4::proto::getresponse $chan $rtag] != 0} { return 1 } @@ -1686,34 +1999,178 @@ tcl::namespace::eval punk::imap4 { set allowstates NOAUTH } set username [dict get $values username] + set username [punk::imap4::stringprep::normal_userpass $username] set password [dict get $values password] + set password [punk::imap4::stringprep::normal_userpass $password] package require base64 set b64_creds [base64::encode $opt_authorization\0$username\0$password] - if {[punk::imap4::proto::simplecmd $chan "AUTHENTICATE PLAIN" {*}$allowstates $b64_creds]} { + if {[punk::imap4::proto::simplecmd $chan -validstates $allowstates AUTHENTICATE PLAIN $b64_creds]} { return 1 } set info($chan,state) AUTH return 0 } + lappend PUNKARGS [list { + @id -id ::punk::imap4::MYRIGHTS + @cmd -name punk::imap4::MYRIGHTS -help\ + "Get the set of rights that the current user + has to the mailbox. + + incomplete + Currently need debug mode or showlog + to see results" + @leaders -min 1 -max 1 + chan + @values -min 0 -max 1 + mailbox -default INBOX + }] + proc MYRIGHTS {args} { + set argd [punk::args::parse $args withid ::punk::imap4::MYRIGHTS] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + if {[punk::imap4::proto::simplecmd $chan MYRIGHTS $mailbox] != 0} { + return 1 + } + #todo - store in appropriate cache - retrieve if -inline specified? + return 0 + } + lappend PUNKARGS [list { + @id -id ::punk::imap4::GETACL + @cmd -name punk::imap4::GETACL -help\ + "Get ACL for a mailbox. + The current user must have permission to administer + the mailbox (the \"a\" right) to perform ACL commands + ie SETACL/GETACL/DELETEACL/LISTRIGHTS + + As opposed to MYRIGHTS, GETACL will return info + about other users' rights on the mailbox + (including current user) + + incomplete + Currently need debug mode or showlog + to see results" + @leaders -min 1 -max 1 + chan + @values -min 0 -max 1 + mailbox -default INBOX + }] + proc GETACL {args} { + set argd [punk::args::parse $args withid ::punk::imap4::GETACL] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + if {[punk::imap4::proto::simplecmd $chan GETACL $mailbox] != 0} { + return 1 + } + #todo - store in appropriate cache - retrieve if -inline specified? + return 0 + } + lappend PUNKARGS [list { + @id -id ::punk::imap4::SETACL + @cmd -name punk::imap4::SETACL -help\ + "Set ACL for a specified user on a mailbox. + The current user must have permission to administer + the mailbox (the \"a\" right) to perform ACL commands + ie SETACL/GETACL/DELETEACL/LISTRIGHTS" + @leaders -min 1 -max 1 + chan + @values -min 3 -max 3 + mailbox + user + rights -help\ + "A rights string consisting of zero or more rights + characters (lowercase) optionally beginning with a + \"+\" or \"-\" + e.g SETACL projectfolder other.user +cda + If the string starts with a plus, the following + rights are added to any existing rights for the + specified user. + If the string starts with a minus, the following + rights are removed from any existing rights for + the specified user. + If the string does not start with a plus or minus, + the rights replace any existing rights for the + specified user. + " + }] + proc SETACL {args} { + set argd [punk::args::parse $args withid ::punk::imap4::SETACL] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + set user [dict get $values user] + set rights [dict get $values rights] + if {[punk::imap4::proto::simplecmd $chan SETACL $mailbox $user $rights] != 0} { + return 1 + } + #todo - update appropriate cache? + return 0 + } + + lappend PUNKARGS [list { + @id -id ::punk::imap4::LISTRIGHTS + @cmd -name punk::imap4::LISTRIGHTS -help\ + "Get information about the required rights + and the optional rights for a specified user + on this mailbox. + The required rights (a possibly empty string) + are the rights that will always be granted to that + user in the mailbox. + The optional rights are rights that CAN be granted. + + incomplete + Currently need debug mode or showlog + to see results" + @leaders -min 1 -max 1 + chan + @values -min 0 -max 2 + mailbox -default INBOX + user -default anyone + }] + proc LISTRIGHTS {args} { + set argd [punk::args::parse $args withid ::punk::imap4::LISTRIGHTS] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + set user [dict get $values user] + if {[punk::imap4::proto::simplecmd $chan LISTRIGHTS $mailbox $user] != 0} { + return 1 + } + #todo - store in appropriate cache - retrieve if -inline specified? + return 0 + } + + + lappend PUNKARGS [list { @id -id ::punk::imap4::SELECT @cmd -name punk::imap4::SELECT -help\ - "Selects a mailbox so that messages in the mailbox can be + {Selects a mailbox so that messages in the mailbox can be accessed. - Only one mailbox can be selected at a time in a connection; - simultaneous access to multiple mailboxes requires multiple + Only one mailbox can be selected at a time in a connection. + This is termed a "session". + Simultaneous access to multiple mailboxes requires multiple connections. The SELECT command automatically deselects any currently selected mailbox before attempting the new selection. Consequently, if a mailbox is selected and a SELECT command that fails is attempted, no mailbox is selected. - " + } @leaders -min 1 -max 1 chan @values -min 0 -max 1 - mailbox -default INBOX + mailbox -default INBOX -help\ + {To supply a mailbox name with spaces + The value will need to be enclosed with + double quotes - and these quotes need to + be sent to the server. Enclose in curly + braces to ensure this. + e.g + SELECT $ch {"Deleted Items"} + } }] proc SELECT {args} { set argd [punk::args::parse $args withid ::punk::imap4::SELECT] @@ -1724,10 +2181,40 @@ tcl::namespace::eval punk::imap4 { selectmbox $chan SELECT $mailbox } + lappend PUNKARGS [list { + @id -id ::punk::imap4::EXAMINE + @cmd -name punk::imap4::EXAMINE -help\ + {The EXAMINE command is identical to SELECT and returns the + same output; however, the selected mailbox is identified as + read-only. No changes to the permanent state of the mailbox, + including per-user state, are permitted.} + @leaders -min 1 -max 1 + chan + @values -min 0 -max 1 + #todo - share argdefs more! + mailbox -default INBOX -help\ + {To supply a mailbox name with spaces + The value will need to be enclosed with + double quotes - and these quotes need to + be sent to the server. Enclose in curly + braces to ensure this. + e.g + SELECT $ch {"Deleted Items"} + } + }] + proc EXAMINE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::EXAMINE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + + selectmbox $chan EXAMINE $mailbox + } # General function for selection. proc selectmbox {chan cmd mailbox} { upvar ::punk::imap4::proto::info info variable mboxinfo + variable msginfo punk::imap4::proto::requirestate $chan {AUTH SELECT} # Clean info about the previous mailbox if any, @@ -1735,6 +2222,10 @@ tcl::namespace::eval punk::imap4 { #set savedmboxinfo [array get mboxinfo $chan,*] #array unset mboxinfo $chan,* dict unset mboxinfo $chan + #msginfo is based on seq-number - which is per mailbox, so we have to clear it for now. + #todo - keep cache of per mailbox msginfo even when based on seq-number? + dict unset msginfo $chan + #review - keep cache of uid based msginfo - where? set rtag [punk::imap4::proto::request $chan "$cmd $mailbox"] if {[punk::imap4::proto::getresponse $chan $rtag] != 0} { #array set mboxinfo $savedmboxinfo @@ -1742,30 +2233,81 @@ tcl::namespace::eval punk::imap4 { return 1 } + #TODO - state SELECT vs EXAMINE? set info($chan,state) SELECT + # Set the new name as mbox->current. #set mboxinfo($chan,current) $mailbox _set_mboxinfo $chan current $mailbox return 0 } - # Read-only equivalent of SELECT. - proc EXAMINE {chan {mailbox INBOX}} { - selectmbox $chan EXAMINE $mailbox + + #parse_seq-range - parse a seq-range from a sequence-set + #sequence-set + #Example: a message sequence number set of + # ; 2,4:7,9,12:* for a mailbox with 15 messages is + # ; equivalent to 2,4,5,6,7,9,12,13,14,15 + + + #parse_seq-range should be used primarily for examining sequence-set members + #when we want to determine the applicable ranges e.g to lookup cached info for each message + #When sending a sequence-set to the server, we can use parse_seq-range to check for errors, + #but we shouldn't be 'expanding' a valid sequence-set being sent to the server. + #We don't accept the : or :n or n: syntax accepted by the tcllib imap4 library + # - because the more explicit syntax specified in the IMAP RFCs is preferred + #(with possible * special value) + proc parse_seq-range {chan range} { + if {[string first , $range] >=0} { + error "parse_seq_range supplied value '$range' appears to be a sequence-set, not a seq-range or seq-number" + } + set rangelist [split $range :] + switch -- [llength $rangelist] { + 1 { + if {$range eq "*"} { + set start [mboxinfo $chan exists] + set end $start + } else { + set start $range + set end $range + } + if {![punk::imap4::proto::is_imap_nznumber $start] || ![punk::imap4::proto::is_imap_nznumber $end]} { + error "parse_seq-range Invalid range '$range'" + } + } + 2 { + lassign $rangelist start end + if {$start eq "*" && $end eq "*"} { + set end [mboxinfo $chan exists] + set start $end + } elseif {$start eq "*"} { + set start [mboxinfo $chan exists] + } elseif {$end eq "*"} { + set end [mboxinfo $chan exists] + } + if {![punk::imap4::proto::is_imap_nznumber $start] || ![punk::imap4::proto::is_imap_nznumber $end]} { + error "parse_seq-range Invalid range '$range'" + } + } + default { + error "parse_seq-range Invalid range '$range'" + } + } + return [list $start $end] } - # Parse an IMAP range, store 'start' and 'end' in the + #old_parse_seq-range + # Parse an IMAP seq-range, store 'start' and 'end' in the # named vars. If the first number of the range is omitted, # 1 is assumed. If the second number of the range is omitted, # the value of "exists" of the current mailbox is assumed. # # So : means all the messages. - proc parserange {chan range startvar endvar} { + proc old_parse_seq-range {chan range startvar endvar} { upvar $startvar start $endvar end set rangelist [split $range :] switch -- [llength $rangelist] { 1 { - ##nagelfar ignore if {![string is integer $range]} { error "Invalid range" } @@ -1780,7 +2322,6 @@ tcl::namespace::eval punk::imap4 { if {![string length $end]} { set end [mboxinfo $chan exists] } - ##nagelfar ignore if {![string is integer $start] || ![string is integer $end]} { error "Invalid range" } @@ -1796,28 +2337,35 @@ tcl::namespace::eval punk::imap4 { @cmd -name punk::imap4::FETCH -help\ "Fetch a number of attributes from messages. A mailbox must be SELECTed first and an appropriate - range supplied for the message(s) of interest." + sequence-set supplied for the message(s) of interest." @leaders -min 1 -max 1 chan @opts -inline -type none - @values -min 1 -max -1 - range -help\ - "Message sequence number set. + @values -min 2 -max -1 + #todo - use same sequence-set definition across argdefs + sequence-set -help\ + "Message sequence set. + 1 is the lowest valid sequence number. + * represents the maximum message sequence number + in the mailbox. e.g 1 - 1:3 2:2 - :3 + 1:3 + 3,5,9:10 + 1,10:* + *:5 + * " queryitems -default {} -help\ "Some common FETCH queries are shown here, but this list isn't exhaustive."\ - -multiple 1 -choiceprefix 0 -choicerestricted 0 -choicecolumns 2 -choices { + -multiple 1 -optional 0 -choiceprefix 0 -choicerestricted 0 -choicecolumns 2 -choices { ALL FAST FULL BODY BODYSTRUCTURE ENVELOPE FLAGS INTERNALDATE SIZE RFC822.SIZE UID - TEXT HEADER BODY[] + TEXT HEADER BODY[] BINARY[] BINARY.SIZE[] } -choicelabels { ALL\ " Macro equivalent to: @@ -1840,8 +2388,45 @@ tcl::namespace::eval punk::imap4 { " A parenthesized list that describes the MIME-IMB body structure of a message." {BODY[]}\ - "This retrieves the entire body including - headers" + { This retrieves the entire body including headers. + (RFC5322 expression of the entire message) + This implicitly sets the \Seen flag, as do other + FETCH BODY[...] operations. Ensure the mailbox is + opened using EXAMINE, or use BODY.PEEK[...] to avoid + this.} + {BINARY[]}\ + { Requests that the specified section be transmitted + after performing decoding of the section's + Content-Transfer-Encoding. + Like BODY[...] it will set the \Seen flag and also + has a BINARY.PEEK[...] alternate form. + Can only be requested for leaf body parts: those that + have media types other than multipart/*, + message/rfc822, or message/global.} + {BINARY.SIZE[]}\ + { Requests the decoded size fo the section (i.e , the + size to expect in response to the corresponding + FETCH BINARY request). + Only available for leaf body parts. + Can be an expensive operation on some servers. + } + RFC822.SIZE\ + { Number of octets in the message when the message + is expressed in RFC5322 format. SHOULD match the + result of a "FETCH BODY[]" command. Some servers + may store with different internal format and store + the size to avoid recalculation.} + SIZE\ + { Client-side alias for RFC822.SIZE for consistency + with tcllib IMAP4. Consider deprecating.} + ENVELOPE\ + " The envelope structure of the message. + Computed by the server by parsing the RFC5322 + header defaulting various fields as necessary" + INTERNALDATE\ + " The internal date of the message. + (Suitable as date arg for APPEND if copying a msg + from one server to another)" } }] proc FETCH {args} { @@ -1851,11 +2436,15 @@ tcl::namespace::eval punk::imap4 { set chan [dict get $leaders chan] set opt_inline [dict exists $received -inline] - set range [dict get $values range] + set sequenceset [dict get $values sequence-set] set query_items [dict get $values queryitems] punk::imap4::proto::requirestate $chan SELECT - parserange $chan $range start end + + #parse each seqrange to give it a chance to raise error for bad values + foreach seqrange [split $sequenceset ,] { + parse_seq-range $chan $seqrange + } set items {} set hdrfields {} @@ -1948,9 +2537,9 @@ tcl::namespace::eval punk::imap4 { # #don't wrap a single element in brackets - it may already be bracketed by the caller #for ALL FAST FULL - which can only occur on their own, bracketing is not allowed anyway. - set request_tag [punk::imap4::proto::request $chan "FETCH $start:$end [lindex $items 0]"] + set request_tag [punk::imap4::proto::request $chan "FETCH $sequenceset [lindex $items 0]"] } else { - set request_tag [punk::imap4::proto::request $chan "FETCH $start:$end ([join $items])"] + set request_tag [punk::imap4::proto::request $chan "FETCH $sequenceset ([join $items])"] } if {[punk::imap4::proto::getresponse $chan $request_tag] != 0} { if {$opt_inline} { @@ -2183,21 +2772,67 @@ tcl::namespace::eval punk::imap4 { proc NOOP {args} { set argd [punk::args::parse $args withid ::punk::imap4::NOOP] set chan [dict get $argd leaders chan] - punk::imap4::proto::simplecmd $chan NOOP * {} + punk::imap4::proto::simplecmd $chan NOOP } # CHECK. Flush to disk. - proc CHECK {chan} { - punk::imap4::proto::simplecmd $chan CHECK SELECT {} + lappend PUNKARGS [list { + @id -id ::punk::imap4::CHECK + @cmd -name punk::imap4::CHECK -help\ + "OBSOLETED in RFC9051. + NOOP should generally be used instead. + + The CHECK command requests a checkpoint of the currently + selected mailbox. + This was for implementation dependent housekeeping associated + with the mailbox. + " + @leaders -min 1 -max 1 + chan -optional 0 + @opts + @values -min 0 -max 0 + }] + proc CHECK {args} { + set argd [punk::args::parse $args withid ::punk::imap4::CHECK] + set chan [dict get $argd leaders chan] + punk::imap4::proto::simplecmd $chan -validstates {SELECT} CHECK } # Close the mailbox. Permanently removes \Deleted messages and return to # the AUTH state. - proc CLOSE {chan} { + lappend PUNKARGS [list { + @id -id ::punk::imap4::CLOSE + @cmd -name punk::imap4::CLOSE -help\ + {The CLOSE command permanently removes all messages that have the + \Deleted flag set from the currently selected mailbox, and it returns + to the authenticated state from the selected state. No untagged + EXPUNGE responses are sent. + + No messages are removed, and no error is given, if the mailbox is + selected by an EXAMINE command or is otherwise selected as read-only. + + Even if a mailbox is selected, a SELECT, EXAMINE, or LOGOUT command + MAY be issued without previously issuing a CLOSE command. The + SELECT, EXAMINE, and LOGOUT commands implicitly close the currently + selected mailbox without doing an expunge. However, when many + messages are deleted, a CLOSE-LOGOUT or CLOSE-SELECT sequence is + considerably faster than an EXPUNGE-LOGOUT or EXPUNGE-SELECT because + no untagged EXPUNGE responses (which the client would probably + ignore) are sent.} + @leaders -min 1 -max 1 + chan -optional 0 + @opts + @values -min 0 -max 0 + }] + proc CLOSE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::CLOSE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + upvar ::punk::imap4::proto::info info variable mboxinfo - if {[punk::imap4::proto::simplecmd $chan CLOSE SELECT {}]} { + if {[punk::imap4::proto::simplecmd $chan -validstates {SELECT} CLOSE]} { return 1 } @@ -2257,7 +2892,7 @@ tcl::namespace::eval punk::imap4 { } #todo - limit to imap4 rev2+? - if {[punk::imap4::proto::simplecmd $chan UNSELECT {*}$allowstates {}]} { + if {[punk::imap4::proto::simplecmd $chan -validstates $allowstates UNSELECT]} { return 1 } #array set mboxinfo {} ;#JMN @@ -2267,22 +2902,65 @@ tcl::namespace::eval punk::imap4 { } proc NAMESPACE {chan} { - punk::imap4::proto::simplecmd $chan NAMESPACE * + punk::imap4::proto::simplecmd $chan NAMESPACE } # Create a new mailbox. #todo - allow creation with specialuse metadata if # CREATE-SPECIAL-USE capability is present - proc CREATE {chan mailbox} { - punk::imap4::proto::simplecmd $chan CREATE {AUTH SELECT} $mailbox + lappend PUNKARGS [list { + @id -id "::punk::imap4::CREATE" + @cmd -name "punk::imap4::CREATE" -help\ + "Create a mailbox with the given name. + It is an error to attempt to create INBOX + or a name that refers to an existing mailbox. + Servers will generally allow creation of a + hierarchy of mailboxes if the mailbox separator + is within the name." + @leaders -min 1 -max 1 + chan + @opts + @values -min 1 -max 1 + mailbox + }] + proc CREATE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::CREATE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT} CREATE $mailbox } + + # RFC 5464 The IMAP METADATA Extension # ------------------------------------------------------------ # - RFC6154 IMAP LIST Extension for Special-use Mailboxes # - other mailbox 'annotations' ? # - relevant CAPS: SPECIAL-USE CREATE-SPECIAL-USE LIST-EXTENDED # ------------------------------------------------------------ - proc GETMETADATA {chan mailbox annotation} { + lappend PUNKARGS [list { + @id -id "::punk::imap4::GETMETADATA" + @cmd -name "punk::imap4::GETMETDATA" -help\ + "Get metadata on named mailbox, or server annotations + if empty-string provided instead of mailbox name." + @leaders -min 1 -max 1 + chan + @opts + @values -min 2 -max 2 + mailbox -help\ + {Mailbox name or empty string {""} for server annotations} + annotation -choicerestricted 0 -help\ + "May include glob character *"\ + -choices { + /private/specialuse /private/squat /private/sieve /private/sharedseen /private/comment + /private/expire /private/news2mail /private/pop3showafter + } -help\ + "Annotation is a string beginning with /private/ or /shared/ + Check specific server for supported mailbox annotations. + " + }] + proc GETMETADATA {args} { #on cyrus at least, annotation must begin with /shared or /private #e.g /private/specialuse #C: GETMETDATA "Foldername" /private/specialuse @@ -2294,20 +2972,35 @@ tcl::namespace::eval punk::imap4 { #S: \Junk #S: ) #S: OK Completed + set argd [punk::args::parse $args withid ::punk::imap4::GETMETADATA] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + set annotation [dict get $values annotation] + set annotation [string trim $annotation] if {![string match "/private/?*" $annotation] && ![string match "/shared/?*" $annotation]} { + #cyrus IMAP enforces this anyway.. others? can we ever send just the following? GETMETADATA name * error "GETMETADATA annotation must begin with /shared/ or /private/" } - punk::imap4::proto::simplecmd $chan GETMETADATA {AUTH SELECT} $mailbox $annotation + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} GETMETADATA $mailbox $annotation } lappend PUNKARGS [list { @id -id "::punk::imap4::SETMETADATA" @cmd -name "punk::imap4::SETMETDATA" -help\ - "Set metadata on mailbox" + "Set metadata on mailbox name. + + If an empty string is provided instead of the + mailbox name - the annotation is applied at + the server level. Users may be able to set + /private or /shared annotations at the server + level depending on how the server restricts + them." @leaders -min 1 -max 1 chan @opts + -ignorestate -type none @values -min 3 -max 3 mailbox annotation -choicerestricted 0 -choices { @@ -2324,6 +3017,11 @@ tcl::namespace::eval punk::imap4 { set argd [punk::args::parse $args withid ::punk::imap4::SETMETADATA] lassign [dict values $argd] leaders opts values received set chan [dict get $leaders chan] + if {[dict exists $received -ignorestate]} { + set ignorestate 1 + } else { + set ignorestate 0 + } set mailbox [dict get $values mailbox] set annotation [dict get $values annotation] set value [dict get $values value] @@ -2332,38 +3030,121 @@ tcl::namespace::eval punk::imap4 { if {![string match /private/?* $annotation] && ![string match /shared/?* $annotation]} { error "SETMETADATA annotation must begin with /shared/ or /private/" } + if {$ignorestate} { + set validstates * + } else { + set validstates {AUTH SELECT EXAMINE} + } if {$value in [list "" NIL]} { - punk::imap4::proto::simplecmd $chan SETMETADATA {AUTH SELECT} $mailbox "($annotation NIL)" + punk::imap4::proto::simplecmd $chan -validstates $validstates SETMETADATA $mailbox "($annotation NIL)" } else { - punk::imap4::proto::simplecmd $chan SETMETADATA {AUTH SELECT} $mailbox "($annotation \"$value\")" + punk::imap4::proto::simplecmd $chan -validstates $validstates SETMETADATA $mailbox "($annotation \"$value\")" } } # ------------------------------------------------------------ - # Delete a mailbox + lappend PUNKARGS [list { + @id -id "::punk::imap4::DELETE" + @cmd -name "punk::imap4::DELETE" -help\ + "Permanently delete the mailbox with the + given name. + Server behaviour may vary with regards + to when/if mailboxes with sub-boxes can + be deleted. + If the mailbox is successfully deleted, + all messages in that mailbox are removed. + Todo - document more." + @leaders -min 1 -max 1 + chan + @opts + @values -min 1 -max 1 + mailbox + }] proc DELETE {chan mailbox} { - punk::imap4::proto::simplecmd $chan DELETE {AUTH SELECT} $mailbox + set argd [punk::args::parse $args withid ::punk::imap4::DELETE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} DELETE $mailbox } - # Rename a mailbox - proc RENAME {chan oldname newname} { - punk::imap4::proto::simplecmd $chan RENAME {AUTH SELECT} $oldname $newname + lappend PUNKARGS [list { + @id -id "::punk::imap4::RENAME" + @cmd -name "punk::imap4::RENAME" -help\ + "Rename a mailbox. + It is an error to attempt to rename from a mailbox + name that does not exist or to a mailbox name that + already exists. + Some servers will allow renaming INBOX - but with + special behaviour - moving all messages in INBOX + to a folder with the given name, leaving INBOX + empty - except that submailboxes of INBOX (if any) + are not moved." + @leaders -min 1 -max 1 + chan + @opts + @values -min 2 -max 2 + oldname + newname + }] + proc RENAME {args} { + set argd [punk::args::parse $args withid ::punk::imap4::SUBSCRIBE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set oldname [dict get $values oldname] + set newname [dict get $values newname] + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} RENAME $oldname $newname } - # Subscribe to a mailbox - proc SUBSCRIBE {chan mailbox} { - punk::imap4::proto::simplecmd $chan SUBSCRIBE {AUTH SELECT} $mailbox + lappend PUNKARGS [list { + @id -id "::punk::imap4::SUBSCRIBE" + @cmd -name "punk::imap4::SUBSCRIBE" -help\ + "Add the specified mailbox name to the server's set + of \"active\" or \"subscribed\" mailboxes as returned + by the LIST (SUBSCRIBED) command. + + Some servers may maintain a mailbox name in its + subscribed list even if the mailbox doesn't always + exist. e.g a system-alerts mailbox that is created + and removed as necessary. + " + @leaders -min 1 -max 1 + chan + @opts + @values -min 1 -max 1 + mailbox + }] + proc SUBSCRIBE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::SUBSCRIBE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} SUBSCRIBE $mailbox } - # Unsubscribe to a mailbox - proc UNSUBSCRIBE {chan mailbox} { - punk::imap4::proto::simplecmd $chan UNSUBSCRIBE {AUTH SELECT} $mailbox + lappend PUNKARGS [list { + @id -id "::punk::imap4::UNSUBSCRIBE" + @cmd -name "punk::imap4::UNSUBSCRIBE" -help\ + "Unsubscribe to a mailbox" + @leaders -min 1 -max 1 + chan + @opts + @values -min 1 -max 1 + mailbox + }] + proc UNSUBSCRIBE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::UNSUBSCRIBE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $values mailbox] + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} UNSUBSCRIBE $mailbox } #TODO proc IDLE {chan} { - if {[punk::imap4::prot::has_capability $chan IDLE]} { - punk::imap4::proto::simplecmd $chan IDLE {AUTH SELECT} + if {[punk::imap4::proto::has_capability $chan IDLE]} { + punk::imap4::proto::simplecmd $chan -validstates {AUTH SELECT EXAMINE} IDLE } else { error "IMAP SERVER has NOT advertised the capability IDLE." } @@ -2396,7 +3177,7 @@ tcl::namespace::eval punk::imap4 { -inline -type none @values -min 0 -max 2 ref -default "" - mbox -default "*" + mailboxpattern -default "*" }] # List of folders proc FOLDERS {args} { @@ -2408,7 +3189,7 @@ tcl::namespace::eval punk::imap4 { set opt_inline [dict exists $received -inline] set opt_ignorestate [dict exists $received -ignorestate] set ref [dict get $values ref] - set mbox [dict get $values mbox] + set mbox [dict get $values mailboxpattern] array unset folderinfo $chan,* @@ -2422,29 +3203,30 @@ tcl::namespace::eval punk::imap4 { # parray folderinfo #set rv [punk::imap4::proto::simplecmd $chan LIST $allowstates \"$ref\" \"$mbox\"] if {[has_capability $chan SPECIAL-USE]} { - set rv [punk::imap4::proto::simplecmd $chan LIST $allowstates \"$ref\" \"$mbox\" RETURN (SPECIAL-USE SUBSCRIBED)] + set rv [punk::imap4::proto::simplecmd $chan -validstates $allowstates LIST \"$ref\" \"$mbox\" RETURN {(SPECIAL-USE SUBSCRIBED)}] } else { - set rv [punk::imap4::proto::simplecmd $chan LIST $allowstates \"$ref\" \"$mbox\" RETURN (SUBSCRIBED)] - } - if {$opt_inline} { - set rv {} - foreach f [folderinfo $chan flags] { - set lflags {} - foreach fl [lindex $f 1] { - #review - here we are converting things like {\HasNoChildren} to {hasnochildren} - #This may be desirable from a tcl script user's point of view - but may also - #be a surprise for those expecting the exact IMAP flags. todo? - if {[string is alnum [string index $fl 0]]} { - lappend lflags [string tolower $fl] - } else { - lappend lflags [string tolower [string range $fl 1 end]] - } + set rv [punk::imap4::proto::simplecmd $chan -validstates $allowstates LIST \"$ref\" \"$mbox\" RETURN (SUBSCRIBED)] + } + if {!$opt_inline} { + return $rv + } + + set inlineresult {} + foreach f [folderinfo $chan flags] { + set lflags {} + foreach fl [lindex $f 1] { + #review - here we are converting things like {\HasNoChildren} to {hasnochildren} + #This may be desirable from a tcl script user's point of view - but may also + #be a surprise for those expecting the exact IMAP flags. todo? + if {[string is alnum [string index $fl 0]]} { + lappend lflags [string tolower $fl] + } else { + lappend lflags [string tolower [string range $fl 1 end]] } - lappend rv [list [lindex $f 0] $lflags] } + lappend inlineresult [list [lindex $f 0] $lflags] } - # parray folderinfo - return $rv + return $inlineresult } @@ -2454,8 +3236,8 @@ tcl::namespace::eval punk::imap4 { error "missing arguments. Usage: search chan arg ?arg ...?" } - punk::imap4::proto::requirestate $chan SELECT - set imapexpr [convert_search_expr $args] + punk::imap4::proto::requirestate $chan {SELECT EXAMINE} + set imapexpr [punk::imap4::proto::convert_search_expr $args] punk::imap4::proto::multiline_prefix_command imapexpr "SEARCH" punk::imap4::proto::multiline_request $chan $imapexpr if {[punk::imap4::proto::getresponse $chan]} { @@ -2616,38 +3398,173 @@ tcl::namespace::eval punk::imap4 { # proc ::imap4::store # proc ::imap4::logout (need to clean both msg and mailbox info arrays) - # Amend the flags of a message to be updated once CLOSE/EXPUNGE is initiated - proc STORE {chan range key values} { - set valid_keys { - FLAGS - FLAGS.SILENT - +FLAGS - +FLAGS.SILENT - -FLAGS - -FLAGS.SILENT - } - if {$key ni $valid_keys} { - error "Invalid data item: $key. Must be one of [join $valid_keys ,]" - } - parserange $chan $range start end - set newflags {} - foreach val $values { - if {[regexp {^\\+(.*?)$} $val]} { - lappend newflags $values - } else { - lappend newflags "\\$val" - } + # Amend the flags of a message to be updated once CLOSE/EXPUNGE is initiated ;#obsolete? + #STORE of a flag should be imediately reflected in the server state. + #\Recent is imaprev1 only (deprecated) - but in any case, is read-only + #The UID SEARCH mechanism should now be used instead of looking for \Recent flag on the mailbox + #or the untagged response: * RECENT + #UID SEARCH UID > + #The \Recent flag may exist on messages - but is optional + lappend PUNKARGS [list { + @id -id ::punk::imap4::STORE + @cmd -name punk::imap4::STORE -help\ + "Alters data associated with a message (or messages) in the mailbox. + + The .SILENT suffix for the storetype arg indicates the client is not + requesting an untagged FETCH response indicating the new state of + the flags; however, even in it's presence, servers should send an + untagged FETCH response if an external change to the flags is + observed (e.g changed by another client/session) + " + @leaders -min 1 -max 1 + chan -optional 0 -help\ + "existing channel for an open IMAP connection" + @values -min 2 -max 3 + sequence-set -help\ + "A message sequence set such as: + 1:1 + 2:4 + *:3 + 1,3,5,7:9 + " + storetype -default +FLAGS -choicecolumns 1 -choices {+FLAGS +FLAGS.SILENT -FLAGS -FLAGS.SILENT FLAGS FLAGS.SILENT}\ + -choicelabels { + +FLAGS\ + "Add the supplied flagnames to the flags for the message. + The new value of the flags is returned as if a FETCH of + those flags was done." + +FLAGS.SILENT\ + "Equivalent to FLAGS, but without returning the new value." + -FLAGS\ + "Remove the supplied flagnames from the flags for the + message. The new value of the flags is returned as if a + FETCH of those flags was done." + -FLAGS.SILENT\ + "Equivalent to -FLAGS, but without returning a new value." + FLAGS\ + "REPLACE the flags for the message with the suplied + flagnames. The new value of the flags is returned as if + a FETCH of those flags was done." + FLAGS.SILENT\ + "Equivalent to FLAGS, but without returning a new value." + } -help\ + "The type of STORE operation to be performed on the upplied flagnames" + flagname -multiple 1 -choicecolumns 2 -choicerestricted 0 -choicegroups { + SystemFlags {{\Deleted} {\Flagged} {\Seen} {\Answered} {\Draft}} + Keywords9051 {{$MDNSent} {$Forwarded} {$Junk} {$NotJunk} {$Phishing}} + OtherKeywords {{$Important} {$Submitted} {$SubmitPending}} + Obsolete {{\Recent}} + }\ + -choicelabels { + {\Seen}\ + { Message has been read} + {\Answered}\ + { Message has been answered} + {\Flagged}\ + { Message is "flagged" for urgent/special attention} + {\Deleted}\ + { Message is "deleted" for removal by later EXPUNGE} + {\Draft}\ + { Message has not completed composition (marked as a + draft).} + {\Recent}\ + { This flag was in use in IMAP4rev1 and was deprecated + in RFC9051} + $Forwarded\ + " Message has been forwarded to another email address + by being embedded within, or attached to a new message. + An email client sets this keyword when it successfully + forwards the message to another email address. Typical + usage of this keyword is to show a different (or + additional) icon for a message that has been forwarded. + Once set, the flag SHOULD NOT be cleared." + $MDNSent\ + " Message Disposition Notification [RFC8098] was + generated and sent for this message. See [RFC3503] for + more details on how this keyword is used and for + requirements on clients and servers." + $Junk\ + " The user (or a delivery agent on behalf of the user) + may choose to mark a message as definitely containing + junk. The $Junk keyword can be used to mark, group, + or hide undesirable messages (and such messages might + be removed or deleted later)." + $NotJunk\ + " The user (or a delivery agent on behalf of the user) + may choose to mark a message as definitely not + containing junk. The $NotJunk keyword can be used to + mark, group, or show messages that the user wants to + see." + $Phishing\ + " The $Phishing keyword can be used by a delivery agent + to mark a message as highly likely to be a phishing + email. A message that's determined to be a phishing + email by the delivery agent should also be considered + junk email and have the appropriate junk filtering + applied, including setting the $Junk flag and placing + the message in the \Junk special-use mailbox if + available" + } -help\ + {Each supplied value is a system flag such as \Seen \Deleted etc or a + keyword/user-defined flag (a name not beginning with a backslash) + The items listed as Keywords9051 are mentioned in RFC9051 as SHOULD be supported + by servers. See also registered keywords: + https://www.iana.org/assignments/imap-jmap-keywords/imap-jmap-keywords.xhtml + } + }] + proc STORE {args} { + set argd [punk::args::parse $args withid ::punk::imap4::STORE] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set sequenceset [dict get $values sequence-set] + set storetype [dict get $values storetype] + set flagnames [dict get $values flagname] ;#multiple + + set ranges [split $sequenceset ,] + #parse each seq-range to give a chance to raise error + foreach range $ranges { + parse_seq-range $chan $range } - set clitag [punk::imap4::proto::request $chan "STORE $start:$end $key ([join $newflags])"] + + #review - do we need any client side validation? Duplicates only? + #What about presence of inconsistent flags $Junk $NotJunk? + #probably just best to let the server sort it out + #set validatedflags {} + #foreach fname $flagnames { + # if {[regexp {^\\+(.*?)$} $fname]} { + # #system flag - restrict? + # lappend validatedflags "\\$fname" + # } else { + # #user-defined flag - any name that does not start with a backslash + # lappend validatedflags $fname + # } + #} + set clitag [punk::imap4::proto::request $chan "STORE $sequenceset $storetype ([join $flagnames])"] if {[punk::imap4::proto::getresponse $chan $clitag]} { return 1 } return 0 } - # Logout - proc LOGOUT {chan} { - if {[punk::imap4::proto::simplecmd $chan LOGOUT * {}]} { + lappend PUNKARGS [list { + @id -id ::punk::imap4::LOGOUT + @cmd -name punk::imap4::LOGOUT -help\ + "End the connection cleanly. + + This disconnects from the server and reads the untagged BYE response + from the server. + It also tidies up client state associated with the channel." + @leaders -min 1 -max 1 + chan -optional 0 + @opts + @values -min 0 -max 0 + }] + proc LOGOUT {args} { + set argd [punk::args::parse $args withid ::punk::imap4::LOGOUT] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + + if {[punk::imap4::proto::simplecmd $chan LOGOUT]} { # clean out info arrays variable folderinfo variable mboxinfo @@ -2670,23 +3587,84 @@ tcl::namespace::eval punk::imap4 { return 0 } - # Expunge : force removal of any messages with the - # flag \Deleted + #Permanently removes all messages that have the \Deleted flag + #set from the currently selected mailbox. proc EXPUNGE {chan} { - if {[punk::imap4::proto::simplecmd $chan EXPUNGE SELECT {}]} { + #Cannot call from EXAMINE state + if {[punk::imap4::proto::simplecmd $chan -validstates {SELECT} EXPUNGE]} { return 1 } return 0 } # copy : copy a message to a destination mailbox - proc COPY {chan msgid mailbox} { - if {[punk::imap4::proto::simplecmd $chan COPY SELECT [list $msgid $mailbox]]} { + lappend PUNKARGS [list { + @id -id ::punk::imap4::COPY + @cmd -name punk::imap4::COPY -help\ + "Copies the specified message(s) to the end + of the destination mailbox. + The server SHOULD preserve the flags and + internal date of the message(s) in the copy." + @leaders -min 1 -max 1 + chan + @values -min 2 -max 2 + sequence-set + mailbox + }] + proc COPY {args} { + set argd [punk::args::parse $args withid :punk::imap4::COPY] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set sequenceset [dict get $values sequence-set] + set mailbox [dict get $values mailbox] + if {[punk::imap4::proto::simplecmd $chan -validstates {SELECT EXAMINE} COPY $sequenceset $mailbox]} { return 1 } return 0 } + lappend PUNKARGS [list { + @id -id ::punk::imap4::APPEND + @cmd -name punk::imap4::APPEND -help\ + "EXPERIMENTAL - incomplete" + @leaders -min 2 -max 4 + chan + mailbox + #The API is a little clunky because the IMAP function has optional interim arguments between mailbox and message. + #We can only put flags after all leaders - which can make this function + #appear inconsistent with others where options always come after chan. + #This is a somewhat deliberate limitation of punk::args - it is intended to provide a simple understandable model + #covering most use-cases - not totally freeform mixes of options between other arguments - especially with optional + #non-flag arguments. (efficiency and complexity and unambiguity regarding values starting with - are important considerations) + #e.g "func a -opt1 o1 b? c? d e" is not supported. + #(optional non-flag args must be at end of leaders or values - and opts must be between those 2 sets.) + #so instead we will use the equiv of "func a b? c? -opt1 o1 d e" + flaglist -default {} -optional 1 -type list -help\ + {List of flags such as \Seen \Flagged} + datetime -default "" -optional 1 -type string + @opts + @values -min 1 -max 1 + message + }] + proc APPEND {args} { + set argd [punk::args::parse $args withid ::punk::imap4::APPEND] + lassign [dict values $argd] leaders opts values received + set chan [dict get $leaders chan] + set mailbox [dict get $leaders mailbox] + set flaglist [dict get $leaders flaglist] + set datetime [dict get $leaders datetime] + set message [dict get $values message] + + #todo - send as single synchronizing literal after getting server's continuation (or non-synchronising literals) + + return 1 + #if {[punk::imap4::proto::simplecmd $chan -validstates {SELECT EXAMINE} APPEND $mailbox]} { + # return 1 + #} + #return 0 + } + + #ascii art from RFC3501/RFC9051 proc rfc_diagram {} { punk::args::lib::tstr { @@ -2739,6 +3717,12 @@ tcl::namespace::eval punk::imap4 { } } + #FROM RFC9051 + #"Session" refers to the sequence of client/server interaction from + #the time that a mailbox is selected (SELECT or EXAMINE command) until + #the time that selection ends (SELECT or EXAMINE of another mailbox, + #CLOSE command, UNSELECT command, or connection termination). + #*** !doctools #[list_end] [comment {--- end definitions namespace punk::imap4 ---}] } @@ -3193,6 +4177,28 @@ tcl::namespace::eval punk::imap4::lib { return $words } + #taking an existing words dict that may contain type = literal entries (value = {n}) + # and a list of the previously read literals + # stitch them together + proc imapwords_resolved {words literals} { + dict for {wordindex wordinfo} $words { + if {[dict get $wordinfo type] eq "literal"} { + set lit [dict get $wordinfo value] + set litinner [string range $lit 1 end-1] + #server does not send non-synchronizing literals e.g {123+} + set resolved_value [::lpop literals 0] + if {[punk::imap4::proto::is_imap_number64 $litinner] && [string length $resolved_value] == $litinner} { + dict set words $wordindex value $resolved_value + } else { + #protoerror $chan "IMAP: METADATA malformed response ($lit mismatch size of literal [string length $val]) '$line'" + } + + dict set words $wordindex type resolvedliteral + } + } + return $words ;#resolved words where type 'literal' has been replaced with 'resolvedliteral' + } + #firstword_basic and secondword_basic don't handle IMAP structures such as lists etc proc firstword_basic {line} { if {[regexp -indices -start 0 {\S+} $line range]} { @@ -3424,7 +4430,7 @@ if {[info script] eq $argv0} { set folder [dict get $values folder] # open and login ... - set imap [punk::imap4::OPEN {*}$debugflags -security $opt_security $server $opt_port] + set imap [punk::imap4::CONNECT {*}$debugflags -security $opt_security $server $opt_port] punk::imap4::AUTH_LOGIN $imap $user $pass punk::imap4::select $imap $folder @@ -3439,7 +4445,7 @@ if {[info script] eq $argv0} { set fields {from: to: subject: size} # fetch 3 records (at most)) inline set max [expr {$num_mails<=3?$num_mails:3}] - foreach rec [punk::imap4::FETCH $imap :$max -inline {*}$fields] { + foreach rec [punk::imap4::FETCH $imap 1:$max -inline {*}$fields] { puts -nonewline "#[incr idx])" for {set j 0} {$j<[llength $fields]} {incr j} { puts "\t[lindex $fields $j] [lindex $rec $j]" diff --git a/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm new file mode 100644 index 00000000..d98c38c4 --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm @@ -0,0 +1,1228 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2025 +# +# @@ Meta Begin +# Application punk::netbox 0.1.0 +# Meta platform tcl +# Meta license MIT +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::netbox 0 0.1.0] +#[copyright "2025"] +#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] +#[moddesc {-}] [comment {-- Description at end of page heading --}] +#[require punk::netbox] +#[keywords module] +#[description] +#[para] - + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::netbox +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::netbox +#[list_begin itemized] + +package require Tcl 8.6- +package require http +package require rest +package require punk::args +#*** !doctools +#[item] [package {Tcl 8.6}] +#[item] [package {http}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#tcl::namespace::eval punk::netbox::class { + #*** !doctools + #[subsection {Namespace punk::netbox::class}] + #[para] class definitions + #if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + #} +#} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +tcl::namespace::eval punk::netbox {} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +tcl::namespace::eval punk::netbox::system { + #*** !doctools + #[subsection {Namespace punk::netbox::system}] + #[para] Internal functions that are not part of the API + + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + + punk::args::define { + @id -id ::punk::netbox::system::make_rest_func + @leaders -min 2 -max 2 + commandname -help\ + "Fully qualified commandname. + There must be an existing punk::args definition with @id + directive -id matching the name" + endpoint -help\ + "The subpath to be appended to the base url. + e.g api/ipam/ip-addresses/" + -verb -default get -choices {get post patch head put delete} + -body -default optional -choicecolumns 2 -choices {none optional required mime_multipart}\ + -choicelabels { + none\ + " The call has no request body, + none must be supplied." + optional\ + " A request body can be supplied, + but is not required" + required\ + " A request body must be supplied." + mime_multipart\ + " A request body must be supplied + and will be interpreted as each + argument representing one part of + a mime/multipart document. Arguments + must be lists containing 2 elements, + a list of header keys and values, + and the mime part body, in this order." + } + } + proc make_rest_func {args} { + set argd [punk::args::parse $args withid ::punk::netbox::system::make_rest_func] + lassign [dict values $argd] leaders opts values received + + set commandname [dict get $leaders commandname] + set endpoint [dict get $leaders endpoint] + set verb [dict get $opts -verb] + set body [dict get $opts -body] + + set custom [dict create\ + %commandname% $commandname\ + %endpoint% $endpoint\ + %verb% $verb\ + %body% $body\ + %showdict% {!@@results @@results/@*/@*.@*}\ + %showdict2% {@@results/@*/@*.@* !@@results}\ + ] + if {$commandname eq "::punk::netbox::status"} { + #we get duplicate django-version for %showdict% - todo - something. + dict set custom %showdict% {@@django-version @@installed-apps/@*.@* !@@installed-apps} + dict set custom %showdict2% {@@installed-apps/@*.@* !@@installed-apps} + } + + set procbody [string map $custom { + set argd [punk::args::parse $args withid %commandname%] + lassign [dict values $argd] leaders opts values received + set apicontextid [dict get $leaders apicontextid] + if {[dict exists $received -RETURN]} { + set returntype [dict get $opts -RETURN] + } else { + if {[dict exists $opts -RETURN]} { + #not received - but has default + set returntype [dict get $opts -RETURN] + } else { + #fallback if -RETURN was defined without a default or was omitted + set returntype dict + } + } + + set query [dict create] + dict for {k v} $opts { + switch -- $k { + -CUSTOM_PARAM { + foreach custval $v { + lassign $custval param value + dict set query $param $value + } + } + -RETURN { + #ignore - already handled + } + default { + if {[string match *_FILTER $k]} { + set field [string range [string tolower [lindex [split $k _] 0]] 1 end] ;# -NAME_FILTER -> name + foreach fv $v { + lassign $fv filter value + dict set query ${field}__$filter $value + } + } else { + dict set query [string range $k 1 end] $v + } + } + } + + } + set body %body% + switch -- $body { + required { + set requestbody [dict get $values body] + } + optional { + if {[dict exists $received body]} { + set requestbody [dict get $values body] + } else { + set requestbody "" + } + } + } + upvar ::punk::netbox::contexts contexts + if {![dict exists $contexts $apicontextid]} { + error "specified contextid '$apicontextid' not found" + } + set config [dict create\ + format json\ + result json\ + ] + #rest api documentation is unclear on 'result' field + #note our default: result json + #this actually converts the json to a dict + + + dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] + if {$returntype eq "json"} { + #if we set result json - we get a dict instead of json :/ + dict set config result raw + } + + #variable headerdict + #set config [dict create\ + # headers $headerdict\ + #] + + set url [dict get $contexts $apicontextid url value] + puts "${url}%endpoint% '$query' '$config'" + if {$body in {required optional}} { + set result [::rest::%verb% ${url}%endpoint% $query $config $requestbody] + } else { + set result [::rest::%verb% ${url}%endpoint% $query $config] + } + switch -exact -- $returntype { + showdict { + #return [punk::lib::showdict $result !@@results @@results/@*/@*.@*] + return [punk::lib::showdict $result %showdict%] + } + showdict2 { + #return [punk::lib::showdict $result @@results/@*/@*.@* !@@results] + return [punk::lib::showdict $result %showdict2%] + } + default { + #dict or json - the counterintuitive 'result' field above sets this + return $result + } + } + }] + proc $commandname {args} $procbody + } + +} + +tcl::namespace::eval punk::netbox { + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + # Base namespace + # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + #*** !doctools + #[subsection {Namespace punk::netbox}] + #[para] Core API functions for punk::netbox + #[list_begin definitions] + + variable PUNKARGS + + variable has_tls + set has_tls [expr {![catch {package require tls}]}] + + if {$has_tls} { + ::http::register https 443 ::tls::socket + } + + variable ipam + + #TEMP - todo + variable headerdict + set headerdict [dict create\ + Authorization "Token af65b993000874eaefeca0fa02b0d86014e48365"\ + ] + #temp + variable url https://www.netbox1.intx.com.au/ + + + variable contexts [dict create] + variable context_id 0 + + proc api_context_names {} { + variable contexts + return [dict keys $contexts] + } + + lappend PUNKARGS [list { + @id -id ::punk::netbox::api_contexts + @cmd -name punk::netbox::api_contexts -help\ + "Show in-memory api contexts. + These are named contexts for calling + the NETBOX rest api. + They are loaded using api_contexts_load from + a .toml configuration file, or created using + api_context_create." + -return -default table -choices {table tableobject dict} + -fields -type list -default {url tokentail comment} -choices {url token tokentail comment *} -choicemultiple {0 -1} -choicerestricted 0 -help\ + "The * token can be included in the list of specified + fields, and represents any other available fields found + from the matched contexts" + @values -min 0 -max 1 + globname -default * -help\ + "pattern to match the context name(s)" + }] + proc api_contexts {args} { + set argd [punk::args::parse $args withid ::punk::netbox::api_contexts] + lassign [dict values $argd] leaders opts values received + set returntype [dict get $opts -return] + set fields [dict get $opts -fields] + set globname [dict get $values globname] + + + variable contexts + set matches [dict keys $contexts $globname] + + + if {"*" in $fields} { + set starposn [lsearch -exact $fields *] + set before [lrange $fields 0 $starposn-1] + set after [lrange $fields $starposn+1 end] + set allspecified [list {*}$before {*}$after] + # use * as placeholder for all others not specified - retain order of specified columns + set fields [list] + #check fields in all matches + set starfields [list] + if {"tokentail" ni $allspecified} { + #calculated column + lappend starfields tokentail + } + foreach k $matches { + set contextinfo [dict get $contexts $k] + dict for {valkey valinfo} $contextinfo { + if {$valkey ni $allspecified && $valkey ni $starfields} { + lappend starfields $valkey + } + } + } + set fields [list {*}$before {*}$starfields {*}$after] + } + + + switch -- $returntype { + table - tableobject { + package require textblock + set t [textblock::table -return tableobject -minwidth 75 -headers [list contextid {*}$fields]] + foreach k $matches { + set contextinfo [dict get $contexts $k] + set tokentail "" + if {"tokentail" in $fields} { + #computed column + if {[dict exists $contextinfo token]} { + set tokentail [string range [dict get $contextinfo token] end-5 end] + } + } + set rowdata [list $k] + foreach f $fields { + if {[dict exists $contextinfo $f value]} { + lappend rowdata [dict get $contextinfo $f value] + } else { + if {$f eq "tokentail"} { + lappend rowdata $tokentail + } else { + lappend rowdata "" + } + } + } + $t add_row $rowdata + } + if {$returntype eq "table"} { + set tableview [$t print] + $t destroy + return $tableview + } else { + return $t + } + } + dict { + set result [dict create] + foreach k $matches { + set contextinfo [dict get $contexts $k] + set tokentail "" + if {"tokentail" in $fields} { + #computed column + if {[dict exists $contextinfo token]} { + set tokentail [string range [dict get $contextinfo token] end-5 end] + } + } + dict set result $k {} ;#ensure record is output even if empty fieldlist + foreach f $fields { + if {[dict exists $contextinfo $f value]} { + dict set result $k $f [dict get $contextinfo $f value] + } else { + if {$f eq "tokentail"} { + dict set result $k tokentail $tokentail + } + } + } + #dict for {valkey valinfo} $contextinfo { + # dict set result $k $valkey [dict get $valinfo value] + #} + } + return $result + } + } + } + + + + #get api handle(s) for a netbox server (with url and token) to pass to the punk::netbox api functions + lappend PUNKARGS [list { + @id -id ::punk::netbox::api_context_load + @cmd -name punk::netbox::api_context_load -help\ + "Load API context information (url token) + from a .toml file in the data directory + or from a specified file. + To create an initial file, use api_context + to create one or more named configurations + specifying the url and authentication token. + Then use api_context_save to persist them." + @opts + -contextname -default * -help\ + "Name of an API context or a pattern for + which contexts to load from the file." + @values + filepath -default "" -type file + }] + proc api_context_load {args} { + set argd [punk::args::parse $args withid ::punk::netbox::api_context_load] + lassign [dict values $argd] leaders opts values received + set contextglob [dict get $opts -contextname] + set filepath [dict get $values filepath] + + if {$filepath eq ""} { + set filepath [_datafile] + } + if {![file exists $filepath]} { + error "No existing datafile at '$filepath'\nUse api_context_create to configure a context and save it with api_context_save" + } + package require tomlish + set tomldata [readFile $filepath] + set tomlish [tomlish::from_toml $tomldata] ;#intermediate (unvalidated) representation of toml data - maintaining whitespace and comments + set tomldict [tomlish::to_dict $tomlish] ;#lossy conversion to a programmatic structure (loss is of comments, whitespace) + variable contexts + #merge into any existing-in-memory loaded/created contexts + set loaded [list] + dict for {contextid contextinfo} $tomldict { + if {[string match $contextglob $contextid]} { + if {![dict exists $contextinfo url]} { + puts "api_context_load warning: Loaded context $contextid is missing 'url' key" + } + if {![dict exists $contextinfo token]} { + puts "api_context_load warning: Loaded context $contextid is missing 'token' key" + } + dict set contexts $contextid $contextinfo + lappend loaded $contextid + } + } + return $loaded + } + + lappend PUNKARGS [list { + @id -id ::punk::netbox::api_context_create + @cmd -name punk::netbox::api_context_create -help\ + "Create an in-memory configuration for an API context. + This consists of a name (contextid) under which a + url and authentication token are stored. + It can optionally be persisted using api_context_save + to the file of your choice, or to a reasonable default + location. (see _datafile). + The api_context_load function can be used to retrieve + previously stored contextids instead of calling this + function each time. + + A contextid is required when calling the netbox rest api + functions such as ipam::vrfs + This allows easy intermixing of calls to either the same + or different servers using the different permissions + granted by each token. + " + @leaders -min 1 -max 1 + contextid -type string -help\ + "Name for the api context. + If saved to a .toml file, this + will be the name of a toplevel table + containing configuration elements such + as url and token." + @opts + -property_value -type list -minsize 2 -maxsize 2 -multiple 1 -help\ + "custom property and value. + e.g + property_value {comment {test comment}}" + @values -min 2 -max 2 + url -type string -help\ + "Base url of netbox server" + token -type string -help\ + "Netbox API authentication token" + }] + proc api_context_create {args} { + set argd [punk::args::parse $args withid ::punk::netbox::api_context_create] + lassign [dict values $argd] leaders opts values received + set contextid [dict get $leaders contextid] + if {[dict exists $received -property_value]} { + set propvals [dict get $opts -property_value] ;#multiple - as pairs + } else { + set propvals [list] + } + set baseurl [dict get $values url] + set token [dict get $values token] + + variable contexts + if {[dict exists $contexts $contextid]} { + error "api_context_create a context with id '$contextid' already exists." + } + set allprops [dict create url [dict create type STRING value $baseurl] token [dict create type STRING value $token]] + foreach pv $propvals { + lassign $pv p v + if {$p in {url token}} { + puts stderr "ignoring -property_value $p - invalid - already specified in arguments" + } + #todo - multiline? + dict set allprops $p [dict create type STRING value $v] + } + dict set contexts $contextid $allprops + return $contextid + } + proc _homedir {} { + if {[info exists ::env(HOME)]} { + set home [file normalize $::env(HOME)] + } else { + #not available on 8.6? ok will error out here. + set home [file tildeexpand ~] + } + return $home + } + lappend PUNKARGS [list { + @id -id ::punk::netbox::_datafile + @cmd -name punk::netbox::_datafile -help\ + "Get the path for the default storage file + used when an explicit path is not given by + the caller to the api_context load/save + functions. This file is in toml format. + The XDG_DATA_HOME env var is the preferred + choice of location - considered more secure + than XDG_CONFIG_HOME, although not as good + as a proper secret store. + A folder under the user's home directory, + at .local/share/punk/netbox is chosen if + XDG_DATA_HOME is not configured. + " + @leaders -min 0 -max 0 + @opts + -quiet -type none -help\ + "Suppress warning given when the folder does + not yet exist" + @values -min 0 -max 0 + }] + proc _datafile {args} { + set argd [punk::args::parse $args withid ::punk::netbox::_datafile] + lassign [dict values $argd] leaders opts values received + set be_quiet [dict exists $received -quiet] + + set was_noisy 0 + if {[info exists ::env(XDG_DATA_HOME)]} { + set data_home $::env(XDG_DATA_HOME) + } else { + set data_home [file join [_homedir] .local share] + if {!$be_quiet} { + puts stderr "Environment variable XDG_DATA_HOME does not exist - consider setting it if $data_home is not a suitable location" + set was_noisy 1 + } + } + if {!$be_quiet && ![file exists $data_home]} { + #parent folder for 'punk' config dir doesn't exist + set msg "configuration location (XDG_DATA_HOME or ~/.local/share) $data_home does not yet exist" + append msg \n " - please create it and/or set XDG_DATA_HOME env var." + puts stderr $msg + set was_noisy 1 + } + set punk_netbox_data_dir [file join $data_home punk netbox] + if {!$be_quiet && ![file exists $punk_netbox_data_dir]} { + set msg "punk::netbox data storage folder at $punk_netbox_data_dir does not yet exist." + append msg \n " It will be created if api_context_save is called without specifying an alternate location." + puts stderr $msg + set was_noisy 1 + } + if {!$be_quiet && $was_noisy} { + puts stderr "punk::netbox::_datafile - call with -quiet option to suppress these messages" + } + return [file join $punk_netbox_data_dir netbox_api_contexts.toml] + } + + lappend PUNKARGS [list { + @id -id ::punk::netbox::api_context_save + @cmd -name punk::netbox::api_context_save -help\ + "" + @values + contextid -type string -help\ + "Name for the api context. + If saved to a .toml file, this + will be the name of a toplevel table + containing configuration elements such + as url and token." + filepath -default "" -optional 1 -type file -help\ + "Path of .toml configuration file containing + API url and token information. + If empty it will store under XDG_DATA_DIR + if the env var is defined, or in the + corresponding location within ~/.local/share. + In both cases the subfolder netbox/punk will + be used. + These locations are fairly reasonable for + sensitive data - but as tokens are not + encrypted, a proper security store should be + used instead if your risk-policy requires + more serious security. + " + }] + proc api_context_save {args} { + set argd [punk::args::parse $args withid ::punk::netbox::api_context_save] + lassign [dict values $argd] leaders opts values received + set contextid [dict get $values contextid] + set filepath [dict get $values filepath] + + variable contexts + if {![dict exists $contexts $contextid]} { + error "punk::netbox::api_context_save error. No context with id '$contextid' exists. Load from file, or create it using punk::netbox::api_context" + } + if {$filepath eq ""} { + set filepath [_datafile -quiet] + set filefolder [file dirname $filepath] + if {![file exists $filefolder]} { + file mkdir $filefolder + } + } + set configdir [file dirname $filepath] + if {![file exists $configdir]} { + error "api_context_save error: folder $configdir doesn't exist" + } + package require tomlish + if {[file exists $filepath]} { + set existing_toml [readFile $filepath] + set tomlish [tomlish::from_toml $existing_toml] + set data_dict [tomlish::to_dict $tomlish] + if [dict exists $data_dict $contextid] { + #todo - nondestructive merge - don't destroy comments/formatting of existing records + #if we use to_dict on the existing tomlish - we lose comments etc + #also from_dict doesn't yet produce canonical nice-for-humans tomlish/toml + #merge + puts stderr "contextid '$contextid' exists in file $filepath" + puts stderr "Merge not implemented.." + set newfiledata "" + } else { + #append to existing toml data + set newdict [dict create $contextid [dict get $contexts $contextid]] + #we store our contexts in a structure already suitable for toml + # (ie one where we tag strings,ints e.g {type STRING value "etc"}) + set newtomlish [tomlish::from_dict $newdict] + set newtoml [tomlish::to_toml $newtomlish] + set newfiledata $existing_toml\n$newtoml + } + } else { + set newdict [dict create $contextid [dict get $contexts $contextid]] + set newtomlish [tomlish::from_dict $newdict] + set newtoml [tomlish::to_toml $newtomlish] + set newfiledata $newtoml + } + + if {$newfiledata ne ""} { + writeFile $filepath $newfiledata + puts stderr "saved [string length $newfiledata] bytes to '$filepath'" + } + } + + + namespace eval argdoc { + set _page_options { + -limit -default 100 -type integer -help\ + "Each REST query returns a maximum number + of results. This can be set to 0 to mean + no limit - but it is still restricted to + the max configured on the server. (1000?) + + This is effectively the page-size of the + results. To retrieve more than a page, the + next and previous urls can be iterated over." + -offset -default 0 -type integer + } + set _create_update_options { + -created + -created__gte + -created__lte + -last_updated + -last_updated__gte + -last_updated__lte + } + set _tenant_options { + -tenant_group_id + -tenant_group + -tenant_id + -tenant + } + set _region_options { + -region_id + -region + } + set _site_options { + -site_group_id + -site_group + -site_id + -site + } + set _group_options { + -group_id + -group + } + set _role_options { + -role_id + -role + } + set _filter_string [list\ + "ie \n Exact match\n(case-insensitive)"\ + "nie \n Inverse exact match\n(case-insensitive)"\ + "n \n Not equal to"\ + "ic \n Contains\n (case-insensitive)"\ + "nic \n Does not contain\n (case-insensitive)"\ + "isw \n Starts with\n (case-insensitive)"\ + "nisw \n Does not start with\n (case-insensitive)"\ + "iew \n Ends with\n (case-insensitive)"\ + "niew \n Does not end with\n (case-insensitive)"\ + "empty \n Is empty/null"\ + ] + set _CUSTOM_PARAMS { + -CUSTOM_PARAM -type list -minsize 2 -maxsize 2 -multiple 1 -help\ + "Specify a parameter not in this API + e.g -CUSTOM_PARAM {mytag blah}" + } + set _RETURN { + -RETURN -type string -choices {dict showdict showdict2 json} -choicelabels { + dict\ + " Tcl dictionary + (fastest)" + showdict\ + " human readable dict display + with same order as dict." + showdict2\ + " human readable dict display + results first metadata last." + } -help\ + "Options for returned data. + Note that showdict results are relatively slow, especially for large resultsets" + } + set _RETURN_STATUS { + -RETURN -type string -default showdict2 -choices {dict showdict showdict2 json} -choicelabels { + dict\ + " Tcl dictionary" + showdict\ + " human readable dict display" + showdict2\ + " human readable dict display + installed-apps first." + } -help\ + "Options for returned data." + } + + set _name_filter_help "Paired search filter for name:\n" + append _name_filter_help [textblock::list_as_table -columns 4 -show_hseps 1 $_filter_string] + + set _description_filter_help "Paired search filter for description:\n" + append _description_filter_help [textblock::list_as_table -columns 4 -show_hseps 1 $_filter_string] + + set string_filter_help "Paired search filter for string:\n" + append _string_filter_help [textblock::list_as_table -columns 4 -show_hseps 1 $_filter_string] + } + + punk::args::define {*}[list\ + { + @dynamic + @id -id ::punk::netbox::status + @cmd -name punk::netbox::status -help\ + "status_list + GET request for endpoint /status/ + + Netbox's current operational status + " + @leaders -min 1 -max 1 + apicontextid -help\ + "The name of the stored api context to use. + A contextid can be created in-memory using + api_context_create, or loaded from a .toml + file using api_context_load."\ + -choices {${[punk::netbox::api_context_names]}} + @opts + }\ + [set ::punk::netbox::argdoc::_RETURN_STATUS]\ + { + @values -min 0 -max 0 + }] + ::punk::netbox::system::make_rest_func ::punk::netbox::status api/status/ -verb get -body none + + + #test function - todo use punk::netbox::system::make_rest_func + #proc vrfs {args} { + # set argd [punk::args::parse $args withid ::punk::netbox::vrfs] + # lassign [dict values $argd] leaders opts values received + # set apicontextid [dict get $leaders apicontextid] + # set query [dict create] + # dict for {k v} $opts { + # if {$k eq "-CUSTOM_PARAM"} { + # foreach custval $v { + # lassign $custval param value + # dict set query $param $value + # } + # } elseif {[string match *_FILTER $k]} { + # set field [string range [string tolower [lindex [split $k _] 0]] 1 end] ;# -NAME_FILTER -> name + # foreach fv $v { + # lassign $fv filter value + # dict set query ${field}__$filter $value + # } + # } else { + # dict set query [string range $k 1 end] $v + # } + # } + # variable contexts + # if {![dict exists $contexts $apicontextid]} { + # error "specified contextid '$apicontextid' not found" + # } + # set config [dict create\ + # result json\ + # ] + # dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] + + # #variable headerdict + # #set config [dict create\ + # # headers $headerdict\ + # # result json\ + # #] + # #variable url + # set url [dict get $contexts $apicontextid url value] + + # puts "${url}api/ipam/vrfs/ '$query' '$config'" + # rest::get ${url}api/ipam/vrfs/ $query $config + #} + + #set ipam(vrfs) [dict create\ + # url https://www.netbox1.intx.com.au/api/ipam/vrfs/\ + # method get\ + # result json\ + # body none\ + # headers $headerdict\ + # opt_args {id: name: limit:100 offset:0} + #] + #set ipam(ip-addresses) [dict create\ + # url https://www.netbox1.intx.com.au/api/ipam/ip-addresses/\ + # method get\ + # headers $headerdict\ + # opt_args {parent: limit:100 offset:0} + #] + #set ipam(prefixes) [dict create\ + # url https://www.netbox1.intx.com.au/api/ipam/prefixes/\ + # method get\ + # headers $headerdict\ + # opt_args {prefix: limit:100 offset:0} + #] + #rest::create_interface ::punk::netbox::ipam + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::netbox ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +tcl::namespace::eval punk::netbox::ipam { + namespace export {[a-z]*} + lappend PUNKARGS [list\ + { + @dynamic + @id -id ::punk::netbox::ipam::vrfs + @cmd -name punk::netbox::ipam::vrfs -help\ + "ipam_vrfs_list + GET request for endpoint /ipam/vrfs/" + @leaders -min 1 -max 1 + apicontextid -help\ + "The name of the stored api context to use. + A contextid can be created in-memory using + api_context_create, or loaded from a .toml + file using api_context_load."\ + -choices {${[punk::netbox::api_context_names]}} + @opts + -id -type integer + -name + -NAME_FILTER -type list -minsize 2 -maxsize 2 -multiple 1 -help {${$::punk::netbox::argdoc::_name_filter_help}} + -rd -type string -help\ + "Route distinguisher in any format" + -enforce_unique + -description -type string -help "Exact Match (case sensitive)" + -DESCRIPTION_FILTER -type list -minsize 2 -maxsize 2 -multiple 1 -help {${$::punk::netbox::argdoc::_description_filter_help}} + }\ + [set ::punk::netbox::argdoc::_create_update_options]\ + { + -q + -tag + }\ + [set ::punk::netbox::argdoc::_tenant_options]\ + [set ::punk::netbox::argdoc::_region_options]\ + [set ::punk::netbox::argdoc::_site_options]\ + [set ::punk::netbox::argdoc::_group_options]\ + [set ::punk::netbox::argdoc::_role_options]\ + { + -status + -available_on_device + -available_on_virtualmachine + }\ + [set ::punk::netbox::argdoc::_page_options]\ + [set ::punk::netbox::argdoc::_CUSTOM_PARAMS]\ + [set ::punk::netbox::argdoc::_RETURN]\ + { + @values -min 0 -max 0 + }] + ::punk::netbox::system::make_rest_func ::punk::netbox::ipam::vrfs api/ipam/vrfs/ -verb get -body none + + + + punk::args::define {*}[list\ + { + @dynamic + @id -id ::punk::netbox::ipam::prefixes + @cmd -name punk::netbox::ipam::prefixes -help\ + "ipam_prefixes_list + GET request for endpoint /ipam/prefixes/" + @leaders -min 1 -max 1 + apicontextid -help\ + "The name of the stored api context to use. + A contextid can be created in-memory using + api_context_create, or loaded from a .toml + file using api_context_load."\ + -choices {${[punk::netbox::api_context_names]}} + @opts + -id -type integer + -is_pool + -mark_utilized + -description -type string -help "Exact Match (case sensitive)" + -DESCRIPTION_FILTER -type list -minsize 2 -maxsize 2 -multiple 1 -help {${$::punk::netbox::argdoc::_description_filter_help}} + }\ + [set ::punk::netbox::argdoc::_create_update_options]\ + { + -q + -tag + }\ + [set ::punk::netbox::argdoc::_tenant_options]\ + [set ::punk::netbox::argdoc::_region_options]\ + [set ::punk::netbox::argdoc::_site_options]\ + [set ::punk::netbox::argdoc::_group_options]\ + [set ::punk::netbox::argdoc::_role_options]\ + { + -family + -prefix + -within + -within_include + -contains + -depth + -children + -mask_length + -mask_length__gte + -mask_length__lte + -vrf_id + -vrf + -role_id + -role + -status + -available_on_device + -available_on_virtualmachine + }\ + [set ::punk::netbox::argdoc::_page_options]\ + [set ::punk::netbox::argdoc::_CUSTOM_PARAMS]\ + [set ::punk::netbox::argdoc::_RETURN]\ + { + @values -min 0 -max 0 + }] + ::punk::netbox::system::make_rest_func ::punk::netbox::ipam::prefixes api/ipam/prefixes/ -verb get -body none + + punk::args::define {*}[list\ + { + @dynamic + @id -id ::punk::netbox::ipam::ip-addresses + @cmd -name punk::netbox::ipam::ip-addresses -help\ + "ipam_ip-addresses_list + GET request for endpoint /ipam/ip-addresses/" + @leaders -min 1 -max 1 + apicontextid -help\ + "The name of the stored api context to use. + A contextid can be created in-memory using + api_context_create, or loaded from a .toml + file using api_context_load."\ + -choices {${[punk::netbox::api_context_names]}} + @opts + -id -type integer + -dns_name + -DNS_NAME_FILTER -type list -minsize 2 -maxsize 2 -multiple 1 -help {${$::punk::netbox::argdoc::_string_filter_help}} + -description -type string -help "Exact Match (case sensitive)" + -DESCRIPTION_FILTER -type list -minsize 2 -maxsize 2 -multiple 1 -help {${$::punk::netbox::argdoc::_description_filter_help}} + }\ + [set ::punk::netbox::argdoc::_create_update_options]\ + { + -q + -tag + }\ + [set ::punk::netbox::argdoc::_tenant_options]\ + [set ::punk::netbox::argdoc::_region_options]\ + [set ::punk::netbox::argdoc::_site_options]\ + [set ::punk::netbox::argdoc::_group_options]\ + [set ::punk::netbox::argdoc::_role_options]\ + { + -family + -parent + -address + -mask_length + -vrf_id + -vrf + -present_in_vrf_id + -present_in_vrf + -device + -device_id + -virtual_machine + -virtual_machine_id + -interface + -interface_id + -vminterface + -vminterface_id + -fhrpgroup_id + -assigned_to_interface + -status + -role + -available_on_device + -available_on_virtualmachine + }\ + [set ::punk::netbox::argdoc::_page_options]\ + [set ::punk::netbox::argdoc::_CUSTOM_PARAMS]\ + [set ::punk::netbox::argdoc::_RETURN]\ + { + @values -min 0 -max 0 + }] + ::punk::netbox::system::make_rest_func ::punk::netbox::ipam::ip-addresses api/ipam/ip-addresses/ -verb get -body none +} + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +tcl::namespace::eval punk::netbox::lib { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + tcl::namespace::path [tcl::namespace::parent] + #*** !doctools + #[subsection {Namespace punk::netbox::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::netbox::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + + + +# == === === === === === === === === === === === === === === +# Sample 'about' function with punk::args documentation +# == === === === === === === === === === === === === === === +tcl::namespace::eval punk::netbox { + tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase + variable PUNKARGS + variable PUNKARGS_aliases + + lappend PUNKARGS [list { + @id -id "(package)punk::netbox" + @package -name "punk::netbox" -help\ + "Package + Description" + }] + + namespace eval argdoc { + #namespace for custom argument documentation + proc package_name {} { + return punk::netbox + } + proc about_topics {} { + #info commands results are returned in an arbitrary order (like array keys) + set topic_funs [info commands [namespace current]::get_topic_*] + set about_topics [list] + foreach f $topic_funs { + set tail [namespace tail $f] + lappend about_topics [string range $tail [string length get_topic_] end] + } + #Adjust this function or 'default_topics' if a different order is required + return [lsort $about_topics] + } + proc default_topics {} {return [list Description *]} + + # ------------------------------------------------------------- + # get_topic_ functions add more to auto-include in about topics + # ------------------------------------------------------------- + proc get_topic_Description {} { + punk::args::lib::tstr [string trim { + package punk::netbox + description to come.. + } \n] + } + proc get_topic_License {} { + return "MIT" + } + proc get_topic_Version {} { + return "$::punk::netbox::version" + } + proc get_topic_Contributors {} { + set authors {{Julian Noble }} + set contributors "" + foreach a $authors { + append contributors $a \n + } + if {[string index $contributors end] eq "\n"} { + set contributors [string range $contributors 0 end-1] + } + return $contributors + } + proc get_topic_custom-topic {} { + punk::args::lib::tstr -return string { + A custom + topic + etc + } + } + # ------------------------------------------------------------- + } + + # we re-use the argument definition from punk::args::standard_about and override some items + set overrides [dict create] + dict set overrides @id -id "::punk::netbox::about" + dict set overrides @cmd -name "punk::netbox::about" + dict set overrides @cmd -help [string trim [punk::args::lib::tstr { + About punk::netbox + }] \n] + dict set overrides topic -choices [list {*}[punk::netbox::argdoc::about_topics] *] + dict set overrides topic -choicerestricted 1 + dict set overrides topic -default [punk::netbox::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict + set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] + lappend PUNKARGS [list $newdef] + proc about {args} { + package require punk::args + #standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on + set argd [punk::args::parse $args withid ::punk::netbox::about] + lassign [dict values $argd] _leaders opts values _received + punk::args::package::standard_about -package_about_namespace ::punk::netbox::argdoc {*}$opts {*}[dict get $values topic] + } +} +# end of sample 'about' function +# == === === === === === === === === === === === === === === + + +# ----------------------------------------------------------------------------- +# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked +# ----------------------------------------------------------------------------- +# variable PUNKARGS +# variable PUNKARGS_aliases +namespace eval ::punk::args::register { + #use fully qualified so 8.6 doesn't find existing var in global namespace + lappend ::punk::args::register::NAMESPACES ::punk::netbox ::punk::netbox::ipam +} +# ----------------------------------------------------------------------------- + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::netbox [tcl::namespace::eval punk::netbox { + variable pkg punk::netbox + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm index 51e74719..f0a4a444 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/path-0.1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_punk::path 0 0.1.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] -#[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] +#[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] #[require punk::path] #[description] #[keywords module path filesystem] @@ -104,21 +104,21 @@ namespace eval punk::path { #*** !doctools #[subsection {Namespace punk::path}] - #[para] Core API functions for punk::path + #[para] Core API functions for punk::path #[list_begin definitions] - # -- --- + # -- --- #punk::path::normjoin # - simplify . and .. segments as far as possible whilst respecting specific types of root. - # -- --- + # -- --- #a form of file normalize that supports //xxx to be treated as server path names #(ie regardless of unices ignoring (generally) leading double slashes, and regardless of windows volumerelative path syntax) - #(sometimes //server.com used as a short form for urls - which doesn't seem too incompatible with this anyway) - # -- --- + #(sometimes //server.com used as a short form for urls - which doesn't seem too incompatible with this anyway) + # -- --- #This is intended to be purely a string analysis - without reference to filesystem volumes or vfs or zipfs mountpoints etc # #TODO - option for caller to provide a -base below which we can't backtrack. - #This is preferable to setting policy here for example regarding forcing no trackback below //servername/share + #This is preferable to setting policy here for example regarding forcing no trackback below //servername/share #Our default is to allow trackback to: # :// # :/ @@ -128,7 +128,7 @@ namespace eval punk::path { # ./../ - (track back indefinitely on relpath as we are not resolving to anything physical and can't fully simplify the leading backtracks) # #The caller should do the file/vfs operations to determine this - not us. - # -- --- + # -- --- #simplify path with respect to /./ & /../ elements - independent of platform #NOTE: "anomalies" in standard tcl processing on windows: #e.g file normalize {//host} -> c:/host (or e.g d:/host if we happen to be on another volume) @@ -148,9 +148,9 @@ namespace eval punk::path { #known issues: #1) # normjoin d://a//b//c -> d://a/b/c - # This is because we don't detect specific schemes. ie it's treated the same as https://a/b/c -> https://a/b/c + # This is because we don't detect specific schemes. ie it's treated the same as https://a/b/c -> https://a/b/c # Not considered a problem - just potentially surprising. - # To avoid it we would have to enumerate possible schemes. + # To avoid it we would have to enumerate possible schemes. # As it stands a unix system could define a 'scheme' that happens to match windows style driveletters. Consider a 'feature' ? review. # won't fix? #2) @@ -164,16 +164,16 @@ namespace eval punk::path { # normjoin ///server/share -> ///server/share #This is effectively an empty servername in the input with 'server' being pushed one level down - and the output is consistent # possibly won't fix - review - #4) inconsistency + #4) inconsistency # we return normalized //server/share for //./UNC/server share # but other dos device paths are maintained # e.g //./c:/etc # This is because such paths could contain alternate segment names (windows shortnames) which we aren't in a position to resolve. - # caller should - # #as with 'case' below - caller will need to run a post 'file normalize' + # caller should + # #as with 'case' below - caller will need to run a post 'file normalize' #5) we don't normalize case like file normalize does on windows platform. # This is intentional. It could only be done with reference to underlying filesystem which we don't want here. - # + # # ================ # #relpaths all end up with leading . - while not always the simplest form, this is ok. (helps stop inadvertent conversions to absolutes) @@ -194,14 +194,14 @@ namespace eval punk::path { /// { #if this is effectively //$emptyservername/ #then for consistency we should trail //=3 #todo - shortcircuit that here? } } - # /// - set doubleslash1_posn [string first // $path] + # /// + set doubleslash1_posn [string first // $path] # -- --- --- temp warning on windows only - no x-platform difference in result #on windows //host is of type volumerelative @@ -221,7 +221,7 @@ namespace eval punk::path { } # -- --- --- - set is_relpath 0 + set is_relpath 0 #set path [string map [list \\ /] $path] set finalparts [list] @@ -264,11 +264,11 @@ namespace eval punk::path { #normalize by dropping leading slash before split - and then treating first 2 segments as a root #set parts [file split [string range $path 1 end]] set parts [split $path /] - #assert parts here has {} {} as first 2 entries + #assert parts here has {} {} as first 2 entries set rootindex 2 #currently prefer can backtrack to the //zipfs:/ scheme (below the mountpoint - to browse other mounts) #alternative handling for //zipfs:/path - don't go below mountpoint - #but we can't determine just from string if mountpoint is direct subpath or a lower one e.g //zipfs:/arbitraryname/actualmountpoint + #but we can't determine just from string if mountpoint is direct subpath or a lower one e.g //zipfs:/arbitraryname/actualmountpoint #review - more generally //:/path ? #todo - make an option for zipfs and others to determine the 'base' #if {"zipfs:" eq [lindex $parts 2]} { @@ -281,7 +281,7 @@ namespace eval punk::path { #set parts [file split $path] set parts [::split $path /] #e.g /a/b/c -> {} a b c - #or relative path a/b/c -> a b c + #or relative path a/b/c -> a b c #or c:/a/b/c -> c: a b c if {[string match *: [lindex $parts 0]]} { if {[lindex $parts 1] eq ""} { @@ -295,9 +295,9 @@ namespace eval punk::path { } elseif {[lindex $parts 0] ne ""} { #relpath a/b/c set parts [linsert $parts 0 .] - set rootindex 0 - #allow backtracking arbitrarily for leading .. entries - simplify where possible - #also need to stop possible conversion to absolute path + set rootindex 0 + #allow backtracking arbitrarily for leading .. entries - simplify where possible + #also need to stop possible conversion to absolute path set is_relpath 1 } } @@ -306,7 +306,7 @@ namespace eval punk::path { #puts stderr "-->baseparts:$baseparts" #ensure that if our rootindex already spans a dotted segment (after the first one) we remove it #must maintain initial . for relpaths to stop them converting to absolute via backtrack - # + # set finalparts [list [lindex $baseparts 0]] foreach b [lrange $baseparts 1 end] { if {$b ni {. ..}} { @@ -333,7 +333,7 @@ namespace eval punk::path { lappend finalparts $p } } - incr i + incr i } } else { foreach p [lrange $parts $rootindex+1 end] { @@ -345,7 +345,7 @@ namespace eval punk::path { switch -exact -- $p { . - "" {} .. { - lpop finalparts ;#uses punk::lib::compat::lpop if on < 8.7 + lpop finalparts ;#uses punk::lib::compat::lpop if on < 8.7 } default { lappend finalparts $p @@ -403,16 +403,16 @@ namespace eval punk::path { } - #x-platform - punk::path::pathtype - can be used in safe interps - different concept of pathtypes to 'file pathtype' - # - no volumerelative + #x-platform - punk::path::pathtype - can be used in safe interps - different concept of pathtypes to 'file pathtype' + # - no volumerelative # - no lookup of file volumes (volume is a windows concept - but with //zipfs:/ somewhat applicable to other platforms) # - /* as absolute (covers also //zipfs:/ (volume), //server , //./etc , //./UNC) # - xxx:// as absolute (scheme) # - xxx:/ or x:/ as absolute - # - x: xxx: -> as absolute (volume-basic or volume-extended) + # - x: xxx: -> as absolute (volume-basic or volume-extended) #note also on windows - legacy name for COM devices - # COM1 = COM1: + # COM1 = COM1: # //./COM1 ?? review proc pathtype {str} { @@ -425,7 +425,7 @@ namespace eval punk::path { return absolute } - #only firstsegment with single colon at last position (after some non empty string) counts as volume or scheme - review + #only firstsegment with single colon at last position (after some non empty string) counts as volume or scheme - review #e.g a:b:/.. or a::/.. or :/.. is not treated as volume/scheme whereas ab:/ is. set firstslash [string first / $str] if {$firstslash == -1} { @@ -434,9 +434,9 @@ namespace eval punk::path { set firstsegment [string range $str 0 $firstslash-1] } if {[set firstc [string first : $firstsegment]] > 0} { - set lhs_firstsegment [string range $firstsegment 0 $firstc-1] + set lhs_firstsegment [string range $firstsegment 0 $firstc-1] set rhs_firstsegment [string range $firstsegment $firstc+1 end] ;#exclude a:b/ etc - if {$rhs_firstsegment eq ""} { + if {$rhs_firstsegment eq ""} { set rhs_entire_path [string range $str $firstc+1 end] #assert lhs_firstsegment not empty since firstc > 0 #count following / sequence @@ -466,7 +466,7 @@ namespace eval punk::path { } } } - #assert first element of any return has been absolute or relative + #assert first element of any return has been absolute or relative return relative } @@ -489,7 +489,7 @@ namespace eval punk::path { } return $str } - #purely string based - no reference to filesystem knowledge + #purely string based - no reference to filesystem knowledge #unix-style forward slash only proc plainjoin {args} { set args [lmap a $args {string map "\\\\ /" $a}] @@ -499,12 +499,12 @@ namespace eval punk::path { set out "" foreach a $args { if {![string length $out]} { - append out [plain $a] + append out [plain $a] } else { set a [plain $a] if {[string map {/ ""} $out] eq ""} { set out [string range $out 0 end-1] - } + } if {[string map {/ ""} $a] eq ""} { #all / segment @@ -512,16 +512,16 @@ namespace eval punk::path { } else { if {[string length $a] > 2 && [string match "./*" $a]} { set a [string range $a 2 end] - } + } if {[string index $out end] eq "/"} { append out $a } else { - append out / $a + append out / $a } } } } - return $out + return $out } proc plainjoin1 {args} { if {[llength $args] == 1} { @@ -530,9 +530,9 @@ namespace eval punk::path { set out [trim_final_slash [lindex $args 0]] foreach a [lrange $args 1 end] { set a [trim_final_slash $a] - append out / $a + append out / $a } - return $out + return $out } #intention? @@ -554,13 +554,13 @@ namespace eval punk::path { #*** !doctools #[call [fun pathglob_as_re] [arg pathglob]] #[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|? in any segment of the path structure - #[para] ** matches any number of subdirectories. + #[para] ** matches any number of subdirectories. #[para] e.g /etc/**/*.txt will match any .txt files at any depth below /etc (except directly within /etc itself) #[para] e.g /etc/**.txt will match any .txt files at any depth below /etc #[para] any segment that does not contain ** must match exactly one segment in the path - #[para] e.g the glob /etc/*/*.doc - will match any .doc files that are exactly one tree level below /etc + #[para] e.g the glob /etc/*/*.doc - will match any .doc files that are exactly one tree level below /etc #[para] The pathglob doesn't have to contain glob characters, in which case the returned regex will match the pathglob exactly as specified. - #[para] Regular expression syntax is deliberateley not supported within the pathglob string so that supplied regex characters will be treated as literals + #[para] Regular expression syntax is deliberateley not supported within the pathglob string so that supplied regex characters will be treated as literals #todo - consider whether a way to escape the glob chars ? * is practical - to allow literals ? * @@ -572,9 +572,9 @@ namespace eval punk::path { } switch -- $seg { * {lappend pats {[^/]*}} - ** {lappend pats {.*}} + ** {lappend pats {.*}} default { - set seg [string map [list {^ {\^} $ {\$} [} {\[} ( {\(} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters in the input as literals + set seg [string map [list {^ {\^} $ {\$} [} {\[} ( {\(} \{ \\\{ \\ {\\}] $seg] ;#treat regex characters in the input as literals #set seg [string map [list . {[.]}] $seg] set seg [string map {. [.]} $seg] if {[regexp {[*?]} $seg]} { @@ -614,14 +614,14 @@ namespace eval punk::path { } } } - # -- --- --- --- --- --- + # -- --- --- --- --- --- set opt_nocase [dict get $opts -nocase] - set explicit_nocase 1 ;#default to disprove + set explicit_nocase 1 ;#default to disprove if {$opt_nocase eq "\uFFFF"} { set opt_nocase 0 set explicit_nocase 0 - } - # -- --- --- --- --- --- + } + # -- --- --- --- --- --- if {$opt_nocase} { return [regexp -nocase [pathglob_as_re $pathglob] $path] } else { @@ -651,33 +651,33 @@ namespace eval punk::path { -call-depth-internal -default 0 -type integer -antiglob_paths -default {} -help\ "list of path patterns to exclude - may include * and ** path segments e.g + may include * and ** path segments e.g /usr/** (exlude subfolders based at /usr but not files within /usr itself) **/_aside (exlude files where _aside is last segment) **/_aside/* (exclude folders one below an _aside folder) **/_aside/** (exclude all folders with _aside as a segment)" - @values -min 0 -max -1 -optional 1 -type string + @values -min 0 -max -1 -optional 1 -type string tailglobs -default * -multiple 1 -help\ "Patterns to match against filename portion (last segment) of each file path within the directory tree being searched." } - #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ + #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ #then review if treefiles can replace dirfiles or if both should exist (dirfiles can have literal glob chars in path segments - but that is a rare usecase) proc treefilenames {args} { #*** !doctools #[call [fun treefilenames] [opt {option value...}] [opt {globpattern...}]] #[para]basic (glob based) list of filenames matching each pattern in tailglobs - recursive #[para] options: - #[para] [opt -dir] + #[para] [opt -dir] #[para] defaults to [lb]pwd[rb] - base path for tree to search - #[para] [opt -antiglob_paths] + #[para] [opt -antiglob_paths] #[para] list of path patterns to exclude - may include * and ** path segments e.g /usr/** #[para]no natsorting - so order is dependent on filesystem set argd [punk::args::parse $args withid ::punk::path::treefilenames] - lassign [dict values $argd] leaders opts values received + lassign [dict values $argd] leaders opts values received set tailglobs [dict get $values tailglobs] # -- --- --- --- --- --- --- set opt_antiglob_paths [dict get $opts -antiglob_paths] @@ -694,7 +694,7 @@ namespace eval punk::path { set opt_dir [dict get $opts -directory] } if {![file isdirectory $opt_dir]} { - return [list] + return [list] } } else { #assume/require to exist in any recursive call @@ -713,15 +713,26 @@ namespace eval punk::path { } #todo - account for vfs where matched path could appear to be a directory but is mounted so could be a desired match? - set dirfiles [lsort [glob -nocomplain -dir $opt_dir -type f {*}$tailglobs]] + if {[catch {glob -nocomplain -dir $opt_dir -type f {*}$tailglobs} matches]} { + #we can get for example a permissions error + puts stderr "treefilenames error while listing files in dir $opt_dir\n $matches" + set dirfiles [list] + } else { + set dirfiles [lsort $matches] + } + lappend files {*}$dirfiles - set dirdirs [glob -nocomplain -dir $opt_dir -type d *] + if {[catch {glob -nocomplain -dir $opt_dir -type d *} dirdirs]} { + puts stderr "treefilenames error while listing subdirs in dir $opt_dir\n $dirdirs" + set dirdirs [list] + } + foreach dir $dirdirs { set skip 0 foreach anti $opt_antiglob_paths { if {[globmatchpath $anti $dir]} { set skip 1 - break + break } } if {$skip} { @@ -743,8 +754,8 @@ namespace eval punk::path { #[item] #[para] Arguments: # [list_begin arguments] - # [arg_def string reference] The path from which the relative path to location is determined. - # [arg_def string location] The location path which may be above or below the reference path + # [arg_def string reference] The path from which the relative path to location is determined. + # [arg_def string location] The location path which may be above or below the reference path # [list_end] #[item] #[para] Results: @@ -753,7 +764,7 @@ namespace eval punk::path { #[item] #[para] Notes: #[para] Both paths must be the same type - ie both absolute or both relative - #[para] Case sensitive. ie punk::path::relative /etc /etC + #[para] Case sensitive. ie punk::path::relative /etc /etC # will return ../etC #[para] On windows, the drive-letter component (only) is not case sensitive #[example_begin] @@ -774,7 +785,7 @@ namespace eval punk::path { #[example_begin] # P% punk::path::relative /usr/local/etc/ /usr/local/etc/somewhere/below # - somewhere/below - # P% punk::path::relative /usr/local/etc/somewhere /usr/local/lib/here + # P% punk::path::relative /usr/local/etc/somewhere /usr/local/lib/here # - ../../lib/here #[example_end] #[list_end] @@ -791,7 +802,7 @@ namespace eval punk::path { #avoid normalizing if possible (file normalize *very* expensive on windows) set do_normalize 0 if {[file pathtype $reference] eq "relative"} { - #if reference is relative so is location + #if reference is relative so is location if {[regexp {[.]{2}} [list $reference $location]]} { set do_normalize 1 } @@ -857,7 +868,7 @@ namespace eval punk::path::lib { namespace path [namespace parent] #*** !doctools #[subsection {Namespace punk::path::lib}] - #[para] Secondary functions that are part of the API + #[para] Secondary functions that are part of the API #[list_begin definitions] @@ -877,17 +888,17 @@ namespace eval punk::path::lib { namespace eval punk::path::system { #*** !doctools #[subsection {Namespace punk::path::system}] - #[para] Internal functions that are not part of the API + #[para] Internal functions that are not part of the API } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ -## Ready +## Ready package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.1.0 + set version 0.1.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm index 2d185f01..c102ca29 100644 --- a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm @@ -5974,13 +5974,40 @@ tcl::namespace::eval textblock { [>punk . rhs]\ [punk::lib::list_as_lines -- [lrepeat 8 " | "]] } + punk::args::define [punk::lib::tstr -return string { + @id -id ::textblock::table + @cmd -name "textblock::table" -help\ + "A wrapper for creating a textblock::class::table + + NOTE: more options available - argument definition + is incomplete" + @opts + -return -choices {table tableobject} + -rows -type list -default "" -help\ + "A list of lists. + Each toplevel element represents a row. + The number of elements in each row must + be the same. + e.g for 2 rows and 3 columns: + table -rows {{r0c0 r0c1 r0c2} {r1c0 r1c1 r1c2}} + " + -headers -type list -default "" -help\ + "This is a simplified form where each column + has a single header row. + Each element in this list goes into the top + header row for a column. + More complex header arrangements where each + column has multiple headers can be made + by using -return tableobject and calling + $tableobj configure_column -headers" + }] proc table {args} { #todo - use punk::args upvar ::textblock::class::opts_table_defaults toptdefaults set defaults [tcl::dict::create\ -rows [list]\ -headers [list]\ - -return string\ + -return table\ ] @@ -6017,7 +6044,7 @@ tcl::namespace::eval textblock { - if {$opt_return eq "string"} { + if {$opt_return eq "table"} { set result [$t print] $t destroy return $result diff --git a/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.2.tm b/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.2.tm new file mode 100644 index 00000000..9270ca9c --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/tomlish-1.1.2.tm @@ -0,0 +1,5566 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# (C) 2024 +# +# @@ Meta Begin +# Application tomlish 1.1.2 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin tomlish_module_tomlish 0 1.1.2] +#[copyright "2024"] +#[titledesc {tomlish toml parser}] [comment {-- Name section and table of contents description --}] +#[moddesc {tomlish}] [comment {-- Description at end of page heading --}] +#[require tomlish] +#[keywords module parsing toml configuration] +#[description] +#[para] tomlish is an intermediate representation of toml data in a tree structure (tagged lists representing type information) +#[para] The design goals are for tomlish to be whitespace and comment preserving ie byte-for byte preservation during roundtrips from toml to tomlish and back to toml +#[para] The tomlish representation can then be converted to a Tcl dict structure or to other formats such as json, +#[para] although these other formats are generally unlikely to retain whitespace or comments +#[para] A further goal is to allow at least a useful subset of in-place editing operations which also preserve whitespace and comments. +#[para] e.g leaf key value editing, and table reordering/sorting, key-renaming at any level, key insertions/deletions +#[para] The API for editing (tomldoc object?) may require explicit setting of type if accessing an existing key +#[para] e.g setting a key that already exists and is a different type (especially if nested structure such as a table or array) +#[para] will need a -type option (-force ?) to force overriding with another type such as an int. + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of tomlish +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by tomlish +#[list_begin itemized] + +package require Tcl 8.6- +package require struct::stack +package require logger + +#*** !doctools +#[item] [package {Tcl 8.6-}] +#[item] [package {struct::stack}] + +#limit ourselves to clear, destroy, peek, pop, push, rotate, or size (e.g v 1.3 does not implement 'get') + + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval tomlish { + namespace export {[a-z]*}; # Convention: export all lowercase + variable types + + #IDEAS: + # since get_toml produces tomlish with whitespace/comments intact: + # tomldoc object - allow (at least basic?) editing of toml whilst preserving comments & whitespace + # - setKey (set leaf only to value) how to specify type? -type option? - whole array vs index into arrays and further nested objects? - option for raw toml additions? + # - separate addKey?? + # - deleteKey (delete leaf) + # - deleteTable (delete table - if only has leaves? - option to delete with child tables?) + # - set/add Table? - position in doc based on existing tables/subtables? + + #The tomlish intermediate representation allows things such as sorting the toml document by table name or other re-ordering of tables - + # because the tables include subkeys, comments and newlines within their structure - those elements all come along with it nicely during reordering. + #The same goes for the first newline following a keyval e.g x=1 \ny=2\n\n + #The newline is part of the keyval structure so makes reordering easier + #example from_toml "a=1\nb=2\n\n\n" + # 0 = TOMLISH + # 1 = KEY a = {INT 1} {NEWLINE lf} + # 2 = NEWLINE lf + # 3 = KEY b = {INT 2} {NEWLINE lf} + # 4 = NEWLINE lf + # 5 = NEWLINE lf + + + #ARRAY is analogous to a Tcl list + #TABLE is analogous to a Tcl dict + #WS = inline whitespace + #KEY = bare key and value + #QKEY = double quoted key and value ;#todo - rename to DQKEY? + #SQKEY = single quoted key and value + #ITABLE = inline table (*can* be anonymous table) + # inline table values immediately create a table with the opening brace + # inline tables are fully defined between their braces, as are dotted-key subtables defined within + # No additional subtables or arrays of tables may be defined within an inline table after the ending brace - they must be entirely self-contained + + set tags [list TOMLISH ARRAY TABLE ITABLE ANONTABLE WS NEWLINE COMMENT DOTTEDKEY KEY QKEY SQKEY STRING STRINGPART MULTISTRING LITERAL LITERALPART MULTILITERAL INT FLOAT BOOL DATETIME] + #tomlish v1.0 should accept arbitrary 64-bit signed ints (from -2^63 to 2^63-1) + #we will restrict to this range for compatibility for now - although Tcl can handle larger (arbitrarily so?) + set min_int -9223372036854775808 ;#-2^63 + set max_int +9223372036854775807 ;#2^63-1 + + proc Dolog {lvl txt} { + #return "$lvl -- $txt" + set msg "[clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"] tomlish '$txt'" + puts stderr $msg + } + logger::initNamespace ::tomlish + foreach lvl [logger::levels] { + interp alias {} tomlish_log_$lvl {} ::tomlish::Dolog $lvl + log::logproc $lvl tomlish_log_$lvl + } + + #*** !doctools + #[subsection {Namespace tomlish}] + #[para] Core API functions for tomlish + #[list_begin definitions] + + proc tags {} { + return $::tomlish::tags + } + + #helper function for to_dict + proc _get_keyval_value {keyval_element} { + log::notice ">>> _get_keyval_value from '$keyval_element'<<<" + set found_value 0 + #find the value + # 3 is the earliest index at which the value could occur (depending on whitespace) + set found_sub [list] + if {[lindex $keyval_element 2] ne "="} { + error "tomlish _get_keyval_value keyval_element doesn't seem to be a properly structured { = } list" + } + foreach sub [lrange $keyval_element 2 end] { + #note that a barekey/quotedkey won't occur directly inside a barekey/quotedkey + switch -exact -- [lindex $sub 0] { + STRING - LITERAL - MULTISTRING - MULTILITERAL - INT - FLOAT - BOOL - DATETIME - TABLE - ARRAY - ITABLE { + set type [lindex $sub 0] + set value [lindex $sub 1] + set found_sub $sub + incr found_value 1 + } + default {} + } + } + if {!$found_value} { + error "tomlish Failed to find value element in KEY. '$keyval_element'" + } + if {$found_value > 1} { + error "tomlish Found multiple value elements in KEY, expected exactly one. '$keyval_element'" + } + + switch -exact -- $type { + INT - FLOAT - BOOL - DATETIME { + #simple (non-container, no-substitution) datatype + set result [list type $type value $value] + } + STRING - STRINGPART { + set result [list type $type value [::tomlish::utils::unescape_string $value]] + } + LITERAL - LITERALPART { + #REVIEW + set result [list type $type value $value] + } + TABLE { + #invalid? + error "tomlish _get_keyval_value invalid to have type TABLE on rhs of =" + } + ITABLE { + set result [::tomlish::to_dict [list $found_sub]] + } + ARRAY { + #we need to recurse to get the corresponding dict for the contained item(s) + #pass in the whole $found_sub - not just the $value! + set result [list type $type value [::tomlish::to_dict [list $found_sub]]] + } + MULTISTRING - MULTILITERAL { + #review - mapping these to STRING might make some conversions harder? + #if we keep the MULTI - we know we have to look for newlines for example when converting to json + #without specific types we'd have to check every STRING - and lose info about how best to map chars within it + set result [list type $type value [::tomlish::to_dict [list $found_sub]]] + } + default { + error "tomlish Unexpected value type '$type' found in keyval '$keyval_element'" + } + } + return $result + } + + proc _get_dottedkey_info {dottedkeyrecord} { + set key_hierarchy [list] + set key_hierarchy_raw [list] + if {[lindex $dottedkeyrecord 0] ne "DOTTEDKEY"} { + error "tomlish _get_dottedkey_info error. Supplied list doesn't appear to be a DOTTEDKEY (tag: [lindex $dottedkeyrecord 0])" + } + set compoundkeylist [lindex $dottedkeyrecord 1] + set expect_sep 0 + foreach part $compoundkeylist { + set parttag [lindex $part 0] + if {$parttag eq "WS"} { + continue + } + if {$expect_sep} { + if {$parttag ne "DOTSEP"} { + error "DOTTEDKEY missing dot separator between parts. '$dottedkeyrecord'" + } + set expect_sep 0 + } else { + set val [lindex $part 1] + switch -exact -- $parttag { + KEY { + lappend key_hierarchy $val + lappend key_hierarchy_raw $val + } + QKEY { + lappend key_hierarchy [::tomlish::utils::unescape_string $val] + lappend key_hierarchy_raw \"$val\" + } + SQKEY { + lappend key_hierarchy $val + lappend key_hierarchy_raw "'$val'" + } + default { + error "DOTTED key unexpected part '$parttag' - ensure dot separator is between key parts. '$item'" + } + } + set expect_sep 1 + } + } + return [dict create keys $key_hierarchy keys_raw $key_hierarchy_raw] + } + + + #to_dict is a *basic* programmatic datastructure for accessing the data. + # produce a dictionary of keys and values from a tomlish tagged list. + # to_dict is primarily for reading toml data. + #Extraneous (not within quoted sections) whitespace and comments are not preserved in this structure, + # so a roundtrip from toml to this datastructure and back to toml will lose whitespace formatting and comments. + # creating/changing toml values can be done directly on a tomlish list if preserving (or adding) formatting/comments is desired. + #A separate package 'tomlish::object' may be needed to allow easier programmatic creating/updating/deleting of data elements whilst preserving (or adding or selectively deleting/editing) such formatting. + # + #Note, currently we get a plain sub dictionary when an inline table is a direct value for a key, but an ITABLE when it's in an ARRAY - REVIEW + #Namespacing? + #ie note the difference: + #[Data] + #temp = { cpu = 79.5, case = 72.0} + # versus + #[Data] + #temps = [{cpu = 79.5, case = 72.0}] + proc to_dict {tomlish} { + + #keep track of which tablenames have already been directly defined, + # so we can raise an error to satisfy the toml rule: 'You cannot define any key or table more than once. Doing so is invalid' + #Note that [a] and then [a.b] is ok if there are no subkey conflicts - so we are only tracking complete tablenames here. + #we don't error out just because a previous tablename segment has already appeared. + variable tablenames_seen [list] + + + log::info ">>> processing '$tomlish'<<<" + set items $tomlish + + foreach lst $items { + if {[lindex $lst 0] ni $::tomlish::tags} { + error "supplied string does not appear to be toml parsed into a tomlish tagged list. Run tomlish::decode::toml on the raw toml data to produce a tomlish list" + } + } + + if {[lindex $tomlish 0] eq "TOMLISH"} { + #ignore TOMLISH tag at beginning + set items [lrange $tomlish 1 end] + } + + set datastructure [dict create] + foreach item $items { + set tag [lindex $item 0] + #puts "...> item:'$item' tag:'$tag'" + switch -exact -- $tag { + KEY - QKEY - SQKEY { + log::debug "--> processing $tag: $item" + set key [lindex $item 1] + if {$tag eq "QKEY"} { + set key [::tomlish::utils::unescape_string $key] + } + #!todo - normalize key. (may be quoted/doublequoted) + + if {[dict exists $datastructure $key]} { + error "Duplicate key '$key'. The key already exists at this level in the toml data. The toml data is not valid." + } + + #lassign [_get_keyval_value $item] type val + set keyval_dict [_get_keyval_value $item] + dict set datastructure $key $keyval_dict + } + DOTTEDKEY { + log::debug "--> processing $tag: $item" + set dkey_info [_get_dottedkey_info $item] + set dotted_key_hierarchy [dict get $dkey_info keys] + set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw] + + #a.b.c = 1 + #table_key_hierarchy -> a b + #leafkey -> c + if {[llength $dotted_key_hierarchy] == 0} { + #empty?? probably invalid. review + #This is different to '' = 1 or ''.'' = 1 which have lengths 1 and 2 respectively + error "DOTTED key has no parts - invalid? '$item'" + } elseif {[llength $dotted_key_hierarchy] == 1} { + #dottedkey is only a key - no table component + set table_hierarchy [list] + set leafkey [lindex $dotted_key_hierarchy 0] + } else { + set table_hierarchy [lrange $dotted_key_hierarchy 0 end-1] + set table_hierarchy_raw [lrange $dotted_key_hierarchy_raw 0 end-1] + set leafkey [lindex $dotted_key_hierarchy end] + } + + #ensure empty tables are still represented in the datastructure + set pathkeys [list] + foreach k $table_hierarchy { + lappend pathkeys $k + if {![dict exists $datastructure {*}$pathkeys]} { + dict set datastructure {*}$pathkeys [list] + } else { + tomlish::log::notice "to_dict datastructure at key path $pathkeys already had data: [dict get $datastructure {*}$pathkeys]" + } + } + + set keyval_dict [_get_keyval_value $item] + dict set datastructure {*}$pathkeys $leafkey $keyval_dict + } + TABLE { + set tablename [lindex $item 1] + set tablename [::tomlish::utils::tablename_trim $tablename] + + if {$tablename in $tablenames_seen} { + error "Table name '$tablename' has already been directly defined in the toml data. Invalid." + } + + log::debug "--> processing $tag (name: $tablename): $item" + set name_segments [::tomlish::utils::tablename_split $tablename] + set last_seg "" + #toml spec rule - all segments mst be non-empty + #note that the results of tablename_split are 'raw' - ie some segments may be enclosed in single or double quotes. + + set table_key_hierarchy [list] + set table_key_hierarchy_raw [list] + + foreach rawseg $name_segments { + + set seg [::tomlish::utils::normalize_key $rawseg] ;#strips one level of enclosing quotes, and substitutes only toml-specified escapes + set c1 [tcl::string::index $rawseg 0] + set c2 [tcl::string::index $rawseg end] + if {($c1 eq "'") && ($c2 eq "'")} { + #single quoted segment. No escapes are processed within it. + set seg [tcl::string::range $rawseg 1 end-1] + } elseif {($c1 eq "\"") && ($c2 eq "\"")} { + #double quoted segment. Apply escapes. + set seg [::tomlish::utils::unescape_string [tcl::string::range $rawseg 1 end-1]] + } else { + set seg $rawseg + } + + #no need to check for empty segments here - we've already called tablename_split which would have raised an error for empty segments. + #if {$rawseg eq ""} { + # error "Table name '[lindex $item 1]' is not valid. All segments (parts between dots) must be non-empty" + #} + lappend table_key_hierarchy $seg + lappend table_key_hierarchy_raw $rawseg + + if {[dict exists $datastructure {*}$table_key_hierarchy]} { + #It's ok for this key to already exist *if* it was defined by a previous tablename, + # but not if it was defined as a key/qkey/skey ? + + set testkey [join $table_key_hierarchy_raw .] + + set testkey_length [llength $table_key_hierarchy_raw] + set found_testkey 0 + if {$testkey in $tablenames_seen} { + set found_testkey 1 + } else { + #see if it was defined by a longer entry + foreach seen $tablenames_seen { + set seen_segments [::tomlish::utils::tablename_split $seen] + #these are raw unnormalized tablename segments. Need to normalize the double-quoted ones, + # and strip the quotes from both single-quoted and double-quoted entries. + + #note: it is not safe to compare normalized tablenames using join! + # e.g a.'b.c'.d is not the same as a.b.c.d + # instead compare {a b.c d} with {a b c d} + # Here is an example where the number of keys is the same, but they must be compared as a list, not a joined string. + #'a.b'.'c.d.e' vs 'a.b.c'.'d.e' + + #VVV the test below is wrong VVV! + #we need to normalize the tablenames seen so that {"x\ty"} matches {"xy"} + + set seen_match [join [lrange $seen_segments 0 [expr {$testkey_length -1}]] .] + puts stderr "testkey:'$testkey' vs seen_match:'$seen_match'" + if {$testkey eq $seen_match} { + set found_testkey 1 + } + } + } + + if {$found_testkey == 0} { + #the raw table_key_hierarchy is better to display in the error message, although it's not the actual dict keyset + set msg "key [join $table_key_hierarchy_raw .] already exists in datastructure, but wasn't defined by a supertable." + append msg "tablenames_seen:" + foreach ts $tablenames_seen { + append msg " " $ts \n + } + error $msg + } + } + + } + + #ensure empty tables are still represented in the datastructure + set table_keys [list] + foreach k $table_key_hierarchy { + lappend table_keys $k + if {![dict exists $datastructure {*}$table_keys]} { + dict set datastructure {*}$table_keys [list] + } else { + tomlish::log::notice "to_dict datastructure at (TABLE) subkey $table_keys already had data: [dict get $datastructure {*}$table_keys]" + } + } + + #We must do this after the key-collision test above! + lappend tablenames_seen $tablename + + + log::debug ">>>>>>>>>>>>>>>>>>>>table_key_hierarchy : $table_key_hierarchy" + log::debug ">>>>>>>>>>>>>>>>>>>>table_key_hierarchy_raw: $table_key_hierarchy_raw" + + #now add the contained elements + foreach element [lrange $item 2 end] { + set type [lindex $element 0] + switch -exact -- $type { + DOTTEDKEY { + set dkey_info [_get_dottedkey_info $element] + set dotted_key_hierarchy [dict get $dkey_info keys] + set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw] + set leaf_key [lindex $dotted_key_hierarchy end] + set dkeys [lrange $dotted_key_hierarchy 0 end-1] + + #ensure empty keys are still represented in the datastructure + set test_keys $table_keys + foreach k $dkeys { + lappend test_keys $k + if {![dict exists $datastructure {*}$test_keys]} { + dict set datastructure {*}$test_keys [list] + } else { + tomlish::log::notice "to_dict datastructure at (DOTTEDKEY) subkey $test_keys already had data: [dict get $datastructure {*}$test_keys]" + } + } + + if {[dict exists $datastructure {*}$table_keys {*}$dkeys $leaf_key]} { + error "Duplicate key '$table_keys $dkeys $leaf_key'. The key already exists at this level in the toml data. The toml data is not valid." + } + set keyval_dict [_get_keyval_value $element] + dict set datastructure {*}$table_keys {*}$dkeys $leaf_key $keyval_dict + } + KEY - QKEY - SQKEY { + #obsolete ? + set keyval_key [lindex $element 1] + if {$type eq "QKEY"} { + set keyval_key [::tomlish::utils::unescape_string $keyval_key] + } + if {[dict exists $datastructure {*}$dotted_key_hierarchy $keyval_key]} { + error "Duplicate key '$dotted_key_hierarchy $key'. The key already exists at this level in the toml data. The toml data is not valid." + } + set keyval_dict [_get_keyval_value $element] + dict set datastructure {*}$dotted_key_hierarchy $keyval_key $keyval_dict + } + NEWLINE - COMMENT - WS { + #ignore + } + default { + error "Sub element of type '$type' not understood in table context. Expected only KEY,QKEY,SQKEY,NEWLINE,COMMENT,WS" + } + } + } + #now make sure we add an empty value if there were no contained elements! + #!todo. + } + ITABLE { + #SEP??? + set datastructure [list] + foreach element [lrange $item 1 end] { + set type [lindex $element 0] + switch -exact -- $type { + DOTTEDKEY { + set dkey_info [_get_dottedkey_info $element] + set dotted_key_hierarchy [dict get $dkey_info keys] + set dotted_key_hierarchy_raw [dict get $dkey_info keys_raw] + set leaf_key [lindex $dotted_key_hierarchy end] + set dkeys [lrange $dotted_key_hierarchy 0 end-1] + + #ensure empty keys are still represented in the datastructure + set table_keys [list] ;#We don't know the context - next level up will have to check for key collisions? + set test_keys $table_keys + foreach k $dkeys { + lappend test_keys $k + if {![dict exists $datastructure {*}$test_keys]} { + dict set datastructure {*}$test_keys [list] + } else { + tomlish::log::notice "to_dict datastructure at (DOTTEDKEY) subkey $test_keys already had data: [dict get $datastructure {*}$test_keys]" + } + } + + if {[dict exists $datastructure {*}$table_keys {*}$dkeys $leaf_key]} { + error "Duplicate key '$table_keys $dkeys $leaf_key'. The key already exists at this level in the toml data. The toml data is not valid." + } + set keyval_dict [_get_keyval_value $element] + dict set datastructure {*}$table_keys {*}$dkeys $leaf_key $keyval_dict + } + NEWLINE - COMMENT - WS { + #ignore + } + default { + error "Sub element of type '$type' not understood in ITABLE context. Expected only KEY,QKEY,SQKEY,NEWLINE,COMMENT,WS" + } + } + } + } + ARRAY { + #arrays in toml are allowed to contain mixtures of types + set datastructure [list] + log::debug "--> processing array: $item" + + foreach element [lrange $item 1 end] { + set type [lindex $element 0] + switch -exact -- $type { + INT - FLOAT - BOOL - DATETIME { + set value [lindex $element 1] + lappend datastructure [list type $type value $value] + } + STRING { + set value [lindex $element 1] + lappend datastructure [list type $type value [::tomlish::utils::unescape_string $value]] + } + LITERAL { + set value [lindex $element 1] + lappend datastructure [list type $type value $value] + } + ITABLE - TABLE - ARRAY - MULTISTRING - MULTILITERAL { + set value [lindex $element 1] + lappend datastructure [list type $type value [::tomlish::to_dict [list $element]]] + } + WS - SEP - NEWLINE - COMMENT { + #ignore whitespace, commas, newlines and comments + } + default { + error "Unexpected value type '$type' found in array" + } + } + } + } + MULTILITERAL { + #triple squoted string + #first newline stripped only if it is the very first element + #(ie *immediately* following the opening delims) + #All whitespace other than newlines is within LITERALPARTS + # ------------------------------------------------------------------------- + #todo - consider extension to toml to allow indent-aware multiline literals + # how - propose as issue in toml github? Use different delim? e.g ^^^ ? + #e.g + # xxx=?'''abc + # def + # etc + # ''' + # - we would like to trimleft each line to the column following the opening delim + # ------------------------------------------------------------------------- + + log::debug "--> processing multiliteral: $item" + set parts [lrange $item 1 end] + if {[lindex $parts 0 0] eq "NEWLINE"} { + set parts [lrange $parts 1 end] ;#skip it + } + for {set idx 0} {$idx < [llength $parts]} {incr idx} { + set element [lindex $parts $idx] + set type [lindex $element 0] + switch -exact -- $type { + LITERALPART { + append stringvalue [lindex $element 1] + } + NEWLINE { + set val [lindex $element 1] + if {$val eq "nl"} { + append stringvalue \n + } else { + append stringvalue \r\n + } + } + default { + error "Unexpected value type '$type' found in multistring" + } + } + } + set datastructure $stringvalue + } + MULTISTRING { + #triple dquoted string + log::debug "--> processing multistring: $item" + set stringvalue "" + set idx 0 + set parts [lrange $item 1 end] + for {set idx 0} {$idx < [llength $parts]} {incr idx} { + set element [lindex $parts $idx] + set type [lindex $element 0] + #We use STRINGPART in the tomlish representation as a distinct element to STRING - which would imply wrapping quotes to be reinserted + switch -exact -- $type { + STRING { + #todo - do away with STRING ? + #we don't build MULTISTRINGS containing STRING - but should we accept it? + tomlish::log::warn "double quoting a STRING found in MULTISTRING - should be STRINGPART?" + append stringvalue "\"[::tomlish::utils::unescape_string [lindex $element 1]]\"" + } + STRINGPART { + append stringvalue [::tomlish::utils::unescape_string [lindex $element 1]] + } + CONT { + #When the last non-whitespace character on a line is an unescaped backslash, + #it will be trimmed along with all whitespace (including newlines) up to the next non-whitespace character or closing delimiter + # review - we allow some whitespace in stringpart elements - can a stringpart ever be all whitespace? + set next_nl [lsearch -index 0 -start $idx+1 $parts NEWLINE] + if {$next_nl == -1} { + #last line + set non_ws [lsearch -index 0 -start $idx+1 -not $parts WS] + if {$non_ws >= 0} { + append stringvalue "\\" ;#add the sep + } else { + #skip over ws without emitting + set idx [llength $parts] + } + } else { + set parts_til_nl [lrange $parts 0 $next_nl-1] + set non_ws [lsearch -index 0 -start $idx+1 -not $parts_til_nl WS] + if {$non_ws >= 0} { + append stringvalue "\\" + } else { + #skip over ws on this line + set idx $next_nl + #then have to check each subsequent line until we get to first non-whitespace + set trimming 1 + while {$trimming && $idx < [llength $parts]} { + set next_nl [lsearch -index 0 -start $idx+1 $parts NEWLINE] + if {$next_nl == -1} { + #last line + set non_ws [lsearch -index 0 -start $idx+1 -not $parts WS] + if {$non_ws >= 0} { + set idx [expr {$non_ws -1}] + } else { + set idx [llength $parts] + } + set trimming 0 + } else { + set non_ws [lsearch -index 0 -start $idx+1 -not [lrange $parts 0 $next_nl-1] WS] + if {$non_ws >= 0} { + set idx [expr {$non_ws -1}] + set trimming 0 + } else { + set idx $next_nl + #keep trimming + } + } + } + } + } + } + NEWLINE { + #if newline is first element - it is not part of the data of a multistring + if {$idx > 0} { + set val [lindex $element 1] + if {$val eq "nl"} { + append stringvalue \n + } else { + append stringvalue \r\n + } + } + } + WS { + append stringvalue [lindex $element 1] + } + default { + error "Unexpected value type '$type' found in multistring" + } + } + } + set datastructure $stringvalue + } + WS - COMMENT - NEWLINE { + #ignore + } + default { + error "Unexpected tag '$tag' in Tomlish list '$tomlish'" + } + } + } + return $datastructure + } + + + proc _from_dictval_tomltype {parents tablestack keys typeval} { + set type [dict get $typeval type] + set val [dict get $typeval value] + switch -- $type { + ARRAY { + set subitems [list] + foreach item $val { + lappend subitems [_from_dictval [list {*}$parents ARRAY] $tablestack $keys $item] SEP + } + if {[lindex $subitems end] eq "SEP"} { + set subitems [lrange $subitems 0 end-1] + } + return [list ARRAY {*}$subitems] + } + ITABLE { + if {$val eq ""} { + return ITABLE + } else { + return [_from_dictval [list {*}$parents ITABLE] $tablestack $keys $val] + } + } + MULTISTRING { + #value is a raw string that isn't encoded as tomlish + #create a valid toml snippet with the raw value and decode it to the proper tomlish MULTISTRING format + set tomlpart "x=\"\"\"\\\n" + append tomlpart $val "\"\"\"" + set tomlish [tomlish::decode::toml $tomlpart] + #e.g if val = " etc\nblah" + #TOMLISH {DOTTEDKEY {{KEY x}} = {MULTISTRING CONT {NEWLINE LF} {WS { }} {STRINGPART etc} {NEWLINE lf} {STRINGPART blah} } } + #lindex 1 3 is the MULTISTRING tomlish list + return [lindex $tomlish 1 3] + } + MULTILITERAL { + set tomlpart "x='''\n" + append tomlpart $val ''' + set tomlish [tomlish::decode::toml $tomlpart] + return [lindex $tomlish 1 3] + } + default { + return [list $type $val] + } + } + } + + proc _from_dictval {parents tablestack keys vinfo} { + set k [lindex $keys end] + if {[regexp {\s} $k] || [string first . $k] >= 0} { + #Any dot in the key would have been split by to_dict - so if it's present here it's part of this key - not a level separator! + #todo - QKEY? + set K_PART [list SQKEY $k] + } else { + set K_PART [list KEY $k] + } + puts stderr "---parents:'$parents' keys:'$keys' vinfo: $vinfo---" + puts stderr "---tablestack: $tablestack---" + set result [list] + set lastparent [lindex $parents end] + if {$lastparent in [list "" do_inline]} { + if {[tomlish::dict::is_tomltype $vinfo]} { + set type [dict get $vinfo type] + #treat ITABLE differently? + set sublist [_from_dictval_tomltype $parents $tablestack $keys $vinfo] + lappend result DOTTEDKEY [list $K_PART {WS { }}] = {WS { }} $sublist {NEWLINE lf} + } else { + #set result [list TABLE $k {NEWLINE lf}] + if {$vinfo ne ""} { + + #set result [list DOTTEDKEY [list [list KEY $k]] = ] + #set records [list ITABLE] + + set last_tomltype_posn [tomlish::dict::last_tomltype_posn $vinfo] + + if {$lastparent eq "do_inline"} { + set result [list DOTTEDKEY [list $K_PART] =] + set records [list ITABLE] + } else { + #review - quoted k ?? + set result [list TABLE $k {NEWLINE lf}] + set tablestack [list {*}$tablestack [list T $k]] + set records [list] + } + + + + set lastidx [expr {[dict size $vinfo] -1}] + set dictidx 0 + dict for {vk vv} $vinfo { + if {[regexp {\s} $vk] || [string first . $vk] >= 0} { + set VK_PART [list SQKEY $vk] + } else { + set VK_PART [list KEY $vk] + } + if {[tomlish::dict::is_tomltype $vv]} { + #type x value y + set sublist [_from_dictval_tomltype $parents $tablestack $keys $vv] + set record [list DOTTEDKEY [list $VK_PART {WS { }}] = {WS { }} $sublist] + } else { + if {$vv eq ""} { + #experimental + if {[lindex $parents 0] eq "" && $dictidx > $last_tomltype_posn} { + puts stderr "_from_dictval could uninline KEY $vk (tablestack:$tablestack)" + #set tname [tomlish::dict::name_from_tablestack [list {*}$tablestack [list T $vk]]] + set tname [join [list {*}$keys $vk] .] + set record [list TABLE $tname {NEWLINE lf}] + set tablestack [list {*}$tablestack [list T $vk]] + } else { + set record [list DOTTEDKEY [list $VK_PART] = ITABLE] + set tablestack [list {*}$tablestack [list I $vk]] + } + } else { + if { 0 } { + #experiment.. sort of getting there. + if {[lindex $parents 0] eq "" && $dictidx > $last_tomltype_posn} { + puts stderr "_from_dictval could uninline2 KEYS [list {*}$keys $vk] (tablestack:$tablestack)" + set tname [join [list {*}$keys $vk] .] + set record [list TABLE $tname {NEWLINE lf}] + set tablestack [list {*}$tablestack [list T $vk]] + + #review - todo? + set dottedkey_value [_from_dictval [list {*}$parents TABLE] $tablestack [list {*}$keys $vk] $vv] + lappend record {*}$dottedkey_value + + } else { + set dottedkey_value [_from_dictval [list {*}$parents ITABLE] $tablestack [list {*}$keys $vk] $vv] + set record [list DOTTEDKEY [list $VK_PART] = $dottedkey_value] + } + } else { + set dottedkey_value [_from_dictval [list {*}$parents ITABLE] $tablestack [list {*}$keys $vk] $vv] + set record [list DOTTEDKEY [list $VK_PART] = $dottedkey_value] + } + } + } + if {$dictidx != $lastidx} { + #lappend record SEP + if {$lastparent eq "do_inline"} { + lappend record SEP + } else { + lappend record {NEWLINE lf} + } + } + lappend records $record + incr dictidx + } + if {$lastparent eq "do_inline"} { + lappend result $records {NEWLINE lf} + } else { + lappend result {*}$records {NEWLINE lf} + } + } else { + if {$lastparent eq "do_inline"} { + lappend result DOTTEDKEY [list [list KEY $k]] = ITABLE {NEWLINE lf} + } else { + lappend result TABLE $k {NEWLINE lf} + } + } + } + } else { + #lastparent is not toplevel "" or "do_inline" + if {[tomlish::dict::is_tomltype $vinfo]} { + #type x value y + set sublist [_from_dictval_tomltype $parents $tablestack $keys $vinfo] + lappend result {*}$sublist + } else { + if {$lastparent eq "TABLE"} { + #review + dict for {vk vv} $vinfo { + set dottedkey_value [_from_dictval [list {*}$parents DOTTEDKEY] $tablestack [list {*}$keys $vk] $vv] + lappend result [list DOTTEDKEY [list [list KEY $vk]] = $dottedkey_value {NEWLINE lf}] + } + } else { + if {$vinfo ne ""} { + set lastidx [expr {[dict size $vinfo] -1}] + set dictidx 0 + set sub [list] + set result $lastparent ;#e.g sets ITABLE + set last_tomltype_posn [tomlish::dict::last_tomltype_posn $vinfo] + dict for {vk vv} $vinfo { + if {[regexp {\s} $vk] || [string first . $vk] >=0} { + set VK_PART [list SQKEY $vk] + } else { + set VK_PART [list KEY $vk] + } + if {[tomlish::dict::is_tomltype $vv]} { + #type x value y + set sublist [_from_dictval_tomltype $parents $tablestack $keys $vv] + set record [list DOTTEDKEY [list $VK_PART] = $sublist] + } else { + if {$vv eq ""} { + #can't just uninline at this level + #we need a better method to query main dict for uninlinability at each level + # (including what's been inlined already) + #if {[lindex $parents 0] eq "" && $dictidx > $last_tomltype_posn} { + # puts stderr "_from_dictval uninline2 KEY $keys" + # set tname [join [list {*}$keys $vk] .] + # set record [list TABLE $tname {NEWLINE lf}] + # set tablestack [list {*}$tablestack [list T $vk]] + #} else { + set record [list DOTTEDKEY [list $VK_PART] = ITABLE] + #} + } else { + #set sub [_from_dictval ITABLE $vk $vv] + set dottedkey_value [_from_dictval [list {*}$parents ITABLE] $tablestack [list {*}$keys $vk] $vv] + #set record [list DOTTEDKEY [list $VK_PART] = ITABLE $dottedkey_value] + set record [list DOTTEDKEY [list $VK_PART] = $dottedkey_value] + } + } + if {$dictidx != $lastidx} { + lappend record SEP + } + lappend result $record + incr dictidx + } + } else { + puts stderr "table x-1" + lappend result DOTTEDKEY [list $K_PART] = ITABLE + } + } + } + } + return $result + } + + + proc from_dict {d} { + #consider: + # t1={a=1,b=2} + # x = 1 + #If we represent t1 as an expanded table we get + # [t1] + # a=1 + # b=2 + # x=1 + # --- which is incorrect - as x was a toplevel key like t1! + #This issue doesn't occur if x is itself an inline table + # t1={a=1,b=2} + # x= {no="problem"} + # + # (or if we were to reorder x to come before t1) + + #As the dictionary form doesn't distinguish the structure used to create tables {[table1]\nk=v} vs inline {table1={k=v}} + #Without a solution, from_dict would have to always produce the inline form for toplevel tables unless we allowed re-ordering, + #which is unpreferred here. + + #A possible solution: + #scan the top level to see if all (trailing) elements are themselves dicts + # (ie not of form {type XXX value yyy}) + # + # A further point is that if all root level values are at the 'top' - we can treat lower table-like structures as {[table]} elements + #ie we don't need to force do_inline if all the 'simple' keys are before any compound keys + + #set root_has_values 0 + #approach 1) - the naive approach - forces inline when not always necessary + #dict for {k v} $d { + # if {[llength $v] == 4 && [lindex $v 0] eq "type"} { + # set root_has_values 1 + # break + # } + #} + + + #approach 2) - track the position of last {type x value y} in the dictionary built by to_dict + # - still not perfect. Inlines dotted tables unnecessarily + #This means from_dict doesn't produce output optimal for human editing. + set last_simple [tomlish::dict::last_tomltype_posn $d] + + + ## set parent "do_inline" ;#a value used in _from_dictval to distinguish from "" or other context based parent values + #Any keys that are themselves tables - will need to be represented inline + #to avoid reordering, or incorrect assignment of plain values to the wrong table. + + ## set parent "" + #all toplevel keys in the dict structure can represent subtables. + #we are free to use {[tablename]\n} syntax for toplevel elements. + + + set tomlish [list TOMLISH] + set dictposn 0 + set tablestack [list [list T root]] ;#todo + dict for {t tinfo} $d { + if {$last_simple > $dictposn} { + set parents [list do_inline] + } else { + set parents [list ""] + } + set keys [list $t] + set trecord [_from_dictval $parents $tablestack $keys $tinfo] + lappend tomlish $trecord + incr dictposn + } + return $tomlish + } + + proc json_to_toml {json} { + #*** !doctools + #[call [fun json_to_toml] [arg json]] + #[para] + + set tomlish [::tomlish::from_json $json] + set toml [::tomlish::to_toml $tomlish] + } + + #TODO use huddle? + proc from_json {json} { + set jstruct [::tomlish::json_struct $json] + return [::tomlish::from_json_struct $jstruct] + } + + proc from_json_struct {jstruct} { + package require fish::json_toml + return [fish::json_toml::jsonstruct2tomlish $jstruct] + } + + proc toml_to_json {toml} { + set tomlish [::tomlish::from_toml $toml] + return [::tomlish::get_json $tomlish] + } + + proc get_json {tomlish} { + package require fish::json + set d [::tomlish::to_dict $tomlish] + #return [::tomlish::dict_to_json $d] + return [fish::json::from "struct" $d] + } + + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +namespace eval tomlish::encode { + #*** !doctools + #[subsection {Namespace tomlish::encode}] + #[para] + #[list_begin definitions] + + #STRING,INT,FLOAT,BOOL, DATETIME - simple wrappers for completeness + # take a value of the appropriate type and wrap as a tomlish tagged item + proc string {s} { + return [list STRING $s] + } + + proc int {i} { + #whole numbers, may be prefixed with a + or - + #Leading zeros are not allowed + #Hex,octal binary forms are allowed (toml 1.0) + #We will error out on encountering commas, as commas are interpreted differently depending on locale (and don't seem to be supported in the toml spec anyway) + #!todo - Tcl can handle bignums - bigger than a 64bit signed long as specified in toml. + # - We should probably raise an error for number larger than this and suggest the user supply it as a string? + if {[tcl::string::last , $i] > -1} { + error "Unable to interpret '$i' as an integer. Use underscores if you need a thousands separator [::tomlish::parse::report_line]" + } + if {![::tomlish::utils::int_validchars $i]} { + error "Unable to interpret '$i' as an integer. Only 0-9 + 1 _ characters are acceptable. [::tomlish::parse::report_line]" + } + + if {[::tomlish::utils::is_int $i]} { + return [list INT $i] + } else { + error "'$i' is not a valid integer as per the Toml spec. [::tomlish::parse::report_line]" + } + + } + + proc float {f} { + #convert any non-lower case variants of special values to lowercase for Toml + if {[::tcl::string::tolower $f] in {nan +nan -nan inf +inf -inf}} { + return [list FLOAT [tcl::string::tolower $f]] + } + if {[::tomlish::utils::is_float $f]} { + return [list FLOAT $f] + } else { + error "Unable to interpret '$f' as Toml float. Check your input, or check that tomlish is able to handle all Toml floats properly [::tomlish::parse::report_line]" + } + } + + proc datetime {str} { + if {[::tomlish::utils::is_datetime $str]} { + return [list DATETIME $str] + } else { + error "Unable to interpret '$str' as Toml datetime. Check your input, or check that tomlish is able to handle all Toml datetimes properly [::tomlish::parse::report_line]" + } + } + + proc boolean {b} { + #convert any Tcl-acceptable boolean to boolean as accepted by toml - lower case true/false + if {![tcl::string::is boolean -strict $b]} { + error "Unable to convert '$b' to Toml boolean true|false. [::tomlish::parse::report_line]" + } else { + if {[expr {$b && 1}]} { + return [::list BOOL true] + } else { + return [::list BOOL false] + } + } + } + + + #TODO + #Take tablename followed by + # a) *tomlish* name-value pairs e.g table mydata [list KEY item11 = [list STRING "test"]] {KEY item2 = [list INT 1]} + # (accept also key value {STRING }) + # b) simple 2-element tcl lists being name & *simple* value pairs for which basic heuristics will be used to determine types + proc table {name args} { + set pairs [list] + foreach t $args { + if {[llength $t] == 4} { + if {[tcl::string::tolower [lindex $t 0]] ne "key" || [tcl::string::tolower [lindex $t 2]] ni "= value"} { + error "Only items tagged as KEY = currently accepted as name-value pairs for table command" + } + lassign $t _k keystr _eq valuepart + if {[llength $valuepart] != 2} { + error "supplied value must be typed. e.g {INT 1} or {STRING test}" + } + lappend pairs [list KEY $keystr = $valuepart] + } elseif {[llength $t] == 2} { + #!todo - type heuristics + lassign $t n v + lappend pairs [list KEY $n = [list STRING $v]] + } else { + error "'KEY = { toml but + # the first newline is not part of the data. + # we elect instead to maintain a basic LITERALPART that must not contain newlines.. + # and to compose MULTILITERAL of multiple NEWLINE LITERALPART parts, + #with the datastructure representation dropping the first newline (if immediately following opening delim) when building the value. + set literal "" + foreach part [lrange $item 1 end] { + append literal [::tomlish::encode::tomlish [list $part] $nextcontext] + } + append toml '''$literal''' + } + INT - + BOOL - + FLOAT - + DATETIME { + append toml [lindex $item 1] + } + INCOMPLETE { + error "cannot process tomlish term tagged as INCOMPLETE" + } + COMMENT { + append toml "#[lindex $item 1]" + } + BOM { + #Byte Order Mark may appear at beginning of a file. Needs to be preserved. + append toml "\uFEFF" + } + default { + error "Not a properly formed 'tomlish' taggedlist.\n '$list'\n Unknown tag '[lindex $item 0]'. See output of \[tomlish::tags\] command." + } + } + + } + return $toml + } + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::encode ---}] +} +#fish toml from tomlish + +#(encode tomlish as toml) +interp alias {} tomlish::to_toml {} tomlish::encode::tomlish + +# + + +namespace eval tomlish::decode { + #*** !doctools + #[subsection {Namespace tomlish::decode}] + #[para] + #[list_begin definitions] + + #return a Tcl list of tomlish tokens + #i.e get a standard list of all the toml terms in string $s + #where each element of the list is a *tomlish* term.. i.e a specially 'tagged' Tcl list. + #(simliar to a tcl 'Huddle' - but also supporting whitespace preservation) + # ---------------------------------------------------------------------------------------------- + # NOTE: the production of tomlish from toml source doesn't indicate the toml source was valid!!! + # e.g we deliberately don't check certain things such as duplicate table declarations here. + # ---------------------------------------------------------------------------------------------- + #Part of the justification for this is that as long as the syntax is toml shaped - we can load files which violate certain rules and allow programmatic manipulation. + # (e.g perhaps a toml editor to highlight violations for fixing) + # A further stage is then necessary to load the tomlish tagged list into a data structure more suitable for efficient query/reading. + # e.g dicts or an object oriented structure + #Note also - *no* escapes in quoted strings are processed. This is up to the datastructure stage + #e.g to_dict will substitute \r \n \uHHHH \UHHHHHHH etc + #This is important for tomlish to maintain the ability to perform competely lossless round-trips from toml to tomlish and back to toml. + # (which is handy for testing as well as editing some part of the structure with absolutely no effect on other parts of the document) + #If we were to unescape a tab character for example + # - we have no way of knowing if it was originally specified as \t \u0009 or \U00000009 or directly as a tab character. + # For this reason, we also do absolutely no line-ending transformations based on platform. + # All line-endings are maintained as is, and even a file with mixed cr crlf line-endings will be correctly interpreted and can be 'roundtripped' + + proc toml {args} { + #*** !doctools + #[call [fun toml] [arg arg...]] + #[para] return a Tcl list of tomlish tokens + + set s [join $args \n] + + namespace upvar ::tomlish::parse is_parsing is_parsing + set is_parsing 1 + + + if {[info command ::tomlish::parse::spacestack] eq "::tomlish::parse::spacestack"} { + tomlish::parse::spacestack destroy + } + struct::stack ::tomlish::parse::spacestack + + namespace upvar ::tomlish::parse last_space_action last_space_action + namespace upvar ::tomlish::parse last_space_type last_space_type + + + namespace upvar ::tomlish::parse tok tok + set tok "" + + namespace upvar ::tomlish::parse type type + namespace upvar ::tomlish::parse tokenType tokenType + ::tomlish::parse::set_tokenType "" + namespace upvar ::tomlish::parse tokenType_list tokenType_list + set tokenType [list] ;#Flat (un-nested) list of tokentypes found + + namespace upvar ::tomlish::parse lastChar lastChar + set lastChar "" + + + set result "" + namespace upvar ::tomlish::parse nest nest + set nest 0 + + namespace upvar ::tomlish::parse v v ;#array keyed on nest level + + + set v(0) {TOMLISH} + array set s0 [list] ;#whitespace data to go in {SPACE {}} element. + set parentlevel 0 + + namespace upvar ::tomlish::parse i i + set i 0 + + namespace upvar ::tomlish::parse state state + + namespace upvar ::tomlish::parse braceCount braceCount + set barceCount 0 + namespace upvar ::tomlish::parse bracketCount bracketCount + set bracketCount 0 + + set sep 0 + set r 1 + namespace upvar ::tomlish::parse token_waiting token_waiting + set token_waiting [dict create] ;#if ::tok finds a *complete* second token during a run, it will put the 2nd one here to be returned by the next call. + + + set state "table-space" + ::tomlish::parse::spacestack push {type space state table-space} + namespace upvar ::tomlish::parse linenum linenum;#'line number' of input data. (incremented for each literal linefeed - but not escaped ones in data) + set linenum 1 + + set ::tomlish::parse::state_list [list] + try { + while {$r} { + set r [::tomlish::parse::tok $s] + #puts stdout "got tok: '$tok' while parsing string '$s' " + set next_tokenType_known 0 ;#whether we begin a new token here based on what terminated the token result of 'tok' + + + + #puts "got token: '$tok' tokenType='$tokenType'. while v($nest) = [set v($nest)]" + #puts "-->tok: $tok tokenType='$tokenType'" + set prevstate $state + set transition_info [::tomlish::parse::goNextState $tokenType $tok $state] + #review goNextState could perform more than one space_action + set space_action [dict get $transition_info space_action] + set newstate [dict get $transition_info newstate] ;#use of 'newstate' vs 'state' makes code clearer below + + if {[tcl::string::match "err-*" $state]} { + ::tomlish::log::warn "---- State error in state $prevstate for tokenType: $tokenType token value: $tok. $state aborting parse. [tomlish::parse::report_line]" + lappend v(0) [list ERROR tokentype $tokenType state $prevstate to $state leveldata [set v($nest)]] + return $v(0) + } + # --------------------------------------------------------- + #NOTE there may already be a token_waiting at this point + #set_token_waiting can raise an error here, + # in which case the space_action branch needs to be rewritten to handle the existing token_waiting + # --------------------------------------------------------- + + if {$space_action eq "pop"} { + #pop_trigger_tokens: newline tablename endarray endinlinetable + #note a token is a pop trigger depending on context. e.g first newline during keyval is a pop trigger. + set parentlevel [expr {$nest -1}] + set do_append_to_parent 1 ;#most tokens will leave this alone - but some like squote_seq need to do their own append + switch -exact -- $tokenType { + squote_seq { + #### + set do_append_to_parent 0 ;#mark false to indicate we will do our own appends if needed + #Without this - we would get extraneous empty list entries in the parent + # - as the xxx-squote-space isn't a space level from the toml perspective + # - the use of a space is to give us a hook here to (possibly) integrate extra quotes into the parent space when we pop + switch -- $tok { + ' { + tomlish::parse::set_token_waiting type startsquote value $tok complete 1 startindex [expr {$i -1}] + } + '' { + #review - we should perhaps return double_squote instead? + #tomlish::parse::set_token_waiting type literal value "" complete 1 + tomlish::parse::set_token_waiting type double_squote value "" complete 1 startindex [expr {$i - 2}] + } + ''' { + #### + #if already an eof in token_waiting - set_token_waiting will insert before it + tomlish::parse::set_token_waiting type triple_squote value $tok complete 1 startindex [expr {$i - 3}] + } + '''' { + switch -exact -- $prevstate { + leading-squote-space { + error "---- 4 squotes from leading-squote-space - shouldn't get here" + #we should have emitted the triple and left the last for next loop + } + trailing-squote-space { + tomlish::parse::set_token_waiting type triple_squote value $tok complete 1 startindex [expr {$i - 4}] + #todo integrate left squote with nest data at this level + set lastpart [lindex $v($parentlevel) end] + switch -- [lindex $lastpart 0] { + LITERALPART { + set newval "[lindex $lastpart 1]'" + set parentdata $v($parentlevel) + lset parentdata end [list LITERALPART $newval] + set v($parentlevel) $parentdata + } + NEWLINE { + lappend v($parentlevel) [list LITERALPART "'"] + } + default { + error "--- don't know how to integrate extra trailing squote with data $v($parentlevel)" + } + } + } + default { + error "--- unexpected popped due to squote_seq but came from state '$prevstate' should have been leading-squote-space or trailing-squote-space" + } + } + } + ''''' { + switch -exact -- $prevstate { + leading-squote-space { + error "---- 5 squotes from leading-squote-space - shouldn't get here" + #we should have emitted the triple and left the following squotes for next loop + } + trailing-squote-space { + tomlish::parse::set_token_waiting type triple_squote value $tok complete 1 startindex [expr {$i-5}] + #todo integrate left 2 squotes with nest data at this level + set lastpart [lindex $v($parentlevel) end] + switch -- [lindex $lastpart 0] { + LITERALPART { + set newval "[lindex $lastpart 1]''" + set parentdata $v($parentlevel) + lset parentdata end [list LITERALPART $newval] + set v($parentlevel) $parentdata + } + NEWLINE { + lappend v($parentlevel) [LITERALPART "''"] + } + default { + error "--- don't know how to integrate extra trailing 2 squotes with data $v($parentlevel)" + } + } + } + default { + error "--- unexpected popped due to squote_seq but came from state '$prevstate' should have been leading-squote-space or trailing-squote-space" + } + } + } + } + puts "---- HERE squote_seq pop <$tok>" + } + triple_squote { + #presumably popping multiliteral-space + ::tomlish::log::debug "---- triple_squote for last_space_action pop leveldata: $v($nest)" + set merged [list] + set lasttype "" + foreach part $v($nest) { + switch -exact -- [lindex $part 0] { + MULTILITERAL { + lappend merged $part + } + LITERALPART { + if {$lasttype eq "LITERALPART"} { + set prevpart [lindex $merged end] + lset prevpart 1 [lindex $prevpart 1][lindex $part 1] + lset merged end $prevpart + } else { + lappend merged $part + } + } + NEWLINE { + #note that even though first newline ultimately gets stripped from multiliterals - that isn't done here + #we still need the first one for roundtripping. The datastructure stage is where it gets stripped. + lappend merged $part + } + default { + error "---- triple_squote unhandled part type [lindex $part 0] unable to merge leveldata: $v($next)" + } + } + set lasttype [lindex $part 0] + } + set v($nest) $merged + } + equal { + if {$prevstate eq "dottedkey-space"} { + tomlish::log::debug "---- equal ending dottedkey-space for last_space_action pop" + #re-emit for parent space + tomlish::parse::set_token_waiting type equal value = complete 1 startindex [expr {$i-1}] + } + } + newline { + incr linenum + lappend v($nest) [list NEWLINE $tok] + } + tablename { + #note: a tablename only 'pops' if we are greater than zero + error "---- tablename pop should already have been handled as special case zeropoppushspace in goNextState" + } + tablearrayname { + #!review - tablearrayname different to tablename regarding push/pop? + #note: a tablename only 'pops' if we are greater than zero + error "---- tablearrayname pop should already have been handled as special case zeropoppushspace in goNextState" + } + endarray { + #nothing to do here. + } + comma { + #comma for inline table will pop the keyvalue space + lappend v($nest) "SEP" + } + endinlinetable { + ::tomlish::log::debug "---- endinlinetable for last_space_action pop" + } + endmultiquote { + ::tomlish::log::debug "---- endmultiquote for last_space_action 'pop'" + } + default { + error "---- unexpected tokenType '$tokenType' for last_space_action 'pop'" + } + } + if {$do_append_to_parent} { + #e.g squote_seq does it's own appends as necessary - so won't get here + lappend v($parentlevel) [set v($nest)] + } + + incr nest -1 + + } elseif {$last_space_action eq "push"} { + set prevnest $nest + incr nest 1 + set v($nest) [list] + # push_trigger_tokens: barekey quotedkey startinlinetable startarray tablename tablearrayname + + + switch -exact -- $tokenType { + squote_seq_begin { + #### + if {[dict exists $transition_info starttok] && [dict get $transition_info starttok] ne ""} { + lassign [dict get $transition_info starttok] starttok_type starttok_val + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType $starttok_type + set tok $starttok_val + } + } + squotedkey { + switch -exact -- $prevstate { + table-space - itable-space { + set v($nest) [list DOTTEDKEY] + } + } + #todo - check not something already waiting? + tomlish::parse::set_token_waiting type $tokenType value $tok complete 1 startindex [expr {$i -[tcl::string::length $tok]}] ;#re-submit token in the newly pushed space + } + barekey { + switch -exact -- $prevstate { + table-space - itable-space { + set v($nest) [list DOTTEDKEY] + } + } + #todo - check not something already waiting? + set waiting [tomlish::parse::get_token_waiting] + if {[llength $waiting]} { + set i [dict get $waiting startindex] + tomlish::parse::clear_token_waiting + tomlish::parse::set_token_waiting type $tokenType value $tok complete 1 startindex [expr {$i -[tcl::string::length $tok]}] ;#re-submit token in the newly pushed space + } else { + tomlish::parse::set_token_waiting type $tokenType value $tok complete 1 startindex [expr {$i -[tcl::string::length $tok]}] ;#re-submit token in the newly pushed space + } + } + startsquote { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "squotedkey" + set tok "" + } + quotedkey - itablequotedkey { + set v($nest) [list QKEY $tok] ;#$tok is the keyname + } + itablesquotedkey { + set v($nest) [list SQKEY $tok] ;#$tok is the keyname + } + tablename { + #note: we do not use the output of tomlish::tablename_trim to produce a tablename for storage in the tomlish list! + #The tomlish list is intended to preserve all whitespace (and comments) - so a roundtrip from toml file to tomlish + # back to toml file will be identical. + #It is up to the datastructure stage to normalize and interpret tomlish for programmatic access. + # we call tablename_trim here only to to validate that the tablename data is well-formed at the outermost level, + # so we can raise an error at this point rather than create a tomlish list with obviously invalid table names. + + #todo - review! It's arguable that we should not do any validation here, and just store even incorrect raw tablenames, + # so that the tomlish list is more useful for say a toml editor. Consider adding an 'err' tag to the appropriate place in the + # tomlish list? + + set test_only [::tomlish::utils::tablename_trim $tok] + ::tomlish::log::debug "---- trimmed (but not normalized) tablename: '$test_only'" + set v($nest) [list TABLE $tok] ;#$tok is the *raw* table name + #note also that equivalent tablenames may have different toml representations even after being trimmed! + #e.g ["x\t\t"] & ["x "] (tab escapes vs literals) + #These will show as above in the tomlish list, but should normalize to the same tablename when used as keys by the datastructure stage. + } + tablearrayname { + set test_only [::tomlish::utils::tablename_trim $tok] + puts stdout "trimmed (but not normalized) tablearrayname: '$test_only'" + set v($nest) [list TABLEARRAY $tok] ;#$tok is the *raw* tablearray name + } + startarray { + set v($nest) [list ARRAY] ;#$tok is just the opening bracket - don't output. + } + startinlinetable { + set v($nest) [list ITABLE] ;#$tok is just the opening curly brace - don't output. + } + startmultiquote { + ::tomlish::log::debug "---- push trigger tokenType startmultiquote" + set v($nest) [list MULTISTRING] ;#container for STRINGPART, WS, CONT, NEWLINE + } + triple_squote { + ::tomlish::log::debug "---- push trigger tokenType triple_squote" + set v($nest) [list MULTILITERAL] ;#container for NEWLINE,LITERAL + } + default { + error "---- push trigger tokenType '$tokenType' not yet implemented" + } + } + + } else { + #no space level change + switch -exact -- $tokenType { + squotedkey { + puts "---- squotedkey in state $prevstate (no space level change)" + lappend v($nest) [list SQKEY $tok] + } + barekey { + lappend v($nest) [list KEY $tok] + } + dotsep { + lappend v($nest) [list DOTSEP] + } + starttablename { + #$tok is triggered by the opening bracket and sends nothing to output + } + starttablearrayname { + #$tok is triggered by the double opening brackets and sends nothing to output + } + tablename - tablenamearray { + error "---- did not expect 'tablename/tablearrayname' without space level change (no space level change)" + #set v($nest) [list TABLE $tok] + } + endtablename - endtablearrayname { + #no output into the tomlish list for this token + } + startinlinetable { + puts stderr "---- decode::toml error. did not expect startinlinetable without space level change (no space level change)" + } + startquote { + switch -exact -- $newstate { + string-state { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "string" + set tok "" + } + quoted-key { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "quotedkey" + set tok "" + } + itable-quoted-key { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "itablequotedkey" + set tok "" + } + default { + error "---- startquote switch case not implemented for nextstate: $newstate (no space level change)" + } + } + } + startsquote { + switch -exact -- $newstate { + literal-state { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "literal" + set tok "" + } + squoted-key { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "squotedkey" + set tok "" + } + itable-squoted-key { + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "itablesquotedkey" + set tok "" + } + multiliteral-space { + #false alarm squote returned from squote_seq pop + ::tomlish::log::debug "---- adding lone squote to own LITERALPART nextstate: $newstate (no space level change)" + #(single squote - not terminating space) + lappend v($nest) [list LITERALPART '] + #may need to be joined on pop if there are neighbouring LITERALPARTs + } + default { + error "---- startsquote switch case not implemented for nextstate: $newstate (no space level change)" + } + } + } + startmultiquote { + #review + puts stderr "---- got startmultiquote in state $prevstate (no space level change)" + set next_tokenType_known 1 + ::tomlish::parse::set_tokenType "stringpart" + set tok "" + } + endquote { + #nothing to do? + set tok "" + } + endsquote { + set tok "" + } + endmultiquote { + #JMN!! + set tok "" + } + string { + lappend v($nest) [list STRING $tok] ;#directly wrapped in dquotes + } + literal { + lappend v($nest) [list LITERAL $tok] ;#directly wrapped in squotes + } + double_squote { + switch -exact -- $prevstate { + keyval-value-expected { + lappend v($nest) [list LITERAL ""] + } + multiliteral-space { + #multiliteral-space to multiliteral-space + lappend v($nest) [list LITERALPART ''] + } + default { + error "--- unhandled tokenType '$tokenType' when transitioning from state $prevstate to $newstate [::tomlish::parse::report_line] (no space level change)" + } + } + } + multistring { + #review + lappend v($nest) [list MULTISTRING $tok] + } + stringpart { + lappend v($nest) [list STRINGPART $tok] ;#will not get wrapped in dquotes directly + } + multiliteral { + lappend v($nest) [LIST MULTILITERAL $tok] + } + literalpart { + lappend v($nest) [list LITERALPART $tok] ;#will not get wrapped in squotes directly + } + quotedkey { + #lappend v($nest) [list QKEY $tok] ;#TEST + } + itablequotedkey { + + } + untyped_value { + #we can't determine the type of unquoted values (int,float,datetime,bool) until the entire token was read. + if {$tok in {true false}} { + set tag BOOL + } elseif {[::tomlish::utils::is_int $tok]} { + set tag INT + } elseif {[::tomlish::utils::is_float $tok]} { + set tag FLOAT + } elseif {[::tomlish::utils::is_datetime $tok]} { + set tag DATETIME + } else { + error "---- Unable to interpret '$tok' as Boolean, Integer, Float or Datetime as per the toml specs. [tomlish::parse::report_line] (no space level change)" + } + lappend v($nest) [list $tag $tok] + + } + comment { + #puts stdout "----- comment token returned '$tok'------" + lappend v($nest) [list COMMENT "$tok"] + } + equal { + #we append '=' to the nest so that any surrounding whitespace is retained. + lappend v($nest) = + } + comma { + lappend v($nest) SEP + } + newline { + incr linenum + lappend v($nest) [list NEWLINE $tok] + } + whitespace { + lappend v($nest) [list WS $tok] + } + continuation { + lappend v($nest) CONT + } + bom { + lappend v($nest) BOM + } + eof { + #ok - nothing more to add to the tomlish list. + #!todo - check previous tokens are complete/valid? + } + default { + error "--- unknown tokenType '$tokenType' during state $prevstate [::tomlish::parse::report_line] (no space level change)" + } + } + } + + if {!$next_tokenType_known} { + ::tomlish::log::notice "---- tomlish::decode::toml - current tokenType:$tokenType Next token type not known" + ::tomlish::parse::set_tokenType "" + set tok "" + } + + if {$state eq "end-state"} { + break + } + + + } + + #while {$nest > 0} { + # lappend v([expr {$nest -1}]) [set v($nest)] + # incr nest -1 + #} + while {[::tomlish::parse::spacestack size] > 1} { + ::tomlish::parse::spacestack pop + lappend v([expr {$nest -1}]) [set v($nest)] + incr nest -1 + + #set parent [spacestack peek] ;#the level being appended to + #lassign $parent type state + #if {$type eq "space"} { + # + #} elseif {$type eq "buffer"} { + # lappend v([expr {$nest -1}]) {*}[set v($nest)] + #} else { + # error "invalid spacestack item: $parent" + #} + } + + } finally { + set is_parsing 0 + } + return $v(0) + } + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::decode ---}] +} +#decode toml to tomlish +interp alias {} tomlish::from_toml {} tomlish::decode::toml + +namespace eval tomlish::utils { + #*** !doctools + #[subsection {Namespace tomlish::utils}] + #[para] + #[list_begin definitions] + + + #tablenames (& tablearraynames) may contain irrelevant leading, trailing and interspersed whitespace + # tablenames can be made up of segments delimited by dots. .eg [ a.b . c ] + #trimmed, the tablename becomes {a.b.c} + # A segment may contain whitespace if it is quoted e.g [a . b . "c etc " ] + #ie whitespace is only irrelevant if it's outside a quoted segment + #trimmed, the tablename becomes {a.b."c etc "} + proc tablename_trim {tablename} { + set segments [tablename_split $tablename false] + set trimmed_segments [list] + foreach seg $segments { + lappend trimmed_segments [::string trim $seg " \t"] + } + return [join $trimmed_segments .] + } + + #basic generic quote matching for single and double quotes + #note for example that {[o'malley]} will return sq - as the single quote is not closed or wrapped in double quotes + proc tok_in_quotedpart {tok} { + set sLen [tcl::string::length $tok] + set quote_type "" + set had_slash 0 + for {set i 0} {$i < $sLen} {incr i} { + set c [tcl::string::index $tok $i] + if {$quote_type eq ""} { + if {$had_slash} { + #don't enter quote mode + #leave slash_mode because even if current char is slash - it is escaped + set had_slash 0 + } else { + set ctype [tcl::string::map [list {"} dq {'} sq \\ bsl] $c] + switch -- $ctype { + dq { + set quote_type dq + } + sq { + set quote_type sq + } + bsl { + set had_slash 1 + } + } + } + } else { + if {$had_slash} { + #don't leave quoted mode + #leave slash_mode because even if current char is slash - it is escaped + set had_slash 0 + } else { + set ctype [tcl::string::map [list {"} dq {'} sq \\ bsl] $c] + switch -- $ctype { + dq { + if {$quote_type eq "dq"} { + set quote_type "" + } + } + sq { + if {$quote_type eq "sq"} { + set quote_type "" + } + } + bsl { + set had_slash 1 + } + } + } + } + } + return $quote_type ;#dq | sq + } + + #utils::tablename_split + proc tablename_split {tablename {normalize false}} { + #we can't just split on . because we have to handle quoted segments which may contain a dot. + #eg {dog."tater.man"} + set sLen [tcl::string::length $tablename] + set segments [list] + set mode "unknown" ;#5 modes: unknown, quoted,litquoted, unquoted, syntax + #quoted is for double-quotes, litquoted is for single-quotes (string literal) + set seg "" + for {set i 0} {$i < $sLen} {incr i} { + + if {$i > 0} { + set lastChar [tcl::string::index $tablename [expr {$i - 1}]] + } else { + set lastChar "" + } + + set c [tcl::string::index $tablename $i] + + if {$c eq "."} { + switch -exact -- $mode { + unquoted { + #dot marks end of segment. + lappend segments $seg + set seg "" + set mode "unknown" + } + quoted { + append seg $c + } + unknown { + lappend segments $seg + set seg "" + } + litquoted { + append seg $c + } + default { + #mode: syntax + #we got our dot. - the syntax mode is now satisfied. + set mode "unknown" + } + } + } elseif {($c eq "\"") && ($lastChar ne "\\")} { + if {$mode eq "unknown"} { + if {[tcl::string::trim $seg] ne ""} { + #we don't allow a quote in the middle of a bare key + error "tablename_split. character '\"' invalid at this point in tablename. tablename: '$tablename'" + } + set mode "quoted" + set seg "\"" + } elseif {$mode eq "unquoted"} { + append seg $c + } elseif {$mode eq "quoted"} { + append seg $c + lappend segments $seg + set seg "" + set mode "syntax" ;#make sure we only accept a dot or end-of-data now. + } elseif {$mode eq "litquoted"} { + append seg $c + } elseif {$mode eq "syntax"} { + error "tablename_split. expected whitespace or dot, got double quote. tablename: '$tablename'" + } + } elseif {($c eq "\'")} { + if {$mode eq "unknown"} { + append seg $c + set mode "litquoted" + } elseif {$mode eq "unquoted"} { + #single quote inside e.g o'neill + append seg $c + } elseif {$mode eq "quoted"} { + append seg $c + + } elseif {$mode eq "litquoted"} { + append seg $c + lappend segments $seg + set seg "" + set mode "syntax" + } elseif {$mode eq "syntax"} { + error "tablename_split. expected whitespace or dot, got single quote. tablename: '$tablename'" + } + + } elseif {$c in [list " " \t]} { + if {$mode eq "syntax"} { + #ignore + } else { + append seg $c + } + } else { + if {$mode eq "syntax"} { + error "tablename_split. Expected a dot separator. got '$c'. tablename: '$tablename'" + } + if {$mode eq "unknown"} { + set mode "unquoted" + } + append seg $c + } + if {$i == $sLen-1} { + #end of data + ::tomlish::log::debug "End of data: mode='$mode'" + switch -exact -- $mode { + quoted { + if {$c ne "\""} { + error "tablename_split. missing closing double-quote in a segment. tablename: '$tablename'" + } + if {$normalize} { + lappend segments $seg + } else { + lappend segments [::tomlish::utils::unescape_string [tcl::string::range $seg 1 end-1]] + #lappend segments [subst -nocommands -novariables [::string range $seg 1 end-1]] ;#wrong + } + } + litquoted { + set trimmed_seg [tcl::string::trim $seg] + if {[tcl::string::index $trimmed_seg end] ne "\'"} { + error "tablename_split. missing closing single-quote in a segment. tablename: '$tablename'" + } + lappend segments $seg + } + unquoted - unknown { + lappend segments $seg + } + syntax { + #ok - segment already lappended + } + default { + lappend segments $seg + } + } + } + } + foreach seg $segments { + set trimmed [tcl::string::trim $seg " \t"] + #note - we explicitly allow 'empty' quoted strings '' & "" + # (these are 'discouraged' but valid toml keys) + #if {$trimmed in [list "''" "\"\""]} { + # puts stderr "tablename_split. warning - Empty quoted string as tablename segment" + #} + if {$trimmed eq "" } { + error "tablename_split. Empty segment found. tablename: '$tablename' segments [llength $segments] ($segments)" + } + } + return $segments + } + + proc unicode_escape_info {slashu} { + #!todo + # validate that slashu is either a \uxxxx or \Uxxxxxxxx value of the correct length and + # is a valid 'unicode scalar value' + # ie integers in the range 0 to D7FF16 and E00016 to 10FFFF16 inclusive + #expr {(($x >= 0) && ($x <= 0xD7FF16)) || (($x >= 0xE00016) && ($x <= 0x10FFFF16))} + if {[tcl::string::match {\\u*} $slashu]} { + set exp {^\\u([0-9a-fA-F]{4}$)} + if {[regexp $exp $slashu match hex]} { + if {[scan $hex %4x dec] != 1} { + #why would a scan ever fail after matching the regexp? !todo - review. unreachable branch? + return [list err [list reason "Failed to convert '$hex' to decimal"]] + } else { + return [list ok [list char [subst -nocommand -novariable $slashu]]] + } + } else { + return [list err [list reason "Supplied string not of the form \\uHHHH where H in \[0-9a-fA-F\]"]] + } + } elseif {[tcl::string::match {\\U*} $slashu]} { + set exp {^\\U([0-9a-fA-F]{8}$)} + if {[regexp $exp $slashu match hex]} { + if {[scan $hex %8x dec] != 1} { + #why would a scan ever fail after matching the regexp? !todo - review. unreachable branch? + return [list err [list reason "Failed to convert '$hex' to decimal"]] + } else { + if {(($dec >= 0) && ($dec <= 0xD7FF16)) || (($dec >= 0xE00016) && ($dec <= 0x10FFFF16))} { + return [list ok [list char [subst -nocommand -novariable $slashu]]] + } else { + return [list err [list reason "$slashu is not within the 'unicode scalar value' ranges 0 to 0xD7FF16 or 0xE00016 to 0x10FFFF16"]] + } + } + } else { + return [list err [list reason "Supplied string not of the form \\UHHHHHHHH where H in \[0-9a-fA-F\]"]] + } + } else { + return [list err [list reason "Supplied string did not start with \\u or \\U" ]] + } + + } + + proc unescape_string {str} { + #note we can't just use Tcl subst because: + # it also transforms \a (audible bell) and \v (vertical tab) which are not in the toml spec. + # it would strip out backslashes inappropriately: e.g "\j" becomes just j + # it recognizes other escapes which aren't approprite e.g \xhh and octal \nnn + # it replaces\ with a single whitespace + #This means we shouldn't use 'subst' on the whole string, but instead substitute only the toml-specified escapes (\r \n \b \t \f \\ \" \uhhhh & \Uhhhhhhhh + + set buffer "" + set buffer4 "" ;#buffer for 4 hex characters following a \u + set buffer8 "" ;#buffer for 8 hex characters following a \u + + set sLen [tcl::string::length $str] + + #we need to handle arbitrarily long sequences of backslashes. \\\\\ etc + set slash_active 0 + set unicode4_active 0 + set unicode8_active 0 + + + #!todo - check for invalid data in the form of a raw carriage return (decimal 13) without following linefeed? + set i 0 + for {} {$i < $sLen} {} { + if {$i > 0} { + set lastChar [tcl::string::index $str [expr {$i - 1}]] + } else { + set lastChar "" + } + + set c [tcl::string::index $str $i] + ::tomlish::log::debug "unescape_string. got char $c" + scan $c %c n + if {($n <= 31) && ($n != 9) && ($n != 10) && ($n != 13)} { + #we don't expect unescaped unicode characters from 0000 to 001F - + #*except* for raw tab (which is whitespace) and newlines + error "unescape_string. Invalid data for a toml string. Unescaped control character (decimal $n) [::tomlish::utils::string_to_slashu $c]" + } + incr i ;#must incr here because we do'returns'inside the loop + if {$c eq "\\"} { + if {$slash_active} { + append buffer "\\" + set slash_active 0 + } elseif {$unicode4_active} { + error "unescape_string. unexpected case slash during unicode4 not yet handled" + } elseif {$unicode8_active} { + error "unescape_string. unexpected case slash during unicode8 not yet handled" + } else { + # don't output anything (yet) + set slash_active 1 + } + } else { + if {$unicode4_active} { + if {[tcl::string::length $buffer4] < 4} { + append buffer4 $c + } + if {[tcl::string::length $buffer4] == 4} { + #we have a \uHHHH to test + set unicode4_active 0 + set result [tomlish::utils::unicode_escape_info "\\u$buffer4"] + if {[lindex $result 0] eq "ok"} { + append buffer [dict get $result ok char] + } else { + error "unescape_string error: [lindex $result 1]" + } + } + } elseif {$unicode8_active} { + if {[tcl::string::length $buffer8] < 8} { + append buffer8 $c + } + if {[tcl::string::length $buffer8] == 8} { + #we have a \UHHHHHHHH to test + set unicode8_active 0 + set result [tomlish::utils::unicode_escape_info "\\U$buffer8"] + if {[lindex $result 0] eq "ok"} { + append buffer [dict get $result ok char] + } else { + error "unescape_string error: [lindex $result 1]" + } + } + } elseif {$slash_active} { + set slash_active 0 + set ctest [tcl::string::map {{"} dq} $c] + switch -exact -- $ctest { + dq { + set e "\\\"" + append buffer [subst -nocommand -novariable $e] + } + b - t - n - f - r { + set e "\\$c" + append buffer [subst -nocommand -novariable $e] + } + u { + set unicode4_active 1 + set buffer4 "" + } + U { + set unicode8_active 1 + set buffer8 "" + } + default { + set slash_active 0 + + append buffer "\\" + append buffer $c + } + } + } else { + append buffer $c + } + } + } + #puts stdout "EOF 4:$unicode4_active 8:$unicode8_active slash:$slash_active" + if {$unicode4_active} { + error "End of string reached before complete unicode escape sequence \uHHHH" + } + if {$unicode8_active} { + error "End of string reached before complete unicode escape sequence \UHHHHHHHH" + } + if {$slash_active} { + append buffer "\\" + } + return $buffer + } + + proc normalize_key {rawkey} { + set c1 [tcl::string::index $rawkey 0] + set c2 [tcl::string::index $rawkey end] + if {($c1 eq "'") && ($c2 eq "'")} { + #single quoted segment. No escapes allowed within it. + set key [tcl::string::range $rawkey 1 end-1] + } elseif {($c1 eq "\"") && ($c2 eq "\"")} { + #double quoted segment. Apply escapes. + # + set keydata [tcl::string::range $rawkey 1 end-1] ;#strip outer quotes only + set key [::tomlish::utils::unescape_string $keydata] + #set key [subst -nocommands -novariables $keydata] ;#wrong. Todo - create a string escape substitution function. + } else { + set key $rawkey + } + return $key + } + + proc string_to_slashu {string} { + set rv {} + foreach c [split $string {}] { + scan $c %c c + append rv {\u} + append rv [format %.4X $c] + } + return $rv + } + + #'nonprintable' is conservative here because some systems (e.g windows console) are very limited in what they can display. + proc nonprintable_to_slashu {s} { + set res "" + foreach i [split $s ""] { + scan $i %c c + + set printable 0 + if {($c>31) && ($c<127)} { + set printable 1 + } + if {$printable} {append res $i} else {append res \\u[format %.4X $c]} + } + set res + } ;#RS + + #check if str is valid for use as a toml bare key + proc is_barekey {str} { + if {[tcl::string::length $str] == 0} { + return 0 + } else { + set matches [regexp -all {[a-zA-Z0-9\_\-]} $str] + if {[tcl::string::length $str] == $matches} { + #all characters match the regexp + return 1 + } else { + return 0 + } + } + } + + #test only that the characters in str are valid for the toml specified type 'integer'. + proc int_validchars1 {str} { + set numchars [tcl::string::length $str] + if {[regexp -all {[0-9\_\-\+]} $str] == $numchars} { + return 1 + } else { + return 0 + } + } + #add support for hex,octal,binary 0x.. 0o.. 0b... + proc int_validchars {str} { + set numchars [tcl::string::length $str] + if {[regexp -all {[0-9\_xo\-\+A-Fa-f]} $str] == $numchars} { + return 1 + } else { + return 0 + } + } + + proc is_int {str} { + set matches [regexp -all {[0-9\_xo\-\+A-Fa-f]} $str] + + if {[tcl::string::length $str] == $matches} { + #all characters in legal range + + # --------------------------------------- + #check for leading zeroes in non 0x 0b 0o + #first strip any +, - or _ (just for this test) + set check [tcl::string::map {+ "" - "" _ ""} $str] + if {([tcl::string::length $check] > 1) && ([tcl::string::index $check 0] eq "0") && ([tcl::string::index $check 1] ni {o x b})} { + return 0 + } + # --------------------------------------- + + #check +,- only occur in the first position. + if {[tcl::string::last - $str] > 0} { + return 0 + } + if {[tcl::string::last + $str] > 0} { + return 0 + } + set numeric_value [tcl::string::map {_ ""} $str] ;#allow some earlier tcl versions which don't support underscores + #use Tcl's integer check to ensure we don't let things like 3e4 through - which is a float (would need to be 0x3e4 for hex) + if {![tcl::string::is integer -strict $numeric_value]} { + return 0 + } + #!todo - check bounds only based on some config value + #even though Tcl can handle bignums, we won't accept anything outside of toml 1.0 minimum requirements. + #presumably very large numbers would have to be supplied in a toml file as strings. + #Review - toml 1.0 only says that it must handle up to 2^63 - not that this is a max + if {$numeric_value > $::tomlish::max_int} { + return 0 + } + if {$numeric_value < $::tomlish::min_int} { + return 0 + } + } else { + return 0 + } + #Got this far - didn't find anything wrong with it. + return 1 + } + + #test only that the characters in str are valid for the toml specified type 'float'. + proc float_validchars {str} { + set numchars [tcl::string::length $str] + if {[regexp -all {[eE0-9\_\-\+\.]} $str] == $numchars} { + return 1 + } else { + #only allow lower case for these special values - as per Toml 1.0 spec + if {$str ni {inf +inf -inf nan +nan -nan}} { + return 0 + } else { + return 1 + } + } + } + + proc is_float {str} { + set matches [regexp -all {[eE0-9\_\-\+\.]} $str] + #don't test for case variations - as Toml doesn't allow (whereas Tcl allows Inf NaN etc) + if {$str in {inf +inf -inf nan +nan -nan}} { + return 1 + } + + if {[tcl::string::length $str] == $matches} { + #all characters in legal range + #A leading zero is ok, but we should disallow multiple leading zeroes (same rules as toml ints) + #Toml spec also disallows leading zeros in the exponent part + #... but this seems less interoperable (some libraries generate leading zeroes in exponents) + #for now we will allow leading zeros in exponents + #!todo - configure 'strict' option to disallow? + #first strip any +, - or _ (just for this test) + set check [tcl::string::map {+ "" - "" _ ""} $str] + set r {([0-9])*} + regexp $r $check intpart ;#intpart holds all numerals before the first .,e or E + set z {([0])*} + regexp $z $intpart leadingzeros + if {[tcl::string::length $leadingzeros] > 1} { + return 0 + } + #for floats, +,- may occur in multiple places + #e.g -2E-22 +3e34 + #!todo - check bounds ? + + #strip underscores for tcl double check + set check [tcl::string::map {_ ""} $str] + #string is double accepts inf nan +NaN etc. + if {![tcl::string::is double $check]} { + return 0 + } + + } else { + return 0 + } + #Got this far - didn't find anything wrong with it. + return 1 + } + + #test only that the characters in str are valid for the toml specified type 'datetime'. + proc datetime_validchars {str} { + set numchars [tcl::string::length $str] + if {[regexp -all {[zZtT0-9\-\+\.:]} $str] == $numchars} { + return 1 + } else { + return 0 + } + } + + #review - we + proc is_datetime {str} { + #e.g 1979-05-27 + #e.g 1979-05-27T00:32:00Z + #e.g 1979-05-27 00:32:00-07:00 + #e.g 1979-05-27 00:32:00+10:00 + #e.g 1979-05-27 00:32:00.999999-07:00 + + #review + #minimal datetimes? + # 2024 ok - shortest valid 4 digit year? + # 02:00 ok + # 05-17 ok + if {[string length $str] < 4} { + return 0 + } + + set matches [regexp -all {[zZtT0-9\-\+\.:]} $str] + if {[tcl::string::length $str] == $matches} { + #all characters in legal range + #!todo - use full RFC 3339 parser? + lassign [split $str T] datepart timepart + #!todo - what if the value is 'time only'? + + #Tcl's free-form clock scan (no -format option) is deprecated + # + #if {[catch {clock scan $datepart} err]} { + # puts stderr "tcl clock scan failed err:'$err'" + # return 0 + #} + + #!todo - verify time part is reasonable + } else { + return 0 + } + return 1 + } + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::utils ---}] +} + +namespace eval tomlish::parse { + #*** !doctools + #[subsection {Namespace tomlish::parse}] + #[para] + #[list_begin definitions] + + #This is a somewhat curly mix of a statemachine and toml-nesting-stack littered with special cases. + #The code is a pig's-nest - but it should be noted that for example trailing single double quotes in multiline strings are perhaps not so trivial to parse using more standard methods either: + # - e.g some kind of backtracking required if using an ABNF parser? + #I don't know the precise technical name for this sort of parser; probably something like "Dog's Breakfast" + #More seriously, we don't have distinct lex/parse steps - so it is basically a 'fused lexer' or 'scannerless parser' + + #It is also desirable for this system to be useful in 'interactive' use. review - would a separate lexer make this easier or harder? + + #A possible alternative more structured approach might be to use a PEG (Parsing Expression Grammar) + + + variable is_parsing 0 ;#whether we are in the middle of parsing tomlish text + + variable state + # states: + # table-space, itable-space, array-space + # value-expected, keyval-syntax, + # quoted-key, squoted-key + # string-state, literal-state, multistring... + # + # notes: + # only the -space states are also 'spaces' ie a container which is pushed/popped on the spacestack + + # + # value-expected - we also allow for leading whitespace in this state, but once a value is returned we jump to a state based on the containing space. e.g keyval-tail or array-syntax + # + #stateMatrix defines for each state, actions to take for each possible token. + #single-element actions are the name of the next state into which to transition, or a 'POPSPACE' instruction to pop a level off the spacestack and add the data to the parent container. + #dual-element actions are a push instruction and the name of the space to push on the stack. + # - PUSHSPACE is a simple push onto the spacestack, zeropoppushspace also pushes, but will first do a pop *if* the current space level is greater than zero (ie if only if not already in root table-space) + + # -- --- --- --- --- --- + #token/state naming guide + # -- --- --- --- --- --- + #tokens : underscore separated or bare name e.g newline, start_quote, start_squote + #private tokens: always have a leading underscore (These are private 'temporary state' tokens that are never returned as actual tokens e.g _start_squote_sequence + #states : always contain at least one dash e.g err-state, table-space + #instructions + # -- --- --- --- --- --- + + + #stateMatrix dict of elements mapping current state to next state based on returned tokens + # current-state {token-encountered next-state ... } + # where next-state can be a 1 or 2 element list. + #If 2 element - the first item is an instruction (ucase) + #If 1 element - it is either a lowercase dashed state name or an ucase instruction + #e.g {PUSHSPACE } or POPSPACE or SAMESPACE + + + #SAMESPACE - got to same space as parent without popping a level, but has it's own autotransition lookup - strange concept - review usecases + + variable stateMatrix + set stateMatrix [dict create] + + #xxx-space vs xxx-syntax inadequately documented - TODO + + # --------------------------------------------------------------------------------------------------------------# + # incomplete example of some state starting at table-space + # --------------------------------------------------------------------------------------------------------------# + # ( = -> value-expected) + # keyval-syntax (popped -> keyval-space -> keyval-tail) (autotransition on pop) + # keyval-space (autotransition on push ^) + # table-space (barekey^) (startquote -> quoted-key ^) + # --------------------------------------------------------------------------------------------------------------# + + dict set stateMatrix\ + table-space { + bom "table-space"\ + whitespace "table-space"\ + newline "table-space"\ + barekey {PUSHSPACE "keyval-space" state "keyval-syntax"}\ + squotedkey {PUSHSPACE "keyval-space" state "keyval-syntax" note ""}\ + startquote "quoted-key"\ + XXXstartsquote "squoted-key"\ + comment "table-space"\ + starttablename "tablename-state"\ + starttablearrayname "tablearrayname-state"\ + startmultiquote "err-state"\ + endquote "err-state"\ + comma "err-state"\ + eof "end-state"\ + equal "err-state"\ + } + + #itable-space/ curly-syntax : itables + dict set stateMatrix\ + itable-space {\ + whitespace "itable-space"\ + newline "itable-space"\ + squote_seq_begin {PUSHSPACE "leading-squote-space" returnstate itable-space starttok {squote_seq "'"}}\ + barekey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ + squotedkey {PUSHSPACE "itable-keyval-space" state "itable-keyval-syntax"}\ + endinlinetable "POPSPACE"\ + startquote "quoted-key"\ + startsquote {TOSTATE "squoted-key" comment "jn-testing"}\ + comma "itable-space"\ + comment "err-state"\ + eof "err-state"\ + } + + + dict set stateMatrix\ + keyval-space {\ + whitespace "keyval-syntax"\ + equal "keyval-value-expected"\ + } + + # ' = ' portion of keyval + dict set stateMatrix\ + keyval-syntax {\ + whitespace "keyval-syntax"\ + squotedkey {PUSHSPACE "dottedkey-space"}\ + barekey {PUSHSPACE "dottedkey-space"}\ + equal "keyval-value-expected"\ + comma "err-state"\ + newline "err-state"\ + eof "err-state"\ + } + #### + dict set stateMatrix\ + keyval-value-expected {\ + whitespace "keyval-value-expected"\ + untyped_value {TOSTATE "keyval-tail" note ""}\ + squote_seq_begin {PUSHSPACE "leading-squote-space" returnstate keyval-value-expected starttok {squote_seq "'"}}\ + startquote {TOSTATE "string-state" returnstate keyval-tail}\ + startmultiquote {PUSHSPACE "multistring-space" returnstate keyval-tail}\ + startsquote {TOSTATE "literal-state" returnstate keyval-tail note "usual way a literal is triggered"}\ + double_squote {TOSTATE "keyval-tail" note "empty literal received when double squote occurs"}\ + triple_squote {PUSHSPACE "multiliteral-space" returnstate keyval-tail}\ + startinlinetable {PUSHSPACE itable-space returnstate keyval-tail}\ + startarray {PUSHSPACE array-space returnstate keyval-tail}\ + } + #squote_seq_begin {PUSHSPACE "leading-squote-space" returnstate keyval-process-leading-squotes starttok {squote_seq "'"}} + dict set stateMatrix\ + leading-squote-space {\ + squote_seq "POPSPACE"\ + } + #dict set stateMatrix\ + # keyval-process-leading-squotes {\ + # startsquote "literal-state"\ + # triple_squote {PUSHSPACE "multiliteral-space" returnstate keyval-tail}\ + # } + + dict set stateMatrix\ + keyval-tail {\ + whitespace "keyval-tail"\ + newline "POPSPACE"\ + comment "keyval-tail"\ + eof "end-state"\ + } + + dict set stateMatrix\ + itable-keyval-syntax {\ + whitespace "itable-keyval-syntax"\ + squotedkey {PUSHSPACE "dottedkey-space"}\ + barekey {PUSHSPACE "dottedkey-space"}\ + equal "itable-keyval-value-expected"\ + newline "err-state"\ + eof "err-state"\ + } + dict set stateMatrix\ + itable-keyval-value-expected {\ + whitespace "itable-keyval-value-expected"\ + untyped_value {TOSTATE "itable-val-tail" note ""}\ + squote_seq_begin {PUSHSPACE "leading-squote-space" returnstate itable-keyval-value-expected starttok {squote_seq "'"}}\ + startquote {TOSTATE "string-state" returnstate itable-val-tail}\ + startmultiquote {PUSHSPACE "multistring-space" returnstate itable-val-tail}\ + startsquote {TOSTATE "literal-state" returnstate itable-val-tail note "usual way a literal is triggered"}\ + double_squote {TOSTATE "itable-val-tail" note "empty literal received when double squote occurs"}\ + triple_squote {PUSHSPACE "multiliteral-space" returnstate itable-val-tail}\ + startinlinetable {PUSHSPACE "itable-space" returnstate itable-val-tail}\ + startarray {PUSHSPACE "array-space" returnstate itable-val-tail}\ + } + dict set stateMatrix\ + itable-keyval-space {\ + whitespace "itable-keyval-syntax"\ + equal {TOSTATE "itable-keyval-value-expected" note "required"}\ + } + + dict set stateMatrix\ + itable-val-tail {\ + whitespace "itable-val-tail"\ + endinlinetable "POPSPACE"\ + comma "POPSPACE"\ + Xnewline {TOSTATE "itable-val-tail" note "itable-space ??"}\ + newline "err-state"\ + comment "itable-val-tail"\ + eof "err-state"\ + } + #dict set stateMatrix\ + # itable-quoted-key {\ + # whitespace "NA"\ + # itablequotedkey {PUSHSPACE "itable-keyval-space"}\ + # newline "err-state"\ + # endquote "itable-keyval-syntax"\ + # } + #dict set stateMatrix\ + # itable-squoted-key {\ + # whitespace "NA"\ + # itablesquotedkey {PUSHSPACE "itable-keyval-space"}\ + # newline "err-state"\ + # endsquote "itable-keyval-syntax"\ + # } + + + + + + dict set stateMatrix\ + value-expected {\ + whitespace "value-expected"\ + untyped_value {"SAMESPACE" "" replay untyped_value}\ + startquote "string-state"\ + startsquote "literal-state"\ + startmultiquote {PUSHSPACE "multistring-space"}\ + triple_squote {PUSHSPACE "multiliteral-space"}\ + startinlinetable {PUSHSPACE itable-space}\ + startarray {PUSHSPACE array-space}\ + comment "err-state-value-expected-got-comment"\ + comma "err-state"\ + newline "err-state"\ + eof "err-state"\ + } + + #dottedkey-space is not used within [tablename] or [[tablearrayname]] + #it is for keyval ie x.y.z = value + dict set stateMatrix\ + dottedkey-space {\ + whitespace "dottedkey-space"\ + dotsep "dottedkey-space"\ + barekey "dottedkey-space"\ + squotedkey "dottedkey-space"\ + quotedkey "dottedkey-space"\ + equal "POPSPACE"\ + newline "err-state"\ + comma "err-state"\ + comment "err-state"\ + } + #dottedkeyend "POPSPACE" + + + + + #REVIEW + #toml spec looks like heading towards allowing newlines within inline tables + #https://github.com/toml-lang/toml/issues/781 + dict set stateMatrix\ + curly-syntax {\ + whitespace "curly-syntax"\ + newline "curly-syntax"\ + barekey {PUSHSPACE "itable-keyval-space"}\ + itablequotedkey "itable-keyval-space"\ + endinlinetable "POPSPACE"\ + startquote "itable-quoted-key"\ + comma "itable-space"\ + comment "itable-space"\ + eof "err-state"\ + } + #review comment "err-state" vs comment "itable-space" - see if TOML 1.1 comes out and allows comments in multiline ITABLES + #We currently allow multiline ITABLES (also with comments) in the tokenizer. + #if we want to disallow as per TOML 1.0 - we should do so when attempting to get structure? + + + #JMN REVIEW + dict set stateMatrix\ + array-space {\ + whitespace "array-space"\ + newline "array-space"\ + untyped_value "SAMESPACE"\ + startarray {PUSHSPACE "array-space"}\ + endarray "POPSPACE"\ + startmultiquote {PUSHSPACE multistring-space}\ + startinlinetable {PUSHSPACE itable-space}\ + startquote "string-state"\ + startsquote "literal-state"\ + triple_squote {PUSHSPACE "multiliteral-space" returnstate array-syntax note "seems ok 2024"}\ + comma "array-space"\ + comment "array-space"\ + eof "err-state-array-space-got-eof"\ + } + dict set stateMatrix\ + array-syntax {\ + whitespace "array-syntax"\ + newline "array-syntax"\ + untyped_value "SAMESPACE"\ + startarray {PUSHSPACE array-space}\ + endarray "POPSPACE"\ + startmultiquote {PUSHSPACE multistring-space}\ + startquote "string-state"\ + startsquote "literal-state"\ + comma "array-space"\ + comment "err-state"\ + } + + + + #quoted-key & squoted-key need to PUSHSPACE from own token to keyval-space + dict set stateMatrix\ + quoted-key {\ + whitespace "NA"\ + quotedkey {PUSHSPACE "keyval-space"}\ + newline "err-state"\ + endquote "keyval-syntax"\ + } + dict set stateMatrix\ + squoted-key {\ + whitespace "NA"\ + squotedkey "squoted-key"\ + newline "err-state"\ + } + # endsquote {PUSHSPACE "keyval-space"} + + dict set stateMatrix\ + string-state {\ + whitespace "NA"\ + string "string-state"\ + endquote "SAMESPACE"\ + newline "err-state"\ + eof "err-state"\ + } + dict set stateMatrix\ + literal-state {\ + whitespace "NA"\ + literal "literal-state"\ + endsquote "SAMESPACE"\ + newline "err-state"\ + eof "err-state"\ + } + + + #dict set stateMatrix\ + # stringpart {\ + # continuation "SAMESPACE"\ + # endmultiquote "POPSPACE"\ + # eof "err-state"\ + # } + dict set stateMatrix\ + multistring-space {\ + whitespace "multistring-space"\ + continuation "multistring-space"\ + stringpart "multistring-space"\ + newline "multistring-space"\ + endmultiquote "POPSPACE"\ + eof "err-state"\ + } + + + #only valid subparts are literalpart and newline. other whitespace etc is within literalpart + #todo - treat sole cr as part of literalpart but crlf and lf as newline + dict set stateMatrix\ + multiliteral-space {\ + literalpart "multiliteral-space"\ + newline "multiliteral-space"\ + squote_seq_begin {PUSHSPACE "trailing-squote-space" returnstate multiliteral-space starttok {squote_seq "'"}}\ + triple_squote {POPSPACE note "on popping - we do any necessary concatenation of LITERALPART items due to squote processing"}\ + double_squote {TOSTATE multiliteral-space note "short squote_seq: can occur anywhere in the space e.g emitted at end when 5 squotes occur"}\ + startsquote {TOSTATE multiliteral-space note "short squote_seq: same as double_squote - false alarm"}\ + eof "err-premature-eof-in-multiliteral-space"\ + } + + #trailing because we are looking for possible terminating ''' - but must accept '''' or ''''' and re-integrate the 1st one or 2 extra squotes + dict set stateMatrix\ + trailing-squote-space {\ + squote_seq "POPSPACE"\ + } + + + dict set stateMatrix\ + tablename-state {\ + whitespace "NA"\ + tablename {zeropoppushspace table-space}\ + tablename2 {PUSHSPACE table-space}\ + endtablename "tablename-tail"\ + comma "err-state"\ + newline "err-state"\ + } + dict set stateMatrix\ + tablearrayname-state {\ + whitespace "NA"\ + tablearrayname {zeropoppushspace table-space}\ + tablearrayname2 {PUSHSPACE table-space}\ + endtablearray "tablearrayname-tail"\ + comma "err-state"\ + newline "err-state"\ + } + + dict set stateMatrix\ + tablename-tail {\ + whitespace "tablename-tail"\ + newline "table-space"\ + comment "tablename-tail"\ + eof "end-state"\ + } + dict set stateMatrix\ + tablearrayname-tail {\ + whitespace "tablearrayname-tail"\ + newline "table-space"\ + comment "tablearrayname-tail"\ + eof "end-state"\ + } + dict set stateMatrix\ + end-state {} + + set knowntokens [list] + set knownstates [list] + dict for {state transitions} $stateMatrix { + if {$state ni $knownstates} {lappend knownstates $state} + dict for {tok instructions} $transitions { + if {$tok ni $knowntokens} {lappend knowntokens $tok} + } + } + dict set stateMatrix nostate {} + foreach tok $knowntokens { + dict set stateMatrix nostate $tok "err-nostate-received-token-$tok" + } + + + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + #purpose - debugging? remove? + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + #build a list of 'push triggers' from the stateMatrix + # ie tokens which can push a new space onto spacestack + set push_trigger_tokens [list] + tcl::dict::for {s transitions} $stateMatrix { + tcl::dict::for {token transition_to} $transitions { + set instruction [lindex $transition_to 0] + switch -exact -- $instruction { + PUSHSPACE - zeropoppushspace { + if {$token ni $push_trigger_tokens} { + lappend push_trigger_tokens $token + } + } + } + } + } + ::tomlish::log::debug "push_trigger_tokens: $push_trigger_tokens" + # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- + + + + #This seems hacky... (deprecate in favour of explicit arguments to the instructions in stateMatrix?) + #spacePopTransitions, spacePushTransitions, spaceSameTransitions below for auto state redirections on POPSPACE,PUSHSPACE,SAMESPACE + + #mainly for the -space states: + #redirect to another state $c based on a state transition from $whatever to $b + # e.g "string {array-space array-syntax}" means when transitioning from string to array-space, jump to array-syntax instead. + #this is useful as we often don't know state $b. e.g when it is decided by 'POPSPACE' + + #Push to, next + #default first states when we push to these spaces + variable spacePushTransitions { + keyval-space keyval-syntax + itable-keyval-space itable-keyval-syntax + array-space array-space + table-space tablename-state + } + #itable-space itable-space + #Pop to, next + variable spacePopTransitions { + array-space array-syntax + } + #itable-space curly-syntax + #itable-keyval-space itable-val-tail + #review + #we pop to keyval-space from dottedkey-space or from value-expected? we don't always want to go to keyval-tail + #leave it out and make the POPSPACE caller explicitly specify it + #keyval-space keyval-tail + + variable spaceSameTransitions { + array-space array-syntax + } + #itable-space curly-syntax + #itable-keyval-space itable-val-tail + + + variable state_list ;#reset every tomlish::decode::toml + + namespace export tomlish toml + namespace ensemble create + + #goNextState has various side-effects e.g pushes and pops spacestack + #REVIEW - setting nest and v elements here is ugly + #todo - make neater, more single-purpose? + proc goNextState {tokentype tok currentstate} { + variable state + variable nest + variable v + + set prevstate $currentstate + + + variable spacePopTransitions + variable spacePushTransitions + variable spaceSameTransitions + + variable last_space_action "none" + variable last_space_type "none" + variable state_list + + set result "" + set starttok "" + + if {[dict exists $::tomlish::parse::stateMatrix $currentstate $tokentype]} { + set transition_to [dict get $::tomlish::parse::stateMatrix $currentstate $tokentype] + ::tomlish::log::debug "--->> goNextState tokentype:$tokentype tok:$tok currentstate:$currentstate : transition_to = $transition_to" + switch -exact -- [lindex $transition_to 0] { + POPSPACE { + spacestack pop + set parent_info [spacestack peek] + set type [dict get $parent_info type] + set parentspace [dict get $parent_info state] + + set last_space_action "pop" + set last_space_type $type + + if {[dict exists $parent_info returnstate]} { + set next [dict get $parent_info returnstate] + #clear the returnstate on current level + set existing [spacestack pop] + dict unset existing returnstate + spacestack push $existing ;#re-push modification + ::tomlish::log::info "--->> POPSPACE transition to parent space $parentspace redirected to stored returnstate $next <<---" + } else { + ### + #review - do away with spacePopTransitions - which although useful to provide a default.. + # - involve error-prone configurations distant to the main state transition configuration in stateMatrix + if {[dict exists $::tomlish::parse::spacePopTransitions $parentspace]} { + set next [dict get $::tomlish::parse::spacePopTransitions $parentspace] + ::tomlish::log::info "--->> POPSPACE transition to parent space $parentspace redirected state to $next (spacePopTransitions)<<---" + } else { + set next $parentspace + ::tomlish::log::info "--->> POPSPACE transition to parent space $parentspace<<---" + } + } + set result $next + } + SAMESPACE { + set currentspace_info [spacestack peek] + ::tomlish::log::debug "--->> SAMESPACE got current space entry: $currentspace_info <<<<<" + set type [dict get $currentspace_info type] + set currentspace [dict get $currentspace_info state] + + if {[dict exists $currentspace_info returnstate]} { + set next [dict get $currentspace_info returnstate] + #clear the returnstate on current level + set existing [spacestack pop] + dict unset existing returnstate + spacestack push $existing ;#re-push modification + ::tomlish::log::info "--->> SAMESPACE transition to space $currentspace redirected to stored returnstate $next" + } else { + if {[dict exists $::tomlish::parse::spaceSameTransitions $currentspace]} { + set next [dict get $::tomlish::parse::spaceSameTransitions $currentspace] + ::tomlish::log::info "--->> SAMESPACE transition to space $currentspace redirected state to $next (spaceSameTransitions)" + } else { + set next $currentspace + ::tomlish::log::info "--->> SAMESPACE transition to space $currentspace" + } + } + set result $next + } + zeropoppushspace { + if {$nest > 0} { + #pop back down to the root level (table-space) + spacestack pop + set parentinfo [spacestack peek] + set type [dict get $parentinfo type] + set target [dict get $parentinfo state] + + set last_space_action "pop" + set last_space_type $type + + #----- + #standard pop + set parentlevel [expr {$nest -1}] + lappend v($parentlevel) [set v($nest)] + incr nest -1 + #----- + } + #re-entrancy + + #set next [list PUSHSPACE [lindex $transition_to 1]] + set nexttokentype ${tokentype}2 ;#fake token type e.g tablename2 or tablearrayname2 + #::tomlish::log::notice "goNextState REENTRANCY. calling goNextState $nexttokentype $tokentype" + #set result [::tomlish::parse::goNextState $nexttokentype $tokentype] + ::tomlish::log::debug "--->> zeropoppushspace goNextState REENTRANCY. calling goNextState $nexttokentype $currentstate" + set transition_info [::tomlish::parse::goNextState $nexttokentype $tok $currentstate] + set result [dict get $transition_info newstate] + } + PUSHSPACE { + set original_target [dict get $transition_to PUSHSPACE] + if {[dict exists $transition_to returnstate]} { + #adjust the existing space record on the stack. + #struct::stack doesn't really support that - so we have to pop and re-push + #todo - investigate a custom stack implementation where we can efficiently lset the top of the stack + set currentspace [spacestack pop] + dict set currentspace returnstate [dict get $transition_to returnstate] + spacestack push $currentspace ;#return modified info to stack so when we POPSPACE the returnstate is available. + } + if {[dict exists $transition_to starttok]} { + set starttok [dict get $transition_to starttok] + } + spacestack push [dict create type space state $original_target] + + set last_space_action "push" + set last_space_type "space" + + if {[dict exists $transition_to state]} { + #an explicit state in the pushed space was requested in the stateMatrix - override the spacePushTransition (spacePushTransitions can be deprecated if we require explicitness?) + set next [dict get $transition_to state] + ::tomlish::log::info "--->> PUSHSPACE transition to space $original_target redirected state to $next by explicit 'state' entry" + } else { + #puts $::tomlish::parse::spacePushTransitions + if {[dict exists $::tomlish::parse::spacePushTransitions $original_target]} { + set next [dict get $::tomlish::parse::spacePushTransitions $original_target] + ::tomlish::log::info "--->> PUSHSPACE transition to space $original_target redirected state to $next (spacePushTransitions) " + } else { + set next $original_target + ::tomlish::log::info "--->> PUSHSPACE transition to space $original_target" + } + } + set result $next + } + TOSTATE { + if {[dict exists $transition_to returnstate]} { + #adjust the existing space record on the stack. + #struct::stack doesn't really support that - so we have to pop and re-push + #todo - investigate a custom stack implementation where we can efficiently lset the top of the stack + set currentspace [spacestack pop] + dict set currentspace returnstate [dict get $transition_to returnstate] + spacestack push $currentspace ;#return modified info to stack so when we POPSPACE the returnstate is available. + } + set result [dict get $transition_to TOSTATE] + } + default { + #simplified version of TOSTATE + set result [lindex $transition_to 0] ;#ignore everything but first word + } + } + } else { + ::tomlish::log::error "--->> No state transition defined from state $currentstate when tokentype $tokentype received" + set result "nostate" + } + lappend state_list [list tokentype $tokentype from $currentstate to $result] + set state $result + ::tomlish::log::notice "--->> STATE TRANSITION tokenType: '$tokentype' tok:$tok triggering '$currentstate' -> '$result' last_space_action:$last_space_action " + return [dict create prevstate $prevstate newstate $result space_action $last_space_action starttok $starttok] + } + + proc report_line {{line ""}} { + variable linenum + variable is_parsing + if {$is_parsing} { + if {$line eq ""} { + set line $linenum + } + return "Line Number: $line" + } else { + #not in the middle of parsing tomlish text - return nothing. + return "" + } + } + + #produce a *slightly* more readable string rep of the nest for puts etc. + proc nest_pretty1 {list} { + set prettier "{" + + foreach el $list { + if { [lindex $el 0] eq "NEWLINE"} { + append prettier "[list $el]\n" + } elseif {([llength $el] > 1) && ([lindex $el 0] in {KEY QKEY SQKEY TABLE ARRAY})} { + append prettier [nest_pretty1 $el] + } else { + append prettier "[list $el] " + } + } + append prettier "}" + return $prettier + } + + proc set_tokenType {t} { + variable tokenType + variable tokenType_list + if {![info exists tokenType]} { + set tokenType "" + } + lappend tokenType_list $t + set tokenType $t + } + + proc switch_tokenType {t} { + variable tokenType + variable tokenType_list + lset tokenType_list end $t + set tokenType $t + } + + proc get_tokenType {} { + variable tokenType + return $tokenType + } + + proc _shortcircuit_startquotesequence {} { + variable tok + variable i + set toklen [tcl::string::length $tok] + if {$toklen == 1} { + set_tokenType "startquote" + incr i -1 + return -level 2 1 + } elseif {$toklen == 2} { + puts stderr "_shortcircuit_startquotesequence toklen 2" + set_tokenType "startquote" + set tok "\"" + incr i -2 + return -level 2 1 + } + } + + proc get_token_waiting {} { + variable token_waiting + return [lindex $token_waiting 0] + } + proc clear_token_waiting {} { + variable token_waiting + set token_waiting [list] + } + + #token_waiting is a list - but our standard case is to have only one + #in certain circumstances such as near eof we may have 2 + #the set_token_waiting function only allows setting when there is not already one waiting. + #we want to catch cases of inadvertently trying to set multiple + # - the reason being that the state transition triggered by the previous token may have invalidated the assumptions made when a token was added as waiting. + proc set_token_waiting {args} { + if {[llength $args] %2 != 0} { + error "tomlish set_token_waiting must have args of form: type value complete 0|1" + } + variable token_waiting + + if {[llength $token_waiting] && [dict get [lindex $token_waiting end] type] ne "eof"} { + #tokloop already set a token_waiting - but something (post tokloop processing?) is trying to set another + #we may need to remove the existing token_waiting and reset the tokloop index to the previous char so it's reprocessed in the possibly new context + #rather than attempt to make the right decision here - we raise an error and require the caller to check/handle it + set err "tomlish set_token_waiting already has token_waiting: [lindex $token_waiting 0]" + append err \n " - cannot add token_waiting: $args" + error $err + #set tomlish::parse::i [expr {[dict get $token_waiting startindex] -1}] + #set token_waiting [list] + } + + set waiting [dict create] + dict for {k v} $args { + switch -exact $k { + type - complete { + dict set waiting $k $v + } + value { + dict set waiting tok $v + } + startindex { + dict set waiting startindex $v + } + default { + error "tomlish set_token_waiting error - unrecognised key $k. known keys: [dict keys $args]" + } + } + } + if {![tcl::string::is boolean -strict [dict get $waiting complete]]} { + error "tomlish set_token_waiting error - 'complete' must be a boolean. got [dict get $waiting complete]" + } + if {![llength $token_waiting]} { + set token_waiting [list $waiting] + } else { + #an extra sanity-check that we don't have more than just the eof.. + if {[llength $token_waiting] > 1} { + set err "tomlish Unexpected. Existing token_waiting count > 1.\n" + foreach tw $token_waiting { + append err " $tw" \n + } + append err " - cannot add token_waiting: $waiting" + error $err + } + #last entry must be a waiting eof + set token_waiting [list $waiting [lindex $token_waiting end]] + } + return + } + + #returns 0 or 1 + #tomlish::parse::tok + #we attempt to do this without lookahead (potential use in streaming toml? for what benefit?) todo -final flag + # - the possible benefit is being able to more easily process in arbitrarily split chunks (although we would still have to watch crlf splitting ?) + # - interactive use? + + proc tok {s} { + variable nest + variable v + variable i + variable tok + variable type ;#character type + variable state ;#FSM + + + variable tokenType + variable tokenType_list + + + variable endToken + + variable lastChar + + variable braceCount + variable bracketCount + + + #------------------------------ + #Previous run found another (presumably single-char) token + #The normal case is for there to be only one dict in the list + #multiple is an exception - primarily for eof + variable token_waiting + if {[llength $token_waiting]} { + set waiting [lindex $token_waiting 0] + + set tokenType [dict get $waiting type] + set tok [dict get $waiting tok] + #todo: dict get $token_waiting complete + set token_waiting [lrange $token_waiting 1 end] + return 1 + } + #------------------------------ + + set resultlist [list] + set sLen [tcl::string::length $s] + + set slash_active 0 + set quote 0 + set c "" + set multi_dquote "" + for {} {$i < $sLen} {} { + if {$i > 0} { + set lastChar [tcl::string::index $s [expr {$i - 1}]] + } else { + set lastChar "" + } + + set c [tcl::string::index $s $i] + set cindex $i + tomlish::log::debug "- tokloop char <$c> index $i tokenType:$tokenType tok:<$tok>" + #puts "got char $c during tokenType '$tokenType'" + incr i ;#must incr here because we do returns inside the loop + + set ctest [tcl::string::map {\{ lc \} rc \[ lb \] rb \" dq ' sq \\ bsl \r cr \n lf \t tab \uFEFF bom} $c] + switch -exact -- $ctest { + # { + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + + if {$had_slash} {append tok "\\"} ;#if tokentype not appropriate for \, we would already have errored out. + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + barekey { + error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z_-\] allowed. [tomlish::parse::report_line]" + } + whitespace { + # hash marks end of whitespace token + #do a return for the whitespace, set token_waiting + #set_token_waiting type comment value "" complete 1 + incr i -1 ;#leave comment for next run + return 1 + } + untyped_value { + #REVIEW! the spec isn't clear.. is whitespace after an int,bool etc required before comment? + #we will accept a comment marker as an immediate terminator of the untyped_value. + incr i -1 + return 1 + } + starttablename - starttablearrayname { + #fix! + error "tomlish Character '#' is invalid first character for $tokenType. [tomlish::parse::report_line]" + } + tablename - tablearrayname { + #invalid in bare parts - but allowed in quoted parts - let tablename parser sort it out + append tok $c + } + default { + #quotedkey, itablequotedkey, string,literal, multistring + append tok $c + } + } + } else { + switch -- $state { + multistring-space { + set_tokenType stringpart + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok "$dquotes#" + } + multiliteral-space { + set_tokenType "literalpart" + set tok "#" + } + default { + #start of token if we're not in a token + set_tokenType comment + set tok "" ;#The hash is not part of the comment data + } + } + } + } + lc { + #left curly brace + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart - squotedkey - itablesquotedkey { + append tok $c + } + string - quotedkey - itablequotedkey { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + starttablename - starttablearrayname { + #*bare* tablename can only contain letters,digits underscores + error "tomlish Invalid tablename first character \{ [tomlish::parse::report_line]" + } + tablename - tablearrayname { + #valid in quoted parts + append tok $c + } + comment { + if {$had_slash} {append tok "\\"} + append tok "\[" + } + default { + #end any other token. + incr i -1 + return 1 + } + } + } else { + switch -exact -- $state { + itable-keyval-value-expected - keyval-value-expected - value-expected { + #switch last key to tablename?? + set_tokenType "startinlinetable" + set tok "\{" + return 1 + } + array-space - array-syntax { + #nested anonymous inline table + set_tokenType "startinlinetable" + set tok "\{" + return 1 + } + table-space { + #invalid - but allow parser statemachine to report it. ? + set_tokenType "startinlinetable" + set tok "\{" + return 1 + } + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok "$dquotes\{" + } + multiliteral-space { + set_tokenType "literalpart" + set tok "\{" + } + default { + error "tomlish state: '$state'. left brace case not implemented [tomlish::parse::report_line]" + } + } + } + + } + rc { + #right curly brace + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart - squotedkey - itablesquotedkey { + append tok $c + } + string - quotedkey - itablequotedkey - comment { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + starttablename - tablename { + if {$had_slash} {append tok "\\"} + #invalid! - but leave for datastructure loading stage to catch + set_token_waiting type endinlinetable value "" complete 1 startindex $cindex + return 1 + } + starttablearrayname - tablearrayname { + if {$had_slash} {append tok "\\"} + #invalid! - but leave for datastructure loading stage to catch + set_token_waiting type endtablearrayname value "" complete 1 startindex $cindex + return 1 + } + itable-val-tail { + #review + error "tomlish right-curly in itable-val-tail" + } + default { + #end any other token + incr i -1 + return 1 + } + } + } else { + #$slash_active not relevant when no tokenType + switch -exact -- $state { + value-expected { + #invalid - but allow parser statemachine to report it. + set_tokenType "endinlinetable" + set tok "\}" + return 1 + } + table-space { + #invalid - but allow parser statemachine to report it. ? + set_tokenType "endinlinetable" + set tok "\}" + return 1 + } + itable-space { + set_tokenType "endinlinetable" + set tok "\}" + return 1 + } + tablename-state { + #e.g [] - empty tablename - allowed or not? + #empty tablename/tablearrayname ? + #error "unexpected tablename problem" + + set_tokenType "endinlinetable" + set tok "" ;#no output into the tomlish list for this token + return 1 + } + tablearrayname-state { + error "tomlish unexpected tablearrayname-state problem" + set_tokenType "endinlinetable" + set tok "" ;#no output into the tomlish list for this token + return 1 + } + array-syntax - array-space { + #invalid + set_tokenType "endinlinetable" + set tok "\}" + return 1 + } + curly-syntax { + set_tokenType "endinlinetable" + set tok "\}" + return 1 + } + itable-val-tail { + set_tokenType "endinlinetable" + set tok "" + #we need to pop the keyval - and then reprocess to pop the inlinetable - so we incr -1 + incr i -1 + return 1 + } + itable-keyval-syntax { + error "tomlish endinlinetable unexpected at this point. Expecting key=val syntax [tomlish::parse::report_line]" + } + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok "$dquotes\}" + } + multiliteral-space { + set_tokenType "literalpart" ; #review + set tok "\}" + } + default { + #JMN2024b keyval-tail? + error "tomlish state '$state'. endinlinetable case not implemented [tomlish::parse::report_line]" + } + } + } + + } + lb { + #left square bracket + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart - squotedkey - itablesquotedkey { + append tok $c + } + string - quotedkey - itablequotedkey { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + starttablename { + #change the tokenType + switch_tokenType "starttablearrayname" + set tok "" ;#no output into the tomlish list for this token + #any following whitespace is part of the tablearrayname, so return now + return 1 + } + tablename { + #e.g a."x[0]".c is valid table name sequence - so we need to track quoting to know if rb is an end token + if {$had_slash} { + #resultant tablename may be invalid - but leave for datastructure loading stage to catch + append tok "\\[" + } else { + if {[tomlish::utils::tok_in_quotedpart $tok] eq ""} { + #invalid at this point - state machine should disallow table -> starttablearrayname + set_token_waiting type starttablearrayname value "" complete 1 startindex $cindex + return 1 + } else { + #we appear to still be in single or double quoted section + append tok "\[" + } + } + } + comment { + if {$had_slash} {append tok "\\"} + append tok "\[" + } + default { + #end any other token. + incr i -1 + return 1 + } + } + } else { + #$slash_active not relevant when no tokenType + switch -exact -- $state { + keyval-value-expected - itable-keyval-value-expected - value-expected { + set_tokenType "startarray" + set tok "\[" + return 1 + } + table-space { + #table name + #assume it's a single bracket - but we need to wait for non-bracket to confirm it's not a tablearray + #note that a starttablearrayname token may contain whitespace between the brackets + # e.g \[ \[ + set_tokenType "starttablename" + set tok "" ;#there is no output into the tomlish list for this token + } + array-space - array-syntax { + #nested array? + set_tokenType "startarray" + set tok "\[" + return 1 + #error "state: array-space. startarray case not implemented [tomlish::parse::report_line]" + } + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok "$dquotes\[" + } + multiliteral-space { + set_tokenType "literalpart" + set tok "\[" + } + itable-space { + #handle state just to give specific error msg + error "tomlish state: '$state'. Left square bracket invalid. Cannot start array in inline table without key. Use key=\[\] syntax. [tomlish::parse::report_line]" + } + default { + error "tomlish state: '$state'. startarray case not implemented [tomlish::parse::report_line]" + } + } + } + } + rb { + #right square bracket + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart - squotedkey - itablesquotedkey { + append tok $c + } + string - quotedkey - itablequotedkey { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + comment { + if {$had_slash} {append tok "\\"} + append tok $c + } + whitespace { + if {$state eq "multistring-space"} { + #???? + incr i -1 + if {$had_slash} {incr i -1} ;#reprocess + return 1 + } else { + incr i -1 + if {$had_slash} {incr i -1} ;#reprocess + return 1 + } + } + tablename { + #e.g a."x[0]".c is valid table name sequence - so we need to track quoting to know if rb is an end token + if {$had_slash} { + #resultant tablename may be invalid - but leave for datastructure loading stage to catch + append tok "\\]" + } else { + if {[tomlish::utils::tok_in_quotedpart $tok] eq ""} { + set_token_waiting type endtablename value "" complete 1 startindex $cindex + return 1 + } else { + #we appear to still be in single or double quoted section + append tok "]" + } + } + } + tablearraynames { + #todo? + if {$had_slash} {append tok "\\"} + #invalid! - but leave for datastructure loading stage to catch + set_token_waiting type endtablearrayname value "" complete 1 startindex $cindex + return 1 + } + default { + incr i -1 + return 1 + } + } + } else { + #$slash_active not relevant when no tokenType + switch -exact -- $state { + value-expected { + #invalid - but allow parser statemachine to report it. + set_tokenType "endarray" + set tok "\]" + return 1 + } + table-space { + #invalid - but allow parser statemachine to report it. ? + set_tokenType "endarray" + set tok "\]" + return 1 + } + tablename-state { + #e.g [] - empty tablename - allowed or not? + #empty tablename/tablearrayname ? + #error "unexpected tablename problem" + + set_tokenType "endtablename" + set tok "" ;#no output into the tomlish list for this token + return 1 + } + tablearrayname-state { + error "tomlish unexpected tablearrayname problem" + set_tokenType "endtablearray" + set tok "" ;#no output into the tomlish list for this token + return 1 + } + array-syntax - array-space { + set_tokenType "endarray" + set tok "\]" + return 1 + } + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok "$dquotes\]" + } + multiliteral-space { + set_tokenType "literalpart" + set tok "\]" + } + default { + error "tomlish state '$state'. endarray case not implemented [tomlish::parse::report_line]" + } + } + } + } + bsl { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + #backslash + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + whitespace { + if {$state eq "multistring-space"} { + #end whitespace token + incr i -1 ;#reprocess bsl in next run + return 1 + } else { + error "tomlish Unexpected backslash during whitespace. [tomlish::parse::report_line]" + } + } + literal - literalpart - squotedkey - itablesquotedkey { + #never need to set slash_active true when in single quoted tokens + append tok "\\" + set slash_active 0 + } + string - quotedkey - itablequotedkey - comment { + if {$slash_active} { + set slash_active 0 + append tok "\\\\" + } else { + set slash_active 1 + } + } + stringpart { + if {$slash_active} { + #assert - quotes empty - or we wouldn't have slash_active + set slash_active 0 + append tok "\\\\" + } else { + append tok $dquotes + set slash_active 1 + } + } + starttablename - starttablearrayname { + error "tomlish backslash is invalid as first character of $tokenType [tomlish::parse::report_line]" + } + tablename - tablearrayname { + if {$slash_active} { + set slash_active 0 + append tok "\\\\" + } else { + set slash_active 1 + } + } + barekey { + error "tomlish Unexpected backslash during barekey. [tomlish::parse::report_line]" + } + default { + error "tomlish Backslash unexpected during tokentype: '$tokenType'. [tomlish::parse::report_line]" + } + } + } else { + switch -exact -- $state { + multistring-space { + if {$slash_active} { + set_tokenType "stringpart" + set tok "\\\\" + set slash_active 0 + } else { + if {$dquotes ne ""} { + set_tokenType "stringpart" + set tok $dquotes + } + set slash_active 1 + } + } + multiliteral-space { + #nothing can be escaped in multiliteral-space - not even squotes (?) review + set_tokenType "literalpart" + set tok "\\" + } + default { + error "tomlish tok error: Unexpected backslash when no token is active. [tomlish::parse::report_line]" + } + } + } + } + sq { + #single quote + set had_slash $slash_active + set slash_active 0 + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + #short squote_seq tokens are returned if active during any other character + #longest allowable for leading/trailing are returned here + #### + set existingtoklen [tcl::string::length $tok] ;#toklen prior to this squote + switch -- $state { + leading-squote-space { + append tok $c + if {$existingtoklen > 2} { + error "tomlish tok error: squote_seq unexpected length $existingtoklen when another received" + } elseif {$existingtoklen == 2} { + return 1 ;#return tok ''' + } + } + trailing-squote-space { + append tok $c + if {$existingtoklen == 4} { + #maxlen to be an squote_seq is multisquote + 2 = 5 + #return tok ''''' + return 1 + } + } + default { + error "tomlish tok error: squote_seq in unexpected state '$state' - expected leading-squote-space or trailing-squote-space" + } + } + } + whitespace { + #end whitespace + incr i -1 ;#reprocess sq + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + #temp token creatable only during value-expected or array-space + switch -- [tcl::string::length $tok] { + 1 { + append tok $c + } + 2 { + #switch? + append tok $c + set_tokenType triple_squote + return 1 + } + default { + error "tomlish unexpected token length [tcl::string::length $tok] in '_start_squote_sequence'" + } + } + } + literal { + #slash_active always false + #terminate the literal + set_token_waiting type endsquote value "'" complete 1 startindex $cindex + return 1 + } + literalpart { + #ended by ''' - but final could be '''' or ''''' (up to 2 squotes allowed directly before ending triple squote sequence) + #todo + # idea: end this literalpart (possibly 'temporarily') + # let the sq be reprocessed in the multiliteral-space to push an end-multiliteral-sequence to state stack + # upon popping end-multiliteral-sequence - stitch quotes back into this literalpart's token (if either too short - or a long ending sequence as shown above) + incr i -1 ;#throw the "'" back to loop - will be added to an squote_seq token for later processing + return 1 + } + itablesquotedkey { + set_token_waiting type endsquote value "'" complete 1 startindex $cindex + return 1 + } + squotedkey { + ### + #set_token_waiting type endsquote value "'" complete 1 + return 1 + } + starttablename - starttablearrayname { + #!!! + incr i -1 + return 1 + } + tablename - tablearrayname { + append tok $c + } + default { + append tok $c + } + } + } else { + switch -exact -- $state { + value-expected - array-space { + set_tokenType "_start_squote_sequence" + set tok "'" + } + itable-keyval-value-expected - keyval-value-expected { + set_tokenType "squote_seq_begin" + set tok "'" + return 1 + } + table-space { + ### + set_tokenType "squotedkey" + set tok "" + } + itable-space { + set_tokenType "squote_seq_begin" + set tok "'" + return 1 + } + tablename-state { + #first char in tablename-state/tablearrayname-state + set_tokenType tablename + append tok "'" + } + tablearrayname-state { + set_tokenType tablearrayname + append tok "'" + } + literal-state { + tomlish::log::debug "- tokloop sq during literal-state with no tokentype - empty literal?" + set_tokenType literal + incr -1 + return 1 + } + multistring-space { + error "tomlish unimplemented - squote during state '$state'. [tomlish::parse::report_line]" + } + multiliteral-space { + #each literalpart is not necessarily started/ended with squotes - but may contain up to 2 in a row + #we are building up an squote_seq to determine if + #a) it is shorter than ''' so belongs in a literalpart (either previous, subsequent or it's own literalpart between newlines + #b) it is exactly ''' and we can terminate the whole multiliteral + #c) it is 4 or 5 squotes where the first 1 or 2 beling in a literalpart and the trailing 3 terminate the space + set_tokenType "squote_seq_begin" + set tok "'" + return 1 + } + dottedkey-space { + set_tokenType squotedkey + } + default { + error "tomlish unhandled squote during state '$state'. [tomlish::parse::report_line]" + } + } + } + + } + dq { + #double quote + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + set toklen [tcl::string::length $tok] + if {$toklen == 1} { + append tok $c + } elseif {$toklen == 2} { + append tok $c + #switch vs set? + set_tokenType "startmultiquote" + return 1 + } else { + error "tomlish unexpected token length $toklen in 'startquotesequence'" + } + } + _start_squote_sequence { + set toklen [tcl::string::length $tok] + switch -- $toklen { + 1 { + set_tokenType "startsquote" + incr i -1 + return 1 + } + 2 { + set_tokenType "startsquote" + incr i -2 + return 1 + } + default { + error "tomlish unexpected _start_squote_sequence length $toklen" + } + } + } + literal - literalpart { + append tok $c + } + string { + if {$had_slash} { + append tok "\\" $c + } else { + #unescaped quote always terminates a string? + set_token_waiting type endquote value "\"" complete 1 startindex $cindex + return 1 + } + } + stringpart { + #sub element of multistring + if {$had_slash} { + append tok "\\" $c + } else { + #incr i -1 + + if {$multi_dquote eq "\"\""} { + set_token_waiting type endmultiquote value "\"\"\"" complete 1 startindex [expr {$cindex -2}] + set multi_dquote "" + return 1 + } else { + append multi_dquote "\"" + } + } + } + whitespace { + switch -exact -- $state { + multistring-space { + #REVIEW + if {$had_slash} { + incr i -2 + return 1 + } else { + switch -- [tcl::string::length $multi_dquote] { + 2 { + set_token_waiting type endmultiquote value "\"\"\"" complete 1 startindex [expr {$cindex-2}] + set multi_dquote "" + return 1 + } + 1 { + incr i -2 + return 1 + } + 0 { + incr i -1 + return 1 + } + } + } + } + keyval-value-expected - value-expected { + #end whitespace token and reprocess + incr i -1 + return 1 + + #if {$multi_dquote eq "\"\""} { + # set_token_waiting type startmultiquote value "\"\"\"" complete 1 + # set multi_dquote "" + # return 1 + #} else { + # #end whitespace token and reprocess + # incr i -1 + # return 1 + #} + } + default { + set_token_waiting type startquote value "\"" complete 1 startindex $cindex + return 1 + } + } + } + comment { + if {$had_slash} {append tok "\\"} + append tok $c + } + quotedkey - itablequotedkey { + if {$had_slash} { + append tok "\\" + append tok $c + } else { + set_token_waiting type endquote value "\"" complete 1 startindex $cindex + return 1 + } + } + squotedkey - itablesquotedkey { + append tok $c + } + tablename - tablearrayname { + if {$had_slash} {append tok "\\"} + append tok $c + } + starttablename - starttablearrayname { + incr i -1 ;## + return 1 + } + default { + error "tomlish got quote during tokenType '$tokenType' [tomlish::parse::report_line]" + } + } + } else { + #$slash_active not relevant when no tokenType + #token is string only if we're expecting a value at this point + switch -exact -- $state { + keyval-value-expected - value-expected - array-space { + #!? start looking for possible multistartquote + #set_tokenType startquote + #set tok $c + #return 1 + set_tokenType "startquotesequence" ;#one or more quotes in a row - either startquote or multistartquote + set tok $c + } + itable-keyval-value-expected { + #JMN 2025 - review + set_tokenType "startquotesequence" ;#one or more quotes in a row - either startquote or multistartquote + set tok $c + } + multistring-space { + #TODO - had_slash!!! + #REVIEW + if {$had_slash} { + set_tokenType "stringpart" + set tok "\\\"" + set multi_dquote "" + } else { + if {$multi_dquote eq "\"\""} { + tomlish::log::debug "- tokloop char dq ---> endmultiquote" + set_tokenType "endmultiquote" + set tok "\"\"\"" + return 1 + #set_token_waiting type endmultiquote value "\"\"\"" complete 1 + #set multi_dquote "" + #return 1 + } else { + append multi_dquote "\"" + } + } + } + multiliteral-space { + set_tokenType "literalpart" + set tok "\"" + } + table-space { + set_tokenType "startquote" + set tok $c + return 1 + } + itable-space { + set_tokenType "startquote" + set tok $c + return 1 + } + tablename-state { + set_tokenType tablename + set tok $c + } + tablearrayname-state { + set_tokenType tablearrayname + set tok $c + } + dottedkey-space { + set_tokenType dquote_seq_begin + set tok $c + } + default { + error "tomlish Unexpected quote during state '$state' [tomlish::parse::report_line]" + } + } + } + } + = { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + set had_slash $slash_active + set slash_active 0 + + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart - squotedkey { + #assertion had_slash 0, multi_dquote "" + append tok $c + } + string - comment - quotedkey - itablequotedkey { + #for these tokenTypes an = is just data. + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + whitespace { + if {$state eq "multistring-space"} { + set backlen [expr {[tcl::string::length $dquotes] + 1}] + incr i -$backlen + return 1 + } else { + set_token_waiting type equal value = complete 1 startindex $cindex + return 1 + } + } + barekey { + #set_token_waiting type equal value = complete 1 + incr i -1 + return 1 + } + starttablename - starttablearrayname { + error "tomlish Character '=' is invalid first character for $tokenType. [tomlish::parse::report_line]" + } + tablename - tablearrayname { + #invalid in bare name - but valid in quoted parts - leave for tablename parser to sort out + append tok $c + } + default { + error "tomlish unexpected = character during tokentype $tokenType. case not implemented. [tomlish::parse::report_line]" + } + } + } else { + switch -exact -- $state { + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} { + append tok "\\" + } + append tok ${dquotes}= + } + multiliteral-space { + set_tokenType "literalpart" + set tok "=" + } + dottedkey-space { + set_tokenType "equal" + set tok "=" + return 1 + } + default { + set_tokenType "equal" + set tok = + return 1 + } + } + } + } + cr { + #REVIEW! + set dquotes $multi_dquote + set multi_dquote "" ;#!! + # \r carriage return + if {$slash_active} {append tok "\\"} ;#if tokentype not appropriate for \, we would already have errored out. + set slash_active 0 + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal { + append tok $c + } + literalpart { + #part of MLL string (multi-line literal string) + #we need to split out crlf as a separate NEWLINE to be consistent + ::tomlish::log::warn "literalpart ended by cr - needs testing" + #return literalpart temporarily - allow cr to be reprocessed from multiliteral-space + incr i -1 + return 1 + } + stringpart { + #part of MLB string (multi-line basic string) + #jmn2025 - review + #append tok $dquotes$c + incr i -1 + return 1 + } + starttablename - starttablearrayname { + error "tomlish Character is invalid first character for $tokenType. [tomlish::parse::report_line]" + } + tablename - tablearrayname { + #could in theory be valid in quoted part of name + #review - might be better just to disallow here + append tok $c + } + default { + #!todo - error out if cr inappropriate for tokenType + append tok $c + } + } + } else { + #lf may be appended if next + #review - lone cr as newline? - this is uncommon - but so is lone cr in a string(?) + set_tokenType "newline" + set tok cr + } + } + lf { + # \n newline + set dquotes $multi_dquote + set multi_dquote "" ;#!! + set had_slash $slash_active + set slash_active 0 + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal { + #nl is not allowed *within* a literal - require multiliteral syntax for any literal containing a newline ''' ''' + #even though we terminate the literal without the closing quote here - the token_waiting newline should trigger a state error + set_token_waiting type newline value lf complete 1 startindex $cindex + return 1 + } + literalpart { + #we allow newlines - but store them within the multiliteral as their own element + #This is a legitimate end to the literalpart - but not the whole multiliteral + set_token_waiting type newline value lf complete 1 startindex $cindex + return 1 + } + newline { + #review + #this lf is the trailing part of a crlf + append tok lf ;#assert we should now have tok "crlf" - as a previous cr is the only way to have an incomplete newline tok + return 1 + } + stringpart { + if {$dquotes ne ""} { + append tok $dquotes + incr i -1 + return 1 + } else { + if {$had_slash} { + #emit the stringpart (return 1), queue the continuation, go back 1 to reprocess the lf (incr i -1) + set_token_waiting type continuation value \\ complete 1 startindex [expr {$cindex-1}] + incr i -1 + return 1 + } else { + set_token_waiting type newline value lf complete 1 startindex $cindex + return 1 + } + } + } + starttablename - tablename - tablearrayname - starttablearrayname { + error "tomlish Character is invalid in $tokenType. [tomlish::parse::report_line]" + } + default { + #newline ends all other tokens. + #note for string: we don't add (raw unescaped) newline to simple string. (must use multi-string for this) + #note for whitespace: + # we will use the convention that \n terminates the current whitespace even if whitespace follows + # ie whitespace is split into separate whitespace tokens at each newline + + #puts "-------------- newline lf during tokenType $tokenType" + set_token_waiting type newline value lf complete 1 startindex $cindex + return 1 + } + } + } else { + switch -exact -- $state { + multistring-space { + if {$had_slash} { + set_tokenType "continuation" + set tok "\\" + incr i -1 + return 1 + } else { + if {$dquotes ne ""} { + #e.g one or 2 quotes just before nl + set_tokenType "stringpart" + set tok $dquotes + incr i -1 + return 1 + } + set_tokenType "newline" + set tok lf + return 1 + } + } + multiliteral-space { + #assert had_slash 0, multi_dquote "" + set_tokenType "newline" + set tok "lf" + return 1 + } + default { + #ignore slash? error? + set_tokenType "newline" + set tok lf + return 1 + } + } + #if {$had_slash} { + # #CONT directly before newline - allows strings_5_byteequivalent test to pass + # set_tokenType "continuation" + # set tok "\\" + # incr i -1 + # return 1 + #} else { + # set_tokenType newline + # set tok lf + # return 1 + #} + } + } + , { + set dquotes $multi_dquote + set multi_dquote "" + set had_slash $slash_active + set slash_active 0 + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + newline { + #incomplete newline + set_tokenType "cr" + incr i -1 + return 1 + } + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + comment - tablename - tablearrayname { + if {$had_slash} {append tok "\\"} + append tok , + } + string - quotedkey - itablequotedkey { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + #stringpart can have up to 2 quotes too + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + literal - literalpart - squotedkey - itablesquotedkey { + #assert had_slash always 0, multi_dquote "" + append tok $c + } + whitespace { + if {$state eq "multistring-space"} { + set backlen [expr {[tcl::string::length $dquotes] + 1}] + incr i -$backlen + return 1 + } else { + set_token_waiting type comma value "," complete 1 startindex $cindex + return 1 + } + } + default { + set_token_waiting type comma value "," complete 1 startindex $cindex + if {$had_slash} {append tok "\\"} + return 1 + } + } + } else { + switch -exact -- $state { + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} {append tok "\\"} + append tok "$dquotes," + } + multiliteral-space { + #assert had_slash 0, multi_dquote "" + set_tokenType "literalpart" + set tok "," + } + default { + set_tokenType "comma" + set tok "," + return 1 + } + } + } + } + . { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + set had_slash $slash_active + set slash_active 0 + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + newline { + #incomplete newline + set_tokenType "cr" + incr i -1 + return 1 + } + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + comment - untyped_value { + if {$had_slash} {append tok "\\"} + append tok $c + } + string - quotedkey - itablequotedkey { + if {$had_slash} {append tok "\\"} + append tok $c + } + stringpart { + if {$had_slash} {append tok "\\"} + append tok $dquotes$c + } + literal - literalpart - squotedkey - itablesquotedkey { + #assert had_slash always 0, multi_dquote "" + append tok $c + } + whitespace { + switch -exact -- $state { + multistring-space { + set backchars [expr {[tcl::string::length $dquotes] + 1}] + if {$had_slash} { + incr backchars 1 + } + incr i -$backchars + return 1 + } + dottedkey-space { + incr i -1 + return 1 + } + default { + error "tomlish Received period during tokenType 'whitespace' [tomlish::parse::report_line]" + } + } + } + starttablename - starttablearrayname { + #This would correspond to an empty table name + error "tomlish Character '.' is not allowed as first character ($tokenType). [tomlish::parse::report_line]" + } + tablename - tablearrayname { + #subtable - split later - review + append tok $c + } + barekey { + #e.g x.y = 1 + #we need to transition the barekey to become a structured table name ??? review + #x is the tablename y is the key + set_token_waiting type dotsep value "." complete 1 startindex $cindex + return 1 + } + default { + error "tomlish Received period during tokenType '$tokenType' [tomlish::parse::report_line]" + #set_token_waiting type period value . complete 1 + #return 1 + } + } + } else { + switch -exact -- $state { + multistring-space { + set_tokenType "stringpart" + set tok "" + if {$had_slash} {append tok "\\"} + append tok "$dquotes." + } + multiliteral-space { + set_tokenType "literalpart" + set tok "." + } + dottedkey-space { + ### + set_tokenType "dotsep" + set tok "." + return 1 + } + default { + set_tokenType "untyped_value" + set tok "." + } + } + } + + } + " " { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + if {[tcl::string::length $tokenType]} { + set had_slash $slash_active + set slash_active 0 + switch -exact -- $tokenType { + newline { + #incomplete newline + set_tokenType "cr" + incr i -1 + return 1 + } + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + barekey { + #todo had_slash - emit token or error + #whitespace is a terminator for bare keys + #set_token_waiting type whitespace value $c complete 1 + incr i -1 + return 1 + } + untyped_value { + #unquoted values (int,date,float etc) are terminated by whitespace + #set_token_waiting type whitespace value $c complete 1 + incr i -1 + return 1 + } + comment { + if {$had_slash} { + append tok "\\" + } + append tok $dquotes$c + } + string - quotedkey - itablequotedkey { + if {$had_slash} { append tok "\\" } + append tok $c + } + stringpart { + #for stringpart we store WS separately for ease of processing continuations (CONT stripping) + if {$had_slash} { + #REVIEW + #emit the stringpart - go back to the slash + incr i -2 + return 1 + } else { + #split into STRINGPART aaa WS " " + append tok $dquotes + incr i -1 + return 1 + } + } + literal - literalpart - squotedkey - itablesquotedkey { + append tok $c + } + whitespace { + if {$state eq "multistring-space"} { + if {$dquotes ne ""} { + #end whitespace token + #go back by the number of quotes plus this space char + set backchars [expr {[tcl::string::length $dquotes] + 1}] + incr i -$backchars + return 1 + } else { + append tok $c + } + } else { + append tok $c + } + } + starttablename - starttablearrayname { + incr i -1 + return 1 + } + tablename - tablearrayname { + #include whitespace in the tablename/tablearrayname + #Will need to be normalized upon interpreting the tomlish as a datastructure + append tok $c + } + default { + error "tomlish Received whitespace space during tokenType '$tokenType' [tomlish::parse::report_line]" + } + } + } else { + set had_slash $slash_active + set slash_active 0 + switch -exact -- $state { + tablename-state { + #tablename can have leading,trailing and interspersed whitespace! + #These will not be treated as whitespace tokens, instead forming part of the name. + set_tokenType tablename + set tok "" + if {$had_slash} {append tok "\\"} + append tok $c + } + tablearrayname-state { + set_tokenType tablearrayname + set tok "" + if {$had_slash} {append tok "\\"} + append tok $c + } + multistring-space { + if {$had_slash} { + set_tokenType "continuation" + set tok "\\" + incr i -1 + return 1 + } else { + if {$dquotes ne ""} { + set_tokenType "stringpart" + set tok $dquotes + incr i -1 + return 1 + } + set_tokenType "whitespace" + append tok $c + } + } + multiliteral-space { + set_tokenType "literalpart" + set tok $c + } + default { + if {$had_slash} { + error "tomlish unexpected backslash [tomlish::parse::report_line]" + } + set_tokenType "whitespace" + append tok $c + } + } + } + } + tab { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + + if {[tcl::string::length $tokenType]} { + if {$slash_active} {append tok "\\"} ;#if tokentype not appropriate for \, we would already have errored out (?review) + set slash_active 0 + switch -exact -- $tokenType { + newline { + #incomplete newline + set_tokenType "cr" + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + barekey { + #whitespace is a terminator for bare keys + incr i -1 + #set_token_waiting type whitespace value $c complete 1 + return 1 + } + untyped_value { + #unquoted values (int,date,float etc) are terminated by whitespace + #set_token_waiting type whitespace value $c complete 1 + incr i -1 + return 1 + } + quotedkey - itablequotedkey - squotedkey - itablesquotedkey { + append tok $c + } + string - comment - whitespace { + append tok $c + } + stringpart { + #for stringpart we store WS separately for ease of processing continuations (CONT stripping) + if {$had_slash} { + #REVIEW + #emit the stringpart - go back to the slash + incr i -2 + return 1 + } else { + #split into STRINGPART aaa WS " " + append tok $dquotes + incr i -1 + return 1 + } + } + literal - literalpart { + append tok $c + } + starttablename - starttablearrayname { + incr i -1 + return 1 + } + tablename - tablearraynames { + #include whitespace in the tablename/tablearrayname + #Will need to be normalized upon interpreting the tomlish as a datastructure + append tok $c + } + default { + error "tomlish Received whitespace tab during tokenType '$tokenType' [tomlish::parse::report_line]" + } + } + } else { + set had_slash $slash_active + if {$slash_active} { + set slash_active 0 + } + switch -exact -- $state { + tablename-state { + #tablename can have leading,trailing and interspersed whitespace! + #These will not be treated as whitespace tokens, instead forming part of the name. + set_tokenType tablename + set tok $c + } + tablearrayname-state { + set_tokenType tablearrayname + set tok $c + } + multistring-space { + if {$had_slash} { + set_tokenType "continuation" + set tok "\\" + incr i -1 + return 1 + } else { + if {$dquotes ne ""} { + set_tokenType stringpart + set tok $dquotes + incr i -1 + return 1 + } else { + set_tokenType whitespace + append tok $c + } + } + } + multiliteral-space { + set_tokenType "literalpart" + set tok $c + } + default { + set_tokenType "whitespace" + append tok $c + } + } + } + } + bom { + #BOM (Byte Order Mark) - ignored by token consumer + if {[tcl::string::length $tokenType]} { + switch -exact -- $tokenType { + _start_squote_sequence { + #assert - tok will be one or two squotes only + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + literal - literalpart { + append tok $c + } + default { + set_token_waiting type bom value "\uFEFF" complete 1 startindex $cindex + return 1 + } + } + } else { + switch -exact -- $state { + multiliteral-space { + set_tokenType "literalpart" + set tok $c + } + default { + set_tokenType "bom" + set tok "\uFEFF" + return 1 + } + } + } + } + default { + set dquotes $multi_dquote + set multi_dquote "" ;#!! + + if {[tcl::string::length $tokenType]} { + if {$slash_active} {append tok "\\"} ;#if tokentype not appropriate for \, we would already have errored out. + set slash_active 0 + switch -exact -- $tokenType { + newline { + #incomplete newline + set_tokenType "cr" + incr i -1 + return 1 + } + squote_seq { + incr i -1 + return 1 + } + startquotesequence { + _shortcircuit_startquotesequence + } + _start_squote_sequence { + incr i -[tcl::string::length $tok] + set_tokenType "startsquote" + return 1 + } + whitespace { + if {$state eq "multistring-space"} { + if {$dquotes ne ""} { + set backlen [expr {[tcl::string::length $dquotes] + 1}] + incr i -$backlen + return 1 + } else { + incr i -1 + return 1 + } + } else { + #review + incr i -1 ;#We don't have a full token to add to the token_waiting dict - so leave this char for next run. + return 1 + } + } + barekey { + if {[tomlish::utils::is_barekey $c]} { + append tok $c + } else { + error "tomlish Unexpected character '$c' during bare key. Only \[a-zA-Z0-9_-\] allowed. [tomlish::parse::report_line]" + } + } + starttablename - starttablearrayname { + incr i -1 + #allow statemachine to set context for subsequent chars + return 1 + } + stringpart { + append tok $dquotes$c + } + default { + #e.g comment/string/literal/literalpart/untyped_value/starttablename/starttablearrayname/tablename/tablearrayname + append tok $c + } + } + } else { + set had_slash $slash_active + set slash_active 0 + switch -exact -- $state { + table-space - itable-space { + #if no currently active token - assume another key value pair + if {[tomlish::utils::is_barekey $c]} { + set_tokenType "barekey" + append tok $c + } else { + error "tomlish Unexpected char $c ([tomlish::utils::nonprintable_to_slashu $c]) whilst no active tokenType. [tomlish::parse::report_line]" + } + } + curly-syntax { + puts stderr "curly-syntax - review" + if {[tomlish::utils::is_barekey $c]} { + set_tokenType "barekey" + append tok $c + } else { + error "tomlish Unexpected char $c ([tomlish::utils::nonprintable_to_slashu $c]) whilst no active tokenType. [tomlish::parse::report_line]" + } + } + multistring-space { + set_tokenType "stringpart" + if {$had_slash} { + #assert - we don't get had_slash and dquotes at same time + set tok \\$c + } else { + set tok $dquotes$c + } + } + multiliteral-space { + set_tokenType "literalpart" + set tok $c + } + tablename-state { + set_tokenType "tablename" + set tok $c + } + tablearrayname-state { + set_tokenType "tablearrayname" + set tok $c + } + dottedkey-space { + set_tokenType barekey + set tok $c + } + default { + tomlish::log::debug "- tokloop char '$c' setting to untyped_value while state:$state" + set_tokenType "untyped_value" + set tok $c + } + } + } + } + } + + } + + #run out of characters (eof) + if {[tcl::string::length $tokenType]} { + #check for invalid ending tokens + #if {$state eq "err-state"} { + # error "Reached end of data whilst tokenType = '$tokenType'. INVALID" + #} + switch -exact -- $tokenType { + startquotesequence { + set toklen [tcl::string::length $tok] + if {$toklen == 1} { + #invalid + #eof with open string + error "tomlish eof reached without closing quote for string. [tomlish::parse::report_line]" + } elseif {$toklen == 2} { + #valid + #we ended in a double quote, not actually a startquoteseqence - effectively an empty string + switch_tokenType "startquote" + incr i -1 + #set_token_waiting type string value "" complete 1 + return 1 + } + } + _start_squote_sequence { + set toklen [tcl::string::length $tok] + switch -- $toklen { + 1 { + #invalid eof with open literal + error "tomlish eof reached without closing single quote for string literal. [tomlish::parse::report_line]" + } + 2 { + #review + set_token_waiting type endsquote value "'" complete 1 startindex [expr {$cindex -1}] + set_tokenType "literal" + set tok "" + return 1 + } + } + } + } + set_token_waiting type eof value eof complete 1 startindex $i ;#review + return 1 + } else { + ::tomlish::log::debug "- No current tokenType, ran out of characters, setting tokenType to 'eof' [tomlish::parse::report_line]" + set tokenType "eof" + set tok "eof" + } + return 0 + } + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::parse ---}] +} + +namespace eval tomlish::dict { + namespace export {[a-z]*}; # Convention: export all lowercase + namespace path [namespace parent] + + proc is_tomltype {d} { + expr {[dict size $d] == 2 && [dict exists $d type] && [dict exists $d value]} + } + proc is_tomltype2 {d} { + upvar ::tomlish::tags tags + expr {[lindex $d 0] eq "type" && [lindex $d 1] in $tags} + } + proc last_tomltype_posn {d} { + set last_simple -1 + set dictposn [expr {[dict size $d] -1}] + foreach k [lreverse [dict keys $d]] { + set dval [dict get $d $k] + if {[is_tomltype $dval]} { + set last_simple $dictposn + break + } + incr dictposn -1 + } + return $last_simple + } + + + #review + proc name_from_tablestack {tablestack} { + set name "" + foreach tinfo [lrange $tablestack 1 end] { + lassign $tinfo type namepart + switch -- $type { + T { + if {$name eq ""} { + append name $namepart + } else { + append name .$namepart + } + } + I { + if {$name eq ""} { + append name $namepart + } else { + append name .$namepart + } + } + default { + #end at first break in the leading sequence of T & I tablenames + break + } + } + } + return $name + } + +} + +tcl::namespace::eval tomlish::app { + variable applist [list encoder decoder test] + + #*** !doctools + #[subsection {Namespace tomlish::app}] + #[para] + #[list_begin definitions] + + proc decoder {args} { + #*** !doctools + #[call app::[fun decoder] [arg args]] + #[para] read toml on stdin until EOF + #[para] on error - returns non-zero exit code and writes error on stderr + #[para] on success - returns zero exit code and writes JSON encoding of the data on stdout + #[para] This decoder is intended to be compatible with toml-test + + set opts [dict merge [dict create] $args] + #fconfigure stdin -encoding utf-8 + fconfigure stdin -translation binary + #Just slurp it all - presumably we are not handling massive amounts of data on stdin. + # - even if the input is large, we probably don't gain much (aside from possible memory savings?) by attempting to process input as it arrives. + if {[catch { + set toml [read stdin] + }]} { + exit 2 ;#read error + } + try { + set j [::tomlish::toml_to_json $toml] + } on error {em} { + puts stderr "decoding failed: '$em'" + exit 1 + } + puts -nonewline stdout $j + exit 0 + } + + proc encoder {args} { + #*** !doctools + #[call app::[fun encoder] [arg args]] + #[para] read JSON on stdin until EOF + #[para] return non-zero exitcode if JSON data cannot be converted to a valid TOML representation + #[para] return zero exitcode and TOML data on stdout if JSON data can be converted. + #[para] This encoder is intended to be compatible with toml-test + + set opts [dict merge [dict create] $args] + fconfigure stdin -translation binary + if {[catch { + set json [read stdin] + }]} { + exit 2 ;#read error + } + try { + set toml [::tomlish::json_to_toml $json] + } on error {em} { + puts stderr "encoding failed: '$em'" + exit 1 + } + puts -nonewline stdout $toml + exit 0 + } + + proc test {args} { + set opts [dict merge [dict create] $args] + + package require test::tomlish + if {[dict exists $opts -suite]} { + test::tomlish::suite [dict get $opts -suite] + } + test::tomlish::run + } + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::app ---}] +} + +proc ::tomlish::appnames {} { + set applist [list] + foreach cmd [info commands ::tomlish::app::*] { + lappend applist [namespace tail $cmd] + } + return $applist +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval tomlish::lib { + namespace export {[a-z]*}; # Convention: export all lowercase + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace tomlish::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace tomlish::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +if {$argc > 0} { + puts stderr "argc: $argc args: $argv" + + if {($argc == 1)} { + if {[tcl::string::tolower $argv] in {help -help h -h}} { + puts stdout "Usage: -app where appname one of:[tomlish::appnames]" + exit 0 + } else { + puts stderr "Argument '$argv' not understood. Try -help" + exit 1 + } + } + set opts [dict create] + set opts [dict merge $opts $argv] + + set opts_understood [list -app ] + if {"-app" in [dict keys $opts]} { + #Don't vet the remaining opts - as they are interpreted by each app + } else { + foreach key [dict keys $opts] { + if {$key ni $opts_understood} { + puts stderr "Option '$key' not understood" + exit 1 + } + } + } + if {[dict exists $opts -app]} { + set app [dict get $opts -app] + if {$app ni [tomlish::appnames]} { + puts stderr "app '[dict get $opts -app]' not found" + exit 1 + } + tomlish::app::$app {*}$opts + } +} + +## Ready +package provide tomlish [namespace eval tomlish { + variable pkg tomlish + variable version + set version 1.1.2 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/pkgIndex.tcl b/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/pkgIndex.tcl new file mode 100644 index 00000000..cca27df9 --- /dev/null +++ b/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/pkgIndex.tcl @@ -0,0 +1,5 @@ +# +# Tcl package index file +# +package ifneeded tzint 1.1.1 \ + [list load [file join $dir tzint111.dll] [string totitle tzint 0 0]] diff --git a/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/tzint111.dll b/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/tzint111.dll new file mode 100644 index 00000000..e8ad6705 Binary files /dev/null and b/src/vfs/punk9magicsplat.vfs/lib_tcl9/tzint1.1.1/tzint111.dll differ diff --git a/src/vfs/punk9win.vfs/lib/materialicons0.2/MaterialIcons-Regular.svg b/src/vfs/punk9win.vfs/lib/materialicons0.2/MaterialIcons-Regular.svg new file mode 100644 index 00000000..69dd831e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/materialicons0.2/MaterialIcons-Regular.svg @@ -0,0 +1,2373 @@ + + + + + +Created by FontForge 20151118 at Mon Feb 8 11:58:02 2016 + By shyndman +Copyright 2015 Google, Inc. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/vfs/punk9win.vfs/lib/materialicons0.2/README.md b/src/vfs/punk9win.vfs/lib/materialicons0.2/README.md new file mode 100644 index 00000000..e52bedcf --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/materialicons0.2/README.md @@ -0,0 +1,62 @@ +MaterialIcons 0.2 +================= + +A Tcl/Tk package wrapping the +[Material Design Icons](https://material.io/tools/icons). + +License +------- + +BSD + +Dependencies +------------ + + package require Tk + package require tdom + package require tksvg + +Usage +----- + + package require MaterialIcons + MaterialIcons names ?pattern? + MaterialIcons svg name ?color? ?opacity? ?stroke? ?strokewidth? + MaterialIcons image name ?size? ?color? ?opacity? + MaterialIcons image_nc name ?size? ?color? ?opacity? + MaterialIcons image_ncg name imgname ?options? + MaterialIcons flush + MaterialIcons rebuild + +Method `names` returns an alphabetically sorted list of icon names +matching the given `pattern`, or all, if `pattern` is omitted. + +Method `svg` returns an SVG string for the icon `name` with optional fill +color `color` (defaults to black), optional fill opacity `opacity` +(defaults to 1.0), optional stroke color `stroke` (defaults to none), +and optional stroke width `strokewidth` (defaults to 1.0). + +Method `image` creates and returns a photo image for the icon `name` with +optional fill color `color` (defaults to black) and optional fill opacity +`opacity` (defaults to 1.0). The `size` option specifies the integer icon +size. If it is negative, the size is in pixels, otherwise in points. The +default value for `size` is 16 points. The photo image is kept in an image +cache for later re-use. + +Method `image_nc` is similar to method `image` except that no caching is +performed, i.e. a newly created image is returned. + +Method `image_ncg` is similar to method `image_nc` but allows to provide +a specific image name and render options as keyword arguments `-size`, +`-fill`, `-opacity`, `-stroke`, and `-strokewidth`. Size and stroke width +can be specified as floating point numbers with an optional unit suffix: +d (density points), p (points), or m (millimeters). The stroke width is +scaled unless a unit suffix is used or a negative number is given. + +Method `flush` deletes all cached icon photo images. + +Method `rebuild` recreates all cached icon photo images which have a size +in points. This is useful when the tk scaling factor is changed at runtime. + +A utility script named `show.tcl` demonstrates the usage of this package +and displays all icons in a canvas widget. diff --git a/src/vfs/punk9win.vfs/lib/materialicons0.2/materialicons.tcl b/src/vfs/punk9win.vfs/lib/materialicons0.2/materialicons.tcl new file mode 100644 index 00000000..bb86ee8e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/materialicons0.2/materialicons.tcl @@ -0,0 +1,240 @@ +# Module to on-demand render MaterialIcons-Regular.svg +# into photo images using tksvg. +# +# chw January 2019 +# image_ncg contributed by dzach May/July 2019 + +package require Tk +package require tdom +package require tksvg + +namespace eval ::MaterialIcons { + + variable glyph ;# SVG glyph cache + array set glyph {} ;# indexed by glyph name + + variable viewbox ;# common viewBox {x y w h} for glyphs + + variable icache ;# image cache indexed by glyph name, size, + array set icache {} ;# opacity, color, e.g. "zoom_out,24,1.0,black" + + variable template ;# SVG template for a glyph + + # Module initializer: parse and cache the SVG file. + + proc _init {file} { + variable glyph + variable viewbox + variable template + set f [open $file] + set doc [dom parse -channel $f] + close $f + set root [$doc documentElement] + foreach node [$root getElementsByTagName glyph] { + if {[$node hasAttribute glyph-name] && [$node hasAttribute d]} { + set d [$node getAttribute d] + if {$d eq "M0 0z"} { + # skip empty icon + continue + } + set glyph([$node getAttribute glyph-name]) $d + } + } + foreach node [$root getElementsByTagName font-face] { + if {[$node hasAttribute bbox]} { + set bbox [$node getAttribute bbox] + # keep only first bbox + break + } + } + $doc delete + if {![info exists bbox]} { + return -code error "no bbox attribute found" + } + set template0 { + + + + + + + } + lassign $bbox x1 y1 x2 y2 + set w [expr {$x2 - $x1}] + set h [expr {$y2 - $y1}] + set viewbox [list $x1 $y1 $w $h] + set template [format $template0 $w $h $viewbox [expr {0 - $y2 - $y1}]] + } + + # Invoke and release initializer. + + _init [file join [file dirname [info script]] MaterialIcons-Regular.svg] + rename _init {} + + # Return list of icon (glyph) names which can be rendered. + + proc names {{pattern *}} { + variable glyph + tailcall lsort [array names glyph $pattern] + } + + # Return SVG for named icon with optional fill color and opacity. + + proc svg {name {color black} {opacity 1.0} + {stroke none} {strokewidth 1.0} {angle 0}} { + variable glyph + variable template + if {![info exists glyph($name)]} { + return -code error "glyph $name does not exist" + } + tailcall format $template $name $color $opacity \ + $stroke $strokewidth $angle $glyph($name) + } + + # Return photo image for named icon with optional size, fill color, + # and opacity. If size is negative, it specifies pixels, else points + # taking the current tk scaling into account. + + proc image {name {size 16} {color black} {opacity 1.0}} { + variable icache + set fullname ${name},${size},${opacity},${color} + if {[info exists icache($fullname)]} { + if {![catch {::image inuse $icache($fullname)}]} { + return $icache($fullname) + } + unset icache($fullname) + } + set icache($fullname) [image_nc $name $size $color $opacity] + return $icache($fullname) + } + + # Like the "image" method above but without caching. + + proc image_nc {name {size 16} {color black} {opacity 1.0}} { + variable viewbox + if {![string is integer $size]} { + return -code error "expect integer size" + } + if {$size == 0} { + return -code error "invalid size" + } + lassign $viewbox x y w h + if {$size < 0} { + set size [expr {-1.0 * $size}] + } else { + set dpi [expr {72.0 * [tk scaling]}] + set size [expr {$dpi * $size / 72.0}] + } + set scale [expr {1.0 * $size / $w}] + tailcall ::image create photo -format [list svg -scale $scale] \ + -data [svg $name $color $opacity] + } + + # Flush image cache. + + proc flush {} { + variable icache + foreach fullname [array names icache] { + catch {::image delete $icache($fullname)} + unset icache($fullname) + } + } + + # Rebuild image cache; useful when tk scaling has changed. + + proc rebuild {} { + variable icache + variable viewbox + set dpi [expr {72.0 * [tk scaling]}] + lassign $viewbox x y w h + foreach fullname [array names icache] { + if {[scan $fullname {%[^,],%d,%g,%s} name size opacity color] == 4 + && $size > 0} { + set size [expr {$dpi * $size / 72.0}] + set scale [expr {1.0 * $size / $w}] + if {[catch {::image inuse $icache($fullname)}]} { + set this [::image create photo \ + -format [list svg -scale $scale] \ + -data [svg $name $color $opacity]] + set icache($fullname) $this + } else { + $icache($fullname) configure -width 1 -height 1 + $icache($fullname) configure -width 0 -height 0 + $icache($fullname) configure \ + -format [list svg -scale $scale] + } + } + } + } + + # Convert a display size including optional unit to pixels. + # Valid unit suffixes are d (density points), p (points), + # and m (millimeters), and without unit suffix, pixels. + + proc val2px {val} { + set dval "" + if {[scan $val "%g" dval] == 1} { + if {[string match "*d" $val]} { + set val [expr {[tk scaling] * 72.0 / 160.0 * $dval}] + } elseif {[string match "*p" $val]} { + set val [expr {[tk scaling] * $dval}] + } elseif {[string match "*m" $val]} { + set val [expr {[tk scaling] * 72.0 / 25.4 * $dval}] + } + } + if {![string is double $val]} { + return -code error "expect number for size" + } elseif {$val < 0} { + set val [expr {-1.0 * $val}] + } + return $val + } + + # Like the "image_nc" method but accepting many options: + # name glyph name to be rendered + # imgname name of photo image + # -size S size with optional unit suffix + # -fill C fill color + # -opacity O fill opacity + # -stroke C stroke color + # -strokewidth S stroke width with optional unit suffix + # -angle A angle in degrees + + proc image_ncg {name imgname args} { + variable viewbox + array set opts { + -size 24d -fill black -opacity 1.0 -stroke none + -strokewidth 1.0 -angle 0 + } + array set opts $args + lassign $viewbox x y w h + set size [val2px $opts(-size)] + if {$size == 0} { + return -code error "invalid size" + } + set scale [expr {1.0 * $size / $w}] + # if stroke width has units or is negative, don't scale it + if {![string is double -strict $opts(-strokewidth)] || + $opts(-strokewidth) < 0} { + # reverse the scale + set opts(-strokewidth) \ + [expr {abs([val2px $opts(-strokewidth)] / $scale)}] + } + tailcall ::image create photo $imgname \ + -format [list svg -scale $scale] \ + -data [svg $name $opts(-fill) $opts(-opacity) $opts(-stroke) \ + $opts(-strokewidth) $opts(-angle)] + } + + # Make some procs visible in MaterialIcons ensemble. + + namespace ensemble create -subcommands { + names svg image image_nc flush rebuild image_ncg + } + +} + +package provide MaterialIcons 0.2 diff --git a/src/vfs/punk9win.vfs/lib/materialicons0.2/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/materialicons0.2/pkgIndex.tcl new file mode 100644 index 00000000..dbfcd2e6 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/materialicons0.2/pkgIndex.tcl @@ -0,0 +1,2 @@ +package ifneeded MaterialIcons 0.2 \ + [list source [file join $dir materialicons.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/materialicons0.2/show.tcl b/src/vfs/punk9win.vfs/lib/materialicons0.2/show.tcl new file mode 100644 index 00000000..7ba45c7d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/materialicons0.2/show.tcl @@ -0,0 +1,109 @@ +# Simple viewer for MaterialIcons package. +# +# chw January 2019 +# search facility: dzach May 2019 + +package require Tk +package require MaterialIcons +package require tooltip + +wm title . "MaterialIcons" + +proc showname {flag} { + if {$flag} { + set ::name [lindex [.v gettags current] 1] + } else { + set ::name "" + } +} + +proc putclipboard {} { + if {$::name eq ""} { + return + } + clipboard clear + clipboard append -type STRING -- $::name +} + +proc showicons {{isconf 0}} { + if {![winfo exists .v]} { + set ::pattern * + frame .f + label .f.s -text "Search: " + entry .f.e -textvariable ::pattern -width 30 + pack .f.s .f.e -side left + grid .f -row 0 -column 0 -padx 4 -pady 4 -columnspan 2 -sticky w + canvas .v -yscrollcommand {.y set} -xscrollcommand {.x set} -bg white + grid .v -row 1 -column 0 -sticky news + ttk::scrollbar .y -orient vertical -command {.v yview} + grid .y -row 1 -column 1 -sticky ns + ttk::scrollbar .x -orient horizontal -command {.v xview} + grid .x -row 2 -column 0 -sticky ew + label .l -textvariable name + grid .l -row 3 -column 0 -sticky ew + grid rowconfigure . 1 -weight 1 + grid columnconfigure . 0 -weight 1 + bind .f.e {showicons ; break} + bind .f.e {showicons ; break} + bind . { + after cancel {showicons 1} + after idle {showicons 1} + break + } + .f.e icursor end + .v bind _icons {showname 1} + .v bind _icons {showname 0} + .v bind _icons <1> putclipboard + } else { + if {$isconf && + [winfo width .] == $::dim(w) && + [winfo height .] == $::dim(h)} { + return + } + .v delete all + tooltip::tooltip .v -items {} {} + } + + set ::name "" + set x 20 + set y 20 + set xmax [winfo width .] + if {$xmax == 1} { + set ::dim(w) [winfo reqwidth .] + set ::dim(h) [winfo reqheight .] + set xmax [expr {[winfo reqwidth .v] + [winfo reqwidth .y]}] + } else { + set ::dim(w) [winfo width .] + set ::dim(h) [winfo height .] + } + set xmax [expr {$xmax - 64}] + if {$xmax < 200} { + set xmax 200 + } + + foreach n [MaterialIcons names $::pattern] { + set i [MaterialIcons image $n 20] + set c [.v create image $x $y -anchor nw -image $i \ + -tags [list _icons $n]] + lassign [.v bbox $c] x1 y1 x2 y2 + if {$x1 > $xmax} { + set y [expr {$y2 + 10}] + set x 20 + .v coords $c $x $y + lassign [.v bbox $c] x1 y1 x2 y2 + } + set x [expr {$x2 + 10}] + tooltip::tooltip .v -items $c $n + } + + set bbox [.v bbox _icons] + if {[llength $bbox]} { + lassign [.v bbox _icons] x1 y1 x2 y2 + .v configure -scrollregion [list [expr {$x1 - 20}] [expr {$y1 - 20}] \ + [expr {$x2 + 20}] [expr {$y2 + 20}]] + } else { + .v configure -scrollregion {} + } +} + +showicons diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/COPYING.txt b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/COPYING.txt new file mode 100644 index 00000000..64bbf8c6 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/COPYING.txt @@ -0,0 +1,29 @@ +This is the copyright notice and license for pgin.tcl. +The wording is from the Tcl and Tcllib licenses, and is +essentially equivalent to the Berkeley/BSD license. +----------------------------------------------------------------------- +This software is Copyright (c) 1998-2017 L Bayuk + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. +----------------------------------------------------------------------------- diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/INTERNALS.txt b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/INTERNALS.txt new file mode 100644 index 00000000..306b86a9 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/INTERNALS.txt @@ -0,0 +1,456 @@ +This is pgintcl/INTERNALS, notes on internal implementation of pgintcl. +Last updated for pgintcl-3.4.0 on 2011-09-19 +The project home page is: http://sourceforge.net/projects/pgintcl/ +----------------------------------------------------------------------------- +INTERNAL IMPLEMENTATION NOTES: + +This information is provided for maintenance, test, and debugging. + +A connection handle is just a Tcl socket channel. The application using +pgin.tcl must not read from or write to this channel. + +Internal procedures, result structures, and other data are stored in a +namespace called "pgtcl". The following namespace variables apply to +all connections: + + pgtcl::debug A debug flag, default 0 (no debugging) + pgtcl::version pgin.tcl version string + pgtcl::rn Result number counter + pgtcl::fnoids Function OID cache; see FAST-PATH FUNCTION CALLS + pgtcl::errnames Constant array of error message field names + +The following arrays are indexed by connection handle, and contain data +applying only to that connection: + + pgtcl::notice() Command to execute when receiving a Notice + pgtcl::xstate() Transaction state + pgtcl::notify() Notifications; see NOTIFICATIONS + pgtcl::notifopt() Notification optionss; see NOTIFICATION + pgtcl::std_str() For pg_escape_string etc; see ESCAPING + pgtcl::bepid() Backend process ID (PID) + +Additional namespace variables are described in the sections below. +Result structure variables are described next. + +----------------------------------------------------------------------------- +RESULT STRUCTURES: + +A result structure is implemented as a variable result$N in the pgtcl +namespace, where N is an integer. (The value of N is stored in pgtcl::rn +and is incremented each time a new result structure is needed.) The result +handle is passed back to the caller as $N, just the integer. The result +structure is an array which stores all the meta-information about the +result as well as the result values. + +The result structure array indexes in use are: + + Variables describing the overall result: + result(conn) The connection handle (the socket channel) + result(nattr) Number of attributes (columns) + result(ntuple) Number of tuples (rows) + result(status) PostgreSQL status code, e.g. PGRES_TUPLES_OK + result(error) Error message if status is PGRES_FATAL_ERROR + result(complete) Command completion status, e.g. "SELECT 10" + result(error,C) Error message field C if status is PGRES_FATAL_ERROR. + C is one of the codes for extended error message fields. + + Variables describing the attributes (columns) in the result: + result(attrs) A list of the name of each attribute + result(types) A list of the type OID for each attribute + result(sizes) A list of attribute byte lengths or -1 if variable + result(modifs) A list of the size modifier for each attributes + result(formats) A list of the data format for each attributes + result(tbloids) A list of the table OIDs for each attribute + + Variables describing prepared query parameters in the result: + result(nparams) The number of prepared statement parameters + result(paramtypes) List of prepared statement parameter type OIDs + + Variables storing the query result values: + result($irow,$icol) Data value for result + result(null,$irow,$icol) NULL flag for result + +The pg_exec and pg_exec_prepared commands create and return a new result +structure. The pg_result command retrieves information from the result +structure and also frees the result structure with the -clear option. +(Other commands, notably pg_select and pg_execute, use pg_exec, so they +also make a result structure, but it stays internal to the command and the +caller never sees it.) The result structure innards are also directly +accessed by some other routines, such as pg_select and pg_execute. Result +structure arrays are unset (freed) by pg_result -clear, and any left-over +result structures associated with a connection handle are freed when the +connection handle is closed by pg_disconnect. + +The query result values are stored in result($irow,$icol) where $irow is +the tuple (row) number, between 0 and $result(ntuples)-1 inclusive, and +$icol is the attribute (column) number, between 0 and $result(nattr)-1 +inclusive. If the value returned by the database is NULL, then +$result($irow,$icol) is set to an empty string, and +$result(null,$irow,$icol) is also set to an empty string for this row and +column. For non-NULL values, $result(null,$irow,$icol) is not set at all. +The "null,*,*" indexes are used only by pg_result -getNull if it is +necessary for the application to distinguish NULL from empty string - both +of which are stored as empty strings in result($irow,$icol) and return an +empty string with any of the pg_result access methods. There is no way to +distinguish NULL from empty string with pg_select, pg_execute, or +pg_exec_prepared. + +The entire result of a query is stored before anything else happens (that +is, before pg_exec and pg_exec_prepared return, and before pg_execute and +pg_select process the first row). This is also true of libpq and pgtcl-ng +(in their synchronous mode), but Tcl can be slower. + +Extended error message fields are new with PostgreSQL-7.4. Individual parts +of a received error message are stored in the result array indexed by +(error,$c) where $c is the one-letter code used in the protocol. See the +pgin.tcl documentation for "pg_result -errorField" for more information. +(As of 2.2.0, pg_result -errorField is the same as pg_result -error: both +take an optional field name or code argument to return an extended error +message field, rather than the full message.) + +----------------------------------------------------------------------------- +BUFFERING + +PostgreSQL protocol version 3 (PostgreSQL-7.4) uses a message-based +protocol. To read messages from the backend, pgin.tcl implements a +per-connection buffer using several Tcl variables in the pgtcl namespace. +The name of the connection handle (the socket name) is part of the variable +name, represented by $c below. + + pgtcl::buf_$c The buffer holding a message from the backend. + pgtcl::bufi_$c Index of the next byte to be processed from buf_$c + pgtcl::bufn_$c Total number of bytes in the buffer buf_$c. + +For example, if the connection handle is "sock3", the variables are +pgtcl::buf_sock3, pgtcl::bufi_sock3, and pgtcl::bufn_sock3. + +A few tests determined that the fastest way to fetch data from the buffers +in Tcl was to use [string index] and [string range], although this might +not seem intuitive. + +----------------------------------------------------------------------------- +PARAMETERS + +The PostgreSQL backend can notify a front-end client about some parameters, +and pgin.tcl stores these in the following variable in the pgtcl namespace: + + pgtcl::param_$c Array of parameter values, indexed by parameter name + +where $c is the connection handle (socket name). + +Access to these parameters is through the pg_parameter_status command, +a pgin.tcl extension. + +----------------------------------------------------------------------------- +PROTOCOL ISSUES + +This version of pgin.tcl speaks only to a Protocol Version 3 PostgreSQL +backend (7.4 or later). There is one concession made to Version 2, and +that is reading an error message. If a Version 2 error message is read, +pgin.tcl will recognize it and pretend it got a Version 3 message. This +is for use during the connection stage, to allow it to fail with a +proper message if connecting to a Version 2-only backend. + +----------------------------------------------------------------------------- +NOTIFICATIONS + +An array pgtcl::notify keeps track of notifications you want. The array is +indexed as pgtcl::notify(connection,name) where connection is the +connection handle (socket name) and name is the parameter used in +pg_listen. The value of an array element is the command to execute on +notification. This can be a procedure name, or a procedure name with +leading arguments. It must be a proper Tcl list. + +Starting with PostgreSQL-9.0.0, a 'payload' string can be provided with the +SQL NOTIFY command. Starting with pgin.tcl-3.2.0, this payload (if not empty) +will be passed as an additional argument to the command. The command is taken +as a list, and the payload is appended as in lappend. The resulting list is +the command to execute. If there is no payload, or it is empty, or the server +is older than PostgreSQL-9.0.0, no additional argument will be passed to the +command. The command should therefore always accept an optional argument. + +Starting with pgintcl-3.4.0, there is an additional array pgtcl::notifopt() +to store options for the notification. This array is indexed the same way +as pgtcl::notif(), and holds integer values. The value is 0 if there are no +options for this notification. The value is 1 if the notification listener +should get the notifying backend process ID as an argument, as indicated by +the -pid option to pg_listen. No other options are defined. + +----------------------------------------------------------------------------- +NOTICES + +Notice and warning message handling can be customized using the +pg_notice_handler command. By default, the notice handler is + puts -nonewline stderr +and this string will be returned the first time pg_notice_handler is +called. A notice handler should be defined as a proc with one or more +arguments. Leading arguments are supplied when the handler is set with +pg_notice_handler, and the final argument is the notice or warning message. + +----------------------------------------------------------------------------- +LARGE OBJECTS + +The large object commands are implemented using the PostgreSQL "fast-path" +function call interface (same as libpq). See the next section for more +information on fast-path. + +The pg_lo_creat command takes a mode argument. According to the PostgreSQL +libpq documentation, lo_creat should take "INV_READ", "INV_WRITE", or +"INV_READ|INV_WRITE". (pgin.tcl accepts "r", "w", and "rw" as equivalent +to those respectively, but this is not compatible with pgtcl-ng.) It isn't +clear why you would ever create a large object with other than +"INV_READ|INV_WRITE". + +The pg_lo_open command also takes a mode argument. According to the +PostgreSQL libpq documentation, lo_open takes the same mode values as +lo_creat. But in libpgtcl the pg_lo_open command takes "r", "w", or "rw" +for the mode, for some reason. pgin.tcl accepts either form for mode, +but to be compatible with libpgtcl you should use "r", "w", or "rw" +with pg_lo_open instead of INV_READ, INV_WRITE, or INV_READ|INV_WRITE. + + +----------------------------------------------------------------------------- +FAST-PATH FUNCTION CALLS + +Access to the PostgreSQL "Fast-path function call" interface is available +in pgin.tcl. This was written to implement the large object command, and +general use is discouraged. See the libpq documentation for more details on +what this interface is and how to use it. + +It is expected that the Fast-path function call interface in PostgreSQL +will be deprecated in favor of using the Extended Protocol to do +separate Prepare, Bind, and Execute steps. See PREPARE/BIND/EXECUTE. + +Internally, backend functions are called by their PostgreSQL OID, but +pgin.tcl handles the mapping of function name to OID for you. The +fast-path function interface in pgin.tcl uses an array pgtcl::fnoids to +cache object IDs of the PostgreSQL functions. One instance of this array +is shared among all connections, under the assumption that these OIDs are +common to all databases. (It is possible that if you have simultaneous +connections to multiple database servers running different versions of +PostgreSQL this could break.) The index to pgtcl::fnoids is the name +of the function, or the function plus argument type list, as supplied +to the pgin.tcl fast-path function call commands. The value of each +array index is the OID of the function. + +PostgreSQL supports overloaded functions (same name, different number +and/or argument types). You can call overloaded functions with pgin.tcl by +specifying the argument type list after the function name. See examples +below. You must specify the argument list exactly like psql "\df" does - as +a list of correct type names, separated by a single comma and space. There +is currently no provision to distinguish functions by their return type. It +doesn't seem like there are any PostgreSQL functions which differ only by +return type. + +Before PostgreSQL-7.4, certain errors in fast-path calls (such as supplying +the wrong number of arguments to the backend function) would cause the +back-end and front-end to lose synchronization, and the channel would be +closed. This was true about libpq as well. This has been fixed with the +new protocol in PostgreSQL-7.4. + + +Commands: + + pg_callfn $db "fname" result "arginfo" arg... + + Call a PostgreSQL backend function and store the result. + Returns the size of the result in bytes. + + Parameters: + + $db is the connection handle. + + "fname" is the PostgreSQL function name. This is either a simple + name, like "encode", or a name followed by a parenthesized + argument type list, like "like(text, text)". The second form + is needed to specify which of several overloaded functions you want + to call. + + "result" is the name of a variable where the PostgreSQL backend + function returned value is to be stored. The number of bytes + stored in "result" is returned as the value of pg_callfn. + + "arginfo" is a list of argument descriptors. Each list element is + one of the following: + I An integer32 argument is expected. + S A Tcl string argument is expected. The length of the + string is used (remember Tcl strings can contain null bytes). + n (an integer > 0) + A Tcl string argument is expected, and exactly this many + bytes of the string argument are passed (padding with null + bytes if needed). + + arg... Zero or more arguments to the PostgreSQL function follow. + The number of arguments must match the number of elements + in the "arginfo" list. The values are passed to the backend + function according to the corresponding descriptor in + "arginfo". + + For PostgreSQL backend functions which return a single integer32 argument, + the following simplified interface is available: + + pg_callfn_int $db "fname" "arginfo" arg... + + The db, fname, arginfo, and other arguments are the same as + for pg_callfn. The return value from pg_callfn_int is the + integer32 value returned by the PostgreSQL backend function. + +Examples: + Note: These examples demonstrate the command, but in both of these + cases you would be better off using an SQL query instead. + + set n [pg_callfn $db version result ""] + This calls the backend function version() and stores the return + value in $result and the result length in $n. + + pg_callfn $db encode result {S S} $str base64 + This calls the backend function encode($str, "base64") with 2 + string arguments and stores the result in $result. + + pg_callfn_int $db length(text) S "This is a test" + This calls the backend function length("This is a test"). Because + there are multiple functions called length(), the argument type + list "(text)" must be given after the function name. The length + of the string (14) is returned by the function. + +----------------------------------------------------------------------------- +PREPARE/BIND/EXECUTE + +Starting with PostgreSQL-7.4, access to separate Parse, Bind, and Execute +steps are provided by the protocol. The Parse step can be replaced by an +SQL PREPARE command. pgin.tcl provides support for this extended query +protocol with pg_exec_prepared (introduced in pgin.tcl-2.0.0), and +pg_exec_params (introduced in pgin.tcl-2.1.0). There is also a variation of +pg_exec which provides a simplified interface to pg_exec_params. + +The main advantage of the extended query protocol is separation of +parameters from the query text string. This avoids the need to quote and +escape parameters, and may prevent SQL injection attacks. pg_exec_prepared +also offers some performance advantages if a query can be prepared, parsed, +and stored once and then execute multiple times without re-parsing. + +In addition to working with text parameters and results, the +pg_exec_prepared and pg_exec_params commands support sending unescaped +binary data to the server. (Fast-path function calls also support this.) +These commands also support returning binary data to the client. (This can +also be done with binary cursors.) Although the protocol definition and +pgin.tcl commands support mixed text and binary results, libpq requires all +result columns to be text, or all binary. Using mixed binary/text result +columns will make your application incompatible with libpq-based versions +of this interface. + +pg_exec_prepared is for execution of pre-prepared SQL statements after +binding parameters. A named SQL statement must be prepared using the SQL +"PREPARE" command before using pg_exec_prepared. An advantage of +pg_exec_prepared is that the protocol-level Parse step requires the client +to translate parameter types to OIDs, but using PREPARE lets the server +determine the parameter argument types. pg_exec_prepared is modeled after +the Libpq call: PQexecPrepared(). + +pg_exec_params does all three steps of the extended query protocol: parse, +bind, and execute. Parameter types can be specified by type OID, or parameters +can be based as text to be interpreted by the server as it does for any +untyped literal string. To find the type OID of a PostgreSQL type '', +you need to query the server like this: + SELECT oid FROM pg_type where typname='' +pg_exec_params is modeled after the Libpq call: PQexecParams(). + +A limitation of both pg_exec_prepared and pg_exec_params is lack of support +for NULLs as parameter values. There is no way to pass a NULL parameter to +the prepared statement. This is not a protocol or database limitation, but +just lack of a good idea on how to implement the command interface to +support NULLs without needlessly complication the more common case without +NULLs. + + +----------------------------------------------------------------------------- +MD5 AUTHENTICATION + +MD5 authentication was added at PostgreSQL-7.2. This is a +challenge/response protocol which avoids having clear-text passwords passed +over the network. To activate this, the PostgreSQL administrator puts "md5" +in the pg_hba.conf file instead of "password". Pgin.tcl supports this +transparently; that is, if the backend requests MD5 authentication during +the connection, pg_connect will use this protocol. The MD5 implementation +was coded by the original author of pgin.tcl. It does not use the tcllib +implementation, which is significantly faster but much more complex. + +----------------------------------------------------------------------------- +ENCODING + +Character set encoding was added to pgin.tcl-3.0.0. More information can be +found in the README and REFERENCE files. + +The following are converted to Unicode before being sent to PostgreSQL: + + + Query strings (pg_exec, and all higher-level commands which use it) + + TEXT-format query parameters in pg_exec_prepared/pg_exec_params + + All parameter arguments in pg_exec when query parameters are used + + Prepared statement name in pg_exec_prepared + + COPY table FROM STDIN data sent using pg_copy_write + +The following are converted from Unicode when received from PostgreSQL: + + + Query result column data when TEXT-format (not when BINARY-format) + + All Error and Notice response strings + + Parameter names and values + + Notification messages + + Command completion message + + Query result field names (column names) + + COPY table TO STDOUT data received using pg_copy_read + +Conversion of data to Unicode for sending to PostgreSQL occurs in 5 places +in the code: pg_exec and pg_exec_params query strings, pg_exec_prepared +statement name, pg_exec_prepared text format parameters, and when writing +COPY FROM data in pg_copy_write. + +Conversion of Unicode data from PostgreSQL occurs in 3 places in the code: +when receiving a protocol message "string" type (which covers various +messages, parameters, and field names), when reading TEXT mode tuple data, +and when reading COPY TO data in pg_copy_read. + +There is no Unicode conversion for the connection parameters username, +database-name, or password. PostgreSQL seems to store these using the +encoding of the database cluster/template1 database, which may differ from +the encoding of the database to which the client is connected. It is +unclear how to recode these characters. At this time, it is wise to avoid +non-ASCII characters in database names, usernames, and passwords. This may +be fixed in the future. + +The fast-path function call interface treats all its arguments as binary +data and does not encode or decode them. The fast-path function calls +were implemented primarily for large object support, and large object +support is not affected by Unicode encoding because it is all binary +data. It is unlikely that encoding support will be added to fast-path +function calls, since parameterized queries are the preferred replacement. + +----------------------------------------------------------------------------- +ESCAPING + +An array pgtcl::std_str() is used to store the per-connection setting for +the PostgreSQL setting standard_conforming_strings. This was added in +Pgin.tcl-3.1.0 to support the versions of pg_escape_string, pg_quote, and +pg_escape_bytea which accept an optional $conn argument. + +If the array value indexed by $conn is 1, then standard conforming strings +is on for that database connection, and the backslash (\) is not considered +special in SQL quoted string constants. In this case, pg_escape_string and +pg_quote will not double backslashes. pg_escape_bytea will omit one level +of backslashes when escaping backslash and octal values. + +If the array value indexed by $conn is 0, then standard conforming strings +is off for that database and connection, and the backslash (\) is special +in SQL quoted string constants. In that case, pg_escape_string and pg_quote +will double backslashes. pg_escape_bytea will use 4 backslashes for a single +backslash, and 2 backslashes in an octal value. + +There is also an array index "_default_" which is used when no $conn +argument is supplied to the escape commands. Just as in libpq, the +_default_ value is set any time a Set Parameter message for +standard_conforming_strings is received over any open database connection. +If you are using a single connection, or multiple connections with the same +value for standard_conforming_strings, you will get correct escaping +behavior even without using the $conn argument when escaping strings. + + +----------------------------------------------------------------------------- diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/NEWS.txt b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/NEWS.txt new file mode 100644 index 00000000..e47bbbec --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/NEWS.txt @@ -0,0 +1,423 @@ +This is pgintcl/NEWS, release notes and change information for pgintcl. +The project home page is: http://sourceforge.net/projects/pgintcl/ +----------------------------------------------------------------------------- + +* 2017-11-12 Released version 3.5.1 + + This version contains a small fix for PostgreSQL-10.x. + + + The pg_server_version command now works with the new 2-part version + numbers used starting with PostgreSQL-10.0, as well as with the 3-part + version numbers in older releases. Note that the PostgreSQL-10.1 version + number as an integer is 100001, not 100100. See the PostgreSQL-10.x libpq + documentation for PQserverVersion for an explanation. + +* 2013-10-06 Released version 3.5.0 + + This version adds 5 new commands, new pg_connect options, and new error + field codes for pg_result. + + + New commands pg_escape_literal, which is an alternative to pg_quote, and + pg_escape_identifier, for escaping SQL identifiers. [Feature Request #5] + + + New connection options are available in pg_connect. This command now + supports a "-connlist {list}" form for option parameters. (The syntax + is from Flightaware Pgtcl, but the implementation is new, and not + completely compatible.) The advantage of using this form is that + it does not require quoting or escaping, especially for the password. + + Also, pg_connect now accepts a URI for a connection string, as described + in the PostgreSQL manual, for example: + pg_connect -conninfo postgresql://myuser:secretd@host.example.com/dbname + Note: pgintcl does not support options in URI connection strings. + [Feature Request #3] + + + New commands for 64-bit Large Object offsets: pg_lo_lseek64, + pg_lo_tell64, and pg_lo_truncate64. These only work when connected to + a PostgreSQL-9.3.0 or higher server. [Feature Request #2] + + + pg_result -error and -errorField now support 5 new field codes, which + were added in PostgreSQL-9.3.0 (and only return data when connected to + a PostgreSQL-9.3.0 or higher server). These provide access to the + schema, table, column, and constraint name. [Feature Request #4] + + Compatibility Warning: + + PostgreSQL-9.2.0 started using lower case letters as the value of the + new PG_DIAG_* symbols. This conflicts with case insensitive field codes + in previous versions of pgintcl. Starting with pgintcl-3.5.0, field code + single-character abbreviations are now case sensitive. This will require + changes to scripts, if they used single-character lower case letters + as field codes. The full field code names remain case insensitive. + For example: + Both of these worked before, and continue to work: + pg_result $res -errorField SEVERITY + pg_result $res -errorField severity + The single-character code for SEVERITY is 'S'. Starting with this + release, an upper case 'S' must be used, as 's' is now used for + SCHEMA_NAME. + pg_result $res -errorField s + Returned the error severity in previous releases. + Returns the error object schema name in this release. + + + This release was tested with Tcl-8.6.0 and PostgreSQL-9.3.0, as well as + several older versions. + + +* 2011-09-17 Released version 3.4.0 + + This version adds 2 new commands and 1 new command option, and fixes 1 bug. + + New command pg_backend_pid to get the backend process ID. + + New command pg_server_version to get the server version as an intger. + + New -pid option to pg_listen, to pass the notifying client's backend + process ID to the notification callback. + + Bug fix: fold the notification name in pg_listen (also called channel name) + to lower case, unless it is in double quotes (which are stripped off). + This now works the same as SQL and pgtclng, but is not compatible with + previous releases of pgintcl if pg_listen was used with a mixed-case or + quoted name. For maximum compatibility, use unquoted lower case names in + notifications, both with SQL and pgintcl. + + In addition to Tcl-8.4.x and Tcl-8.5.x, pgin.tcl was tested with Tcl-8.6 + (which is currently in beta). It was also tested with the just-released + PostgreSQL-9.1 + + +* 2011-03-21 Released version 3.3.0 + + This version adds one new feature: pg_result $r -dict, which returns the + query result as a Tcl dictionary. The idea for this feature came from + the pgfoundry.org 'pgtcl' project. This feature requires Tcl-8.5 or higher. + + pgin.tcl now requires Tcl-8.4 or higher. Previous versions claimed to + require Tcl-8.3 or higher, but were no longer tested with Tcl-8.3. + + +* 2010-10-11 Released version 3.2.1 + + This version fixes bug #1010929, "pg_unescape_bytea fails with + PostgreSQL-9.0". pg_unescape_bytea now handles 'hex' mode decoding, as well + as 'escape' mode, for bytea types. It no longer fails to decode a bytea + value selected from a PostgreSQL-9.0 server which has the default + bytea_output=hex configuration setting. + + Note: Pgintcl-3.2.0 was withdrawn soon after release because of this + problem, although 3.2.0 did not introduce the problem. The problem exists + with all releases of all interfaces, and is caused by PostgreSQL-9.0 + defaulting to the new "hex" mode encoding in bytea type output. This is + incompatible with all interfaces designed pre-9.0. So the same problem + exists with all previous versions of Pgintcl, as well as any libpq-based + interface built with pre-9.0 libpq. However, since pgintcl-3.2.0 was + supposed to be a release for use with PostgreSQL-9.0, it was felt that + this problem needed to be fixed before allowing a release. + + +* 2010-10-10 Released version 3.2.0 (Note: release withdrawn - see note above.) + + This version has one new feature and one change for PostgreSQL-9.0.0: + + + Notification messages can now include a payload, which is passed to + the notification listener callback proc. For example: + Given (in one session): + pg_listen $db my_channel my_callback_proc + + Then (possibly in another session): + SQL> NOTIFY my_channel, 'the payload' + This will result in execution of: my_callback_proc "the payload" + in the original session. + + And: + SQL> NOTIFY my_channel + or: SQL> NOTIFY my_channel, '' + This will result in execution of: my_callback_proc + in the original session. + + Compatibility Warning: + This applies only if you use pg_listen to set up a notification listener + callback procedure. + + Your listener callback should be defined to accept an optional argument + for the payload, for example: proc listen_handler {{payload ""}} { ... } + Starting with version 3.2.0, pgin.tcl will pass a payload argument to the + handler if a non-empty payload is provided in the SQL command. If an empty + payload is provided, or no payload (including any usage with a PostgreSQL + server older than 9.0.0), pgin.tcl will not supply the argument to the + handler. This is intended to improve compatibility with older scripts that + would throw an error if provided an unexpected argument. + + If you do not update your listener callback to have an optional argument, + and you never include a payload in the notification SQL, your script will + not have any problems. However, note that anyone who can connect to the + database can send a notification (if they know the 'channel' name used + in the pg_listen command), and they can include a payload. If your listener + callback does not expect a payload argument, it will throw a background + error (which may or may not terminate the script) if it receives such a + payload argument. + + + Change in pg_result $result_handle -cmdTuples: + It seems that starting with PostgreSQL-9.0, the function that this + emulates (libpq PQcmdTuples) was extended to return the number of + rows returned by SELECT. (Prior to this change, an empty string was + returned for SELECT.) pgin.tcl was modified to work that way, and now + returns row counts for -cmdTuples after SELECT and other commands. + However, it is recommended to use -numTuples for SELECT and -cmdTuples + for commands that modify tables. + +* 2009-09-10 Released version 3.1.0 + + This version contains four new commands: + + pg_encrypt_password to encrypt a password for certain SQL commands + + pg_lo_truncate to truncate a large object + + pg_describe_cursor to return information about a cursor (portal) + + pg_describe_prepared to return information about a prepared statement. + + This version adds two options to pg_result, for use with + pg_describe_prepared to return information about a prepared statement. + The options are -numParams and -paramTypes. + + In this release, pg_escape_string, pg_quote, and pg_escape_bytea + accept an optional connection parameter, which allows pgin.tcl to + use connection-specific information to properly handle string escaping. + For more information, see the REFERENCE file. + + This is the first release that can properly escape strings and bytea's + if standard_conforming_strings is ON (thus backslashes should not be + doubled). This works as long as the client either: uses a single database + connection, or uses multiple database connections all of which have the + same setting for standard_conforming_strings, or always supplies the + connection parameter to pg_escape_string, pg_quote, and pg_escape_bytea. + + The procedure that implements the backend reply protocol has been + rewritten to more completely check that only expected messages are + received, depending on the processing mode. + + Fixed error handling in pg_lo_import and pg_lo_export, to make sure + the file is closed if an error occurs. + + +* 2008-04-26 Released version 3.0.2 + + This version contains a bug fix in executing prepared queries with + extended (non-ASCII) character query parameters. + + Fix pg_exec_prepared to use the parameter length after encoding. + Thanks to giorgio_v -at- mac.com for finding the bug. + +* 2006-08-30 Released version 3.0.1 + + This is the first release on pgfoundry.org. Previous releases were on + gborg.postgresql.org. The release documentation was changed to reflect + the new URL. + ++ Fix/Change: pg_escape_bytea was changed to match a change in the + PostgreSQL-8.1 libpq library function PQescapeBytea. For a single + quote in the argument string, it now returns two quotes ('') instead + of backslash-quote (\'). + + +* 2005-04-16 Released beta version 3.0.0 + + This is a beta release which adds character set encoding/decoding to fix + misbehavior of pgin.tcl when used with non-ASCII character sets. Like + Pgtcl, pgtcl-ng, and libpgtcl, pgin.tcl now sets PostgreSQL + client_encoding to Unicode, and sends/receives UTF-8 encoded text + strings to/from PostgreSQL. Pgin.tcl also recodes COPY data, which + the libpq-based Tcl interfaces do not correctly handle at this time. + + (Thanks to pfm developer Willem Herremans, who first convinced me that + encoding was broken in pgin.tcl, then provided the understanding of how + Tcl and PostgreSQL handle character set conversions and how to get them + to play nicely together.) + + There are no changes to the pgin.tcl command usage from 2.2.0. + + At this time, it hasn't been decided if there will be two versions of + pgin.tcl - one for Unicode, and one without - or if only the Unicode + encoding version will suffice. + + +* 2004-11-11 Released version 2.2.0 + ++ New commands: pg_escape_bytea and pg_unescape_bytea, which emulate the + libpq functions PQescapeBytea() and PQunescapeBytea(). These were + suggest by J. Levan, with a fast implementation of pg_unescape_bytea + provided by B. Riefenstahl. Note however that pg_escape_bytea is slow. + (If possible, use prepared queries in binary mode for bytea types, + not escape/unescape.) Also note that pg_unescape_bytea only produces + valid results for data formated by the PostgreSQL backend bytea + output function; it is not an accurate emulation of PQunescapeBytea(). + ++ Compatibility fixes for extended error codes. + The Gborg pgtcl project (Karl Lehenbauer) release 1.4 contains a way to + fetch extended error field values which is different from the way + pgin.tcl and pgtclng already did it, but better. They extended + pg_result -error, where I added a new subcommand pg_result -errorField. + For compatibility, pg_result -error and pg_result -errorField are now + identical. If an optional code is supplied, that error field value + will be returned. Also added variations on the code names that Gborg + pgtcl uses. + +* Performance fix for prepared queries: As found by Nigel J. Andrews, + prepared queries were slower than they should be. The fix was to + allow Tcl to buffer up the multiple messages making up a prepared + query execution; for some reason this avoids a TCP/IP delay. + + +* 2004-06-01 Released version 2.1.0 + ++ New command: pg_exec_params, parse/bind/execute extended query protocol. + This complements pg_exec_prepared, which works with a pre-prepared + statement. Both are binary safe. + ++ pg_exec can take optional arguments which makes it a parameterized + query like pg_exec_params, but with all text parameters and results. + (idea from karl's implementation in Gborg pgtcl CVS). + ++ New command: pg_quote, to quote and escape a string (from karl's + implementation in Gborg pgtcl CVS), variation on pg_escape_string (which + unfortunately was removed from Gborg pgtcl CVS, breaking compatibility). + pgin.tcl will support both pg_escape_string and pg_quote. + ++ Bug fix (GBorg #802) Fix typo in error return if pg_execute script throws + an error (from n.j.andrews-at-investsystems.co.uk). Testing found + another problem here; fixed error value returned. + + +* 2004-02-25 Version 2.0.1 (not released to Gborg) + ++ New command option: pg_result $res -cmdStatus (suggested by levanj) + Returns the command status tag, e.g. "INSERT 10020", for the result $res. + + +* 2004-02-14 Released version 2.0.0 + +Changes since beta release 2.0b1: + ++ Pgin.tcl can now be installed as a Tcl package. + +The package name is 'pgintcl'. (Not 'pgtcl', which is used by libpgtcl. +Since pgintcl is not 100% compatible, I didn't want to use the same name. +Also the version numbers of the two interfaces do not track.) +This means if you install pgin.tcl and pkgIndex.tcl into your package +directories, you can use {package require pgintcl} to load it. + + ++ Removed feature: Fetch all parameters with {pg_parameter_status $db} + +Libpq does not support this, so to be compatible with future libpq-based +versions of the pgtcl interface, this feature was removed. You must supply +pg_parameter_status with a parameter name. + + ++ Documented incompatibility: pg_exec_prepared mixed text/binary return types + +Although the pg_exec_prepared command in pgin.tcl supports mixing text and +binary return types, libpq does not, so libpq based versions of the pgtcl +interface will not work with these queries. This has now been noted in the +documentation, but support for these queries was not removed from pgin.tcl. + + ++ Incompatible feature change: Dealing with NULL values + +Previous versions of pgin.tcl supported a command to set the string to be +returned if a database value was NULL: { pg_configure $db nulls "string" }. +This proved to be very inefficient to implement in the libpq-based version +of the pgtcl interface. It could slow down all queries, just to support a +feature that would be rarely used, so it was removed. Instead, pgin.tcl +now only provides a way to determine if a database value is NULL: + pg_result $res -getTuple $n +This returns a list of 1s and 0s indicating if each column in tuple $n +is NULL or not. + + ++ Command name change: Setting notice handler + +In previous versions of pgin.tcl you could set the notice handler with: + pg_configure $db notice ?command? +A new command is now used instead: + pg_notice_handler $db ?command? +The pg_configure command is retained for compatibility but should not be +used. + + ++ Large Object Error Handling 'fixed' + +Several of the Large Object calls had undefined or unclear error behavior, +and most were not documented in the PostgreSQL manual. Now pgin.tcl will +throw a Tcl error if any error occurs in any large object calls except for +pg_lo_read and pg_lo_write. Those two were already defined to return -1 on +error, so I left them that way even though I would prefer they threw errors. + + + +* 2003-10-30 Released beta version 2.0b1: + +This is a major rewrite for PostgreSQL-7.4 using the new V3 FE/BE protocol. + +New commands for new features in the V3 protocol: + pg_parameter_status => Get backend-supplied parameter value + pg_transaction_status => Get current transaction/error state + pg_exec_prepared => Execute prepared SQL statement + pg_result -errorField => Show extended error code values + pg_result -lxAttributes => Show extended field attribute information + +Changed commands: pg_configure no longer ignores the connection handle; +nulls and notice settings are now per-connection, not global to all +connections. + +Change (incompatible): COPY FROM/TO must use the pg_copy_read and +pg_copy_write commands, and can not read / write the socket directly. +These calls were introduced in pgin.tcl-1.5.0, but were optional in that +version. Changes to the PostgreSQL protocol now makes it impossible for +pgin.tcl to support COPY with direct reading and writing the socket, so use +of these commands is not required. See REFERENCE for more information. + +The included sample tkpsql program has been updated in this release to be +more schema-aware, while still supporting pre-PostgreSQL-7.3 databases +(untested). Some new special queries were added. + + +* 2003-06-30 Released version 1.5.0 + +Change: default user name for connection now checks environment variable +USERNAME (for WindowsNT) after PGUSER, USER, and LOGNAME. + +Fix: Tkpsql properly gets initial focus on startup on Windows. + +Bug fix: Wrong data was returned by pg_result -getTuple, -list, or -llist +when the query contained duplicate column names. (For example: + SELECT a.id, a.s, b.s FROM a, b WHERE a.id=b.id; +returns two columns named "s", and pg_result -getTuple incorrectly stored +the value from table "b" column "s" twice.) pgin.tcl now internally stores +values indexed by column number, not name, and will correctly store and +return all the values when those access methods are used. Note that other +access methods such as pg_result -assign, -tupleArray, pg_select, and +pg_execute use the column name as an array index, so they are not +compatible with queries returning duplicate column names. Also note you +really should use column name aliases when a query generates duplicate +column names. [gborg bug id #503] + +New function: pg_escape_string to escape strings for SQL constants. This is +in the libpgtcl CVS. + +Bug fixes for empty query. Previously threw an error, now properly handles +an empty query return and sets status to PGRES_EMPTY_QUERY. + +Change: pg_result -cmdTuples returns "", not 0, for any SQL other than +Insert/Update/Delete, this apparently being the correct behavior per libpq. + +Add support for overloaded fast-path function calls (same function name but +with different argument types). + +Fix: pg_execute now handles empty query, COPY FROM, and COPY TO correctly. + +New I/O routines for COPY FROM/TO: pg_copy_read and pg_copy_write. There is +no need to use these yet; you can just read and write from the connection +handle. I put them in for testing compatibility with the future PostgreSQL +FE/BE Protocol Version 3 pgin.tcl, where reading/writing from the connection +handle will not work. + + +* 2003-02-13 Released version 1.3.9 + +This is the first public release. diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/README.txt b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/README.txt new file mode 100644 index 00000000..86114537 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/README.txt @@ -0,0 +1,227 @@ +This is pgintcl/README, describing pgintcl: A PostgreSQL interface in Tcl +Last updated for pgintcl-3.5.1 on 2017-11-12 +The project home page is: http://sourceforge.net/projects/pgintcl/ +----------------------------------------------------------------------------- + +OVERVIEW: + +This is a pure-Tcl interface to the PostgreSQL Database Management System. +It implements almost all the commands in the original libpgtcl, the Tcl +interface which was bundled with PostgreSQL until release 8.0, plus it +has many extensions. But it is written entirely in Tcl, so does not +require compilation for a specific platform or any additional components. + +I originally wrote this to be able to use Tcl/Tk database clients on +platforms where the PostgreSQL client library (libpq) and the Tcl interface +(libpgtcl) were not available, or were too much trouble to build. + +pgin.tcl uses the Tcl binary data and TCP socket features to communicate +directly with a PostgreSQL database server, using the internal PostgreSQL +frontend/backend protocol. Therefore, pgin.tcl is dependent on the +protocol, rather than being protected from its details as are libpq-based +applications. This version of pgin.tcl uses version 3 of the PostgreSQL +protocol, and only communicates with PostgreSQL-7.4 and higher servers. + +pgin.tcl is also highly compatible with pgtcl-ng, the "Next Generation" +libpq-based implementation of the pgtcl interface. pgtcl-ng can be found at + http://sourceforge.net/projects/pgtclng/ +The same test suite is used to verify both interfaces. + +Version 3 of pgin.tcl added Unicode character set encoding and decoding. +It was tested with LATIN1 and UTF8 database encodings, as well as +SQL_ASCII. (Note SQL_ASCII encoded databases are meant for 7-bit ASCII +characters only. Do not use SQL_ASCII databases if your data includes +non-ASCII characters.) It should work with any PostgreSQL database +encoding, but user testing is encouraged. (The previous version 2 of +pgin.tcl does not include character set encoding handling. It may only work +properly with SQL_ASCII encoded databases.) + + +REQUIREMENTS: + + Tcl-8.4.4 or higher, with the latest 8.6.x recommended. + PostgreSQL-9.1.x or higher, with the latest 10.x or 9.6.x recommended. + + Recent testing used the following: + Database server: PostgreSQL-9.6.6 and 10.1. + Client on Linux: Tcl-8.6.5. + Client on Windows XP: ActiveState Tcl-8.6.0 and Tcl-8.5.14 + (Older version of PostgreSQL and Tcl might work but are no longer tested.) + Pgin.tcl should be usable on all platforms with Tcl, however current + testing is limited to 32-bit Linux and Windows platforms. + +CONTENTS: + + Documentation: + Note: In the zip file distribution only, these documentation + files have a ".txt" extension and MS-DOS line endings. + README ........... This file + COPYING .......... The license for pgin.tcl (BSD/Berkeley Open Source) + NEWS ............. Release information and change history + REFERENCE ........ Reference documentation for programmers using pgin.tcl + INTERNALS ........ Some information about the innards of pgin.tcl + + Scripts: + + pgin.tcl ......... This is the complete implementation of the interface. + pkgIndex.tcl ..... Package index file + tkpsql.tcl ....... An example wish script for interactive database querying + + +FEATURES: + ++ Written completely in Tcl ++ Implements virtually all the standard (original, bundled) libpgtcl commands ++ Supports large object manipulation commands ++ Supports listen/notify ++ Supports passing a payload with NOTIFY (PostgreSQL-9.0.0 and higher) ++ Supports replacing the notice handler ++ Supports pg_execute command ++ Supports PostgreSQL MD5 challenge/response authentication ++ pg_result -cmdTuples returns the number of tuples affected by an + INSERT, DELETE, or UPDATE ++ Supports distinguishing NULL database values from empty strings ++ Implements pg_result -list, and pg_result -llist ++ Implements pg_escape_string, pg_quote, pg_escape_literal [New: 3.5.0], and + pg_escape_identifier [New: 3.5.0] for escaping strings. ++ Execute prepared statements with: pg_exec_prepared, including sending + and receiving un-escaped binary data ++ Get PostgreSQL parameters with: pg_parameter_status ++ Get transaction status with: pg_transaction_status ++ Access expanded error message fields with: pg_result -errorField + This was extended [at 2.2.0] to also apply to pg_result -error + for compatibility with pgtcl. More fields were added at 3.5.0. ++ Access extended attribute information with: pg_result -lxAttributes ++ Get command status tag with pg_result -cmdStatus [New: 2.0.1] ++ Separate parse and execute with: pg_exec_params, binary safe [New: 2.1.0] ++ Escape/unescape bytea with: pg_escape_bytea, pg_unescape_bytea [New: 2.2.0] ++ Return query results as a dictionary with pg_result -dict [New: 3.3.0] ++ Access to process ID (PID) of backend and in notifications [New: 3.4.0] ++ Connect via postgresql:// URI, or keyword/value Tcl list [New: 3.5.0] ++ Supports 64-bit offsets in large objects [New: 3.5.0, PostgreSQL-9.3.0 and up] + + +LIMITATIONS and DIFFERENCES: + ++ pg_connect does not support the older method using a separate dbname plus + options for host, port. ++ Does not support $HOME/.pgpass password file. ++ Only talks to v3 backend (PostgreSQL 7.4 or higher required). ++ Uses only TCP/IP sockets (defaults host to localhost, PostgreSQL server must + be listening on TCP sockets). Does not support Unix Domain sockets. ++ Notification messages are only received while reading query results. ++ Performance isn't great, especially when retrieving large amounts of data. ++ The values of connection handles and result handles are of a different + format than other implementations, but nobody should be relying on these. ++ No pg_on_connection_loss (New at PostgreSQL 7.3). ++ No asynchronous query commands (found in pgtcl and pgtcl-ng). ++ Support for COPY FROM/TO is not compatible with other versions of the + interface - must use pg_copy_read and pg_copy_write, no I/O directly to + connection handle. ++ With other pgtcl's, you can have up to 128 active result structures (so leaks + can be caught). pgin.tcl has no limits and will not catch result structure + leaks. ++ [Added at 2.1.0] Do not use "return -code N" (for N>4) in the script + body for pg_select or pg_execute, because the effect is not well defined. + You can safely use return, break, continue, and error (either directly + or via return -code). ++ [Added at 2.2.0] pg_escape_bytea (and pg_unescape_bytea, to a + lesser extent) is quite slow. Using it on large bytea objects is not + recommended; you should use binary prepared queries instead. ++ [Added at 3.1.0] Whether or not you use the $conn argument to the string + and bytea escape routines, pgin.tcl does not use encoding-aware escaping. + This also applies to pg_escape_literal and pg_escape_identifier [at 3.5.0]. ++ [Added at 3.2.0] pg_escape_bytea always uses the older 'escape' encoding + in the returned result, never the newer 'hex' encoding. + + +RELEASE ISSUES: + +Version 3.5.0 added new commands based on more recent Libpq functions, but +some of these will only work when connected to a PostgreSQL-9.3.0 server. This +includes 64-bit Large Object offset commands, and new error field codes. +Also starting with this release, single-character error field codes in +"pg_result -error" and "pg_result -errorField" are now case sensitive. This +incompatible change was necessary due to changes in PostgreSQL-9.3.0. + +Versions 3.4.0 and up handle notification names (also known as channel +names) in pg_listen differently from previous versions. This can result in +compatibility problems if you used mixed-case names in pg_listen. Starting +with version 3.4.0, pgintcl folds the channel name to lower case unless it +is in double quotes. This now matches the behavior of pgtcl-ng. See the +REFERENCE file and pgintcl bug #2 (old #3410251) for more details. + +Versions 3.3.0 and up require Tcl 8.4 or higher. Previous versions checked +for Tcl 8.3 or higher, but were not actually tested with Tcl 8.3. + +Versions 3.2.0 and up pass a payload argument to a notification listener handler +procedure if a non-empty payload was provided in the SQL NOTIFY command. +See the NEWS file for more information and compatibility issues. + +Version 3 does encoding and decoding of character data, as described in +the REFERENCE file. It also sets the PostgreSQL parameter +CLIENT_ENCODING to UNICODE when a connection is opened to the server. This +is the same behavior as Pgtcl and pgtcl-ng. This informs PostgreSQL that +UNICODE data (encoded as UTF-8) will be sent and received. + +Note that the client application using pgin.tcl can have any encoding +which Tcl supports. Tcl converts between the client encoding and Unicode, +and the PostgreSQL server converts between Unicode and the database +encoding. This assumes the database encoding is other than SQL_ASCII. + + * * * CAUTION * * * + + Do not store non-ASCII characters in character or text fields in a + PostgreSQL database which was created with encoding SQL_ASCII. + The SQL_ASCII encoding provides no information to PostgreSQL on + how to translate characters, so the server will be unable to + translate. Applications using a Tcl interface, including + pgin.tcl, will encode these characters using UTF-8 for storage + in the database, but PostgreSQL will not know it due to the + SQL_ASCII encoding setting. The result is that it may be + impossible to access the data correctly from other applications. + Always use the correct encoding when creating a database: for + example, LATIN1 or Unicode. + + Pgin.tcl-2.x and older do not convert to/from Unicode and do not set + client_encoding at all. These older versions may not work with non-ASCII + characters in any database encoding. + + At this time, Pgin.tcl does not recode the connection string parameters + such as Username, Database Name, or Password. Non-ASCII characters in these + fields will probably not work. + + +Older Information: + +There are some incompatibilities between this release and pre-2.0.0 releases: + + pg_parameter_status can no longer fetch all parameters at once; + + "pg_configure nulls" option is no longer available. The only way + to distinguish NULL from empty string now is with pg_result -getNull. + + Changes in large object call error handling. + + COPY FROM/TO must use pg_copy_read/pg_copy_write; you cannot read or + write copy data from the connection. +You will have to change your application if it relies on behavior which +changed. See the file NEWS for more information. + + +INSTALLATION AND USAGE: + +There is no install script. Just copy the script "pgin.tcl" anywhere your +application can access it. In your application, insert "source .../pgin.tcl" +at the top level, where ... is the directory. This must be run at the top +level, so if you need it inside a proc use uplevel as shown below. + +Optionally, you can install and use pgin.tcl as a Tcl package. You should +copy pgin.tcl and pkgIndex.tcl into a sub-directory of your Tcl +installation package library root directory (or you can extend auto_path: +see the Tcl documentation for the 'package' and 'pkgMkIndex' commands). +Then your application can load pgin.tcl with the following: + package require pgintcl + + +You can use the included "tkpsql.tcl" script to try it out. This is a +simple interactive GUI program to issue database queries, vaguely like the +Sybase ASA "dbisql" program. On **ix systems, type "wish tkpsql.tcl" to +start it; under Windows you should be able to double click on it from +Explorer. You need to press F1 or click on the Run button after each query. diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/REFERENCE.txt b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/REFERENCE.txt new file mode 100644 index 00000000..6ad9fc8e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/REFERENCE.txt @@ -0,0 +1,1081 @@ +This is pgintcl/REFERENCE, programmer's reference to pgintcl. +Last updated for pgintcl-3.5.1 on 2017-11-12 +The project home page is: http://sourceforge.net/projects/pgintcl/ +----------------------------------------------------------------------------- + +This is a concise reference to pgin.tcl commands in the version indicated +above. For more information on the details of the commands, refer to the +Pgtcl Reference Manual available with the pgtcl-ng project at + http://sourceforge.net/projects/pgtclng/ +Pgin.tcl attempts to emulate the command usage and behavior of pgtcl-ng +wherever possible. + +(Note: The syntax ?...? refers to optional values, per the Tcl documentation.) + + +CORE COMMANDS: + +pg_conndefaults + + Get the connection parameter defaults. + + Returns: + A list of elements. Each element describes one connection parameter + in the following form: + { OptionName Display-label display-flag display-length default-value } + For example, for the "user" parameter: { user Database-User {} 20 yourname } + + +pg_connect -conninfo conninfo +pg_connect -connlist connlist + + Connects to a database. There are 3 ways to specify the connection + information (server host, port, credentials): Using -conninfo and + a connection string, using -connlist and a connection list, or using + -conninfo and a PostgreSQL connection URI. + + (The older form with separate dbname argument followed by options + is not supported.) + + A connection string contains a series of 'option=value' entries, + separated by spaces. Commonly used connection option names are: + dbname host port user password + Values need to be in single quotes if they contain spaces. + Within single quoted values, use \\ for \ and \' for '. + Note: pgintcl supports a much more limited set of options, compared + to libpq. Use [pg_conndefaults] to see the list. + + A connection list is a Tcl list with alternating option name and option + values. This form does not require special quoting or escaping, provided + it is a proper Tcl list. + + A PostgreSQL connection URI has the form: + postgresql://username:password@hostname:port/dbname + The usual URI-escaping needs to be used (RFC 3986), for example if the + password contains a : it must be written as %3A. More can be found in + the libpq chapter in the PostgreSQL manual, but note pgintcl does not + process URI options (param=value pairs after a '?' in the URI). + + Values default to environment variables or built-in defaults. + Host defaults to the environment variable PGHOST, or to "localhost" + if no PGHOST. (pgtcl-ng defaults to using a Unix Domain Socket + in that case, but pgintcl does not support UDS.) + + Returns: + A connection handle which is used with all other commands to access the + database. + + Notes: + No attempt is made to convert connection parameters such as username + or database name between character sets. Non-ASCII characters in these + parameters may not work properly. + +pg_disconnect db + + Disconnect from database. Also destroys any left-over result + structures associated with this connection. + + Parameters: + db Connection handle to close + + +pg_select db query arrayName script + + Execute a query and iterate a command script over each result row. + + Parameters: + db Connection handle + query Query to execute, almost always a SELECT + arrayName Name of an array variable. For each row, each column value + is assigned to an element of this array with the column + name as the index. + script A command script to execute for each row. The script + can use break, continue, error, and return. + + +pg_exec db query ?args...? + + Execute SQL and return a result handle. + If optional args are supplied, they replace parameters in the query + (written as $1, $2, etc. - remember to escape the $ for Tcl). This can + be used to insert parameters in SQL without concern for quoting or escaping. + It only works with text arguments - it is not binary safe. See also + pg_exec_params. + + Parameters: + db Connection handle + query Query to execute + args... Optional argument values to replace $1, $2, etc. in the query. + + Returns: + A result handle for use with pg_result. Must be freed when no longer + needed. + + +pg_execute ?-oid oidName? ?-array arrayName? db query ?script? + + Execute SQL and optionally iterate a script over the rows. + This command can replace both pg_exec and pg_select in many cases. + If -array is not given on a Select, a variable is created for + each field in the query result. + If no proc is supplied, only the first query result row is saved. + + Options: + -oid oidName A variable to receive the OID of an inserted row + -array arrayName An array variable name to store each row into + + Parameters: + db Connection handle + query Query to execute + script Optional command script to execute for each row. + The script can use break, continue, error, and return. + + Returns: + The number of tuples queried or affected by the command. + + +pg_result result option ?args? + + Get information about a result. The option indicates the desired + information, which is returned by the command. + + Parameters: + result A result handle returned by pg_exec, pg_exec_prepared, + or pg_exec_params. + option One of the command options listed below. + args option-dependent command arguments. + + Returns: + Depends on the command option + + Options: + -status Returns the result status (see notes) + -error ?c? Returns the error message if no code 'c' is provided, + or a error field if a code is provided (see below). + [Before 2.2.0, did not support optional 'c' parameter] + -errorField ?c? Same as -error + [Before 2.2.0, the 'c' parameter was required] + -conn Returns the connection handle for this result + -oid Returns the OID of an inserted tuple + -numTuples Returns the number of tuples in the result + -numAttrs Returns the number of attributes + -assign A Assign the query result data to A(tuple,attribName) + -assignbyidx A s Assign results to an array (see the pgtcl-ng docs) + -getTuple N Return a list of values for tuple N + -getNull N Returns a list of NULL flags for tuple N + -tupleArray N A Store the Nth tuple in array A as A(attribName) + -attributes Returns a list of attributes + -lAttributes Returns a list of attributes as {{name type size}...} + -lxAttributes Returns a list of extended information about + attributes as: {{name type size size_modifier + format table_OID table_column}...} + -cmdTuples Returns the number of tuples INSERTed, DELETEd, UPDATEd + -cmdStatus Returns the command status tag. + -list Returns the result set as a list of values. + -llist Returns the result set as a list of tuple data, each + of which is a list of values. + -numParams Returns the number of parameters in a prepared query. + Only for use with a result from pg_describe_prepared. + -paramTypes Returns a list of type OIDs for the parameters in + a prepared query. + Only for use with a result from pg_describe_prepared. + -clear Deallocate the result structure. Returns nothing. + -dict Returns the query results as a Tcl dictionary. + + Notes: + Result status from pg_result -status is one of these string values: + PGRES_TUPLES_OK PGRES_COMMAND_OK PGRES_FATAL_ERROR + PGRES_COPY_OUT PGRES_COPY_IN PGRES_EMPTY_QUERY + + -oid returns 0 if the query was not an INSERT. + + -cmdTuples is an extension that emulates libpq PQcmdTuples. + It is intended to return the number of rows affected by an SQL + command that modifies rows, and returns an empty string for other + commands. However, in PostgreSQL-9.0.0 and higher libpq also returns + the number of rows from a SELECT query. Older releases returned + an empty string for SELECT. + For the most compatibility, you should always use -numTuples after + SELECT queries, and -cmdTuples after other data modification queries. + + -cmdStatus is an extension which returns the command status tag. + This is the SQL command (for example: "INSERT", "CREATE") possibly + followed by additional data (such as the number of rows affected). + + -errorField is an extension to access error message subfields. + As of 2.2.0, the error field name or code is optional in -errorField, + and can also be supplied to pg_result -error. So -error and + -errorField are now equivalent. The optional field name + or code can be one of the following: + + Field name: Alias: Code: Notes: + SEVERITY S Error severity, e.g. ERROR or FATAL + SQLSTATE C 5-character SQL State code + MESSAGE_PRIMARY PRIMARY M Primary error message + MESSAGE_DETAIL DETAIL D Secondary / detailed message + MESSAGE_HINT HINT H Hint, or suggestion + STATEMENT_POSITION POSITION P Decimal integer cursor position + CONTEXT W Error context, or call stack-trace + SOURCE_FILE FILE F PostgreSQL source code filename + SOURCE_LINE LINE L PostgreSQL source code line number + SOURCE_FUNCTION FUNCTION R PostgreSQL function name + SCHEMA_NAME s Schema name of the effected object + TABLE_NAME t Table associated with the error + COLUMN_NAME c Column associated with the error + DATATYPE_NAME d Datatype associated with the error + CONSTRAINT_NAME n Constraint name + + (Aliases were added for compatibility with another implementation.) + + Field names are not case sensitive. + Starting with pgtclng-2.1.0 and pgintcl-3.5.0, the single character + codes are case sensitive. (In prior releases they worked in either + upper or lower case). This change was necessary when the new codes + for Schema, Table, Column, Constraint, and Datatype were added. + + If the field name or code is defined, pg_result returns + the value of that field (if available), else an empty string. + Do not assume that any given error field is available for any specific + error. The PostgreSQL server decides which fields to supply for each + error condition, and does not necessarily supply the fields that you + might expect. + + Note: pg_result -error or -errorField without a code returns the + SEVERITY followed by the MESSAGE_PRIMARY as a single string. + + -lxAttributes is an extension. It returns the same information as + -lAttributes plus additional information provided by the PostgreSQL + server about the result attributes. + + -getNull is an extension. It returns a list with a flag for each column + in the tuple. The flag is 1 is the column value is NULL, else 0. + This gives you a way to tell if a database result column is NULL, + which otherwise looks the same as an empty string. + + -numParams and -paramTypes are extensions (pgin.tcl-3.1.0). They return + information about a prepared query, from a result structure returned + by pg_describe_prepared. If used on a result structure that comes + from any other command, the options return 0 and an empty list + respectively. + + -dict is an extension (pgintcl-3.3.0). It only works with Tcl 8.5 or + higher, since older versions do not support dictionaries. The returned + value is a Tcl dictionary with one entry for each query result row, + using the zero-based row number as the key. The value of each entry + is a dictionary containing field names as keys, and field values + as values. For an example of usage, if 'd' is a dictionary + returned by pg_result -dict, [dict get $d 5 name] returns the + value of the 'name' column in the 6th result row. + +pg_listen ?-pid? db name ?script? + + Listen for PostgreSQL notifications and call a procedure proc, or unlisten. + See NOTIFICATIONS below. + + Parameters: + -pid Option indicating notifying PID should be passed to script. + db Connection handle + name Notification condition name to start or stop listening for + script If provided, command script to call when notification + arrives. If not provided, clear current notification + listen for condition 'name'. + Note PostgreSQL-9.0 documentation refers to the 'name' as + a 'channel'. + The script should accept an optional 'payload' argument, + which will be provided if the SQL NOTIFY command includes + a non-empty payload. This requires PostgreSQL-9.0.0 or + higher, and pgin.tcl-3.2.0 or higher. + If the -pid option is used, the script should also accept + a PID argument before the payload argument. + + +pg_escape_string ?db? str + + Escape a string for including in SQL strings. That is, returns str with + single quotes doubled up, and possibly backslashes doubled too. + See also pg_quote. + + Parameters: + db Optional database connection handle (see notes) + str String to escape + + Returns: + The escaped string. + + Notes: + The behavior of pg_escape_string in pgin.tcl (and pgtcl-ng) is not + compatible with the behavior in another Pgtcl implementation, + where pg_escape_string is now synonymous with pg_quote. + + The optional db argument, if supplied, is used to determine the + standard_conforming_strings setting for the database, and that is used + to determine if backslashes need to be doubled. If no db argument is + given, the setting used is that of the most recent connected database + (or the one with a most recently changed standard_conforming_strings + setting). + + Libpq-based interfaces also use db to determine the character set + encoding, in order to properly handle multibyte sequences and avoid + a possible security issue. Pgin.tcl does not have this capability. + + +pg_quote ?db? str + + Escape a string for including in SQL strings, and return it with leading + and trailing quotes. These commands are equivalent: + set s '[pg_escape_string $str]' + set s [pg_quote $str] + See also pg_escape_string. + + Parameters: + db Optional database connection handle (see notes) + str String to escape + + Returns: + The escaped string inside single quotes. + + Notes: + The optional db argument, if supplied, is used to determine the + standard_conforming_strings setting for the database, and that is used + to determine if backslashes need to be doubled. If no db argument is + given, the setting used is that of the most recent connected database + (or the one with a most recently changed standard_conforming_strings + setting). + + Libpq-based interfaces also use db to determine the character set + encoding, in order to properly handle multibyte sequences and avoid + a possible security issue. Pgin.tcl does not have this capability. + + +pg_escape_identifier db str + + Escape and quote a string for use as an SQL identifier (for example, a + table or column name). The return value includes opening and closing + double quotes. + + Parameters: + db Database connection handle (ignored) + str String to escape + + Returns: + The escaped string inside double quotes. + + Notes: + The db argument is required, but ignored by Pgin.tcl. + Libpq-based interfaces use db to determine the character set + encoding, in order to properly handle multibyte sequences and avoid + a possible security issue. Pgin.tcl does not have this capability. + + +pg_escape_literal db str + + Escape and quote a string for use as an SQL literal (string constant). + The return value includes opening and closing quotes. This is functionally + equivalent to pg_quote (see above), but implemented differently, and the + result is independent of the setting of standard_conforming_strings. + + Parameters: + db Database connection handle (ignored) + str String to escape + + Returns: + The escaped string inside single quotes. + + Notes: + The db argument is required, but ignored by Pgin.tcl. + Libpq-based interfaces use db to determine the character set + encoding, in order to properly handle multibyte sequences and avoid + a possible security issue. Pgin.tcl does not have this capability. + + +pg_escape_bytea ?db? binstr + + Escape a binary string for including in SQL strings, intended for use + with bytea (byte array) columns. + + Parameters: + db Optional database connection handle (see notes) + binstr String to escape. This can contain arbitrary binary data. + + Returns: + The escaped string. Put it in single quotes when using in SQL. + + Notes: + This is slow on large strings. Consider using binary prepared queries + instead. + + The optional db argument, if supplied, is used to determine the + standard_conforming_strings setting for the database, and that is used + to determine if backslashes need to be doubled. If no db argument is + given, the setting used is that of the most recent connected database + (or the one with a most recently changed standard_conforming_strings + setting). + + PostgreSQL-9.0.0 introduced a new hex encoding format, but pgin.tcl + always uses the older escape encoding with pg_escape_bytea. + + +pg_unescape_bytea str + + Unescape a string coming back from a PostgreSQL query on a bytea (byte + array) column, and return the original binary string. + + Parameters: + str String to unescape. This should be the result of a + query on a bytea column; other uses are undefined (see notes) + + Returns: + The unescaped binary string. + + Notes: + Consider using binary prepared queries instead, for better performance. + + This command does not fully emulate the corresponding libpq function + PQunescapeBytea, and will return different results for some strings. + But it is designed to return the correct data for all strings which can + possibly be returned by a PostgreSQL server in response to a query on a + bytea column. So it should act correctly when used in the intended way. + + This command can decode both 'escape' and 'hex' mode encodings, so it + will work with PostgreSQL-9.0.0 and new servers even with the default + bytea_output='hex' setting. Older versions of pgin.tcl may not properly + decode hex mode data, nor will they detect the error. + + +pg_encrypt_password password username + + Encrypts a password for the given username, in the same way that the + PostgreSQL server does. This is intended for use with commands like + ALTER USER which can take a pre-encrypted password. + + Parameters: + password The password string to encrypt + username The username that goes with the password to encrypt + + Returns: + The encrypted password string, which looks like this: "md5..." + +----------------------------------------------------------------------------- +EXTENSIONS: + +pgin.tcl has some extended commands and variables. +These commands do not exist in the original libpgtcl which was bundled with +PostgreSQL, and may not exist in other implementations of the Pgtcl interface. + + +pg_notice_handler db ?command? + + Query or set a command to handle Notice or Warning messages. + If the command is supplied, sets the handler to that command, and + returns the previous command. If the command is not supplied, + returns the current handler command. See NOTICES below. + + Parameters: + db Connection handle + command Command to execute on receipt of notice or warning + + Returns: + The previous handler command + + +pg_endcopy result + + This must be called after SQL COPY FROM or COPY TO completes. + See COPY FROM/TO below. + + Parameters: + result Result handle on which a COPY is done. + + +pg_copy_read result + + Read the next line (record) for SQL COPY TO STDOUT. Returns the line + read, or an empty string when COPY is done. The returned line does + not end in a newline, so you can just split it on tab to get the + column values. With PostgreSQL-7.4 support, you must use this + routine for COPY TO STDOUT; reading from the socket no longer works. + + Parameters: + result Result handle on which a COPY is active. + + Returns: + The line read from the server, or empty when done. + + +pg_copy_write result line + + Write one line (record) $line for SQL COPY FROM STDIN. + The passed argument must not end in a newline. + With PostgreSQL-7.4 support, you must use this routine for + COPY FROM STDIN; writing to the socket no longer works. + + Parameters: + result Result handle on which a COPY is active. + line One record to write to the server. + +$pgtcl::version + This variable has the pgin.tcl version number. The existence of + this variable can also be used to determine if pgin.tcl has been loaded. + Note: This is deprecated in favor of using Tcl's package management. + Use [package present pgintcl] to test for pgin.tcl and get its version. + + +pg_callfn db fname result arginfo arg... +pg_callfn_int db fname arginfo arg... + + These two commands allow access to the PostgreSQL back-end "fast-path" + function call interface. This is not intended for routine use. + See the INTERNALS document for more information. + + +pg_parameter_status db param + + Fetch the value of a parameter supplied by a PostgreSQL-7.4 or higher + backend. Returns the value of the named parameter (or an empty string + if no such parameter has been sent by the backend). The following + parameters are commonly sent by the backend: + client_encoding DateStyle is_superuser server_encoding + server_version session_authorization + + Parameters: + db Connection handle + param Name of the parameter to get the value of + + +pg_exec_params db query res_formats arg_formats arg_types arg... + + Parse SQL statement, bind parameters, and execute statement. + This is similar to pg_exec_prepared (see below), but doesn't use a + pre-prepared statement, and if you want to binary parameters you + must also provide the type OIDs. + + res_formats is a list (but see note below) describing the query result + columns, and arg_formats is a list describing the query parameter formats, + as follows. An empty list means all parameters or result columns are text + (or, that there are no parameters/result columns). A single word "TEXT" + (or "T"), or "BINARY" (or "B"), indicates the format of all parameters or + of all result columns. Finally, a list of those words indicates the format + of each individual parameter or result column. For example: + {} All text format + T All text format + T B One text, one binary format + B B B Three binary format + + Parameters: + db Connection handle + query Query to execute, may contain parameters $1, $2, ... + res_formats A list describing results: B* => binary, else text + arg_formats A list describing args: B* => Binary, else Text. + arg_types A list of type OIDs for each argument (if Binary). + args Variable number of arguments to bind to the query params. + Returns: + A result handle, for use with pg_result. + + Notes: + There is no support for passing NULL arguments + + If there are any binary format arguments, an arg_type must be specified + for each argument, although the value will be ignored for each text + format argument. + + libpq does not support mixed Text/Binary result columns in prepared + queries. Although pgin.tcl does, this is not recommended because it + will not be compatible with libpq-based versions of the pgtcl interface. + So the res_formats argument should contain at most a single word. + + +pg_exec_prepared db stmt_name res_formats arg_formats arg... + + Executes a pre-prepared SQL statement with text and/or binary parameters + and text and/or binary result columns. Parameter place-holders in the + prepared statement are designated $1, $2, etc. + This allows binding arguments to SQL statement parameters without + quoting problems, and sending and receiving raw binary data. + + The statement must be prepared with the SQL command + PREPARE statement_name (args) AS ... + + res_formats is a list (but see note below) describing the query result + columns, and arg_formats is a list describing the query parameter formats, + as follows. An empty list means all parameters or result columns are text + (or, that there are no parameters/result columns). A single word "TEXT" + (or "T"), or "BINARY" (or "B"), indicates the format of all parameters or + of all result columns. Finally, a list of those words indicates the format + of each individual parameter or result column. (See pg_exec_params) + + Parameters: + db Connection handle + stmt_name Name of a pre-prepared SQL statement + res_formats A list describing results: B* => binary, else text + arg_formats A list describing args: B* => Binary, else Text. + args Variable number of arguments to bind to the query params. + + Returns: + A result handle, for use with pg_result. + + Notes: + There is no support for passing NULL arguments + + libpq does not support mixed Text/Binary result columns in prepared + queries. Although pgin.tcl does, this is not recommended because it + will not be compatible with libpq-based versions of the pgtcl interface. + So the res_formats argument should contain at most a single word. + + +pg_transaction_status db + + Returns the current in-transaction status. + + Parameters: + db Connection handle + + Returns: + The status - one of the following strings: + IDLE (Connection is idle, not in a transaction) + INTRANS (Connection is idle, in a valid transaction block) + INERROR (Connection is in a failed transaction block) + UNKNOWN (Connection is bad or in an unknown state) + + +pg_describe_prepared db stmt_name + + Get a result structure with information about a prepared statement. + + Parameters: + db Connection handle + stmt_name The name of an existing prepared statement. (See the SQL + PREPARE command.) + + Returns: + A result handle for use with pg_result. Must be freed when no longer + needed. + + Notes: + The returned result structure will have no data rows, only attribute + (column) information, and parameter information, and the status will + be PGRES_COMMAND_OK if successful. If the prepared statement has + parameters, then information about the parameters is available using + pg_result -numParams and pg_result -paramTypes. + + +pg_describe_cursor db cursor_name + + Get a result structure with information about a cursor (portal). + + Parameters: + db Connection handle + cursor_name The name of an existing cursor. (See the SQL DECLARE + command.) Note the PostgreSQL documentation refers to + cursors as 'portals'. + + Returns: + A result handle for use with pg_result. Must be freed when no longer + needed. + + Notes: + The result structure will have no data rows, only attribute + (column) information, and the status will be PGRES_COMMAND_OK if + successful. + + +pg_backend_pid db + + Get the backend process ID (PID). + + Parameters: + db Connection handle + + Returns: + A process ID. This is an integer, and uniquely identifies this client + connection from all others connected to the same PostgreSQL server. + + Notes: + The returned value is a PID on the server, not client. + + +pg_server_version db + + Get the PostgreSQL server software version as an integer. + + Parameters: + db Connection handle + + Returns: + An integer representing the PostgreSQL server's version (that is, the + version of PostgreSQL running on the server for this connection handle.) + This is a representation of the same information in the server_version + parameter (see pg_parameter_status). For PostgreSQL releases through 9.x, + there are are two digits allocated to each of the major, minor, and + release levels. For example, if connected to a PostgreSQL-9.6.5 server, + the return value is 90605. For PostgreSQL releases starting with 10.x, + there are 2 digits for the major version, 2 digits of 0, and 2 digits + for the minor version. For example, if connected to a PostgreSQL-10.1 + server, the return value is 100001. + +----------------------------------------------------------------------------- +LARGE OBJECTS: + +pgin.tcl implements the Large Object commands of libpgtcl. + +Remember that these routines must be used inside transactions. Also note +that you, not PostgreSQL, are responsible for tracking the large objects by +their OIDs in your database schema tables. So for example you will +generally have to pair a database INSERT with a pg_lo_creat, and a database +DELETE with a pg_lo_unlink. + +All of the Large Object commands throw a Tcl error if an error occurs, with +the exception of pg_lo_read and pg_lo_write, which return -1 on error. +This is inconsistent, but the read and write commands were already +documented in the PostgreSQL manual to return -1 on error, so that is how +pgin.tcl implements them. Error behavior of the other routines was not +documented; as coded some returned a negative number and some threw an +error. The decision to have the pgin.tcl implementation of these commands +always throw a Tcl error was made because otherwise there is no way to get +at the error message text. It is possible that future versions of the +interface will also have pg_lo_read and pg_lo_write throw a Tcl error if an +error occurs. + + +pg_lo_creat db mode + + Create a large object. Mode should be one of the strings INV_READ, + INV_WRITE, or INV_READ|INV_WRITE, although to be honest I do not know + what the difference is. As an extension, to be compatible with pg_lo_open, + this command also accepts mode of "r", "w", or "rw". + + Parameters: + db Connection handle + mode Mode to create large object: INV_READ|INV_WRITE + + Returns: + A large object OID, which you should promptly insert into a table. + + +pg_lo_open db loid mode + + Open a large object and returns a large object file descriptor. + Mode can be "r", "w", or "rw" specifying read and/or write. As an + extension, to be compatible with pg_lo_creat and libPQ, this command + also accepts mode of INV_READ, INV_WRITE, or "INV_READ|INV_WRITE". + The $loid usually comes from the return value of pg_lo_creat directly, + or indirectly as an oid-type field in a table. + + Parameters: + db Connection handle + loid Large Object ID identifying the large object to open + mode Mode to open large object in: "r", "w", "rw" + + Returns: + A large object file descriptor (a lofd) for use with the commands below. + + +pg_lo_close db lofd + + Close a large object opened with pg_lo_open. + + Parameters: + db Connection handle + lofd Large Object file descriptor to close + + +pg_lo_unlink db loid + + Delete a large object. + + Parameters: + db Connection handle + loid Large Object ID identifying the large object to delete + + +pg_lo_read db lofd buf_name maxlen + + Read from a large object. + + Parameters: + db Connection handle + lofd Large Object file descriptor to read from + buf_name Name of the buffer variable to read into + maxlen Maximum number of bytes to read from the large object + + Returns: + The number of bytes actually read, 0 on end of large object, -1 on error. + + +pg_lo_write db lofd buf len + + Write to a large object. + + Parameters: + db Connection handle + lofd Large Object file descriptor to write to + buf Buffer containing data to write to the large object + len Maximum number of bytes to write from buf to the large object. + (If buf has fewer than len bytes, just write all of buf.) + + Returns: + The number of bytes actually written, -1 on error. + + +pg_lo_lseek db lofd offset whence +pg_lo_lseek64 db lofd offset whence + + Reposition the (virtual) file position pointer in a large object. + + Parameters: + db Connection handle + lofd Large Object file descriptor to position + offset New position, interpreted per "whence" + whence Position mode: SEEK_SET, SEEK_CUR, or SEEK_END specifying + that offset is a byte count relative to start of large object, + current position, or end of large object respectively. + + Notes: + pg_lo_lseek64 is identical to pg_lo_lseek except that the 'offset' + parameter can be a larger value than fits in 32 bits. + Use pg_lo_lseek64 with large objects that can exceed 2GB in size. + pg_lo_lseek64 only works when connected to a PostgreSQL-9.3.0 or higher + server. + + +pg_lo_tell db lofd +pg_lo_tell64 db lofd + + Get the current large object position pointer. + + Parameters: + db Connection handle + lofd Large Object file descriptor to get position of. + + Returns: + The integer (virtual) file offset of the current file position + pointer in the large object. + + Notes: + pg_lo_tell64 is identical to pg_lo_tell except that the return value + can be a larger value than fits in 32 bits. + Use pg_lo_tell64 with large objects that can exceed 2GB in size. + pg_lo_tell64 only works when connected to a PostgreSQL-9.3.0 or higher + server. + + +pg_lo_import db filename + + Create a new large object, and import the contents of a file into it. + + Parameters: + db Connection handle + filename Pathname of a file to import as a large object + + Returns: + A large object OID, which you should promptly insert into a table. + + +pg_lo_export db loid filename + + Export a large object and write its contents into a file. + + Parameters: + db Connection handle + loid Large Object ID identifying the large object to export + filename Pathname of a file to export the large object into + + +pg_lo_truncate db lofd len +pg_lo_truncate64 db lofd len + + Truncate a large object to a specified size. + + Parameters: + db Connection handle + lofd Large Object file descriptor to get position of. + len New length in bytes for the large object. + + Notes: + pg_lo_truncate only works when connected to a PostgreSQL-8.3.0 or + higher server. + pg_lo_truncate64 is identical to pg_lo_truncate except that the 'len' + parameter can be a larger value than fits in 32 bits. + Use pg_lo_truncate64 with large objects that can exceed 2GB in size. + pg_lo_truncate64 only works when connected to a PostgreSQL-9.3.0 or higher + server. + +----------------------------------------------------------------------------- +NOTICES: + +If the backend sends a notice or warning message, the notice handler will +be executed with the text of the notice as the final parameter. The default +procedure just prints the message to stderr (like libpq does). You may +replace this by defining your own procedure and using the command: + pg_notice_handler $conn_handle "notice_command ..." +The actual message will be appended as an additional argument to your +command. + +If you want to suppress notice and warning messages completely, you can set +the notice handler to an empty string. For example, if you need to +temporarily suppress notices and warnings, use something like this: + set save_handler [pg_notice_handler $conn_handle {}] + ... commands with no notice or warning messages reported ... + pg_notice_handler $conn_handle $save_handler +But note that a better way to ignore NOTICE messages is to increase the +message threshold with: SET CLIENT_MIN_MESSAGES TO WARNING + +Don't confuse Notices with Notification. Notice and warning messages are +generated by the server in response to a command from the client, but do +not imply failure of the command so they don't affect the result status. +An example of a notice is index creation as a result of creating a table +with a primary key. An example of a warning is if ROLLBACK is issued +outside a transaction. By contrast, notifications are messages sent on +behalf of another database client. + +Previous versions of this interface used the following syntax instead: + pg_configure $conn_handle notice "notice_command ..." +This is still supported but deprecated. + +----------------------------------------------------------------------------- +NOTIFICATIONS: + +Support for backend notifications differs from pgtcl-ng. With pgtcl-ng, the +notification will be received as soon as Tcl enters the idle loop, e.g. if +you use "update". pgtcl-ng does not need to be reading from the backend to +get a notification. With pgin.tcl, the notification from the backend will +only be seen while something is being read from the backend; that is, +during pg_exec, pg_select, or pg_execute processing. After a notification +is read, it will be delivered the next time Tcl enters the idle loop. + +If pg_listen is used without the -pid option, the handler command should +be declared like this (not counting any additional, fixed arguments +supplied in the pg_listen command): + proc notification_handler {{payload ""}} { ... } +If pg_listen is used with the -pid option, the handler command should +be declared like this: + proc notification_handler {pid {payload ""}} { ... } + +Starting with pgin.tcl-3.4.0, the notification name (called 'channel name' +in PostgreSQL-9.0 and up) is treated in the same manner as SQL regarding case +sensitivity. That is, it is converted to lower case unless it is placed in +double quotes. Note this means an additional level of quotes, not counting +those used by the Tcl parser. If the name is in double quotes, the quotes +are stripped and the case is preserved. This means the following 3 listen / +notify pairs will work: + + 1) Pgtcl: pg_listen $db mychannel mycommand + SQL: NOTIFY mychannel; or NOTIFY MYCHANNEL; or NOTIFY MyChannel; + + 2) Pgtcl: pg_listen $db MYCHANNEL mycommand + SQL: same notifications as case #1 work. + + 3) Pgtcl: pg_listen $db {"MyChannel"} ... + SQL: NOTIFY "MyChannel"; + +This will not work, because PostgreSQL will downcase the notification chanel +name in the NOTIFY command, and it will not match the listening name: + 4) Pgtcl: pg_listen $db {"MyChannel"} ... + SQL: NOTIFY MyChannel; + +Note: pgtclng has always worked this way, downcasing the name unless it +was in double quotes. Pgin.tcl-3.3.0 and earlier always preserved case +on the name, and did not handle quoted names. For maximum compatibility, +use lower case names with pg_listen and NOTIFY. + +----------------------------------------------------------------------------- +COPY FROM/TO: + +Front-end copy is a bulk import or export operation where multiple rows +are sent between the PostgreSQL back-end and client front-end with minimal +formatting. This is implemented in PostgreSQL with the following SQL: + COPY tablename TO STDOUT; -- Export table + COPY tablename FROM STDIN; -- Import table +Each row is transmitted as one line, with columns separated by a delimiter +which defaults to tab, backslash (\) escaping of control characters, and +\N used for NULL. + +(Note: You never have to use COPY FROM/TO. You can always use the standard +SQL SELECT and INSERT instead. COPY FROM/TO is said to be more efficient +for large amounts of data.) + +The COPY protocol changed with PostgreSQL-7.4, and it is no longer possible +to directly read and write to the connection handle as with previous +versions of pgin.tcl. You must use the routines below to read and write +records during COPY. This is currently incompatible with libpgtcl. + +To copy out a table, first issue "COPY tablename TO STDOUT" using pg_exec. +The result status will change to PGRES_COPY_OUT. Then use pg_copy_read to +read each record. Returned records will not end in a newline. Repeat +pg_copy_read until it returns an empty string, then execute pg_endcopy. +For example: + + while {[set line [pg_copy_read $result_handle]] != ""} { + ... Process record in $line ... + } + pg_endcopy $result_handle + +After pg_endcopy returns, the result status should be PGRES_COMMAND_OK if +the copy was successful. + +To copy in a table, first issue "COPY tablename FROM STDIN" using pg_exec. +The result status will change to PGRES_COPY_IN. Then use pg_copy_write to +write each record. Do not append a newline to the record. Repeat +pg_copy_write until you are done, then execute pg_endcopy. For example: + while {... more data to send ...} { + pg_copy_write $result_handle $tab_separated_data_line + } + pg_endcopy $result_handle + +After pg_endcopy returns, the result status should be PGRES_COMMAND_OK if +the copy was successful. + +Do not write or expect to read the old COPY delimiter "\.". + +----------------------------------------------------------------------------- +ENCODINGS: (New at pgin.tcl-3.0.0) + +Pgin.tcl converts all text sent to PostgreSQL (query strings, COPY FROM +data, text-mode parameters of prepared queries, and prepared statement +names) into UTF-8 (Unicode). It converts all text received from PostgreSQL +(query results which are text-mode, error/notice/notify strings, COPY TO +data, field names) back from UTF-8 (Unicode). (This happens implicitly in +the compiled versions of the Tcl interface, but Pgin.tcl has to do it +explicitly.) + +Pgin.tcl informs the PostgreSQL server that it will be using Unicode when +communicating with the server. This is the same behavior as the libpq-based +versions of the Tcl PostgreSQL interface. We do this because Tcl uses +Unicode internally, and using Unicode allows for different client and +server character sets without loss of information. + +PostgreSQL converts between this Unicode data and the database encoding, if +necessary. For example, if the database encoding is Latin1, then Latin1 +characters will be stored in the database, because PostgreSQL converts the +Tcl-supplied UTF-8 (Unicode) into Latin1. If the client application also +uses Latin1, then data is converted twice in each direction: for sending +over the communications link in Unicode, and then in the server or client +back to Latin1. + +Provided the database encoding is correct, translation will happen +transparently to the client application. Other non-Tcl applications, +such as psql, will also be able to access the data correctly provided +they set their client_encoding parameter. + + * * * CAUTION * * * + + Do not store non-ASCII characters in character or text fields in a + PostgreSQL database which was created with encoding SQL_ASCII. + The SQL_ASCII encoding provides no information to PostgreSQL on + how to translate characters, so the server will be unable to + translate. Applications using a Tcl interface, including + pgin.tcl, will encode these characters using UTF-8 for storage + in the database, but PostgreSQL will not know it due to the + SQL_ASCII encoding setting. The result is that it may be + impossible to access the data correctly from other applications. + Always use the correct encoding when creating a database: for + example, LATIN1 or Unicode. + + Pgin.tcl-2.x and older do not convert to/from Unicode and do not set + client_encoding at all. These older versions may not work with non-ASCII + characters in any database encoding. + + At this time, Pgin.tcl does not recode connection string parameters + Username, Database Name, or Password. Non-ASCII characters in these + fields will probably not work. + +----------------------------------------------------------------------------- diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pgin.tcl b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pgin.tcl new file mode 100644 index 00000000..8e64cedd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pgin.tcl @@ -0,0 +1,2154 @@ +# pgin.tcl - PostgreSQL Tcl Interface direct to protocol v3 backend +# $Id: pgin.tcl 593 2017-11-12 23:16:54Z lbayuk $ +# +# Copyright (c) 1998-2017 L Bayuk +# May be freely distributed with or without modification; must retain this +# notice; provided with no warranties. +# See the file COPYING for complete information on usage and redistribution +# of this file, and for a disclaimer of all warranties. +# +# See the file INTERNALS in the source distribution for more information +# about how this thing works, including namespace variables. +# +# Also includes: +# md5.tcl - Compute MD5 Checksum + +# Some features require Tcl-8.5 but these are runtime detected. +package require Tcl 8.4- + +# === Definition of the pgtcl namespace === + +namespace eval pgtcl { + # Debug flag: + variable debug 0 + + # Version number, also used in package provide at the bottom of this file: + variable version 3.5.2 + + # Counter for making uniquely named result structures: + variable rn 0 + + # Array mapping error field names to protocol codes: + variable errnames + array set errnames { + SEVERITY S + SQLSTATE C + MESSAGE_PRIMARY M PRIMARY M + MESSAGE_DETAIL D DETAIL D + MESSAGE_HINT H HINT H + STATEMENT_POSITION P POSITION P + CONTEXT W + SOURCE_FILE F FILE F + SOURCE_LINE L LINE L + SOURCE_FUNCTION R FUNCTION R + SCHEMA_NAME s + TABLE_NAME t + COLUMN_NAME c + DATATYPE_NAME d + CONSTRAINT_NAME n + } + + # For pg_escape_string, pg_quote, and pg_escape_bytea: need to keep the + # value of standard_conforming_strings - both per-connection and global + # default. The default is kept at "_default_" and the other elements + # are indexed by connection handle. + variable std_str + set std_str(_default_) 0 +} + +# === Internal Low-level I/O procedures for v3 protocol === + +# Internal procedure to send a packet to the backend with type and length. +# Type can be empty - this is used for the startup packet. +# The default is to flush the channel, since almost all messages generated +# by pgin.tcl need to wait for a response. The exception is prepared queries. +proc pgtcl::sendmsg {sock type data {noflush ""}} { + puts -nonewline $sock \ + $type[binary format I [expr {[string length $data]+4}]]$data + if {$noflush == ""} { + flush $sock + } +} + +# Read a message and return the message type byte: +# This initializes the per-connection buffer too. +# This has a special check for a v2 error message, which is needed at +# startup in case of talking to v2 server. It assumes we will not +# get a V3 error message longer than 0x20000000 bytes, which is pretty safe. +# It fakes up a V3 error with severity ERROR, code (5 spaces), and the message. +proc pgtcl::readmsg {sock} { + upvar #0 pgtcl::buf_$sock buf pgtcl::bufi_$sock bufi pgtcl::bufn_$sock bufn + set bufi 0 + if {[binary scan [read $sock 5] aI type len] != 2} { + set err "pgtcl: Unable to read message from database" + if {[eof $sock]} { + append err " - server closed connection" + } + error $err + } + if {$type == "E" && $len >= 0x20000000} { + if {$pgtcl::debug} { puts "Warning: V2 error message received!" } + # Build the start of the V3 error, including the 4 misread bytes in $len: + set buf [binary format {a a*x a a*x a I} S ERROR C " " M $len] + while {[set c [read $sock 1]] != ""} { + append buf $c + if {$c == "\000"} break + } + # This is 'code=0' to mark no more error options. + append buf "\000" + set bufn [string length $buf] + } else { + set bufn [expr {$len - 4}] + set buf [read $sock $bufn] + } + return $type +} + +# Return the next byte from the buffer: +proc pgtcl::get_byte {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + set result [string index $buf $bufi] + incr bufi + return $result +} + +# Return the next $n bytes from the buffer: +proc pgtcl::get_bytes {db n} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + set obufi $bufi + incr bufi $n + return [string range $buf $obufi [expr {$obufi + $n - 1}]] +} + +# Return the rest of the buffer. +proc pgtcl::get_rest {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi pgtcl::bufn_$db bufn + set obufi $bufi + set bufi $bufn + return [string range $buf $obufi end] +} + +# Skip next $n bytes in the buffer. +proc pgtcl::skip {db n} { + upvar #0 pgtcl::bufi_$db bufi + incr bufi $n +} + +# Return next int32 from the buffer: +proc pgtcl::get_int32 {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + if {[binary scan $buf "x$bufi I" i] != 1} { + set i 0 + } + incr bufi 4 + return $i +} + +# Return next signed int16 from the buffer: +proc pgtcl::get_int16 {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + if {[binary scan $buf "x$bufi S" i] != 1} { + set i 0 + } + incr bufi 2 + return $i +} + +# Return next unsigned int16 from the buffer: +proc pgtcl::get_uint16 {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + if {[binary scan $buf "x$bufi S" i] != 1} { + set i 0 + } + incr bufi 2 + return [expr {$i & 0xffff}] +} + +# Return next signed int8 from the buffer: +# (This is only used in 1 place in the protocol...) +proc pgtcl::get_int8 {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + if {[binary scan $buf "x$bufi c" i] != 1} { + set i 0 + } + incr bufi + return $i +} + +# Return the next null-terminated string from the buffer: +# This decodes the UNICODE data. It is used for people-readable text like +# messages, not query result data. +proc pgtcl::get_string {db} { + upvar #0 pgtcl::buf_$db buf pgtcl::bufi_$db bufi + set end [string first "\000" $buf $bufi] + if {$end < 0} { + return "" + } + set obufi $bufi + set bufi [expr {$end + 1}] + return [encoding convertfrom identity \ + [string range $buf $obufi [expr {$end - 1}]]] +} + +# === Internal Mid-level I/O procedures for v3 protocol === + +# Parse a backend ErrorResponse or NoticeResponse message. The Severity +# and Message parts are returned together with a trailing newline, like v2 +# protocol did. If optional result_name is supplied, it is the name of +# a result structure to store all error parts in, indexed as (error,$code). +proc pgtcl::get_response {db {result_name ""}} { + if {$result_name != ""} { + upvar $result_name result + } + array set result {error,S ERROR error,M {}} + while {[set c [pgtcl::get_byte $db]] != "\000" && $c != ""} { + set result(error,$c) [pgtcl::get_string $db] + } + return "$result(error,S): $result(error,M)\n" +} + +# Handle ParameterStatus and remember the name and value: +proc pgtcl::get_parameter_status {db} { + upvar #0 pgtcl::param_$db param + set name [pgtcl::get_string $db] + set param($name) [pgtcl::get_string $db] + if {$pgtcl::debug} { puts "+server param $name=$param($name)" } + + # Special cases: + # Remember per-connection and global default for standard_conforming_strings + # for use by pg_escape_string, pg_quote, and pg_escape_bytea. + if {$name eq "standard_conforming_strings"} { + set is_on [expr {$param($name) eq "on"}] + set pgtcl::std_str($db) $is_on + set pgtcl::std_str(_default_) $is_on + } +} + +# Handle a notification ('A') message. +# The notifying backend pid is read and passed to the callback if requested. +# Starting with PostgreSQL-9.0, more_info (ignored) became 'payload' and can be +# sent with SQL. To help avoid breaking exising code, the payload is only sent +# as an argument to the notify command if it is non-empty. But if you send +# a notification with payload to code that doesn't expect it, you will get +# a background error from the 'after' code because of the extra argument. +proc pgtcl::get_notification_response {db} { + set notify_pid [pgtcl::get_int32 $db] + set notify_rel [pgtcl::get_string $db] + set payload [pgtcl::get_string $db] + if {$pgtcl::debug} { + puts "+pgtcl got notify from $notify_pid: $notify_rel $payload" + } + if {[info exists pgtcl::notify($db,$notify_rel)]} { + set cmd $pgtcl::notify($db,$notify_rel) + if {$pgtcl::notifopt($db,$notify_rel) == 1} { + lappend cmd $notify_pid + } + if {$payload ne ""} { + lappend cmd $payload + } + after idle $cmd + } +} + +# Handle a notice ('N') message. If no handler is defined, or the handler is +# empty, do nothing, otherwise, call the handler with the message argument +# appended. For backward compatibility with v2 protocol, the message is +# assumed to end in a newline. +proc pgtcl::get_notice {db} { + set msg [pgtcl::get_response $db] + if {[info exists pgtcl::notice($db)] && [set cmd $pgtcl::notice($db)] != ""} { + eval $cmd [list $msg] + } +} + +# Internal procedure to read a tuple (row) from the backend. +# Column count is redundant, but check it anyway. +# Format code (text/binary) is used to do Unicode decoding on Text only. +proc pgtcl::gettuple {db result_name} { + upvar $result_name result + if {$result(nattr) == 0} { + unset result + error "Protocol error, data before descriptor" + } + set irow $result(ntuple) + set nattr [pgtcl::get_uint16 $db] + if {$nattr != $result(nattr)} { + unset result + error "Expecting $result(nattr) columns, but data row has $nattr" + } + set icol 0 + foreach format $result(formats) { + set col_len [pgtcl::get_int32 $db] + if {$col_len > 0} { + if ($format) { + set result($irow,$icol) [pgtcl::get_bytes $db $col_len] + } else { + set result($irow,$icol) [encoding convertfrom identity \ + [pgtcl::get_bytes $db $col_len]] + } + } else { + set result($irow,$icol) "" + if {$col_len < 0} { + set result(null,$irow,$icol) "" + } + } + incr icol + } + incr result(ntuple) +} + +# Internal procedure to handle common backend utility message types: +# C : Completion status E : Error +# N : Notice message A : Notification +# S : ParameterStatus +# This can be given any message type. If it handles the message, +# it returns 1. If it doesn't handle the message, it returns 0. +# +proc pgtcl::common_message {msgchar db result_name} { + upvar $result_name result + switch -- $msgchar { + A { pgtcl::get_notification_response $db } + C { set result(complete) [pgtcl::get_string $db] } + N { pgtcl::get_notice $db } + S { pgtcl::get_parameter_status $db } + E { + set result(status) PGRES_FATAL_ERROR + set result(error) [pgtcl::get_response $db result] + } + default { return 0 } + } + return 1 +} + +# === Other internal support procedures === + +# Internal procedure to set a default value from the environment: +proc pgtcl::default {default args} { + global env + foreach a $args { + if {[info exists env($a)]} { + return $env($a) + } + } + return $default +} + +# Internal procedure to parse a connection info string. +# This has to handle quoting and escaping. See the PostgreSQL Programmer's +# Guide, Client Interfaces, Libpq, Database Connection Functions. +# The definitive reference is the PostgreSQL source code in: +# interface/libpq/fe-connect.c:conninfo_parse() +# One quirk to note: backslash escapes work in quoted values, and also in +# unquoted values, but you cannot use backslash-space in an unquoted value, +# because the space ends the value regardless of the backslash. +# +# Stores the results in an array $result(paramname)=value. It will not +# create a new index in the array; if paramname does not already exist, +# it means a bad parameter was given (one not defined by pg_conndefaults). +# Returns an error message on error, else an empty string if OK. +proc pgtcl::parse_conninfo {conninfo result_name} { + upvar $result_name result + while {[regexp {^ *([^=]*)= *(.+)} $conninfo unused name conninfo]} { + set name [string trim $name] + if {[regexp {^'(.*)} $conninfo unused conninfo]} { + set value "" + set n [string length $conninfo] + for {set i 0} {$i < $n} {incr i} { + if {[set c [string index $conninfo $i]] == "\\"} { + set c [string index $conninfo [incr i]] + } elseif {$c == "'"} break + append value $c + } + if {$i >= $n} { + return "unterminated quoted string in connection info string" + } + set conninfo [string range $conninfo [incr i] end] + } else { + regexp {^([^ ]*)(.*)} $conninfo unused value conninfo + regsub -all {\\(.)} $value {\1} value + } + if {$pgtcl::debug} { puts "+parse_conninfo name=$name value=$value" } + if {![info exists result($name)]} { + return "invalid connection option \"$name\"" + } + set result($name) $value + } + if {[string trim $conninfo] != ""} { + return "syntax error in connection info string '...$conninfo'" + } + return "" +} + +# Internal helper for parse_connuri: URI character escape decoding. +# Decode %XX hex escapes in a string and return the result: +proc pgtcl::uri_unesc {s} { + set result "" + set re_hex {^([^%]*)%([0-9A-Za-z][0-9A-Za-z])(.*)} + while {$s != "" && [regexp $re_hex $s unused before hex rest]} { + append result $before [binary format a [subst "\\x$hex"]] + set s $rest + } + return $result$s +} + +# Internal procedure to parse a connection URI and merge the parameters +# into a connection parameter array $result. $uri_rest is the part of the +# URI after the scheme and delimiters (postgresql:// or postgres://). +# NOTE: URI parameters (?param=value...) are currently ignored. +# Returns an error message on error, else an empty string if OK. +proc pgtcl::parse_connuri {uri_rest result_name} { + upvar $result_name result + + set s $uri_rest + # Note: Results are stored temporarily in a list $r for debug purposes. + set r {} + + # Parse optional username or username:password, which ends in @ + if {[regexp {^([A-Za-z0-9_%.~-]+)(:[A-za-z0-9_%.~-]+)?@} $s match p1 p2]} { + lappend r user [pgtcl::uri_unesc $p1] + # Remove the : from before the password + if {$p2 != ""} { + lappend r password [pgtcl::uri_unesc [string range $p2 1 end]] + } + set s [string range $s [string length $match] end] + } + + # Parse hostname, port (port is not URI-encoded) + if {[regexp {^([A-Za-z0-9_%.-]+)|(\[[0-9a-fA-F:]+])} $s match]} { + lappend r host [pgtcl::uri_unesc $match] + set s [string range $s [string length $match] end] + if {[regexp {^:([0-9]+)} $s match p1]} { + lappend r port $p1 + set s [string range $s [string length $match] end] + } + } + + # The "path" part of the URI is the database name. + if {[regexp {^/([^?#]*)} $s match p1] && $p1 != ""} { + lappend r dbname [pgtcl::uri_unesc $p1] + } + if {$pgtcl::debug} { puts "+parse_connuri postgresql://$uri_rest\n => {$r}" } + array set result $r + return "" +} + +# Internal procedure to merge connection options into the connection +# options array. $mode is -conninfo or -connlist. conninfo mode accepts a +# connection string (param=value ...) or a URI (postgresql://...) which are +# handled by parse_conninfo and parse_connuri respectively. connlist mode +# accepts a Tcl list of params and values, and is handled here. +# Stores the results in an array $result(paramname)=value. +# Returns an error message on error, else an empty string if OK. +proc pgtcl::merge_connopts {mode arg result_name} { + upvar $result_name result + if {$mode eq "-conninfo"} { + if {[regexp {^postgres(ql)?://(.*)} $arg ignored1 ignored2 uri_rest]} { + return [pgtcl::parse_connuri $uri_rest result] + } + return [pgtcl::parse_conninfo $arg result] + } + foreach {name value} $arg { + if {![info exists result($name)]} { + return "invalid connection option \"$name\"" + } + set result($name) $value + } + return "" +} + +# Internal procedure to check for valid result handle. This returns +# the fully qualified name of the result array. +# Usage: upvar #0 [pgtcl::checkres $res] result +proc pgtcl::checkres {res} { + if {![info exists pgtcl::result$res]} { + error "Invalid result handle\n$res is not a valid query result" + } + return "pgtcl::result$res" +} + +# Password encryption with MD5. This is used by pg_encrypt_password and +# by pg_connect. It needs to be separate from pg_encrypt_password because +# (like libpq's PQencryptPassword) that returns the prefix "md5" in front +# but that doesn't work for the inner encryption in pg_connect. +proc pgtcl::encrypt_password {part1 part2} { + return [md5::digest "$part1$part2"] +} + +# === Public procedures : Connecting and Disconnecting === + +# Return connection defaults as {optname label dispchar dispsize value}... +proc pg_conndefaults {} { + set user [pgtcl::default user PGUSER USER LOGNAME USERNAME] + set result [list \ + [list user Database-User {} 20 $user] \ + [list password Database-Password * 20 [pgtcl::default {} PGPASSWORD]] \ + [list host Database-Host {} 40 [pgtcl::default localhost PGHOST]] \ + {hostaddr Database-Host-IP-Address {} 45 {}} \ + [list port Database-Port {} 6 [pgtcl::default 5432 PGPORT]] \ + [list dbname Database-Name {} 20 [pgtcl::default $user PGDATABASE]] \ + [list tty Backend-Debug-TTY D 40 [pgtcl::default {} PGTTY]] \ + [list options Backend-Debug-Options D 40 [pgtcl::default {} PGOPTIONS]] \ + ] + if {$pgtcl::debug} { puts "+pg_conndefaults: $result" } + return $result +} + +# Connect to database. Two forms are supported: -conninfo (with connection +# info string or URI), and -connlist (with connection keyword/value list). +# The older form with dbname and separate option/value args is not supported. +# We speak backend protocol v3, and only handle clear-text password and +# MD5 authentication (messages R 3, and R 5). +# A parameter is added to set client_encoding to UNICODE. This is due to +# Tcl's way of representing strings. +proc pg_connect {args} { + + if {[llength $args] != 2 || ([set mode [lindex $args 0]] ne "-conninfo" \ + && $mode ne "-connlist")} { + error "wrong # args: should be \"pg_connect -conninfo conninfoString |\ + -connlist conninfoList\"" + } + + # Get connection defaults into an array opt(): + foreach o [pg_conndefaults] { + set opt([lindex $o 0]) [lindex $o 4] + } + + # Merge in command-line options, as a connection list or connection string: + if {[set msg [pgtcl::merge_connopts $mode [lindex $args 1] opt]] ne ""} { + error "Connection to database failed\n$msg" + } + + # Hostaddr overrides host, per documentation, and we need host below. + if {$opt(hostaddr) != ""} { + set opt(host) $opt(hostaddr) + } + + if {$pgtcl::debug} { + puts "+pg_connect to $opt(dbname)@$opt(host):$opt(port) as $opt(user)" + } + + if {[catch {socket $opt(host) $opt(port)} sock]} { + error "Connection to database failed\n$sock" + } + # Note: full buffering, socket must be flushed after write! + fconfigure $sock -buffering full -translation binary + + # Startup packet: + pgtcl::sendmsg $sock {} [binary format "I a*x a*x a*x a*x a*x a*x a*x a*x x" \ + 0x00030000 \ + user $opt(user) database $opt(dbname) \ + client_encoding UNICODE options $opt(options)] + + set msg {} + while {[set c [pgtcl::readmsg $sock]] != "Z"} { + switch -- $c { + E { + set msg [pgtcl::get_response $sock] + break + } + R { + set n [pgtcl::get_int32 $sock] + if {$n == 3} { + pgtcl::sendmsg $sock p "$opt(password)\000" + } elseif {$n == 5} { + set salt [pgtcl::get_bytes $sock 4] + set md5_response [pg_encrypt_password \ + [pgtcl::encrypt_password $opt(password) $opt(user)] $salt] + if {$pgtcl::debug} { puts "+pg_connect MD5 sending: $md5_response" } + pgtcl::sendmsg $sock p "$md5_response\000" + } elseif {$n != 0} { + set msg "Unknown database authentication request($n)" + break + } + } + K { + set pid [pgtcl::get_int32 $sock] + set key [pgtcl::get_int32 $sock] + if {$pgtcl::debug} { puts "+server pid=$pid key=$key" } + } + S { + pgtcl::get_parameter_status $sock + } + default { + set msg "Unexpected reply from database: $c" + break + } + } + } + if {$msg != ""} { + close $sock + error "Connection to database failed\n$msg" + } + # Initialize transaction status; should be get_byte but it better be I: + set pgtcl::xstate($sock) I + # Initialize action for NOTICE messages (see get_notice): + set pgtcl::notice($sock) {puts -nonewline stderr} + # Make sure there is a setting for standard_conforming_strings (should + # have come back via get_parameter_status) + if {![info exists pgtcl::std_str($sock)]} { + set pgtcl::std_str($sock) $pgtcl::std_str(_default_) + } + # Save backend process ID. (Key isn't saved since it isn't usable) + set pgtcl::bepid($sock) $pid + + return $sock +} + +# Disconnect from the database. Free all result structures which are +# associated with this connection, and other data for this connection, +# including the buffer. +proc pg_disconnect {db} { + if {$pgtcl::debug} { puts "+Disconnecting $db from database" } + pgtcl::sendmsg $db X {} + catch {close $db} + foreach v [info vars pgtcl::result*] { + upvar #0 $v result + if {$result(conn) == $db} { + if {$pgtcl::debug} { puts "+Freeing left-over result structure $v" } + unset result + } + } + array unset pgtcl::notify $db,* + array unset pgtcl::notifopt $db,* + unset -nocomplain pgtcl::param_$db pgtcl::xstate($db) pgtcl::notice($db) \ + pgtcl::buf_$db pgtcl::bufi_$db pgtcl::bufn_$db pgtcl::std_str($db) \ + pgtcl::bepid($db) +} + +# === Internal procedures: Query Result and supporting functions === + +# Read the backend reply to a query or other request, and build a +# result structure. This implements most of the backend response protocol. +# The $mode parameter is used to do some checks for expected message types. +# mode "" : Basic query mode +# mode "E" : Extended Query mode, e.g. pg_exec_prepared. +# mode "D" : Describe Portal or Describe Prepared. +# This table indicates which message types are expected in each mode: +# Handled in Mode: +# Message Type: Basic Extended Describe +# -------------------------- ----- -------- -------- +# common C N S E A * * * +# 2 BindComplete * +# G CopyInResponse * * +# H CopyOutResponse * * +# D DataRow * * +# I EmptyQueryResponse * * +# n NoData * * +# t ParameterDescription * +# 1 ParseComplete * +# Z ReadyForQuery * * * +# T RowDescription * * * +# The 'common' types C N S E and A are handled by pgtcl::common_message. +# Not every message/mode pair above is checked. For example, DataRow +# is allowed in every mode although it should never appear in Describe, +# just because it would unnecessarily slow things down. +# +# Note: In Describe mode, the status is PGRES_COMMAND_OK, not +# PGRES_TUPLES_OK, when a RowDescription message is returned. This is +# not easily distinguished from a query that returns no rows, so it is +# special cased here. +# +# Returns a result handle (the number pgtcl::rn), or throws an error. + +proc pgtcl::getresult {db {mode ""}} { + upvar #0 pgtcl::result[incr pgtcl::rn] result + set result(conn) $db + array set result { + nattr 0 ntuple 0 + attrs {} types {} sizes {} modifs {} formats {} + error {} tbloids {} tblcols {} nparam 0 paramtypes {} + complete {} + status PGRES_COMMAND_OK + } + + # Note: Each valid switch branch ends in continue or break. Invalid + # falls through to error handling for an unexpected message type. + # D is special case, no mode check and up top because of its frequency. + while {1} { + set c [pgtcl::readmsg $db] + switch -- $c { + D { + pgtcl::gettuple $db result + continue + } + T { + if {$result(nattr) != 0} { + unset result + error "Protocol failure, multiple descriptors" + } + if {$mode eq "D"} { + set result(status) PGRES_COMMAND_OK + } else { + set result(status) PGRES_TUPLES_OK + } + set nattr [pgtcl::get_uint16 $db] + set result(nattr) $nattr + for {set icol 0} {$icol < $nattr} {incr icol} { + lappend result(attrs) [pgtcl::get_string $db] + lappend result(tbloids) [pgtcl::get_int32 $db] + lappend result(tblcols) [pgtcl::get_uint16 $db] + lappend result(types) [pgtcl::get_int32 $db] + lappend result(sizes) [pgtcl::get_int16 $db] + lappend result(modifs) [pgtcl::get_int32 $db] + lappend result(formats) [pgtcl::get_int16 $db] + } + continue + } + Z { + set pgtcl::xstate($db) [pgtcl::get_byte $db] + break + } + } + + if {[pgtcl::common_message $c $db result]} continue + + if {$mode eq "" || $mode eq "E"} { + switch -- $c { + I { + set result(status) PGRES_EMPTY_QUERY + continue + } + H { + pgtcl::begincopy result OUT + break + } + G { + pgtcl::begincopy result IN + break + } + } + } + + if {$mode eq "E" && ($c eq "2" || $c eq "1")} continue + + if {($mode eq "E" || $mode eq "D") && $c eq "n"} continue + + if {$mode eq "D" && $c eq "t"} { + set result(nparam) [set np [pgtcl::get_int16 $db]] + for {set i 0} {$i < $np} {incr i} { + lappend result(paramtypes) [pgtcl::get_int32 $db] + } + continue + } + unset result + error "Unexpected reply from database: $c" + } + if {$pgtcl::debug > 1} { + puts "+pgtcl::getresult $pgtcl::rn = " + parray result + } + return $pgtcl::rn +} + +# Process format code information for pg_exec_prepared. +# fclist A list of BINARY (or B*) or TEXT (or T*) format code words. +# ncodes_name The name of a variable to get the number of format codes. +# codes_name The name of a variable to get a list of format codes in +# the PostgreSQL syntax: 0=text 1=binary. +proc pgtcl::crunch_fcodes {fclist ncodes_name codes_name} { + upvar $ncodes_name ncodes $codes_name codes + set ncodes [llength $fclist] + set codes {} + foreach k $fclist { + if {[string match B* $k]} { + lappend codes 1 + } else { + lappend codes 0 + } + } +} + +# Return an error code field value for pg_result -error?Field? code. +# For field names, it accepts either the libpq name (without PG_DIAG_) or the +# single-letter protocol code. +# For compatibility with changes made to the other pgtcl after this feature was +# added here, it also accepts some names without the prefixes. +# The $code is not case sensitive, but the protocol letter is. This was +# changed because PostgreSQL-9.3.0 started using some lower case letters too. +# If an unknown field name is used, or the field isn't part of the error +# message, an empty string is substituted. + +proc pgtcl::error_fields {result_name code} { + upvar $result_name result + variable errnames + set upcase_code [string toupper $code] + if {[info exists errnames($upcase_code)]} { + set code $errnames($upcase_code) + } + if {[info exists result(error,$code)]} { + return $result(error,$code) + } + return "" +} + +# === Public procedures : Query and Result === + +# Execute SQL and return a result handle. +# If parameters are supplied, use pg_exec_params in all-text arg mode. +# (Let pg_exec_params encode the query in that case.) + +proc pg_exec {db query args} { + if {$pgtcl::debug} { puts "+pg_exec $query {$args}" } + if {[llength $args] == 0} { + pgtcl::sendmsg $db Q "[encoding convertto identity $query]\000" + return [pgtcl::getresult $db] + } + return [eval [list pg_exec_params $db $query {} {} {}] $args] +} + +# Extract data from a pg_exec result structure. +# -cmdTuples, -list, and -llist are extensions to the baseline libpgtcl which +# have appeared or will appear in beta or future versions. +# -errorField, -lxAttributes and -getNull are proposed new for 7.4. +# -cmdStatus is new with pgintcl-2.0.1 +# -numParams and -paramTypes, for prepared statements, is new with pgintcl-3.1.0 +# -dict for dictionary return, idea credit to pgfoundry/pgtcl developers, new +# with pgintcl-3.3.0. + +proc pg_result {res option args} { + upvar #0 [pgtcl::checkres $res] result + set argc [llength $args] + set ntuple $result(ntuple) + set nattr $result(nattr) + switch -- $option { + -status { return $result(status) } + -conn { return $result(conn) } + -oid { + if {[regexp {^INSERT +([0-9]*)} $result(complete) unused oid]} { + return $oid + } + return 0 + } + -cmdTuples { + if {[regexp {^INSERT +[0-9]* +([0-9]*)} $result(complete) x num] \ + || [regexp {^(UPDATE|DELETE|SELECT|FETCH|MOVE|COPY) +([0-9]*)} \ + $result(complete) x y num]} { + return $num + } + return "" + } + -cmdStatus { return $result(complete) } + -numTuples { return $ntuple } + -numAttrs { return $nattr } + -assign { + if {$argc != 1} { + error "-assign option must be followed by a variable name" + } + upvar $args a + set icol 0 + foreach attr $result(attrs) { + for {set irow 0} {$irow < $ntuple} {incr irow} { + set a($irow,$attr) $result($irow,$icol) + } + incr icol + } + } + -assignbyidx { + if {$argc != 1 && $argc != 2} { + error "-assignbyidxoption requires an array name and optionally an\ + append string" + } + upvar [lindex $args 0] a + if {$argc == 2} { + set suffix [lindex $args 1] + } else { + set suffix {} + } + set attr_first [lindex $result(attrs) 0] + set attr_rest [lrange $result(attrs) 1 end] + for {set irow 0} {$irow < $ntuple} {incr irow} { + set val_first $result($irow,0) + set icol 1 + foreach attr $attr_rest { + set a($val_first,$attr$suffix) $result($irow,$icol) + incr icol + } + } + } + -getTuple { + if {$argc != 1} { + error "-getTuple option must be followed by a tuple number" + } + set irow $args + if {$irow < 0 || $irow >= $ntuple} { + error "argument to getTuple cannot exceed number of tuples - 1" + } + set list {} + for {set icol 0} {$icol < $nattr} {incr icol} { + lappend list $result($irow,$icol) + } + return $list + } + -getNull { + if {$argc != 1} { + error "-getNull option must be followed by a tuple number" + } + set irow $args + if {$irow < 0 || $irow >= $ntuple} { + error "argument to getNull cannot exceed number of tuples - 1" + } + set list {} + for {set icol 0} {$icol < $nattr} {incr icol} { + lappend list [info exists result(null,$irow,$icol)] + } + return $list + } + -tupleArray { + if {$argc != 2} { + error "-tupleArray option must be followed by a tuple number and\ + array name" + } + set irow [lindex $args 0] + if {$irow < 0 || $irow >= $ntuple} { + error "argument to tupleArray cannot exceed number of tuples - 1" + } + upvar [lindex $args 1] a + set icol 0 + foreach attr $result(attrs) { + set a($attr) $result($irow,$icol) + incr icol + } + } + -list { + set list {} + for {set irow 0} {$irow < $ntuple} {incr irow} { + for {set icol 0} {$icol < $nattr} {incr icol} { + lappend list $result($irow,$icol) + } + } + return $list + } + -llist { + set list {} + for {set irow 0} {$irow < $ntuple} {incr irow} { + set sublist {} + for {set icol 0} {$icol < $nattr} {incr icol} { + lappend sublist $result($irow,$icol) + } + lappend list $sublist + } + return $list + } + -attributes { + return $result(attrs) + } + -lAttributes { + set list {} + foreach attr $result(attrs) type $result(types) size $result(sizes) { + lappend list [list $attr $type $size] + } + return $list + } + -lxAttributes { + set list {} + foreach attr $result(attrs) type $result(types) size $result(sizes) \ + modif $result(modifs) format $result(formats) \ + tbloid $result(tbloids) tblcol $result(tblcols) { + lappend list [list $attr $type $size $modif $format $tbloid $tblcol] + } + return $list + } + -clear { + unset result + } + -error - + -errorField { + if {$argc == 0} { + return $result(error) + } + return [pgtcl::error_fields result $args] + } + -numParams { + return $result(nparam) + } + -paramTypes { + return $result(paramtypes) + } + -dict { + if {[catch {dict create} d]} { + error "pg_result -dict requires Tcl dictionary support" + } + for {set irow 0} {$irow < $ntuple} {incr irow} { + set icol 0 + foreach attr $result(attrs) { + dict set d $irow $attr $result($irow,$icol) + incr icol + } + } + return $d + } + default { error "Invalid option to pg_result: $option" } + } +} + +# Run a select query and iterate over the results. Uses pg_exec to run the +# query and build the result structure, but we cheat and directly use the +# result array rather than calling pg_result. +# Each returned tuple is stored into the caller's array, then the caller's +# proc is called. +# If the caller's proc does "break", "return", or gets an error, get out +# of the processing loop. Tcl codes: 0=OK 1=error 2=return 3=break 4=continue +proc pg_select {db query var_name proc} { + upvar $var_name var + global errorCode errorInfo + set res [pg_exec $db $query] + upvar #0 pgtcl::result$res result + if {$result(status) != "PGRES_TUPLES_OK"} { + set msg $result(error) + unset result + error $msg + } + set code 0 + set var(.headers) $result(attrs) + set var(.numcols) $result(nattr) + set ntuple $result(ntuple) + for {set irow 0} {$irow < $ntuple} {incr irow} { + set var(.tupno) $irow + set icol 0 + foreach attr $result(attrs) { + set var($attr) $result($irow,$icol) + incr icol + } + set code [catch {uplevel 1 $proc} s] + if {$code != 0 && $code != 4} break + } + unset result var + if {$code == 1} { + return -code error -errorinfo $errorInfo -errorcode $errorCode $s + } elseif {$code == 2 || $code > 4} { + return -code $code $s + } + return +} + +# Register a listener for backend notification, or cancel a listener. +# Usage: pg_listen db name - Cancel a listener +# pg_listen db name command - Set a new listener +# pg_listen -pid db name command - Set a new listener with PID arg +proc pg_listen {args} { + set nargs [llength $args] + set narg -1 + set options 0 + if {$nargs > 0 && [lindex $args 0] == "-pid"} { + set options 1 + incr narg + incr nargs -1 + } + if {$nargs < 2 || 3 < $nargs} { + error "Wrong # args: should be \"pg_listen ?options? db name ?command?\"" + } + set db [lindex $args [incr narg]] + set name [lindex $args [incr narg]] + # If the name is quoted, strip quotes, else downcase - same as SQL does. + if {![regexp {^"(.*)"$} $name unused ccname]} { + set ccname [string tolower $name] + } + + if {$nargs == 3} { + set proc [lindex $args [incr narg]] + set pgtcl::notify($db,$ccname) $proc + set pgtcl::notifopt($db,$ccname) $options + # Use the original argument here, not case corrected/quotes stripped. + set r [pg_exec $db "listen $name"] + pg_result $r -clear + } elseif {[info exists pgtcl::notify($db,$ccname)]} { + unset -nocomplain pgtcl::notify($db,$ccname) pgtcl::notifopt($db,$ccname) + pg_result [pg_exec $db "unlisten $ccname"] -clear + } +} + +# pg_execute: Execute a query, optionally iterating over the results. +# +# Returns the number of tuples selected or affected by the query. +# Usage: pg_execute ?options? connection query ?proc? +# Options: -array ArrayVar +# -oid OidVar +# If -array is not given with a SELECT, the data is put in variables +# named by the fields. This is generally a bad idea and could be dangerous. +# +# If there is no proc body and the query return 1 or more rows, the first +# row is stored in the array or variables and we return (as does libpgtcl). +# +# Notes: Handles proc return codes of: +# 0(OK) 1(error) 2(return) 3(break) 4(continue) +# Uses pg_exec and pg_result, but also makes direct access to the +# structures used by them. + +proc pg_execute {args} { + global errorCode errorInfo + + set usage "pg_execute ?-array arrayname?\ + ?-oid varname? connection queryString ?loop_body?" + + # Set defaults and parse command arguments: + set use_array 0 + set set_oid 0 + set do_proc 0 + set last_option_arg {} + set n_nonswitch_args 0 + set conn {} + set query {} + set proc {} + foreach arg $args { + if {$last_option_arg != ""} { + if {$last_option_arg == "-array"} { + set use_array 1 + upvar $arg data + } elseif {$last_option_arg == "-oid"} { + set set_oid 1 + upvar $arg oid + } else { + error "Unknown option $last_option_arg\n$usage" + } + set last_option_arg {} + } elseif {[regexp ^- $arg]} { + set last_option_arg $arg + } else { + if {[incr n_nonswitch_args] == 1} { + set conn $arg + } elseif {$n_nonswitch_args == 2} { + set query $arg + } elseif {$n_nonswitch_args == 3} { + set do_proc 1 + set proc $arg + } else { + error "Wrong # of arguments\n$usage" + } + } + } + if {$last_option_arg != "" || $n_nonswitch_args < 2} { + error "Bad arguments\n$usage" + } + + set res [pg_exec $conn $query] + upvar #0 pgtcl::result$res result + + # For non-SELECT query, just process oid and return value. + # Let pg_result do the decoding. + if {[regexp {^PGRES_(COMMAND_OK|COPY|EMPTY_QUERY)} $result(status)]} { + if {$set_oid} { + set oid [pg_result $res -oid] + } + set ntuple [pg_result $res -cmdTuples] + pg_result $res -clear + return $ntuple + } + + if {$result(status) != "PGRES_TUPLES_OK"} { + set status [list $result(status) $result(error)] + pg_result $res -clear + error $status + } + + # Handle a SELECT query. This is like pg_select, except the proc is optional, + # and the fields can go in an array or variables. + # With no proc, store the first row only. + set code 0 + if {!$use_array} { + foreach attr $result(attrs) { + upvar $attr data_$attr + } + } + set ntuple $result(ntuple) + for {set irow 0} {$irow < $ntuple} {incr irow} { + set icol 0 + if {$use_array} { + foreach attr $result(attrs) { + set data($attr) $result($irow,$icol) + incr icol + } + } else { + foreach attr $result(attrs) { + set data_$attr $result($irow,$icol) + incr icol + } + } + if {!$do_proc} break + set code [catch {uplevel 1 $proc} s] + if {$code != 0 && $code != 4} break + } + pg_result $res -clear + if {$code == 1} { + return -code error -errorinfo $errorInfo -errorcode $errorCode $s + } elseif {$code == 2 || $code > 4} { + return -code $code $s + } + return $ntuple +} + +# Extended query protocol: Bind parameters and execute prepared statement. +# This is modelled on libpq PQexecPrepared. Use pg_exec to send a PREPARE +# first; when called externally it does not handle unnamed statements. +# This is also used internally by pg_exec_params, with an unnamed statement. +# Parameters: +# db Connection handle +# stmt Name of the prepared SQL statement to execute +# res_formats A list describing results: B* => Binary, else Text. +# arg_formats A list describing args: B* => Binary, else Text. +# args Variable number of arguments to bind to the query params. +proc pg_exec_prepared {db stmt res_formats arg_formats args} { + set nargs [llength $args] + + if {$pgtcl::debug} { puts "+pg_exec_prepared stmt=$stmt nargs=$nargs" } + # Calculate argument format information: + pgtcl::crunch_fcodes $arg_formats nfcodes fcodes + + # Build the first part of the Bind message: + set out [binary format {x a*x S S* S} \ + [encoding convertto identity $stmt] $nfcodes $fcodes $nargs] + + # Expand fcodes so there is a text/binary flag for each argument: + if {$nfcodes == 0} { + set all_fcodes [string repeat "0 " $nargs] + } elseif {$nfcodes == 1} { + set all_fcodes [string repeat "$fcodes " $nargs] + } else { + set all_fcodes $fcodes + } + + # Append parameter values as { int32 length or 0 or -1 for NULL; data} + # Note: There is no support for NULLs as parameters. + # Encode all text parameters, leave binary parameters alone. + foreach arg $args fcode $all_fcodes { + if {$fcode} { + append out [binary format I [string length $arg]] $arg + } else { + set encoded_arg [encoding convertto identity $arg] + append out [binary format I [string length $encoded_arg]] $encoded_arg + } + } + + # Append result parameter format information: + pgtcl::crunch_fcodes $res_formats nrfcodes rfcodes + append out [binary format {S S*} $nrfcodes $rfcodes] + + # Send it off. Don't wait for BindComplete or Error, because the protocol + # says the BE will discard until Sync anyway. + pgtcl::sendmsg $db B $out -noflush + unset out + # Send DescribePortal for the unnamed portal: + pgtcl::sendmsg $db D "P\0" -noflush + # Send Execute, unnamed portal, unlimited rows: + pgtcl::sendmsg $db E "\0\0\0\0\0" -noflush + # Send Sync + pgtcl::sendmsg $db S {} + + # Fetch query result and return result handle: + return [pgtcl::getresult $db E] +} + +# Extended query protocol: Parse, Bind and execute statement. This is similar +# to pg_exec_prepared, but doesn't use a pre-prepared statement, and if you +# want to pass binary parameters you must also provide the type OIDs. +# This is modelled on libpq PQexecParams. +# Parameters: +# db Connection handle +# query Query to execute, may contain parameters $1, $2, ... +# res_formats A list describing results: B* => binary, else text +# arg_formats A list describing args: B* => Binary, else Text. +# arg_types A list of type OIDs for each argument (if Binary). +# args Variable number of arguments to bind to the query params. + +# Protocol note: Perhaps the right way to do this is to send Parse, +# then Flush, and check for ParseComplete or ErrorResponse. But then +# if there is an error, you need to send Sync and build a result structure. +# Since the backend will ignore everything after error until Sync, this +# is coded the easier way: Just send everything and let the lower-level code +# report the errors, whether on Parse or Bind or Execute. + +proc pg_exec_params {db query res_formats arg_formats arg_types args} { + if {$pgtcl::debug} { puts "+pg_exec_params query=$query" } + # Build and send Parse message with the SQL command and list of arg types: + set out [binary format {x a*x S} [encoding convertto identity $query] \ + [llength $arg_types]] + foreach type $arg_types { + append out [binary format I $type] + } + pgtcl::sendmsg $db P $out -noflush + # See note above regarding not checking for ParseComplete here. + # Proceed as with pg_exec_prepared, but with an unnamed statement: + return [eval [list pg_exec_prepared $db "" $res_formats $arg_formats] $args] +} + +# Get information about cursor ("portal"). See libpq PQdescribePortal +# Parameters: +# db Connection handle +# cursor Name of a cursor. +# Returns a result structure with no data, only column information. +# Note: This does not handle NoData. That is documented as a valid response +# but I don't see how it is possible. + +proc pg_describe_cursor {db cursor} { + if {$pgtcl::debug} { puts "+pg_describe_cursor $cursor" } + # Build and send the Describe Portal message, then sync. + pgtcl::sendmsg $db D "P[binary format {a*x} \ + [encoding convertto identity $cursor]]" -noflush + pgtcl::sendmsg $db S {} + + # Wait for result, Describe mode (D), return result handle. + return [pgtcl::getresult $db D] +} + +# Get information about a prepared statement. See libpq PQdescribePrepared +# Parameters: +# db Connection handle +# statement Name of a prepared statement. +# Returns a result structure with no data, only column information and +# also parameter information. + +proc pg_describe_prepared {db statement} { + if {$pgtcl::debug} { puts "+pg_describe_prepared $statement" } + # Build and send the Describe Statement message, then sync. + pgtcl::sendmsg $db D "S[binary format {a*x} \ + [encoding convertto identity $statement]]" -noflush + pgtcl::sendmsg $db S {} + + # Wait for result, Describe mode (D), return result handle. + return [pgtcl::getresult $db D] +} + +# === Public procedures : Miscellaneous === + +# pg_notice_handler: Set/get handler command for Notice/Warning +# Usage: pg_notice_handler connection ?command? +# Parameters: +# command If supplied, the new handler command. The notice text +# will be appended as a list element. +# If supplied but empty, ignore notice/warnings. +# If not supplied, just return the current value. +# Returns the previous handler command. +proc pg_notice_handler {db args} { + set return_value $pgtcl::notice($db) + if {[set nargs [llength $args]] == 1} { + set pgtcl::notice($db) [lindex $args 0] + } elseif {$nargs != 0} { + error "Wrong # args: should be \"pg_notice_handler connection ?command?\"" + } + return $return_value +} + +# pg_configure: Configure options for PostgreSQL connections +# This is provided only for backward compatibility with earlier versions. +# Do not use. +proc pg_configure {db option args} { + if {[set nargs [llength $args]] > 1} { + error "Wrong # args: should be \"pg_configure connection option ?value?\"" + } + switch -- $option { + debug { upvar pgtcl::debug var } + notice { upvar pgtcl::notice($db) var } + default { + error "Bad option \"$option\": must be one of notice, debug" + } + } + set return_value $var + if {$nargs} { + set var [lindex $args 0] + } + return $return_value +} + +# pg_escape_string: Returns an escaped string for use as an SQL string. +# An optional connection argument can be provided, which is used to +# determine the setting of "standard_conforming_strings". In libpq, this also +# affects handling of non-ASCII characters, but pgin.tcl does not support that. +# Caution: There is an incompatible pg_escape_string in another Pgtcl +# implementation, which makes pg_escape_string and pg_quote equivalent. +# In pgintcl and pgtclng, only pg_quote includes quotes around the return. +proc pg_escape_string {args} { + if {[set argc [llength $args]] == 1} { + set db _default_ + set argi 0 + } elseif {$argc == 2} { + set db [lindex $args 0] + set argi 1 + } else { + error "wrong # args: should be pg_escape_string ?conn? string" + } + if {![info exists pgtcl::std_str($db)]} { + error "$db is not a valid postgresql connection" + } + if {$pgtcl::std_str($db)} { + return [string map {' ''} [lindex $args $argi]] + } + return [string map {' '' \\ \\\\} [lindex $args $argi]] +} + +# pg_quote: Returns a quoted, escaped string for use as an SQL string. +# An optional connection argument can be provided, which is used to +# determine the setting of "standard_conforming_strings". In libpq, this also +# affects handling of non-ASCII characters, but pgin.tcl does not support that. +proc pg_quote {args} { + if {[set argc [llength $args]] == 1} { + return "'[pg_escape_string [lindex $args 0]]'" + } + if {$argc == 2} { + return "'[pg_escape_string [lindex $args 0] [lindex $args 1]]'" + } + error "wrong # args: should be pg_quote ?conn? string" +} + +# pg_escape_identifier: Return a double-quoted, escaped identifier string +# This is for table names, column names, etc. See libpq PQescapeIdentifier(). +# Caution: Pgintcl ignores the connection handle, and does not account for +# encoding. +proc pg_escape_identifier {db_ignored s} { + return "\"[string map {{"} {""}} $s]\"" +} + +# pg_escape_literal: Return a single-quoted, escaped string for use in SQL. +# See libpq PQescapeLiteral(). This is effectively equivalent to pg_quote, +# but the result is independed of standard_conforming_strings - if the +# string has any \, they are doubled and the PostgreSQL-specific Escape +# String syntax E'...' is used. +# Caution: Pgintcl ignores the connection handle, and does not account for +# encoding. +proc pg_escape_literal {db_ignored s} { + if {[string first "\\" $s] >= 0} { + return " E'[string map {' '' \\ \\\\} $s]'" + } + return "'[string map {' ''} $s]'" +} + +# pg_escape_bytea: Escape a binary string for use as a quoted SQL string. +# Returns the escaped string, which is safe for use inside single quotes +# in an SQL statement. Note back-slashes are doubled due to double parsing +# in the backend. Emulates libpq PQescapeBytea() or PQescapeByteaConn(), +# except it always uses 'escape' encoding, never 'hex' encoding. +# See also pg_unescape_bytea, but note that these functions are not inverses. +# (I tried many versions to improve speed and this was fastest, although still +# slow. The numeric constants 92=\ and 39=` were part of that optimization.) +proc pg_escape_bytea {args} { + if {[set argc [llength $args]] == 1} { + set db _default_ + set binstr [lindex $args 0] + } elseif {$argc == 2} { + set db [lindex $args 0] + set binstr [lindex $args 1] + } else { + error "wrong # args: should be pg_escape_bytea ?conn? string" + } + if {![info exists pgtcl::std_str($db)]} { + error "$db is not a valid postgresql connection" + } + if {$pgtcl::std_str($db)} { + set backslash "\\" + } else { + set backslash "\\\\" + } + set result "" + + binary scan $binstr c* val_list + foreach c [split $binstr {}] val $val_list { + if {$val == 92} { + append result $backslash$backslash + } elseif {$val == 39} { + append result '' + } elseif {$val < 32 || 126 < $val} { + append result $backslash [format %03o [expr {$val & 255}]] + } else { + append result $c + } + } + return $result +} + +# pg_unescape_bytea: Unescape a string returned from PostgreSQL as an +# escaped bytea object and return a binary string. +# Emulates libpq PQunescapeBytea(), and supports both 'hex' and 'escape' +# coding, automatically detected, so it works through PostgreSQL-9.0. +# See also pg_escape_bytea, but note that these functions are not inverses. +# Implementation note: Iterative implementations perform very poorly. +# The method used for 'escape' decoding is from Benny Riefenstahl via +# Jerry Levan. It works much faster than looping or string map, and returns +# the correct data on any value produced by the PostgreSQL backend from +# converting a bytea data type to text (byteaout). +# But it does not work the same as PQunescapeBytea() for all values. +# For example, passing \a here returns 0x07, but PQunescapeBytea returns 'a'. +# The method used for 'hex' decoding is also a compromise which should work +# correctly within the range of results produced by PostgreSQL. For example, +# this implementation ignores whitespace anywhere, but PostgreSQL only +# allows whitespace between pairs of digits. +proc pg_unescape_bytea {str} { + if {[string range $str 0 1] != "\\x"} { + # Escape mode + return [subst -nocommands -novariables $str] + } + # Hex mode. Strip leading \x and whitespace, then decode as hex. + return [binary format H* [regsub -all "\\s" [string range $str 2 end] ""]] +} + +# pg_parameter_status: Return the value of a backend parameter value. +# These are generally supplied by the backend during startup. +proc pg_parameter_status {db name} { + upvar #0 pgtcl::param_$db param + if {[info exists param($name)]} { + return $param($name) + } + return "" +} + +# pg_transaction_status: Return the current transaction status. +# Returns a string: IDLE INTRANS INERROR or UNKNOWN. +proc pg_transaction_status {db} { + if {[info exists pgtcl::xstate($db)]} { + switch -- $pgtcl::xstate($db) { + I { return IDLE } + T { return INTRANS } + E { return INERROR } + } + } + return UNKNOWN +} + + +# pg_encrypt_password: Encrypt a password for commands that accept +# a pre-encrypted password, like ALTER USER. +# Returns a PostgreSQL-style encrypted password. +# See pgtcl::encrypt_password for more information. +proc pg_encrypt_password {password username} { + return "md5[pgtcl::encrypt_password $password $username]" +} + +# pg_backend_pid: Return the process ID (PID) of the backend process +proc pg_backend_pid {db} { + if {[info exists pgtcl::bepid($db)]} { + return $pgtcl::bepid($db) + } + return 0 +} + +# pg_server_version: Return the PostgreSQL server version as an integer. +# This parses the server_version parameter sent on connect. +proc pg_server_version {db} { + switch [scan [pg_parameter_status $db server_version] %d.%d.%d x y z] { + 3 { return [expr {($x * 100 + $y) * 100 + $z}] } + 2 { return [expr {$x * 10000 + $y}] } + } + return 0 +} + +# === Internal Procedure to support COPY === + +# Handle a CopyInResponse or CopyOutResponse message: +proc pgtcl::begincopy {result_name direction} { + upvar $result_name result + set db $result(conn) + if {[pgtcl::get_int8 $db]} { + error "pg_exec: COPY BINARY is not supported" + } + set result(status) PGRES_COPY_$direction + # Column count and per-column formats are ignored. + set ncol [pgtcl::get_int16 $db] + pgtcl::skip $db [expr {2*$ncol}] + if {$pgtcl::debug} { puts "+pg_exec begin copy $direction" } +} + +# === Public procedures: COPY === + +# I/O procedures to support COPY. No longer able to just read/write the +# channel, due to the message procotol. + +# Read line from COPY TO. Returns the copy line if OK, else "" on end. +# Note: The returned line does not end in a newline, so you can split it +# on tab and get a list of column values. +# At end of COPY, it takes the CopyDone only. pg_endcopy must be called to +# get the CommandComplete and ReadyForQuery messages. +proc pg_copy_read {res} { + upvar #0 [pgtcl::checkres $res] result + set db $result(conn) + if {$result(status) != "PGRES_COPY_OUT"} { + error "pg_copy_read called but connection is not doing a COPY OUT" + } + # Notice/Notify etc are not allowed during copy, so no loop needed. + set c [pgtcl::readmsg $db] + if {$pgtcl::debug} { puts "+pg_copy_read msg $c" } + if {$c == "d"} { + return [string trimright \ + [encoding convertfrom identity [pgtcl::get_rest $db]] "\n\r"] + } + if {$c == "c"} { + return "" + } + # Error or invalid response. + if {$c == "E"} { + set result(status) PGRES_FATAL_ERROR + set result(error) [pgtcl::get_response $db result] + return "" + } + error "pg_copy_read: procotol violation, unexpected $c in copy out" +} + +# Write line for COPY FROM. This must represent a single record (tuple) with +# values separated by tabs. Do not add a newline; pg_copy_write does this. +proc pg_copy_write {res line} { + upvar #0 [pgtcl::checkres $res] result + pgtcl::sendmsg $result(conn) d "[encoding convertto identity $line]\n" +} + +# End a COPY TO/FROM. This is needed to finish up the protocol after +# reading or writing. On COPY TO, this needs to be called after +# pg_copy_read returns an empty string. On COPY FROM, this needs to +# be called after writing the last record with pg_copy_write. +# Note: Do not write or expect to read "\." anymore. +# When it returns, the result structure (res) will be updated. +proc pg_endcopy {res} { + upvar #0 [pgtcl::checkres $res] result + set db $result(conn) + if {$pgtcl::debug} { puts "+pg_endcopy end $result(status)" } + + # An error might have been sent during a COPY TO, so the result + # status will already be FATAL and should not be disturbed. + if {$result(status) != "PGRES_FATAL_ERROR"} { + if {$result(status) == "PGRES_COPY_IN"} { + # Send CopyDone + pgtcl::sendmsg $db c {} + } elseif {$result(status) != "PGRES_COPY_OUT"} { + error "pg_endcopy called but connection is not doing a COPY" + } + set result(status) PGRES_COMMAND_OK + } + + # We're looking for CommandComplete and ReadyForQuery here, but other + # things can happen too. + while {[set c [pgtcl::readmsg $db]] != "Z"} { + if {![pgtcl::common_message $c $db result]} { + error "Unexpected reply from database: $c" + } + } + set pgtcl::xstate($db) [pgtcl::get_byte $db] + if {$pgtcl::debug} { puts "+pg_endcopy returns, st=$result(status)" } +} + +# === Internal producedures for Function Call (used by Large Object) === + +# Internal procedure to lookup, cache, and return a PostgreSQL function OID. +# This assumes all connections have the same function OIDs, which might not be +# true if you connect to servers running different versions of PostgreSQL. +# Throws an error if the OID is not found by PostgreSQL. +# To call overloaded functions, argument types must be specified in parentheses +# after the function name, in the the exact same format as psql "\df". +# This is a list of types separated by a comma and one space. +# For example: fname="like(text, text)". +# The return type cannot be specified. I don't think there are any functions +# distinguished only by return type. +proc pgtcl::getfnoid {db fname} { + variable fnoids + + if {![info exists fnoids($fname)]} { + + # Separate the function name from the (arg type list): + if {[regexp {^([^(]*)\(([^)]*)\)$} $fname unused fcn arglist]} { + set amatch " and oidvectortypes(proargtypes)='$arglist'" + } else { + set fcn $fname + set amatch "" + } + pg_select $db "select oid from pg_proc where proname='$fcn' $amatch" d { + set fnoids($fname) $d(oid) + } + if {![info exists fnoids($fname)]} { + error "Unable to get OID of database function $fname" + } + } + return $fnoids($fname) +} + +# Internal procedure to implement PostgreSQL "fast-path" function calls. +# $fn_oid is the OID of the PostgreSQL function. See pgtcl::getfnoid. +# $result_name is the name of the variable to store the backend function +# result into. +# $arginfo is a list of argument descriptors, each is I or S or a number. +# I means the argument is an integer32. +# S means the argument is a string, and its actual length is used. +# A number means send exactly that many bytes (null-pad if needed) from +# the argument. +# (Argument type S is passed in Ascii format code, others as Binary.) +# $arglist is a list of arguments to the PostgreSQL function. (This +# is actually a pass-through argument 'args' from the wrappers.) +# Throws Tcl error on error, otherwise returns size of the result +# stored into the $result_name variable. + +proc pgtcl::callfn {db fn_oid result_name arginfo arglist} { + upvar $result_name result + + set nargs [llength $arginfo] + if {$pgtcl::debug} { + puts "+callfn oid=$fn_oid nargs=$nargs info=$arginfo args=$arglist" + } + + # Function call: oid nfcodes fcodes... nargs {arglen arg}... resultfcode + set fcodes {} + foreach k $arginfo { + if {$k == "S"} { + lappend fcodes 0 + } else { + lappend fcodes 1 + } + } + set out [binary format {I S S* S} $fn_oid $nargs $fcodes $nargs] + # Append each argument and its length: + foreach k $arginfo arg $arglist { + if {$k == "I"} { + append out [binary format II 4 $arg] + } elseif {$k == "S"} { + append out [binary format I [string length $arg]] $arg + } else { + append out [binary format Ia$k $k $arg] + } + } + # Append format code for binary result: + append out [binary format S 1] + pgtcl::sendmsg $db F $out + + set result {} + set result_size 0 + # Fake up a partial result structure for pgtcl::common_message : + set res(error) "" + + # FunctionCall response. Also handles common messages (notify, notice). + while {[set c [pgtcl::readmsg $db]] != "Z"} { + if {$c == "V"} { + set result_size [pgtcl::get_int32 $db] + if {$result_size > 0} { + set result [pgtcl::get_bytes $db $result_size] + } else { + set result "" + } + } elseif {![pgtcl::common_message $c $db res]} { + error "Unexpected reply from database: $c" + } + } + set pgtcl::xstate($db) [pgtcl::get_byte $db] + if {$res(error) != ""} { + error $res(error) + } + return $result_size +} + +# === Public prodedures: Function Call === + +# Public interface to pgtcl::callfn. +proc pg_callfn {db fname result_name arginfo args} { + upvar $result_name result + return [pgtcl::callfn $db [pgtcl::getfnoid $db $fname] result $arginfo $args] +} + +# Public, simplified interface to pgtcl::callfn when an int32 return value is +# expected. Returns the backend function return value. +proc pg_callfn_int {db fname arginfo args} { + set n [pgtcl::callfn $db [pgtcl::getfnoid $db $fname] result $arginfo $args] + if {$n != 4} { + error "Unexpected response size ($result_size) to pg function call $fname" + } + binary scan $result I val + return $val +} + +# === Internal procedure to support Large Object === + +# Convert a LO mode string into the value of the constants used by libpq. +# Note: libpgtcl uses a mode like INV_READ|INV_WRITE for lo_creat, but +# r, w, or rw for lo_open (which it translates to INV_READ|INV_WRITE). +# This seems like a mistake. The code here accepts either form for either. +proc pgtcl::lomode {mode} { + set imode 0 + if {[string match -nocase *INV_* $mode]} { + if {[string match -nocase *INV_READ* $mode]} { + set imode 0x40000 + } + if {[string match -nocase *INV_WRITE* $mode]} { + set imode [expr {$imode + 0x20000}] + } + } else { + if {[string match -nocase *r* $mode]} { + set imode 0x40000 + } + if {[string match -nocase *w* $mode]} { + set imode [expr {$imode + 0x20000}] + } + } + if {$imode == 0} { + error "Invalid large object mode $mode" + } + return $imode +} + +# === Public prodedures: Large Object === + +# Create large object and return OID. +# See note regarding mode above at pgtcl::lomode. +proc pg_lo_creat {db mode} { + if {[catch {pg_callfn_int $db lo_creat I [pgtcl::lomode $mode]} result]} { + error "Large Object create failed\n$result" + } + if {$result == -1} { + error "Large Object create failed" + } + return $result +} + +# Open large object and return large object file descriptor. +# See note regarding mode above at pgtcl::lomode. +proc pg_lo_open {db loid mode} { + if {[catch {pg_callfn_int $db lo_open "I I" $loid [pgtcl::lomode $mode]} \ + result]} { + error "Large Object open failed\n$result" + } + if {$result == -1} { + error "Large Object open failed" + } + return $result +} + +# Close large object file descriptor. +proc pg_lo_close {db lofd} { + if {[catch {pg_callfn_int $db lo_close I $lofd} result]} { + error "Large Object close failed\n$result" + } + return $result +} + +# Delete large object: +proc pg_lo_unlink {db loid} { + if {[catch {pg_callfn_int $db lo_unlink I $loid} result]} { + error "Large Object unlink failed\n$result" + } + return $result +} + +# Read from large object. +# Note: The original PostgreSQL documentation says it returns -1 on error, +# which is a bad idea since you can't get to the error message. But it's +# probably too late to change it, so we remain bug compatible. +proc pg_lo_read {db lofd buf_name maxlen} { + upvar $buf_name buf + if {[catch {pg_callfn $db loread buf "I I" $lofd $maxlen} result]} { + return -1 + } + return $result +} + +# Write to large object. At most $len bytes are written. +# See note above on pg_lo_read error return. +proc pg_lo_write {db lofd buf len} { + if {[set buflen [string length $buf]] < $len} { + set len $buflen + } + if {[catch {pg_callfn_int $db lowrite "I $len" $lofd $buf} result]} { + return -1 + } + return $result +} + +# Seek to offset inside large object: +proc pg_lo_lseek {db lofd offset whence} { + if {[set iwhence [lsearch {SEEK_SET SEEK_CUR SEEK_END} $whence]] < 0} { + error "'whence' must be SEEK_SET, SEEK_CUR, or SEEK_END" + } + if {[catch {pg_callfn_int $db lo_lseek "I I I" $lofd $offset $iwhence} \ + result]} { + error "Large Object seek failed\n$result" + } + return $result +} + +# Seek to offset inside large object, using 64-bit offset: +proc pg_lo_lseek64 {db lofd offset whence} { + if {[set iwhence [lsearch {SEEK_SET SEEK_CUR SEEK_END} $whence]] < 0} { + error "'whence' must be SEEK_SET, SEEK_CUR, or SEEK_END" + } + set off64 [binary format W $offset] + if {[catch {pg_callfn $db lo_lseek64 newoff "I 8 I" $lofd $off64 $iwhence} \ + result] || $result != 8} { + error "Large Object seek failed\n$result" + } + binary scan $newoff W off64 + return $off64 +} + +# Return location of file offset in large object: +proc pg_lo_tell {db lofd} { + if {[catch {pg_callfn_int $db lo_tell I $lofd} result]} { + error "Large Object tell offset failed\n$result" + } + return $result +} + +# Return location of file offset in large object, using 64-bit offset: +proc pg_lo_tell64 {db lofd} { + if {[catch {pg_callfn $db lo_tell64 offset I $lofd} result] || $result != 8} { + error "Large Object tell offset failed\n$result" + } + binary scan $offset W offset_int64 + return $offset_int64 +} + +# Truncate large object (or extend) to given size: +proc pg_lo_truncate {db lofd len} { + if {[catch {pg_callfn_int $db lo_truncate "I I" $lofd $len} result]} { + error "Large Object truncate failed\n$result" + } + return $result +} + +# Truncate large object (or extend) to given size, using 64-bit offset +proc pg_lo_truncate64 {db lofd len} { + set size64 [binary format W $len] + if {[catch {pg_callfn_int $db lo_truncate64 "I 8" $lofd $size64} result]} { + error "Large Object truncate failed\n$result" + } + return $result +} + +# Import large object. Wrapper for lo_creat, lo_open, lo_write. +# Returns Large Object OID, which should be stored in a table somewhere. +proc pg_lo_import {db filename} { + if {[catch {open $filename} f]} { + error "Large object import of $filename failed\n$f" + } + fconfigure $f -translation binary + if {[catch {pg_lo_creat $db INV_READ|INV_WRITE} loid]} { + close $f + error "Large Object import of $filename failed\n$loid" + } + if {[catch {pg_lo_open $db $loid w} lofd]} { + close $f + set error "Large Object import of $filename failed\n$lofd" + } + + while {1} { + set buf [read $f 32768] + if {[set len [string length $buf]] == 0} break + if {[pg_lo_write $db $lofd $buf $len] != $len} { + close $f + # Based on comments in libpq source, do not do pg_lo_close here because + # it is already in a failed transaction and will overwrite any error. + error "Large Object import failed to write $len bytes" + } + } + close $f + pg_lo_close $db $lofd + return $loid +} + +# Export large object. Wrapper for lo_open, lo_read. +proc pg_lo_export {db loid filename} { + if {[catch {pg_lo_open $db $loid r} lofd]} { + error "Large Object export to $filename failed\n$lofd" + } + if {[catch {open $filename w} f]} { + pg_lo_close $db $lofd + error "Large object export to $filename failed\n$f" + } + fconfigure $f -translation binary + while {[set len [pg_lo_read $db $lofd buf 32768]] > 0} { + puts -nonewline $f $buf + } + close $f + if {$len < 0} { + # Based on comments in libpq source, do not do pg_lo_close here because + # it is already in a failed transaction and will overwrite any error. + error "Large Object export to $filename failed\nLarge object read error" + } + pg_lo_close $db $lofd +} + +# === MD5 Checksum procedures for password authentication === + +# Coded in Tcl by L Bayuk, using these sources: +# RFC1321 +# PostgreSQL: src/backend/libpq/md5.c +# If you want a better/faster MD5 implementation, see tcllib. + +namespace eval md5 { } + +# Round 1 helper, e.g.: +# a = b + ROT_LEFT((a + F(b, c, d) + X[0] + 0xd76aa478), 7) +# p1 p2 p1 p3 p4 p5 p6 p7 +# Where F(x,y,z) = (x & y) | (~x & z) +# +proc md5::round1 {p1 p2 p3 p4 p5 p6 p7} { + set r [expr {$p2 + ($p1 & $p3 | ~$p1 & $p4) + $p5 + $p6}] + return [expr {$p1 + ($r << $p7 | (($r >> (32 - $p7)) & ((1 << $p7) - 1)))}] +} + +# Round 2 helper, e.g.: +# a = b + ROT_LEFT((a + G(b, c, d) + X[1] + 0xf61e2562), 5) +# p1 p2 p1 p3 p4 p5 p6 p7 +# Where G(x,y,z) = (x & z) | (y & ~z) +# +proc md5::round2 {p1 p2 p3 p4 p5 p6 p7} { + set r [expr {$p2 + ($p1 & $p4 | $p3 & ~$p4) + $p5 + $p6}] + return [expr {$p1 + ($r << $p7 | (($r >> (32 - $p7)) & ((1 << $p7) - 1)))}] +} + +# Round 3 helper, e.g.: +# a = b + ROT_LEFT((a + H(b, c, d) + X[5] + 0xfffa3942), 4) +# p1 p2 p1 p3 p4 p5 p6 p7 +# Where H(x, y, z) = x ^ y ^ z +# +proc md5::round3 {p1 p2 p3 p4 p5 p6 p7} { + set r [expr {$p2 + ($p1 ^ $p3 ^ $p4) + $p5 + $p6}] + return [expr {$p1 + ($r << $p7 | (($r >> (32 - $p7)) & ((1 << $p7) - 1)))}] +} + +# Round 4 helper, e.g.: +# a = b + ROT_LEFT((a + I(b, c, d) + X[0] + 0xf4292244), 6) +# p1 p2 p1 p3 p4 p5 p6 p7 +# Where I(x, y, z) = y ^ (x | ~z) +# +proc md5::round4 {p1 p2 p3 p4 p5 p6 p7} { + set r [expr {$p2 + ($p3 ^ ($p1 | ~$p4)) + $p5 + $p6}] + return [expr {$p1 + ($r << $p7 | (($r >> (32 - $p7)) & ((1 << $p7) - 1)))}] +} + +# Do one set of rounds. Updates $state(0:3) with results from $x(0:16). +proc md5::round {x_name state_name} { + upvar $x_name x $state_name state + set a $state(0) + set b $state(1) + set c $state(2) + set d $state(3) + + # Round 1, steps 1-16 + set a [round1 $b $a $c $d $x(0) 0xd76aa478 7] + set d [round1 $a $d $b $c $x(1) 0xe8c7b756 12] + set c [round1 $d $c $a $b $x(2) 0x242070db 17] + set b [round1 $c $b $d $a $x(3) 0xc1bdceee 22] + set a [round1 $b $a $c $d $x(4) 0xf57c0faf 7] + set d [round1 $a $d $b $c $x(5) 0x4787c62a 12] + set c [round1 $d $c $a $b $x(6) 0xa8304613 17] + set b [round1 $c $b $d $a $x(7) 0xfd469501 22] + set a [round1 $b $a $c $d $x(8) 0x698098d8 7] + set d [round1 $a $d $b $c $x(9) 0x8b44f7af 12] + set c [round1 $d $c $a $b $x(10) 0xffff5bb1 17] + set b [round1 $c $b $d $a $x(11) 0x895cd7be 22] + set a [round1 $b $a $c $d $x(12) 0x6b901122 7] + set d [round1 $a $d $b $c $x(13) 0xfd987193 12] + set c [round1 $d $c $a $b $x(14) 0xa679438e 17] + set b [round1 $c $b $d $a $x(15) 0x49b40821 22] + + # Round 2, steps 17-32 + set a [round2 $b $a $c $d $x(1) 0xf61e2562 5] + set d [round2 $a $d $b $c $x(6) 0xc040b340 9] + set c [round2 $d $c $a $b $x(11) 0x265e5a51 14] + set b [round2 $c $b $d $a $x(0) 0xe9b6c7aa 20] + set a [round2 $b $a $c $d $x(5) 0xd62f105d 5] + set d [round2 $a $d $b $c $x(10) 0x02441453 9] + set c [round2 $d $c $a $b $x(15) 0xd8a1e681 14] + set b [round2 $c $b $d $a $x(4) 0xe7d3fbc8 20] + set a [round2 $b $a $c $d $x(9) 0x21e1cde6 5] + set d [round2 $a $d $b $c $x(14) 0xc33707d6 9] + set c [round2 $d $c $a $b $x(3) 0xf4d50d87 14] + set b [round2 $c $b $d $a $x(8) 0x455a14ed 20] + set a [round2 $b $a $c $d $x(13) 0xa9e3e905 5] + set d [round2 $a $d $b $c $x(2) 0xfcefa3f8 9] + set c [round2 $d $c $a $b $x(7) 0x676f02d9 14] + set b [round2 $c $b $d $a $x(12) 0x8d2a4c8a 20] + + # Round 3, steps 33-48 + set a [round3 $b $a $c $d $x(5) 0xfffa3942 4] + set d [round3 $a $d $b $c $x(8) 0x8771f681 11] + set c [round3 $d $c $a $b $x(11) 0x6d9d6122 16] + set b [round3 $c $b $d $a $x(14) 0xfde5380c 23] + set a [round3 $b $a $c $d $x(1) 0xa4beea44 4] + set d [round3 $a $d $b $c $x(4) 0x4bdecfa9 11] + set c [round3 $d $c $a $b $x(7) 0xf6bb4b60 16] + set b [round3 $c $b $d $a $x(10) 0xbebfbc70 23] + set a [round3 $b $a $c $d $x(13) 0x289b7ec6 4] + set d [round3 $a $d $b $c $x(0) 0xeaa127fa 11] + set c [round3 $d $c $a $b $x(3) 0xd4ef3085 16] + set b [round3 $c $b $d $a $x(6) 0x04881d05 23] + set a [round3 $b $a $c $d $x(9) 0xd9d4d039 4] + set d [round3 $a $d $b $c $x(12) 0xe6db99e5 11] + set c [round3 $d $c $a $b $x(15) 0x1fa27cf8 16] + set b [round3 $c $b $d $a $x(2) 0xc4ac5665 23] + + # Round 4, steps 49-64 + set a [round4 $b $a $c $d $x(0) 0xf4292244 6] + set d [round4 $a $d $b $c $x(7) 0x432aff97 10] + set c [round4 $d $c $a $b $x(14) 0xab9423a7 15] + set b [round4 $c $b $d $a $x(5) 0xfc93a039 21] + set a [round4 $b $a $c $d $x(12) 0x655b59c3 6] + set d [round4 $a $d $b $c $x(3) 0x8f0ccc92 10] + set c [round4 $d $c $a $b $x(10) 0xffeff47d 15] + set b [round4 $c $b $d $a $x(1) 0x85845dd1 21] + set a [round4 $b $a $c $d $x(8) 0x6fa87e4f 6] + set d [round4 $a $d $b $c $x(15) 0xfe2ce6e0 10] + set c [round4 $d $c $a $b $x(6) 0xa3014314 15] + set b [round4 $c $b $d $a $x(13) 0x4e0811a1 21] + set a [round4 $b $a $c $d $x(4) 0xf7537e82 6] + set d [round4 $a $d $b $c $x(11) 0xbd3af235 10] + set c [round4 $d $c $a $b $x(2) 0x2ad7d2bb 15] + set b [round4 $c $b $d $a $x(9) 0xeb86d391 21] + + incr state(0) $a + incr state(1) $b + incr state(2) $c + incr state(3) $d +} + +# Pad out buffer per MD5 spec: +proc md5::pad {buf_name} { + upvar $buf_name buf + + # Length in bytes: + set len [string length $buf] + # Length in bits as 2 32 bit words: + set len64hi [expr {$len >> 29 & 7}] + set len64lo [expr {$len << 3}] + + # Append 1 special byte, then append 0 or more 0 bytes until + # (length in bytes % 64) == 56 + set pad [expr {64 - ($len + 8) % 64}] + append buf [binary format a$pad "\x80"] + + # Append the length in bits as a 64 bit value, low bytes first. + append buf [binary format i1i1 $len64lo $len64hi] + +} + +# Calculate MD5 Digest over a string, return as 32 hex digit string. +proc md5::digest {buf} { + # This is 0123456789abcdeffedcba9876543210 in byte-swapped order: + set state(0) 0x67452301 + set state(1) 0xEFCDAB89 + set state(2) 0x98BADCFE + set state(3) 0x10325476 + + # Pad buffer per RFC to exact multiple of 64 bytes. + pad buf + + # Calculate digest in 64 byte chunks: + set nwords 0 + set nbytes 0 + set word 0 + binary scan $buf c* bytes + # Unclear, but the data seems to get byte swapped here. + foreach c $bytes { + set word [expr {$c << 24 | ($word >> 8 & 0xffffff) }] + if {[incr nbytes] == 4} { + set nbytes 0 + set x($nwords) $word + set word 0 + if {[incr nwords] == 16} { + round x state + set nwords 0 + } + } + } + + # Result is state(0:3), but each word is taken low byte first. + set result {} + for {set i 0} {$i <= 3} {incr i} { + set w $state($i) + append result [format %02x%02x%02x%02x \ + [expr {$w & 255}] \ + [expr {$w >> 8 & 255}] \ + [expr {$w >> 16 & 255}] \ + [expr {$w >> 24 & 255}]] + } + return $result +} +package provide pgintcl $pgtcl::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pkgIndex.tcl similarity index 86% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pkgIndex.tcl index 31333561..721e18d8 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/pkgIndex.tcl @@ -8,4 +8,4 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -package ifneeded khim 1.0.1 [list source [file join $dir khim.tcl]] +package ifneeded pgintcl 3.5.2 [list source [file join $dir pgin.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/tkpsql.tcl b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/tkpsql.tcl new file mode 100644 index 00000000..530ee2b6 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/pgintcl3.5.2/tkpsql.tcl @@ -0,0 +1,880 @@ +# $Id: tkpsql.tcl 515 2011-09-17 19:18:53Z lbayuk $ +# tkpsql - Interactive PostgreSQL SQL Interface +# Copyright 2003-2008 by L Bayuk +# May be freely distributed with or without modification; must retain this +# notice; provided with no warranties. +# See the file COPYING for complete information on usage and redistribution +# of this file, and for a disclaimer of all warranties. + +# Global variables: +# version - Our version string. +# widgets() - Main widget pathnames : input output status +# n_history - Number of history elements +# history() - History array 1:n_history +# history_p - Index in history where next command will be stored +# history_q - Index in history where next command will be recalled from +# db - Handle to open database, if empty there is no connection. +# dbinfo() - Remembers db conection info: host, user, dbname, port, password +# dbinfo(has_schema) Flag: Database has schemas (PostgreSQL >=7.3) +# form_status - Temporary flag for waiting on a popup +# pwd - Starting directory for file open/save +# option() - Array of options +# " (outstyle) - Output style, "wide" or "narrow" +# " (debug) - Debug flag, 0 for none +# " (maxlook) - Max. result rows to examine for column widths +# " (clear) - Clear output pad before each command results +# special() - SQL for special database queries, index by code. +# special_title() - Titles for special queries, indexed by code. +# special_codes - A list of special*() indexes, ordered as they should +# be displayed in the popup. + +set version 1.2.1 +package require Tk + +# ===== Utility Routines ===== + +# Initialization: +proc initialize {} { + global n_history history history_p history_q + global db pwd option + + array set option { + debug 0 + outstyle wide + maxlook 20 + clear 1 + } + + # Initialize the history list: + set n_history 25 + for {set i 1} {$i <= $n_history} {incr i} { + set history($i) {} + } + set history_p 1 + set history_q 1 + + set db {} + set pwd [pwd] + dbms_load + font create monofont -family Courier + font create boldfont -family Courier -weight bold +} + +# Initialize the array of special database queries. +# This has to be done after connecting to the database, so we know if +# the schema-aware versions should be used. It can be called again as needed. +# special(c) contains the SQL for code 'c'. +# special_title(c) contains the displayed title for code 'c'. +# The index values 'c' are arbitrary codes. +# The list special_codes contains the ordered list of indexes. +# +# I mostly copied the SQL queries from psql. The 'schema-aware' queries are +# based on PostgreSQL-7.3.4; the 'non-schema' versions are from some older +# version. But in some cases, I took advantage of the special views. +# +# Note: The pre-7.3 queries are no longer updated/maintained because I don't +# have pre-7.3 server to test them on. +# +proc init_special {} { + global dbinfo special special_title special_codes + catch {unset special_codes special_title special} + + if {$dbinfo(has_schema)} init_special_new init_special_old +} + +# Initialize special queries for PostgreSQL-7.3 and higher. +# See comments for init_special +proc init_special_new {} { + global special special_title special_codes + + # This is the ordered list of codes whose titles will be displayed. + set special_codes { dbs tables views index rules seqs rights user group } + + set special_title(dbs) "List Databases" + set special(dbs) { + select datname as "Database Name", usename as "Owner" + from pg_database, pg_user + where datdba=usesysid order by datname + } + + set special_title(tables) "List Tables" + set special(tables) { + select schemaname as "Schema", tablename as "Table", tableowner as "Owner" + from pg_catalog.pg_tables + where schemaname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1,2 + } + + set special_title(views) "List Views" + set special(views) { + select schemaname as "Schema", viewname as "View", viewowner as "Owner", + definition as "Definition" + from pg_catalog.pg_views + where schemaname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1,2 + } + + set special_title(index) "List Indexes" + set special(index) { + select schemaname as "Schema", indexname as "Index-Name", + tablename as "Base-Table", indexdef as "Definition" + from pg_catalog.pg_indexes + where schemaname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1,2 + } + + set special_title(rules) "List Rules" + set special(rules) { + select schemaname as "Schema", rulename as "Rule", + definition as "Definition" + from pg_catalog.pg_rules + where schemaname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1,2 + } + + # Sequences - no special view, so do it manually. + set special_title(seqs) "List Sequences" + set special(seqs) { + select n.nspname as "Schema", c.relname as "Sequence", + u.usename as "Owner" + from pg_namespace n, pg_class c, pg_user u + where n.oid = c.relnamespace and c.relowner = u.usesysid + and relkind = 'S' + and n.nspname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1, 2 + } + + set special_title(rights) "Show Permissions" + set special(rights) { + select n.nspname as "Schema", c.relname as "Relation", + u.usename as "Owner", c.relacl as "Access Control List" + from pg_class c, pg_user u, pg_namespace n + where c.relowner = u.usesysid and c.relnamespace = n.oid + and c.relkind in ('r', 'v', 'S') + and pg_catalog.pg_table_is_visible(c.oid) + and n.nspname not in ('pg_catalog', 'pg_toast', 'information_schema') + order by 1, 2 + } + + set special_title(user) "List Users" + set special(user) { + select usename as "Username", usesysid as "User-ID", + trim (leading ' ' from + trim (trailing ',' from + case when usesuper then ' Superuser,' else '' end + || case when usecreatedb then ' Create Database,' else '' end + || case when usecatupd then ' Update Catalogs,' else '' end)) + as "Rights" + from pg_user order by usename + } + + set special_title(group) "List Groups" + set special(group) { + select groname as "Groupname", grosysid as "Group-ID", + grolist as "Member-IDs" + from pg_group order by groname + } +} + +# Initialize special queries for PostgreSQL older than 7.3. +# See comments for init_special. This is UNMAINTAINED. +proc init_special_old {} { + global special special_title special_codes + + # This is the ordered list of codes whose titles will be displayed. + set special_codes { dbs tables index rights user group } + + set special_title(dbs) "List Databases" + set special(dbs) { + select datname as "Database Name", usename as "Owner" + from pg_database, pg_user + where datdba=usesysid order by datname + } + + set special_title(tables) "List Tables" + set special(tables) { + select usename as username, relname as table, relkind as kind + from pg_class, pg_user where relkind = 'r' and relname !~ '^pg_' + and usesysid=relowner order by relname + } + + set special_title(index) "List Indexes/Sequences" + set special(index) { + select usename as username, relname as name, relkind as kind + from pg_class, pg_user where (relkind='i' or relkind='S') and + relname !~ '^pg_' and usesysid=relowner order by relname + } + + set special_title(rights) "Show Table/Sequence Rights" + set special(rights) { + select relname as table, usename as owner, relacl as acl from + pg_class, pg_user where (relkind = 'r' or relkind = 'S') and + relname !~ '^pg_' and usesysid=relowner order by relname + } + + set special_title(user) "List Users" + set special(user) { + select usename as "Username", usesysid as "User-ID", + usecreatedb as "Create-DB?", + usesuper as "Superuser?", + usecatupd as "Update-Catalogs?" + from pg_user order by usename + } + + set special_title(group) "List Groups" + set special(group) { + select groname as "Groupname", grosysid as "Group-ID", + grolist as "Member-IDs" + from pg_group order by groname + } +} + + +# Initialize after connecting to a database +# If an error occurs querying the database, ignore the error and don't +# report it. (Will only report errors from user-issued queries.) +# This also inializes the special queries. +proc init_post_connect {} { + global db dbinfo + + # Determine if the database supports schemas. + set dbinfo(has_schema) 0 + if {![catch {pg_exec $db "select nspname from pg_namespace limit 1"} r]} { + if {[pg_result $r -status] == "PGRES_TUPLES_OK"} { + set dbinfo(has_schema) 1 + } + pg_result $r -clear + } + debug_puts "has_schema: $dbinfo(has_schema)" + init_special +} + +# Pluralization +proc plural {n {s "s"}} { + if {$n == 1} { return ""} else { return $s } +} + +# Assign respective list elements to named variables: +proc setlist {list args} { + foreach val $list var $args { + upvar $var v + set v $val + } +} + +# Output some text if debugging is on: +proc debug_puts {s} { + global option + if {$option(debug)} { + puts "+debug: $s" + } +} + +# Load PostgreSQL support with library or emulator: +proc dbms_load {} { + # If it is already loaded; e.g. running under pgtksh, nothing to do. + if {[info commands pg_connect] != ""} return + # Use my pgin.tcl interface library from the same directory: + set cmd [list source [file join [file dirname [info script]] pgin.tcl]] + if {[catch {uplevel #0 $cmd} msg]} { + error "Error: Unable to load database support. $msg" + } +} + +# ===== GUI / Window Utilities ===== + +# Center a window over another window. +# $win : Window to center +# $over : What to center it over: +# "ROOT" => center over the screen. +# "PARENT" => center over $win's parent window. +# Otherwise $over is the name of a window to center $win over. +# On return, the window will be mapped (de-iconified). +proc center_window {win over} { + wm withdraw $win + update + if {$over == "ROOT"} { + set base_x 0 + set base_y 0 + set base_w [winfo screenwidth $win] + set base_h [winfo screenheight $win] + } else { + if {$over == "PARENT"} { + set overwin [winfo parent $win] + } else { + set overwin $over + } + set base_x [winfo rootx $overwin] + set base_y [winfo rooty $overwin] + set base_w [winfo width $overwin] + set base_h [winfo height $overwin] + } + set win_w [winfo reqwidth $win] + set win_h [winfo reqheight $win] + if {[set win_x [expr {$base_x + int(($base_w - $win_w) / 2)}]] < 0} { + set win_x 0 + } + if {[set win_y [expr {$base_y + int(($base_h - $win_h) / 2)}]] < 0} { + set win_y 0 + } + wm geometry $win +$win_x+$win_y + wm deiconify $win +} + +# Make a top-level window and return its name: +proc mk_window {name title} { + catch {destroy $name} + toplevel $name + wm title $name $title + wm transient $name . + return $name +} + +# Position and wait for grabbed popup window. +# Change with care; MS-Win is very sensitive to the command order. +proc window_wait {win focus_to varname} { + global $varname + set save_focus [focus] + center_window $win PARENT + focus $focus_to + grab set $win + tkwait variable $varname + destroy $win + catch {focus $save_focus} +} + +# Build a button with key binding(s) and command. Returns widget name. +proc mk_button {widget label key command} { + button $widget -text "$label $key" -command $command + bind . $key "$widget invoke" + return $widget +} + +# Make a 'buttons' frame with OK and Cancel buttons. +proc mk_buttons {toplevel {ok_action {set form_status 1}}} { + set f $toplevel.buttons + frame $f + button $f.ok -text OK -default active -command $ok_action + bind $toplevel "$f.ok invoke" + button $f.cancel -text Cancel -default normal -command {set form_status 0} + bind $toplevel "$f.cancel invoke" + pack $f.ok $f.cancel -side left -padx 3 -pady 3 +} + +# ===== UI Support Routines ===== + +# Append a line to the output window: +proc oputs {s {tag ""}} { + global widgets + $widgets(output) insert end "$s\n" $tag + $widgets(output) see end +} + +# Clear the output window: +proc clear_output {} { + global widgets + $widgets(output) delete 1.0 end +} + +# Display some text in the status window: +proc show_status {s} { + global widgets + $widgets(status) configure -text $s + update +} + +# Clear the input window and put the focus there; also clears the status. +# This is used when returning from a command so no update is needed. +proc clear_input {} { + global widgets + $widgets(input) delete 1.0 end + focus $widgets(input) + $widgets(status) configure -text {} +} + +# Utility function used by build_format to update max lengths +proc max_list {max_name list} { + upvar $max_name max + set i 0 + foreach s $list { + set slen [string length $s] + if {$slen > $max($i)} { + set max($i) $slen + } + incr i + } +} + +# Create a format for output of query results. This decides how much space +# should be given to each column, and builds a format for {format} and +# returns it. $qr is the pgtcl query result handle. We look at the column +# headers and up to $option(maxlook) rows to find the longest field values. +# The result is a format string like {%-ns %-ns... %s}. +proc build_format {nrow ncol qr} { + global option + + if {$nrow > $option(maxlook)} { + set nrow $option(maxlook) + } + for {set i 0} {$i < $ncol} {incr i} { + set max($i) 0 + } + max_list max [pg_result $qr -attributes] + for {set i 0} {$i < $nrow} {incr i} { + max_list max [pg_result $qr -getTuple $i] + } + # Don't use the last column's width, just do "%s" for it. + set fmt {} + for {set i 0} {$i < $ncol-1} {incr i} { + append fmt "%-$max($i)s " + } + append fmt "%s" + debug_puts "build_format=$fmt" + return $fmt +} + +# Display query results in "narrow" format (one field per line): +proc show_results_narrow {nrow ncol qr} { + set headers [pg_result $qr -attributes] + for {set r 0} {$r < $nrow} {incr r} { + foreach name $headers value [pg_result $qr -getTuple $r] { + oputs "$name: $value" + } + if {$r % 10 == 0} { + show_status "Reading reply...$r" + } + oputs "" + } +} + +# Display query results in "wide" format (one record per line): +proc show_results_wide {nrow ncol qr} { + # Calculate field widths for output: + set fmt [build_format $nrow $ncol $qr] + + # Output the column headers: + oputs [eval format {$fmt} [pg_result $qr -attributes]] under + + # Output all of the rows: + for {set r 0} {$r < $nrow} {incr r} { + oputs [eval format {$fmt} [pg_result $qr -getTuple $r]] + if {$r % 10 == 0} { + show_status "Reading reply...$r" + } + } +} + +# Send SQL to the backend and display the results. Optional title is +# displayed instead of the actual SQL (used for special queries). +proc run_sql {sql {title ""}} { + global db option + + if {$db == ""} { + tk_messageBox -title tkpsql -icon error -type ok \ + -message "Not connected to database" + return + } + debug_puts "SQL: $sql" + + if {$option(clear)} clear_output + + if {$title != ""} { + oputs $title bold + } else { + oputs $sql bold + } + show_status "Sending query..." + # Run the SQL, catch a backend or connection failure. + if {[catch {pg_exec $db $sql} reply]} { + oputs "ERROR executing SQL:" bold + oputs $reply bold + return + } + set status [pg_result $reply -status] + debug_puts "Query status $status" + show_status "" + if {$status == "PGRES_COMMAND_OK"} { + # Command completed with no tuples (e.g. insert, update, etc.). + # Show the OID, if available. (Not available should be 0, but there was + # some confusion early about this and it might be an empty string.) + set show OK + if {[set oid [pg_result $reply -oid]] != 0 && $oid != ""} { + append show ", OID=$oid" + } + # Show affected tuple count. Not all pgtcl's support this. + if {![catch {pg_result $reply -cmdTuples} n] && $n != ""} { + append show ", $n row[plural $n] affected" + } + oputs $show bold + clear_input + } elseif {$status != "PGRES_TUPLES_OK"} { + # Generally this will be PGRES_FATAL_ERROR, but any other status + # is also considered an error. + set errmsg [pg_result $reply -error] + oputs "ERROR ($status):" bold + oputs $errmsg bold + } else { + # Result was PGRES_TUPLES_OK, so there are tuples to show. + set ncol [pg_result $reply -numAttrs] + set nrow [pg_result $reply -numTuples] + oputs "OK with $nrow row[plural $nrow] and $ncol column[plural $ncol]." bold + oputs "" + show_status "Reading reply..." + show_results_$option(outstyle) $nrow $ncol $reply + clear_input + show_status "" + } + pg_result $reply -clear + oputs "" +} + +# Return the string properly escaped for conninfo quoting: +proc conninfo_quote {s} { + regsub -all {\\} $s {\\\\} s + regsub -all {'} $s {\\'} s + return $s +} + +# Call-back for do_connect on OK. Check the form values and try to connect. +# If it worked, set form_status to 1 to finish window_wait; else raise an +# error and return with the connection dialog still up. +proc do_connect_done {toplevel} { + global form_status dbinfo db + if {$dbinfo(dbname) == "" || $dbinfo(user) == "" || $dbinfo(password) == ""} { + tk_messageBox -title tkpsql -icon error -type ok \ + -parent $toplevel \ + -message "Missing information: must supply dbname, user, password" + return + } + + # Connect to the database: + # Only password can contain spaces, and only strings with spaces must + # be escape-quoted. + set conninfo "dbname=$dbinfo(dbname) user=$dbinfo(user)\ + password='[conninfo_quote $dbinfo(password)]'" + # Host is optional, because blank host means use localhost. + # Apply port only if host is used, although technically it can be used + # without a host over UDS. + if {$dbinfo(host) != ""} { + append conninfo " host=$dbinfo(host) port=$dbinfo(port)" + } + show_status "Connecting to $dbinfo(dbname)@$dbinfo(host)..." + + if {[catch {pg_connect -conninfo $conninfo} result]} { + show_status "" + tk_messageBox -title tkpsql -icon error -type ok \ + -parent $toplevel \ + -message "Failed to connect to database: $result" + return + } + set db $result + show_status "Connected to database $dbinfo(dbname)@$dbinfo(host)" + init_post_connect + set form_status 1 +} + +# Run special queries. See do_special and init_special. +proc run_special {code} { + global form_status special special_title + # Close the special query popup: + set form_status 1 + update + run_sql $special($code) $special_title($code) +} + +# ===== Menu Command Routines ===== + +# Manage the history list. +# If op is + or -, step the history pointer, and replace the input +# window contents with the history value (if not empty). If op is +# something else, enter it into the history table. +# When storing into the history list, synchronize the read and write +# indexes. +proc do_history {op} { + global history history_p history_q n_history + global widgets + if {$op == ""} return + debug_puts "do_history '$op' p=$history_p q=$history_q" + if {$op == "+"} { + set n $history_q + incr n + if {$n > $n_history} { + set n 1 + } + if {$history($n) == ""} return + set history_q $n + clear_input + $widgets(input) insert 1.0 $history($history_q) + } elseif {$op == "-"} { + set n $history_q + incr n -1 + if {$n < 1} { + set n $n_history + } + if {$history($n) == ""} return + set history_q $n + clear_input + $widgets(input) insert 1.0 $history($history_q) + } else { + # Delete trailing newlines to keep it neat. + set history($history_p) [string trimright $op] + incr history_p + if {$history_p > $n_history} { + set history_p 1 + } + set history_q $history_p + } +} + +# Connect to database: +proc do_connect {} { + global db dbinfo form_status + + if {$db != ""} do_disconnect + + # Initialize if never done. pg_conndefaults returns list of {key - - - value} + if {![info exists dbinfo(user)]} { + array set dbinfo {user {} host {} dbname {} port {} password {}} + foreach default [pg_conndefaults] { + setlist $default key unused1 unused2 unused3 value + if {[info exists dbinfo($key)]} { + set dbinfo($key) $value + } + } + } + # Build the Connect to Database popup: + set t [mk_window .dbconnect "Connect to DBMS"] + set f $t.entry + frame $f + label $f.host_l -text "Database Host:" + entry $f.host -width 24 -textvariable dbinfo(host) + label $f.port_l -text "Database Port:" + entry $f.port -width 12 -textvariable dbinfo(port) + label $f.dbname_l -text "Database Name:" + entry $f.dbname -width 16 -textvariable dbinfo(dbname) + label $f.user_l -text "Username:" + entry $f.user -width 12 -textvariable dbinfo(user) + label $f.password_l -text "Password:" + entry $f.password -width 24 -textvariable dbinfo(password) -show * + foreach field {host port dbname user password} { + grid $f.${field}_l $f.$field + grid configure $f.${field}_l -sticky e + grid configure $f.${field} -sticky w + } + mk_buttons $t "do_connect_done $t" + pack $t.entry $t.buttons -side top -fill x + set form_status -1 + window_wait $t $t.entry.host form_status + # At this point $form_status is 1 on OK, 0 on Cancel, but we really + # don't care because do_connect_done did all the work on OK. +} + +# Disconnect from the database: +proc do_disconnect {} { + global db dbinfo + if {$db == ""} return + pg_disconnect $db + show_status "Disconnected from database $dbinfo(dbname)@$dbinfo(host)" + set db {} +} + +# Load a file into the input window: +proc do_loadin {} { + global widgets pwd + + set fname [tk_getOpenFile -initialdir $pwd -title "Load input window"] + if {$fname == ""} return + set pwd [file dirname $fname] + if {[catch {open $fname} f]} { + tk_messageBox -title tkpsql -icon error -type ok \ + -message "Failed to open $fname: $f" + return + } + clear_input + $widgets(input) insert end [read -nonewline $f] + close $f +} + +# Save Input or Output text areas to a file. +proc do_save {which} { + global widgets pwd + + set fname [tk_getSaveFile -initialdir $pwd -title "Save $which window"] + if {$fname == ""} return + set pwd [file dirname $fname] + if {[catch {open $fname w} f]} { + tk_messageBox -title tkpsql -icon error -type ok \ + -message "Failed to open $fname: $f" + return + } + show_status "Saving text..." + puts -nonewline $f [$widgets($which) get 1.0 end] + close $f + show_status "" +} + +# Exit the program: +proc do_exit {} { + do_disconnect + exit +} + +# Run the SQL in the input window. First, remove any trailing newlines, +# spaces and ';' chars. +proc do_run {} { + global widgets + set sql [string trimright [$widgets(input) get 1.0 end] " \n;"] + do_history $sql + run_sql $sql +} + +# Clear the input and output boxes: +proc do_clear {} { + clear_input + clear_output +} + +# Display options dialog: +proc do_options {} { + global form_status option + # Save the current options to be restored if the form is Cancelled. + array set copy_option [array get option] + # Build the Options popup: + set t [mk_window .options "Set Options"] + set f $t.opt + frame $f + label $f.outstyle -text "Output Style:" + radiobutton $f.outstyle1 -text Narrow -variable option(outstyle) -value narrow + radiobutton $f.outstyle2 -text Wide -variable option(outstyle) -value wide + label $f.maxlook_l -text "Max rows to look at for column widths:" + entry $f.maxlook -width 5 -textvariable option(maxlook) + checkbutton $f.clear -text "Clear output before results" -variable option(clear) + checkbutton $f.debug -text Debug -variable option(debug) + + grid $f.outstyle $f.outstyle1 $f.outstyle2 + grid $f.maxlook_l - $f.maxlook + grid $f.clear - x + grid $f.debug x x + mk_buttons $t + + pack $t.opt $t.buttons -side top -fill x + set form_status -1 + window_wait $t $t.buttons.ok form_status + + # Restore the options on Cancel: + if {!$form_status} { + array set option [array get copy_option] + } + if {$option(debug)} { + parray option + } +} + +# Special queries. See init_special for the data which drives this. +proc do_special {} { + global form_status special special_title special_codes + + set t [mk_window .special "Special Queries"] + set packme {} + # Generate all the special query buttons: + foreach code $special_codes { + button $t.$code -text $special_title($code) -command "run_special $code" + lappend packme $t.$code + } + button $t.cancel -text Cancel -command "set form_status 0" + bind $t "set form_status 0" + eval pack $packme $t.cancel -side top -fill x -padx 2 -pady 2 + set form_status -1 + window_wait $t $t.cancel form_status +} + +# ===== Main Window UI ===== + +# Build the main user interface: +proc build_ui {} { + global widgets version + + set f .buttons + frame $f + set buttons [list \ + [mk_button $f.run Run do_run] \ + [mk_button $f.clear Clear do_clear] \ + [mk_button $f.next_hist {History Next} {do_history +}] \ + [mk_button $f.prev_hist {History Prev} {do_history -}] \ + [mk_button $f.loadin {Load Input} do_loadin] \ + [mk_button $f.savein {Save Input} {do_save input}] \ + [mk_button $f.saveout {Save Output} {do_save output}] \ + [mk_button $f.connect Connect do_connect] \ + [mk_button $f.disconn Disconnect do_disconnect] \ + [mk_button $f.options Options do_options] \ + [mk_button $f.special Special do_special] \ + [mk_button $f.quit Exit do_exit] \ + ] + eval pack $buttons -side top -fill x -padx 2 -pady 4 + + # Alternate bindings for keyboard without F11 or F12: + bind . do_special + bind . do_exit + # Forget bogus binding of F10 on unix platforms to traverse menus: + bind all {} + + # Frame .r holds the right-hand side with input, output, and status. + set f .r + frame $f + + # Output text area with horizontal and vertical scrollers: + # Must use monospace font so columns line up. + set widgets(output) $f.output + text $widgets(output) -relief sunken -borderwidth 2 -height 16 -width 64 \ + -wrap none -setgrid 1 -font monofont \ + -yscrollcommand "$f.oyscroll set" -xscrollcommand "$f.oxscroll set" + scrollbar $f.oyscroll -command "$f.output yview" + scrollbar $f.oxscroll -orient horizontal -command "$f.output xview" + # Tags for output area for special text display: + $widgets(output) tag configure under -underline on + $widgets(output) tag configure bold -font boldfont + + # Input text area: vertical scroller only, word wrap. + set widgets(input) $f.input + text $widgets(input) -relief sunken -borderwidth 2 -height 5 -width 64 \ + -wrap word \ + -yscrollcommand "$f.iyscroll set" + scrollbar $f.iyscroll -command "$f.input yview" + + # Status area: + set widgets(status) $f.status + label $widgets(status) -relief sunken -borderwidth 1 -anchor w + + # Grid up the output, input, and status with scroll bars: + grid $f.output $f.oyscroll + grid $f.oxscroll x + grid $f.input $f.iyscroll + grid $f.status - + # ... Set stickiness: + grid configure $f.input $f.output -sticky nsew + grid configure $f.oxscroll $f.status -sticky ew + grid configure $f.oyscroll $f.iyscroll -sticky ns + # ... Indicate that the output and input rows expand: + grid rowconfigure $f 0 -weight 3 + grid rowconfigure $f 2 -weight 1 + grid columnconfigure $f 0 -weight 1 + + pack .buttons .r -side left -fill both + pack configure .r -expand 1 + + # Main window setup: + wm title . "tkpsql $version" + wm iconname . tkpsql + wm protocol . WM_DELETE_WINDOW do_exit + center_window . ROOT + + focus $widgets(input) + # Needed on Windows, for some strange reason: + raise . +} + +# ===== Main program ===== + +initialize +build_ui +do_connect diff --git a/src/vfs/punk9win.vfs/lib/publisher2.0/PUBLISHER.txt b/src/vfs/punk9win.vfs/lib/publisher2.0/PUBLISHER.txt new file mode 100644 index 00000000..d0f1e21b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/publisher2.0/PUBLISHER.txt @@ -0,0 +1,7 @@ +PUBLISHER is a tclOO-class providing a general facility for implementing +the publisher-subscribers pattern. + +See + USERGUIDE.txt +and + REFERENCE.txt diff --git a/src/vfs/punk9win.vfs/lib/publisher2.0/REFERENCE.txt b/src/vfs/punk9win.vfs/lib/publisher2.0/REFERENCE.txt new file mode 100644 index 00000000..d4a216eb --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/publisher2.0/REFERENCE.txt @@ -0,0 +1,75 @@ +publisher - 2.0 + +NAME +==== + publisher - publisher-subscribers pattern + +SYNOPSIS +======== +package require publisher + +::publisher new +pubName declare ?_event_ ...? +pubName notify _event_ ?data ...? +pubName destroy + +pubName register _event_ _tag_ _callback_ +pubName unregister _event_ _tag_ +pubName events ?pattern? + +Description +=========== +The *publisher* package provides a general facility for implementing the publisher-subscribers pattern. + +A publisher is an object usually attached to a master-object (e.g. a complex data structure such a list, a graph, a table, a database ...) that can raise events of public interest. +These events usually occur when something in the master-object changes. +The master-object knows nothing about its potentials subscribers; it simply tells the publisher to notify some events to all the (dynamically) registered subscribers. + +Subscribers (also referred as observers) are clients interested about changes occurring on that particular master-object. They inform the publisher they are interested on some events and give it a callback, i.e. a command that publisher should call every time events are generated. +Events may have parameters that will be passed to subscribers' callbacks. + + +COMMANDS +======== + +::publisher new +--------------- +Creates a new publisher object and returns its unique name (pubName). + +pubName declare ?_event_ ...? +------------------------------ +Adds one or more events to the list of declared events. +This list of declared events is a sort of mini-interface that subscribers may query. + +pubName notify _event_ ?data ...? +--------------------------------- +Causes all the registered callback to be independently called, with zero or more event-data. + +pubName destroy +--------------- +Destroys the publisher. A "!destroyed" event (with no event-data) is generated. + +pubName register _event_ _tag_ _callback_ +----------------------------------------- +Registers a _callback_ for a specific _event_ . +Each subscriber should provide a different string _tag_ . + +pubName unregister _event_ _tag_ +-------------------------------- +Un-registers the callback previously set for the {_event_ _tag_) pair. +_event_ may be "*" or any other glob-style pattern. + +pubName events ?_pattern_? +------------------------ +If _pattern_ is not specified, then lists all the declared events. +Else lists all the *registered* glob-style matching events with their tag and callbacks +e.g. +{!ev1 tag1 {callback1 callback2} !ev1 tag2 callback3 !evX tagY callbackZ } + + +CREDITS and COPYRIGHT +===================== +publisher - Copyright(c) 2012-2022 : + +This package is free software; you can use, modify, and redistribute it for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. + diff --git a/src/vfs/punk9win.vfs/lib/publisher2.0/USERGUIDE.txt b/src/vfs/punk9win.vfs/lib/publisher2.0/USERGUIDE.txt new file mode 100644 index 00000000..949e619a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/publisher2.0/USERGUIDE.txt @@ -0,0 +1,112 @@ +PUBLISHER +========= + +PUBLISHER is a tclOO-class providing a general facility for implementing +the publisher-subscribers pattern. + +A publisher is an object usually attached to a master-object (e.g. a complex data structure such a list, a graph, a table, a database ...) that can raise events of public interest. +These events usually occur when something in the master-object changes. +The master-object knows nothing about its potentials subscribers; it simply tells the publisher to notify some events to all the (dynamically) registered subscribers. + +Subscribers (also referred as observers) are clients interested about changes occurring on that particular master-object. They inform the publisher they are interested on some events and give it a callback, i.e. a command that publisher should call every time events are generated. +Events may have parameters that will be passed to subscribers' callbacks. + + +RECOMMENDED NAMING CONVENTIONS +------------------------------ +These naming conventions are not mandatory. You are encouraged to follow them - or any other coherent set of conventions - just because they help to write a more readable code (without the need of extra "comments"). + +* Each *event-name* has a leading "!" (e.g !ev1 !alert ...) +* Each event may carry details (*event's data*) as a list of key-values; Keys have a leading "-" (e.g. -color blue -temperature 100.0 .... ) +* Each different *subscriber* must be identified by a different "id". + If subscriber is a widget, "id" could be the widget-name + If subscriber is a (snit) object, "id" could be its name + Otherwise, you should choose an "id", provided it is unique among all possible subscribers (of the same publisher) +* Each *callback* name should be "On!event" (e.g. On!alert ) + + +How to interact with a publisher (subscribers-side) +-------------------------------------------------- +Let's suppose we have a publisher ($pub) attached to a master-object and some observers wishing to be informed whenever a change in the master-object occur. +The folllowing command lists all the possible events + $pub events ;# --> { !configure !alert !full !evXYZ !destroyed } +Then an observer (whose "id" is "$obsA") interested on event "!evXYZ" should +1) setup a callback + proc On!evXYZ {args} { + array set param $args + .. do something with param(-color), param(-x) param(-y) .... + } +2) tell the publisher to call its callback for all the next notifications. + $pub register !evXYZ $obsA On!evXYZ + +Of course each different event may provide different details (event-data), and it is the subscriber's responsibility to setup a conformant callback. + + +When an observer ($obsA) is no more interested in publisher's notifications it must revoke the subscription + $pub unregister !evXYZ $obsA ;# revoke subscription for event !evXYZ + or + $pub unregister * $obsA ;# revoke ALL its-own subscriptions + +Note that an observer MUST revoke ALL its subscriptions before being destroyed, or the publisher will send all next events to a no-more-existing client. + +** Universal callback ** +For testing purpose with just few lines of code, you can setup an universal callback, able to print every detail, catching all possible events: + # Universal-callback; note the first two "fixed" parameters ... + proc On!EveryEvent {ev pub args} { + puts "event ($ev) from ($pub)" + foreach {key val} $args { + puts "\tkey: ($key) -- ($val)" + } + } + # register for all events + foreach ev [$pub events] { + $pub register $ev $obsA [list On!EveryEvent $ev $pub] + } +Note that the first two parameters of the callback are fixed at "register-time"; the publisher only "appends" events-data (as the usual key-value list) to a command with two "pre-fixed" parameters. + + + +How to interact with subscribers (publisher--side) +-------------------------------------------------- +When a master-object needs to interact with several observers, it must create its own publisher for handling such interactions. + +First, master-object creates a publisher: + set pub [publisher new] + or + set pub [publisher create _name_] +Then it declares the names of events it will provide + $pub declare !evA !evB !evC + or + $pub declare !evA ; $pub declare !evB !evC + +Other than the explicitelly declared event-names, all publishers always provide a standard event named "!destroyed" informing the subscribers that it has been .. destroyed (usually by the master-object). + This standard event doesn't need to be declared. + The !destroyed event carries no event-data. + +Note that (currently) when declaring events there is no way to declare the parameters (event-data). +It's just a matter of good documentation practice: each publishers should document all its events, their meanings, and their parameters. + +*** It is strongly recommended that parameters always be transmitted as an unordered list of key-value pairs. +This key-value convention allows to upgrade the publisher-part ( e.g. adding a parameter "-speed" for a given event), without the need to rewrite the previous subscribers callbacks. (Of course non-upgraded subscribers will simply ignore the new parameter). *** + + + +When a change in the master-object occur, the master-object must tell to its publisher to notify the event. + $pub notify !itemRemoved -id 42342 + $pub notify !itemAdded -id 12312 -parent 1239866 + $pub notify !itemConfigured -id 23452 -color blue -rank "A" + +Note that master-object knows nothing about its currently registered subscribers; that's the publisher's job! + +When a master-object deletes its publisher, the publisher implicitely trasmits a last event + $pub notify !destroyed +Subscribers should simply 'forget' the publisher, without the need to unregister their callback (in fact, they can't unregister, because there is no publisher to contact!) + + +=== Publisher-Subscribers vs. Tk-events ======================================= + +The main difference to the event system built into the Tcl/Tk core is that the latter can generate only virtual events, and only for Tk-widgets. +It is not possible to use the builtin facilities to bind to events on arbitrary (non-Tk-)objects, nor is it able to generate events for such. + +Moreover, even for widgets, the bind-event system is rather clumsy when multiple callbacks should be independently attached (bind) to an event, and indipendently detached. +The publisher-subscribers system can be used in a coherent way both for Tk-widgets and for arbitrary objects. diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/history/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/publisher2.0/pkgIndex.tcl similarity index 70% rename from src/vfs/punk9win.vfs/lib/tklib0.8/history/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/publisher2.0/pkgIndex.tcl index 38180fa7..c5f953fe 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/history/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/publisher2.0/pkgIndex.tcl @@ -1,13 +1,14 @@ -# Tcl package index file, version 1.1 -# This file is generated by the "pkg_mkIndex" command -# and sourced either when an application starts up or -# by a "package unknown" script. It invokes the -# "package ifneeded" command to set up package-related -# information so that packages will be loaded automatically -# in response to "package require" commands. When this -# script is sourced, the variable $dir must contain the -# full path name of this file's directory. - -if { ![package vsatisfies [package provide Tcl] 8.4-] } { return } -package ifneeded history 0.1 [list source [file join $dir history.tcl]] - +# Tcl package index file, version 1.0 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + + +package ifneeded publisher 2.0 \ + [list source [file join $dir publisher.tcl]] + diff --git a/src/vfs/punk9win.vfs/lib/publisher2.0/publisher.tcl b/src/vfs/punk9win.vfs/lib/publisher2.0/publisher.tcl new file mode 100644 index 00000000..e806017b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/publisher2.0/publisher.tcl @@ -0,0 +1,117 @@ +## publisher.tcl + +## publisher - publisher-subscribers pattern +## +## Copyright (c) 2012-2020 : +## +## +## This library is free software; you can use, modify, and redistribute it +## for any purpose, provided that existing copyright notices are retained +## in all copies and that this notice is included verbatim in any +## distributions. +## +## This software is distributed WITHOUT ANY WARRANTY; without even the +## implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +## + +# +# How to use 'publisher': +# Read "publisher.txt" for detailed info. +# + +package provide publisher 2.0 + +oo::class create publisher { + variable myEvents myCallbacks + + constructor {} { + set myEvents {} + array set myCallbacks {} + # all publishers provide a "!destroyed" event + my declare !destroyed + } + + destructor { + my notify !destroyed + } + + # Publisher-side method + # + # Declare all the provided events. + # NOTE: declaring an event twice, is not an error, it's only stupid. + # On the subscribers-side, a subscribe can inspects all the provided events + # with the 'events' method. + method declare {args} { + eval lappend myEvents $args + # remove duplicated events + set myEvents [lsort -unique $myEvents] + } + + # an invalid tag (subscriber-id) is a tag containing "glob" chars (*?) + method IsInvalidTag {tag} { + expr [regexp -- {[*?]} $tag] + } + + # Subscribers-side method + # + # register a callback for a given event. + # 'tag' is simply an id denoting the caller (it should be used for unregister-ing). + # 'tag' should not contain "glob" chars (?*) + method register { ev tag callback } { + if { [lsearch -exact $myEvents $ev] == -1 } { + error "event \"$ev\" not available" + } + if { [my IsInvalidTag $tag] } { + error "tag \"$tag\" is not valid." + } + lappend myCallbacks($ev,$tag) $callback + } + + # Subscribers-side method + # + # Unregister all the callbacks associated with a given tag + # for a single event or an evPattern. + # evPattern : event-name or "*" (or any string with "glob" chars) + # tag: just a tag + # Notes: + # It's not an error if there's no registered event associated with tag. + # Raise an error if tag contains special glob chars (*?) + method unregister {evPattern tag} { + if { [my IsInvalidTag $tag] } { + error "tag \"$tag\" contains disallowed chars." + } + array unset myCallbacks $evPattern,$tag + } + + # Publisher-side method + # + # Send an event-notification to all subscribers. + # The effect is to execute *synchronously* all the registered callbacks + # for that event. + # Any error raised during the callback run is silently ignored. + method notify {ev args} { + foreach { key hList } [array get myCallbacks $ev,*] { + foreach func $hList { + catch { uplevel #0 $func $args } + } + } + } + + # Subscribers-side method + # + # events --> lists all events + # events * --> lists all registered events with their tag and callback + # e.g. {!ev1 tag1 {cb1 cb2} !ev1 tag2 cb3 !evX tagY cbZ } + # events !a* --> same as above, limited to events matching "!a*" + method events { {evPattern {}} } { + if { $evPattern == {} } { + return $myEvents + } + set L {} + foreach { key hList } [array get myCallbacks $evPattern,*] { + lassign [split $key ","] ev tag + lappend L $ev $tag $hList + } + return $L + } +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/ico/pkgIndex.tcl deleted file mode 100644 index 55dfb9a8..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/pkgIndex.tcl +++ /dev/null @@ -1,9 +0,0 @@ -# pkgIndex.tcl -- -# -# Copyright (c) 2003 ActiveState Corporation. -# All rights reserved. -# -# RCS: @(#) $Id: pkgIndex.tcl,v 1.11 2011/10/05 00:10:46 hobbs Exp $ - -package ifneeded ico 0.3.2 [list source [file join $dir ico0.tcl]] -package ifneeded ico 1.1 [list source [file join $dir ico.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/notifywindow/notifywindow.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/notifywindow/notifywindow.tcl deleted file mode 100644 index 6f6ad836..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/notifywindow/notifywindow.tcl +++ /dev/null @@ -1,105 +0,0 @@ -#notifywindow.tcl: provides routines for posting a Growl-style "notification window" in the upper right corner of the screen, fading in and out in an unobtrusive fashion - -#(c) 2015-2019 Kevin Walzer/WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html - -package provide notifywindow 1.0 - -namespace eval notifywindow { - - #Main procedure for window - - proc notifywindow {msg img} { - set w [toplevel ._notify] - if {[tk windowingsystem] eq "aqua"} { - ::tk::unsupported::MacWindowStyle style $w utility {hud - closeBox resizable} - wm title $w "Alert" - } - if {[tk windowingsystem] eq "win32"} { - wm attributes $w -toolwindow true - wm title $w "Alert" - } - if {[lsearch [image names] $img] > -1} { - label $w.l -bg gray30 -fg white -image $img - pack $w.l -fill both -expand yes -side left - } - message $w.message -aspect 150 -bg gray30 -fg white -aspect 150 -text $msg -width 280 - pack $w.message -side right -fill both -expand yes - if {[tk windowingsystem] eq "x11"} { - wm overrideredirect $w true - } - wm attributes $w -alpha 0.0 - puts [winfo reqwidth $w] - set xpos [expr [winfo screenwidth $w] - 325] - wm geometry $w +$xpos+30 - notifywindow::fade_in $w - after 3000 notifywindow::fade_out $w - } - - #Fade and destroy window - proc fade_out {w} { - catch { - set prev_degree [wm attributes $w -alpha] - set new_degree [expr $prev_degree - 0.05] - set current_degree [wm attributes $w -alpha $new_degree] - if {$new_degree > 0.0 && $new_degree != $prev_degree} { - after 10 [list notifywindow::fade_out $w] - } else { - destroy $w - } - - } - } - - #Fade the window into view - proc fade_in {w} { - catch { - raise $w - wm attributes $w -topmost 1 - set prev_degree [wm attributes $w -alpha] - set new_degree [expr $prev_degree + 0.05] - set current_degree [wm attributes $w -alpha $new_degree] - focus -force $w - if {$new_degree < 0.9 && $new_degree != $prev_degree} { - after 10 [list notifywindow::fade_in $w] - } else { - return - } - } - } - - #The obligatory demo - proc demo {} { - - image create photo flag -data { - R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1Pjisd/UjtHJ - a8O4SL2qJcWqAK+SAJN6AGJiAEpKADIyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx - AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r - j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA - YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr - /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA - liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP - /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi - lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ - xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW - MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// - a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW - AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O - zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg - pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiZAAMIHEhQoLqD - CAsqFAigIQB3Dd0tNKjOXSxXrmABWBABgLqCByECuAir5EYJHimKvOgqFqxXrzZ2lBhgJUaY - LV/GOpkSIqybOF3ClPlQIEShMF/lfLVzAcqPRhsKXRqTY1GCFaUy1ckTKkiRGhtapTkxa82u - ExUSJZs2qtOUbQ2ujTsQ4luvbdXNpRtA712+UeEC7ou3YEAAADt= - } - - notifywindow::notifywindow "Man page for Message\n\nSpecifies a non-negative integer value indicating desired aspect ratio for the text. The aspect ratio is specified as 100*width/height. 100 means the text should be as wide as it is tall, 200 means the text should be twice as wide as it is tall, 50 means the text should be twice as tall as it is wide, and so on. Used to choose line length for text if -width option is not specified. Defaults to 150." flag - - } - - namespace export * -} - - - - - diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ntext/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/ntext/pkgIndex.tcl deleted file mode 100644 index 1c97054d..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ntext/pkgIndex.tcl +++ /dev/null @@ -1,2 +0,0 @@ -if {![package vsatisfies [package provide Tcl] 8.5-]} {return} -package ifneeded ntext 1.0b6 [list source [file join $dir ntext.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/pkgIndex.tcl deleted file mode 100644 index fdd2b811..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/pkgIndex.tcl +++ /dev/null @@ -1,2 +0,0 @@ -package ifneeded shtmlview::shtmlview 1.1.0 [list source [file join $dir shtmlview.tcl]] -package ifneeded shtmlview::doctools 0.1 [list source [file join $dir shtmlview-doctools.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pkgIndex.tcl deleted file mode 100644 index b3ac2d08..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pkgIndex.tcl +++ /dev/null @@ -1,3 +0,0 @@ -# Package index file created with stooop version 4.4.1 for stooop packages - -package ifneeded tkpiechart 6.6 [list source [file join $dir tkpiechart.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.8/widget/pkgIndex.tcl deleted file mode 100644 index c78abbe7..00000000 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/pkgIndex.tcl +++ /dev/null @@ -1,32 +0,0 @@ -# Tcl Package Index File 1.0 -if {![llength [info commands ::tcl::pkgindex]]} { - proc ::tcl::pkgindex {dir bundle bundlev packages} { - set allpkgs [list] - foreach {pkg ver file} $packages { - lappend allpkgs [list package require $pkg $ver] - package ifneeded $pkg $ver [list source [file join $dir $file]] - } - if {$bundle != ""} { - lappend allpkgs [list package provide $bundle $bundlev] - package ifneeded $bundle $bundlev [join $allpkgs \n] - } - return - } -} -if {![package vsatisfies [package provide Tcl] 8.4-]} {return} -::tcl::pkgindex $dir widget::all 1.2.4 { - widget 3.1 widget.tcl - widget::arrowbutton 1.0 arrowb.tcl - widget::calendar 1.0.1 calendar.tcl - widget::dateentry 0.96 dateentry.tcl - widget::dialog 1.3.1 dialog.tcl - widget::menuentry 1.0.1 mentry.tcl - widget::panelframe 1.1 panelframe.tcl - widget::ruler 1.1 ruler.tcl - widget::screenruler 1.2 ruler.tcl - widget::scrolledtext 1.0 stext.tcl - widget::scrolledwindow 1.2.1 scrollw.tcl - widget::statusbar 1.2.1 statusbar.tcl - widget::superframe 1.0.1 superframe.tcl - widget::toolbar 1.2.1 toolbar.tcl -} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/autoscroll/autoscroll.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/autoscroll/autoscroll.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/autoscroll/autoscroll.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/autoscroll/autoscroll.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/autoscroll/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/autoscroll/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/autoscroll/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/autoscroll/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_drag.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_drag.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_drag.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_drag.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_ecircle.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_ecircle.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_ecircle.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_ecircle.tcl index 09f8ec44..8bf09e5a 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_ecircle.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_ecircle.tcl @@ -152,7 +152,7 @@ snit::type ::canvas::edit::circle { $self clear lassign $center x y - set edge [list [expr {$x + $radius} $y]] + set edge [list [expr {$x + $radius}] $y] $myeditor add {*}$center $myeditor add {*}$edge diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_epoints.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_epoints.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_epoints.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_epoints.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_epolyline.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_epolyline.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_epolyline.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_epolyline.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_equad.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_equad.tcl similarity index 89% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_equad.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_equad.tcl index da916482..9fb55e57 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_equad.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_equad.tcl @@ -45,39 +45,52 @@ namespace eval ::canvas::edit { ## API snit::type ::canvas::edit::quadrilateral { - option -tag -default QUADRILATERAL -readonly 1 - option -create-cmd -default {} -readonly 1 - option -highlight-cmd -default {} -readonly 1 - option -data-cmd -default {} -readonly 1 - - option -convex -type snit::boolean -default 0 -readonly 1 + option -tag -default QUADRILATERAL -readonly 1 + option -create-cmd -default {} -readonly 1 + option -highlight-cmd -default {} -readonly 1 + option -data-cmd -default {} -readonly 1 + option -convex -default 0 -readonly 1 -type snit::boolean + option -add-remove-point -default {} -readonly 1 + option -drag-point -default 3 -readonly 1 + + # Additional line/polygon configuration + # NOTE: __Cannot__ supercede -color/-hilit-color + option -color -default Skyblue2 constructor {c args} { set mycanvas $c set myfreeref $ourrefs + $self configurelist $args + # Generate an internal point cloud editor, which will handle # the basic tasks regarding the quadrilaterals's vertices. lappend cmd canvas::edit points ${selfns}::P $c - lappend cmd -tag [from args -tag QUADRILATERAL] + lappend cmd -tag $options(-tag) lappend cmd -data-cmd [mymethod Point] lappend cmd -create-cmd [mymethod Create] - set c [from args -highlight-cmd {}] - if {$c ne {}} { lappend cmd -highlight-cmd $c } + # Pass event options/configuration to the subordinate editor + foreach o { + -add-remove-point + -drag-point + -highlight-cmd + } { + set c $options($o) + if {$c ne {}} { lappend cmd $o $c } + } set myeditor [{*}$cmd] set mytracker [canvas::track lines ${selfns}::TRACK $mycanvas] - set c [from args -create-cmd [mymethod DefaultCreate]] - set options(-create-cmd) $c - - $self configurelist $args + if {$options(-create-cmd) eq {}} { + set options(-create-cmd) [mymethod DefaultCreate] + } - # TODO :: Connect this to the option processing to alow me to + # TODO :: Connect this to the option processing to allow me to # drop -readonly 1 from their definition. Note that this also - # requires code to re-tag all the items on the fly. + # may require code to re-tag all the items on the fly. return } @@ -330,7 +343,8 @@ snit::type ::canvas::edit::quadrilateral { # lines. At which point the 'line' may consist of multiple # items. - set segment [$mycanvas create line {*}$a {*}$b -width 1 -fill black] + set segment [$mycanvas create line {*}$a {*}$b \ + -width 1 -fill $options(-color)] $mycanvas lower $segment $options(-tag) set myline($key) $segment @@ -393,7 +407,7 @@ snit::type ::canvas::edit::quadrilateral { # # ## ### ##### ######## ############# ##################### ## Ready -package provide canvas::edit::quadrilateral 0.1 +package provide canvas::edit::quadrilateral 0.2 return # # ## ### ##### ######## ############# ##################### diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_erectangle.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_erectangle.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_erectangle.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_erectangle.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_gradient.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_gradient.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_gradient.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_gradient.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_highlight.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_highlight.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_highlight.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_highlight.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_mvg.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_mvg.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_mvg.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_mvg.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_pdf.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_pdf.tcl new file mode 100644 index 00000000..85a5395d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_pdf.tcl @@ -0,0 +1,51 @@ +# *- tcl -*- +# ### ### ### ######### ######### ######### + +# Copyright (c) 2014 andreas Kupries, Arjen Markus +# OLL licensed (http://wiki.tcl.tk/10892). + +# ### ### ### ######### ######### ######### +## Requisites + +package require Tcl 8.5- +package require Tk 8.5- +package require pdf4tcl +package require fileutil + +namespace eval ::canvas {} + +# ### ### ### ######### ######### ######### +## Implementation. + +proc ::canvas::pdf {canvas} { + #raise [winfo toplevel $canvas] + #update + + set tmp [fileutil::tempfile canvas_pdf_] + + # Note: The paper dimensions are hardcoded. A bit less than A7, + # looks like. This looks to be something which could be improved + # on. + + # Note 2: We go through a temp file to write the pdf, and load it + # back into memory for the caller to use. + + set pdf [::pdf4tcl::new %AUTO% -paper {9.5c 6.0c}] + $pdf canvas $canvas -width 9.2c + $pdf write -file $tmp + $pdf destroy + + set data [fileutil::cat $tmp] + file delete $tmp + + return $data +} + +# ### ### ### ######### ######### ######### +## Helper commands. Internal. + +# ### ### ### ######### ######### ######### +## Ready + +package provide canvas::pdf 1.0.1 +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_snap.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_snap.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_snap.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_snap.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_sqmap.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_sqmap.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_sqmap.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_sqmap.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_tags.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_tags.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_tags.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_tags.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_trlines.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_trlines.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_trlines.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_trlines.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_zoom.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_zoom.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/canvas_zoom.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/canvas_zoom.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/pkgIndex.tcl similarity index 89% rename from src/vfs/punk9win.vfs/lib/tklib0.8/canvas/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/canvas/pkgIndex.tcl index 07dafc72..e0bf7406 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/canvas/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/canvas/pkgIndex.tcl @@ -6,11 +6,12 @@ package ifneeded canvas::drag 0.1 [list source [file join $dir package ifneeded canvas::edit::circle 0.1 [list source [file join $dir canvas_ecircle.tcl]] package ifneeded canvas::edit::points 0.3 [list source [file join $dir canvas_epoints.tcl]] package ifneeded canvas::edit::polyline 0.2 [list source [file join $dir canvas_epolyline.tcl]] -package ifneeded canvas::edit::quadrilateral 0.1 [list source [file join $dir canvas_equad.tcl]] +package ifneeded canvas::edit::quadrilateral 0.2 [list source [file join $dir canvas_equad.tcl]] package ifneeded canvas::edit::rectangle 0.1 [list source [file join $dir canvas_erectangle.tcl]] package ifneeded canvas::gradient 0.2 [list source [file join $dir canvas_gradient.tcl]] package ifneeded canvas::highlight 0.1 [list source [file join $dir canvas_highlight.tcl]] package ifneeded canvas::mvg 1 [list source [file join $dir canvas_mvg.tcl]] +package ifneeded canvas::pdf 1.0.1 [list source [file join $dir canvas_pdf.tcl]] package ifneeded canvas::snap 1.0.1 [list source [file join $dir canvas_snap.tcl]] package ifneeded canvas::tag 0.1 [list source [file join $dir canvas_tags.tcl]] package ifneeded canvas::track::lines 0.1 [list source [file join $dir canvas_trlines.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/chatwidget/chatwidget.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/chatwidget/chatwidget.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/chatwidget/chatwidget.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/chatwidget/chatwidget.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/chatwidget/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/chatwidget/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/chatwidget/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/chatwidget/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/bindDown.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/bindDown.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/bindDown.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/bindDown.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/controlwidget.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/controlwidget.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/controlwidget.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/controlwidget.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/led.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/led.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/led.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/led.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/pkgIndex.tcl similarity index 87% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/pkgIndex.tcl index 9dc20f60..46a3f071 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/pkgIndex.tcl @@ -17,7 +17,7 @@ package ifneeded controlwidget 0.1 [list source [file join $dir controlwidget.tc package ifneeded meter 1.0 [list source [file join $dir vertical_meter.tcl]] package ifneeded led 1.0 [list source [file join $dir led.tcl]] package ifneeded rdial 0.7 [list source [file join $dir rdial.tcl]] -package ifneeded tachometer 0.1 [list source [file join $dir tachometer.tcl]] -package ifneeded voltmeter 0.1 [list source [file join $dir voltmeter.tcl]] +package ifneeded tachometer 0.2 [list source [file join $dir tachometer.tcl]] +package ifneeded voltmeter 0.2 [list source [file join $dir voltmeter.tcl]] package ifneeded radioMatrix 1.0 [list source [file join $dir radioMatrix.tcl]] package ifneeded bindDown 1.0 [list source [file join $dir bindDown.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/radioMatrix.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/radioMatrix.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/radioMatrix.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/radioMatrix.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/rdial.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/rdial.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/rdial.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/rdial.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/tachometer.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/tachometer.tcl similarity index 79% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/tachometer.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/tachometer.tcl index 1a2f24ca..c45b965c 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/tachometer.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/tachometer.tcl @@ -41,12 +41,10 @@ # AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # -# $Id: tachometer.tcl,v 1.4 2010/09/10 17:16:29 andreas_kupries Exp $ -# package require Tk 8.5- package require snit -package provide tachometer 0.1 +package provide tachometer 0.2 namespace eval controlwidget { namespace export tachometer @@ -95,8 +93,9 @@ snit::widget controlwidget::tachometer { # $self configurelist $args - canvas $win.c -background $options(-background) -width $options(-width) -height $options(-height) \ - -relief $options(-relief) -borderwidth $options(-borderwidth) + canvas $win.c -background $options(-background) -width $options(-width) \ + -height $options(-height) \ + -relief $options(-relief) -borderwidth $options(-borderwidth) grid $win.c -sticky news if {$options(-variable) ne ""} { @@ -130,7 +129,9 @@ snit::widget controlwidget::tachometer { # danger marker if { $options(-dangerlevel) != {} && $options(-dangerlevel) < $options(-max)} { - set deltadanger [expr {(360.0-40.0)*($options(-max)-$options(-dangerlevel))/(1.0*$options(-max)-$options(-min))}] + set deltadanger [expr { + (360.0-40.0)*($options(-max)-$options(-dangerlevel))/(1.0*$options(-max)-$options(-min)) + }] # Transform the thickness into a plain number (if given in mm for instance) set id [$win.c create line 0 0 1 0] @@ -144,7 +145,8 @@ snit::widget controlwidget::tachometer { [expr {$width/50.0*4.0+$thickness}] [expr {$width/50.0*4.0+$thickness}] \ [expr {$width/50.0*46.0-$thickness}] [expr {$width/50.0*46.0-$thickness}] \ -start -70 -extent $deltadanger -style arc \ - -outline $options(-dangercolor) -fill $options(-dangercolor) -width $options(-dangerwidth) + -outline $options(-dangercolor) -fill $options(-dangercolor) \ + -width $options(-dangerwidth) } # graduate line @@ -168,8 +170,7 @@ snit::widget controlwidget::tachometer { set l3 [expr {$half*0.62}] set angle 110.0 - for {set i 0} {$i < $num} {incr i} \ - { + for {set i 0} {$i < $num} {incr i} { set a [expr {($angle+$delta*$i)*$pi}] set x1 [expr {$half+$l1*cos($a)}] @@ -182,8 +183,7 @@ snit::widget controlwidget::tachometer { set y1 [expr {$half+$l3*sin($a)}] set label [lindex $options(-labels) $i] - if { [string length $label] } \ - { + if { [string length $label] } { $win.c create text $x1 $y1 \ -anchor center -justify center -fill black \ -text $label -font { Helvetica 10 } @@ -199,11 +199,10 @@ snit::widget controlwidget::tachometer { $self drawline $win $value } - method destructor { widget } \ - { + method destructor { widget } { set varname [option get $widget varname {}] trace remove variable $varname write \ - [namespace code "tracer $widget $varname"] + [namespace code "tracer $widget $varname"] } # @@ -217,11 +216,11 @@ snit::widget controlwidget::tachometer { $self draw $win.c $options(-value) } } + method get {} { return $options(-value) } - # # private methods -- # @@ -250,14 +249,13 @@ snit::widget controlwidget::tachometer { $self drawline $win.c [set ::$options(-variable)] } } - method tracer { varname args } \ - { + + method tracer { varname args } { set options(-value) [set ::$varname] $self drawline $win [set ::$varname] } - method drawline { widget value } \ - { + method drawline { widget value } { set c $widget.c set min $options(-min) @@ -283,18 +281,15 @@ snit::widget controlwidget::tachometer { set options(-indexid) $id } - method needlePress {w} \ - { + method needlePress {w} { set motion 1 } - method needleRelease {w} \ - { + method needleRelease {w} { set motion 0 } - method needleMotion {w x y} \ - { + method needleMotion {w x y} { if {! $motion} { return } if {$y == $yc && $x == $xc} { return } @@ -311,75 +306,75 @@ snit::widget controlwidget::tachometer { set ::$options(-variable) [expr {$options(-min) + ($options(-max)-$options(-min))*(160.0-$angle) / 320.0}] } - proc rivet { c xc yc } \ - { + proc rivet { c xc yc } { set width 5 set bevel 0.5m set angle -45.0 set ticks 7 - shadowcircle $c \ - [expr {$xc-$width}] [expr {$yc-$width}] [expr {$xc+$width}] [expr {$yc+$width}] \ - $ticks $bevel $angle + shadowcircle $c \ + [expr {$xc-$width}] [expr {$yc-$width}] \ + [expr {$xc+$width}] [expr {$yc+$width}] \ + $ticks $bevel $angle } - proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } \ - { + proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } { set angle $orient set delta [expr {180.0/$ticks}] - for {set i 0} {$i <= $ticks} {incr i} \ - { - set a [expr {($angle+$i*$delta)}] - set b [expr {($angle-$i*$delta)}] - - set color [expr {40+$i*(200/$ticks)}] - set color [format "#%x%x%x" $color $color $color] - - $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ - -style arc -outline $color -width $width - $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ - -style arc -outline $color -width $width + for {set i 0} {$i <= $ticks} {incr i} { + set a [expr {($angle+$i*$delta)}] + set b [expr {($angle-$i*$delta)}] + + set color [expr {40+$i*(200/$ticks)}] + ##nagelfar ignore + set color [format "#%x%x%x" $color $color $color] + + $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ + -style arc -outline $color -width $width + $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ + -style arc -outline $color -width $width } } } if {0} { -# main -- -# Demonstration of the tachometer object -# -proc main { argc argv } \ -{ - global forever + # main -- + # Demonstration of the tachometer object + # + proc main { argc argv } { + global forever - wm withdraw . - wm title . "A tachometer-like widget" - wm geometry . +10+10 + wm withdraw . + wm title . "A tachometer-like widget" + wm geometry . +10+10 - controlwidget::tachometer .t1 -variable ::value1 -labels { 0 10 20 30 40 50 60 70 80 90 100 } \ - -pincolor green -dialcolor lightpink - scale .s1 -command "set ::value1" -variable ::value1 + controlwidget::tachometer .t1 -variable ::value1 \ + -labels { 0 10 20 30 40 50 60 70 80 90 100 } \ + -pincolor green -dialcolor lightpink + scale .s1 -command "set ::value1" -variable ::value1 - # - # Note: the labels are not used in the scaling of the values - # - controlwidget::tachometer .t2 -variable ::value2 -labels { 0 {} {} 5 {} {} 10 } -width 100m -height 100m \ - -min 0 -max 10 -dangerlevel 3 - scale .s2 -command "set ::value2" -variable ::value2 -from 0 -to 10 + # + # Note: the labels are not used in the scaling of the values + # + controlwidget::tachometer .t2 -variable ::value2 -labels { 0 {} {} 5 {} {} 10 } \ + -width 100m -height 100m \ + -min 0 -max 10 -dangerlevel 3 + scale .s2 -command "set ::value2" -variable ::value2 -from 0 -to 10 - button .b -text Quit -command "set ::forever 1" + button .b -text Quit -command "set ::forever 1" - grid .t1 .s1 .t2 .s2 .b -padx 2 -pady 2 - wm deiconify . + grid .t1 .s1 .t2 .s2 .b -padx 2 -pady 2 + wm deiconify . - console show + console show - vwait forever - #tachometer::destructor .t1 - #tachometer::destructor .t2 - exit 0 -} + vwait forever + #tachometer::destructor .t1 + #tachometer::destructor .t2 + exit 0 + } -main $argc $argv + main $argc $argv } ### end of file diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/vertical_meter.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/vertical_meter.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/vertical_meter.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/vertical_meter.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/voltmeter.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/voltmeter.tcl similarity index 86% rename from src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/voltmeter.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/voltmeter.tcl index 030369f0..8c32c5af 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/controlwidget/voltmeter.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/controlwidget/voltmeter.tcl @@ -38,12 +38,10 @@ # AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE # MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # -# $Id: voltmeter.tcl,v 1.3 2010/09/10 17:16:29 andreas_kupries Exp $ -# package require Tk 8.5- package require snit -package provide voltmeter 0.1 +package provide voltmeter 0.2 namespace eval controlwidget { namespace export voltmeter @@ -281,7 +279,6 @@ snit::widget controlwidget::voltmeter { set ::$options(-variable) [expr {$options(-min) + ($options(-max)-$options(-min))*(15.0-$angle) / 30.0}] } - proc rivet { c xc yc } { shadowcircle $c \ [expr {$xc-4}] [expr {$yc-4}] [expr {$xc+4}] [expr {$yc+4}] \ @@ -289,55 +286,56 @@ snit::widget controlwidget::voltmeter { } proc shadowcircle { canvas x1 y1 x2 y2 ticks width orient } { - set radius [expr {($x2-$x1)/2.0}] - - set angle $orient - set delta [expr {180.0/$ticks}] - for {set i 0} {$i <= $ticks} {incr i} { - set a [expr {($angle+$i*$delta)}] - set b [expr {($angle-$i*$delta)}] - - set color [expr {40+$i*(200/$ticks)}] - set color [format "#%x%x%x" $color $color $color] - - $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ - -style arc -outline $color -width $width - $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ - -style arc -outline $color -width $width - } + set radius [expr {($x2-$x1)/2.0}] + + set angle $orient + set delta [expr {180.0/$ticks}] + for {set i 0} {$i <= $ticks} {incr i} { + set a [expr {($angle+$i*$delta)}] + set b [expr {($angle-$i*$delta)}] + + set color [expr {40+$i*(200/$ticks)}] + ##nagelfar ignore + set color [format "#%x%x%x" $color $color $color] + + $canvas create arc $x1 $y1 $x2 $y2 -start $a -extent $delta \ + -style arc -outline $color -width $width + $canvas create arc $x1 $y1 $x2 $y2 -start $b -extent $delta \ + -style arc -outline $color -width $width + } } } if {0} { -# main -- -# Demonstration of the voltmeter object -# -proc main { argc argv } { - global forever + # main -- + # Demonstration of the voltmeter object + # + proc main { argc argv } { + global forever - wm withdraw . - wm title . "A voltmeter-like widget" - wm geometry . +10+10 + wm withdraw . + wm title . "A voltmeter-like widget" + wm geometry . +10+10 - ::controlwidget::voltmeter .t1 -variable value1 -labels { 0 50 100 } -title "Voltmeter (V)" - scale .s1 -command "set ::value1" -variable value1 + ::controlwidget::voltmeter .t1 -variable value1 -labels { 0 50 100 } -title "Voltmeter (V)" + scale .s1 -command "set ::value1" -variable value1 - ::controlwidget::voltmeter .t2 -variable value2 -labels { 0 {} 2.5 {} 5 } \ - -width 80m -height 40m -title "Ampere (mA)" -dialcolor lightgreen -scalecolor white \ - -min 0 -max 5 - scale .s2 -command "set ::value2" -variable value2 + ::controlwidget::voltmeter .t2 -variable value2 -labels { 0 {} 2.5 {} 5 } \ + -width 80m -height 40m -title "Ampere (mA)" -dialcolor lightgreen -scalecolor white \ + -min 0 -max 5 + scale .s2 -command "set ::value2" -variable value2 - button .b -text Quit -command "set ::forever 1" + button .b -text Quit -command "set ::forever 1" - grid .t1 .s1 .t2 .s2 .b - wm deiconify . - vwait forever - .t1 destructor - .t2 destructor - exit 0 -} + grid .t1 .s1 .t2 .s2 .b + wm deiconify . + vwait forever + .t1 destructor + .t2 destructor + exit 0 + } -main $argc $argv + main $argc $argv } ### end of file diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/crosshair/crosshair.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/crosshair/crosshair.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/crosshair/crosshair.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/crosshair/crosshair.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/crosshair/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/crosshair/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/crosshair/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/crosshair/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ctext/ctext.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ctext/ctext.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ctext/ctext.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ctext/ctext.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ctext/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ctext/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ctext/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ctext/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/cursor/cursor.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/cursor/cursor.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/cursor/cursor.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/cursor/cursor.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/cursor/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/cursor/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/cursor/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/cursor/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/datefield/datefield.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/datefield/datefield.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/datefield/datefield.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/datefield/datefield.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/datefield/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/datefield/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/datefield/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/datefield/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/application.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/application.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/application.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/application.tcl index 26a30e35..770abc0c 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/application.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/application.tcl @@ -48,7 +48,13 @@ proc ::diagram::application {arguments} { proc ::diagram::application::showerror {text} { global argv0 - puts stderr "$argv0: $text" + if {[catch {package present Tk}]} { + puts stderr "$argv0: $text" + } else { + tk_messageBox -type ok -icon error \ + -title "Error in application" \ + -message "$argv0: $text" + } exit 1 } @@ -466,5 +472,5 @@ proc ::diagram::application::Run::MakeInterpreter {} { } # # ## ### ##### ######## ############# ##################### -package provide diagram::application 1.2 +package provide diagram::application 1.3 return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/attributes.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/attributes.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/attributes.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/attributes.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/basic.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/basic.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/basic.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/basic.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/core.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/core.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/core.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/core.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/diagram.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/diagram.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/diagram.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/diagram.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/direction.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/direction.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/direction.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/direction.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/element.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/element.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/element.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/element.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/navigation.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/navigation.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/navigation.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/navigation.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/pkgIndex.tcl similarity index 92% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/pkgIndex.tcl index 0a41ae3e..601bd6ae 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/pkgIndex.tcl @@ -11,5 +11,5 @@ package ifneeded diagram::core 1 [list source [file join $dir core.tcl]] package ifneeded diagram::basic 1.0.1 [list source [file join $dir basic.tcl]] package ifneeded diagram 1 [list source [file join $dir diagram.tcl]] -package ifneeded diagram::application 1.2 [list source [file join $dir application.tcl]] +package ifneeded diagram::application 1.3 [list source [file join $dir application.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/point.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/point.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/diagrams/point.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/diagrams/point.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/getstring/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/getstring/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/getstring/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/getstring/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/getstring/tk_getString.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/getstring/tk_getString.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/getstring/tk_getString.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/getstring/tk_getString.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/history/history.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/history/history.tcl similarity index 52% rename from src/vfs/punk9win.vfs/lib/tklib0.8/history/history.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/history/history.tcl index 161f363a..698dfe75 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/history/history.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/history/history.tcl @@ -3,14 +3,13 @@ # Provides a history mechanism for entry widgets # # Copyright (c) 2005 Aaron Faupell +# Copyright (c) 2016 MeshParts # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: history.tcl,v 1.4 2005/08/25 03:36:58 andreas_kupries Exp $ package require Tk -package provide history 0.1 +package provide history 0.3 namespace eval history { bind History {::history::up %W} @@ -22,9 +21,9 @@ proc ::history::init {w {len 30}} { variable prefs set bt [bindtags $w] if {[lsearch $bt History] > -1} { error "$w already has a history" } - if {[set i [lsearch $bt $w]] < 0} { error "cant find $w in bindtags" } + if {[set i [lsearch $bt $w]] < 0} { error "can't find $w in bindtags" } bindtags $w [linsert $bt [expr {$i + 1}] History] - array set history [list $w,list {} $w,cur -1] + array set history [list $w,list {} $w,cur 0] set prefs(maxlen,$w) $len return $w } @@ -41,41 +40,46 @@ proc ::history::remove {w} { proc ::history::add {w line} { variable history variable prefs - if {$history($w,cur) > -1 && [lindex $history($w,list) $history($w,cur)] == $line} { - set history($w,list) [lreplace $history($w,list) $history($w,cur) $history($w,cur)] + if {$history($w,cur) > 0 && [lindex $history($w,list) $history($w,cur)] == $line} { + set history($w,list) [lreplace $history($w,list) $history($w,cur) $history($w,cur)] + } + # prevent entry of duplicate lines. effectively pulls old line to the front + set idx [lsearch -dictionary $history($w,list) $line] + if {$idx>=0} { + set history($w,list) [lreplace $history($w,list) $idx $idx] } set history($w,list) [linsert $history($w,list) 0 $line] set history($w,list) [lrange $history($w,list) 0 $prefs(maxlen,$w)] - set history($w,cur) -1 + set history($w,cur) 0 } proc ::history::up {w} { variable history if {[lindex $history($w,list) [expr {$history($w,cur) + 1}]] != ""} { - if {$history($w,cur) == -1} { - set history($w,tmp) [$w get] - } - $w delete 0 end - incr history($w,cur) - $w insert end [lindex $history($w,list) $history($w,cur)] + if {$history($w,cur) == 0} { + set history($w,tmp) [$w get] + } + $w delete 0 end + incr history($w,cur) + $w insert end [lindex $history($w,list) $history($w,cur)] } else { - alert $w + alert $w } } proc ::history::down {w} { variable history - if {$history($w,cur) != -1} { - $w delete 0 end - if {$history($w,cur) == 0} { - $w insert end $history($w,tmp) - set history($w,cur) -1 - } else { - incr history($w,cur) -1 - $w insert end [lindex $history($w,list) $history($w,cur)] - } + if {$history($w,cur) != 0} { + $w delete 0 end + if {$history($w,cur) == 0} { + $w insert end $history($w,tmp) + set history($w,cur) 0 + } else { + incr history($w,cur) -1 + $w insert end [lindex $history($w,list) $history($w,cur)] + } } else { - alert $w + alert $w } } @@ -86,7 +90,7 @@ proc ::history::get {w} { proc ::history::clear {w} { variable history - set history($w,cur) -1 + set history($w,cur) 0 set history($w,list) {} unset -nocomplain history($w,tmp) } @@ -95,19 +99,24 @@ proc ::history::configure {w option {value {}}} { variable history variable prefs switch -exact -- $option { - length { - if {$value == ""} { return $prefs(maxlen,$w) } - if {![string is integer -strict $value]} { error "length must be an integer" } - set prefs(maxlen,$w) $value - } - alert { - if {$value == ""} { return [info body ::history::alert] } - proc ::history::alert w $value - } - default { - error "unknown option $option" - } + length { + if {$value == ""} { return $prefs(maxlen,$w) } + ##nagelfar ignore + if {![string is integer -strict $value]} { + return -code error "length must be an integer" + } + set prefs(maxlen,$w) $value + } + alert { + if {$value == ""} { return [info body ::history::alert] } + proc ::history::alert w $value + } + default { + return -code error "unknown option $option, expected alert, or length" + } } } -proc ::history::alert {w} {bell} +proc ::history::alert {w} { + bell +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/history/pkgIndex.tcl similarity index 54% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/history/pkgIndex.tcl index 12f619b1..5fe05c05 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/history/pkgIndex.tcl @@ -1,3 +1,3 @@ if { ![package vsatisfies [package provide Tcl] 8.4-] } { return } -package ifneeded ipentry 0.3 [list source [file join $dir ipentry.tcl]] +package ifneeded history 0.3 [list source [file join $dir history.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico.tcl index b9b6fe61..6d3a8c52 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico.tcl @@ -4,8 +4,6 @@ # # Copyright (c) 2003-2007 Aaron Faupell # Copyright (c) 2003-2011 ActiveState -# -# RCS: @(#) $Id: ico.tcl,v 1.32 2011/10/05 00:10:46 hobbs Exp $ # Sample usage: # set file bin/wish.exe @@ -433,8 +431,7 @@ proc ::ico::EXEtoICO {exeFile {icoDir {}}} { if {$icoDir == ""} { set icoDir [file dirname $file] } - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] foreach group $RES($file,group,names) { set dir {} @@ -447,8 +444,7 @@ proc ::ico::EXEtoICO {exeFile {icoDir {}}} { } # write them out to a file - set ifh [open [file join $icoDir [file tail $exeFile]-$group.ico] w+] - fconfigure $ifh -eofchar {} -encoding binary -translation lf + set ifh [open [file join $icoDir [file tail $exeFile]-$group.ico] wb+] bputs $ifh sss 0 1 [llength $RES($file,group,$group,members)] set offset [expr {6 + ([llength $RES($file,group,$group,members)] * 16)}] @@ -530,6 +526,7 @@ proc ::ico::getword {fh} { proc ::ico::getulong {fh} { binary scan [read $fh 4] i tmp + ##nagelfar ignore return [format %u $tmp] } @@ -554,13 +551,13 @@ proc ::ico::createImage {colors {name {}}} { if {0} { # if image supported "" colors as transparent pixels, # we could use this much faster op - $img put -to 0 0 $colors + $img put $colors -to 0 0 } else { for {set x 0} {$x < $w} {incr x} { for {set y 0} {$y < $h} {incr y} { set clr [lindex $colors $y $x] if {$clr ne ""} { - $img put -to $x $y $clr + $img put $clr -to $x $y } } } @@ -855,8 +852,7 @@ proc ::ico::readDIBFromData {data loc} { } proc ::ico::getIconListICO {file} { - set fh [open $file r] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] if {"[getword $fh] [getword $fh]" ne "0 1"} { return -code error "not an icon file" @@ -905,8 +901,7 @@ proc ::ico::getIconMembersICO {file name} { return $ret } - set fh [open $file r] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] # both words must be read to keep in sync with later reads if {"[getword $fh] [getword $fh]" ne "0 1"} { @@ -996,8 +991,7 @@ proc ::ico::getIconMembersEXE {file name} { # returns an icon in the form: # {width height depth palette xor_mask and_mask} proc ::ico::getRawIconDataICO {file name} { - set fh [open $file r] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] # both words must be read to keep in sync with later reads if {"[getword $fh] [getword $fh]" ne "0 1"} { @@ -1005,6 +999,7 @@ proc ::ico::getRawIconDataICO {file name} { return -code error "not an icon file" } set num [getword $fh] + ##nagelfar ignore if {![string is integer -strict $name] || $name < 0 || $name >= $num} { return -code error "no icon \"$name\"" } seek $fh [expr {(16 * $name) + 12}] current @@ -1023,6 +1018,7 @@ proc ::ico::getRawIconDataICODATA {data name} { if {[binary scan $data sss h1 h2 num] != 3 || $h1 != 0 || $h2 != 1} { return -code error "not icon data" } + ##nagelfar ignore if {![string is integer -strict $name] || $name < 0 || $name >= $num} { return -code error "No icon $name" } @@ -1074,8 +1070,7 @@ proc ::ico::getRawIconDataEXE {file name} { FindResources $file if {![info exists RES($file,icon,$name,offset)]} { error "No icon \"$name\"" } - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] seek $fh $RES($file,icon,$name,offset) start # readDIB returns: {w h bpp palette xor and} @@ -1086,12 +1081,10 @@ proc ::ico::getRawIconDataEXE {file name} { proc ::ico::writeIconICO {file name w h bpp palette xor and} { if {![file exists $file]} { - set fh [open $file w+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file wb+] set num 0 } else { - set fh [open $file r+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb+] if {"[getword $fh] [getword $fh]" ne "0 1"} { close $fh return -code error "not an icon file" @@ -1109,7 +1102,7 @@ proc ::ico::writeIconICO {file name w h bpp palette xor and} { seek $fh -24 current lappend data [read $fh [expr {$a + $b}]] } - + ##nagelfar ignore if {![string is integer -strict $name] || $name < 0 || $name >= $num} { set name [llength $data] lappend data $newicon @@ -1150,7 +1143,7 @@ proc ::ico::writeIconICODATA {file name w h bpp palette xor and} { lappend data [string range $data $readpos [expr {$readpos + $a + $b}]] incr readpos [expr {$readpos + $a + $b}] } - + ##nagelfar ignore if {![string is integer -strict $name] || $name < 0 || $name >= $num} { set name [llength $data] lappend data $newicon @@ -1175,8 +1168,7 @@ proc ::ico::writeIconICODATA {file name w h bpp palette xor and} { } proc ::ico::writeIconBMP {file name w h bpp palette xor and} { - set fh [open $file w+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file wb+] set size [expr {[string length $palette] + [string length $xor]}] # bitmap header: magic, file size, reserved, reserved, offset of bitmap data bputs $fh a2issi BM [expr {14 + 40 + $size}] 0 0 54 @@ -1198,8 +1190,7 @@ proc ::ico::writeIconEXE {file name w h bpp palette xor and} { return -code error "icon format differs from original" } - set fh [open $file r+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb+] seek $fh [expr {$RES($file,icon,$name,offset) + 40}] start puts -nonewline $fh $palette$xor$and @@ -1213,8 +1204,7 @@ proc ::ico::FindResources {file} { return [llength $RES($file,group,names)] } - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] if {[read $fh 2] ne "MZ"} { close $fh return -code error "file is not a valid executable" @@ -1464,4 +1454,4 @@ interp alias {} ::ico::getIconMembersICL {} ::ico::getIconMembersEXE interp alias {} ::ico::getRawIconDataICL {} ::ico::getRawIconDataEXE interp alias {} ::ico::writeIconICL {} ::ico::writeIconEXE -package provide ico 1.1 +package provide ico 1.1.3 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico0.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico0.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico0.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico0.tcl index a8130c8e..78eaed2e 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ico/ico0.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/ico0.tcl @@ -4,8 +4,6 @@ # # Copyright (c) 2003 Aaron Faupell # Copyright (c) 2003-2004 ActiveState Corporation -# -# RCS: @(#) $Id: ico0.tcl,v 1.3 2011/10/05 00:10:46 hobbs Exp $ # JH: speed has been considered in these routines, although they # may not be fully optimized. Running EXEtoICO on explorer.exe, @@ -282,8 +280,7 @@ proc ::ico::EXEtoICO {exeFile icoFile} { set dir {} set data {} - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] for {set i 0} {$i <= $cnt} {incr i} { seek $fh $ICONS($file,$i) start @@ -294,8 +291,7 @@ proc ::ico::EXEtoICO {exeFile icoFile} { close $fh # write them out to a file - set ifh [open $icoFile w+] - fconfigure $ifh -eofchar {} -encoding binary -translation lf + set ifh [open $icoFile wb+] bputs $ifh sss 0 1 [expr {$cnt + 1}] set offset [expr {6 + (($cnt + 1) * 16)}] @@ -371,6 +367,7 @@ proc ::ico::getword {fh} { proc ::ico::getulong {fh} { binary scan [read $fh 4] i tmp + ##nagelfar ignore return [format %u $tmp] } @@ -397,13 +394,13 @@ proc ::ico::createImage {colors {name {}}} { if {0} { # if image supported "" colors as transparent pixels, # we could use this much faster op - $img put -to 0 0 $colors + $img put $colors -to 0 0 } else { for {set x 0} {$x < $w} {incr x} { for {set y 0} {$y < $h} {incr y} { set clr [lindex $colors $y $x] if {$clr ne ""} { - $img put -to $x $y $clr + $img put $clr -to $x $y } } } @@ -697,8 +694,7 @@ proc ::ico::readDIBFromData {data loc} { } proc ::ico::getIconListICO {file} { - set fh [open $file r] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] # both words must be read to keep in sync with later reads if {"[getword $fh] [getword $fh]" ne "0 1"} { @@ -779,8 +775,7 @@ proc ::ico::getIconListEXE {file} { # returns an icon in the form: # {width height depth palette xor_mask and_mask} proc ::ico::getRawIconDataICO {file index} { - set fh [open $file r] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] # both words must be read to keep in sync with later reads if {"[getword $fh] [getword $fh]" ne "0 1"} { @@ -857,8 +852,7 @@ proc ::ico::getRawIconDataEXE {file index} { if {$cnt < $index} { return -code error "index out of range" } - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] seek $fh $ICONS($file,$index) start # readDIB returns: {w h bpp palette xor and} @@ -869,13 +863,11 @@ proc ::ico::getRawIconDataEXE {file index} { proc ::ico::writeIconICO {file index w h bpp palette xor and} { if {![file exists $file]} { - set fh [open $file w+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file wb+] bputs $fh sss 0 1 0 seek $fh 0 start } else { - set fh [open $file r+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb+] } if {[file size $file] > 4 && "[getword $fh] [getword $fh]" ne "0 1"} { close $fh @@ -965,8 +957,7 @@ proc ::ico::writeIconICODATA {file index w h bpp palette xor and} { proc ::ico::writeIconBMP {file index w h bpp palette xor and} { if {$index != 0} {return -code error "index out of range"} - set fh [open $file w+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file wb+] set size [expr {[string length $palette] + [string length $xor]}] # bitmap header: magic, file size, reserved, reserved, offset of bitmap data bputs $fh a2issi BM [expr {14 + 40 + $size}] 0 0 54 @@ -988,8 +979,7 @@ proc ::ico::writeIconEXE {file index w h bpp palette xor and} { return -code error "icon format differs from original" } - set fh [open $file r+] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb+] seek $fh [expr {$ICONS($file,$index) + 40}] start puts -nonewline $fh $palette$xor$and @@ -1002,8 +992,7 @@ proc ::ico::SearchForIcos {file {index -1}} { if {[info exists ICONS($file,$index)]} { return $ICONS($file,$index) } - set fh [open $file] - fconfigure $fh -eofchar {} -encoding binary -translation lf + set fh [open $file rb] if {[read $fh 2] ne "MZ"} { close $fh return -code error "unknown file format" @@ -1190,4 +1179,4 @@ proc ::ico::Show {file args} { grid columnconfigure $parent 0 -weight 1 } -package provide ico 0.3.2 +package provide ico 0.3.5 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/ico/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/pkgIndex.tcl new file mode 100644 index 00000000..dac3e2cc --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ico/pkgIndex.tcl @@ -0,0 +1,7 @@ +# pkgIndex.tcl -- +# +# Copyright (c) 2003 ActiveState Corporation. +# All rights reserved. + +package ifneeded ico 0.3.5 [list source [file join $dir ico0.tcl]] +package ifneeded ico 1.1.3 [list source [file join $dir ico.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/ipentry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/ipentry.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/ipentry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/ipentry.tcl index 640ec5f8..7f77fb73 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ipentry/ipentry.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/ipentry.tcl @@ -7,18 +7,18 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: ipentry.tcl,v 1.19 2009/01/21 07:10:03 afaupell Exp $ package require Tk -package provide ipentry 0.3 +package provide ipentry 0.3.2 namespace eval ::ipentry { namespace export ipentry ipentry6 # copy all the bindings from Entry class to our own IPEntrybindtag class + variable x foreach x [bind Entry] { bind IPEntrybindtag $x [bind Entry $x] } + # then replace certain keys we are interested in with our own bind IPEntrybindtag {::ipentry::keypress %W %K} bind IPEntrybindtag {::ipentry::backspace %W} @@ -49,6 +49,8 @@ namespace eval ::ipentry { # [list +ttk::style layout IPEntryFrame \ # [ttk::style layout IPEntryFrame]] # } + + unset x } # ipentry -- @@ -838,6 +840,7 @@ proc ::ipentry::_insert {w val} { foreach x {0 1 2 3} { set n [lindex $val $x] if {$n != ""} { + ##nagelfar ignore if {![string is integer -strict $n]} { #error "cannot insert non-numeric arguments" return @@ -916,7 +919,10 @@ proc ::ipentry::widgetCommand {w cmd args} { icursor { if {![string match $w.* [focus]]} { return } set i [lindex $args 0] - if {![string is integer -strict $i]} { error "argument must be an integer" } + ##nagelfar ignore + if {![string is integer -strict $i]} { + return -code error "argument must be an integer" + } set s [expr {$i / 4}] focus $w.$s $w.$s icursor [expr {$i % 4}] @@ -963,7 +969,10 @@ proc ::ipentry::widgetCommand6 {w cmd args} { icursor { if {![string match $w.* [focus]]} { return } set i [lindex $args 0] - if {![string is integer -strict $i]} { error "argument must be am integer" } + ##nagelfar ignore + if {![string is integer -strict $i]} { + return -code error "argument must be an integer" + } set s [expr {$i / 8}] focus $w.$s $w.$s icursor [expr {$i % 8}] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/pkgIndex.tcl new file mode 100644 index 00000000..ae8826a4 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ipentry/pkgIndex.tcl @@ -0,0 +1,3 @@ +if { ![package vsatisfies [package provide Tcl] 8.4-] } { return } +package ifneeded ipentry 0.3.2 [list source [file join $dir ipentry.tcl]] + diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/ROOT.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/ROOT.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/ROOT.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/ROOT.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/cs.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/cs.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/cs.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/cs.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/da.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/da.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/da.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/da.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/de.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/de.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/de.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/de.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/en.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/en.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/en.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/en.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/es.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/es.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/es.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/es.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/khim.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/khim.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/khim.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/khim.tcl index 294091ea..523b4cf7 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/khim.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/khim.tcl @@ -17,9 +17,6 @@ # Refer to the file "license.terms" for the terms and conditions of # use and redistribution of this file, and a DISCLAIMER OF ALL WARRANTEES. # -# $Id: khim.tcl,v 1.10 2007/06/08 19:24:31 kennykb Exp $ -# $Source: /home/rkeene/tmp/cvs2fossil/tcllib/tklib/modules/khim/khim.tcl,v $ -# #---------------------------------------------------------------------- package require Tcl 8.4- @@ -27,7 +24,7 @@ package require Tk 8.4- package require msgcat 1.2 package require autoscroll 1.0 -package provide khim 1.0.1 +package provide khim 1.0.3 namespace eval khim [list variable KHIMDir [file dirname [info script]]] @@ -298,7 +295,7 @@ proc khim::getOptions {w} { checkbutton $w.v -variable ::khim::inputUse -text [mc "Use KHIM"] label $w.l1 -text [mc "Compose key:"] - button $w.b1 -textvariable khim::inputComposeKey \ + button $w.b1 -textvariable ::khim::inputComposeKey \ -command [list ::khim::GetComposeKey $w.b1] labelframe $w.lf1 -text [mc "Key sequences"] -padx 5 -pady 5 -width 400 listbox $w.lf1.lb -height 20 -yscroll [list $w.lf1.y set] \ @@ -1047,7 +1044,7 @@ proc khim::CMapUpdateSpinbox {w args} { set spin $w.spin # Test validity of the code page number - + ##nagelfar ignore if { ![string is integer -strict $CMapInputCodePage($w)] || $CMapInputCodePage($w) < 0 || $CMapInputCodePage($w) >= 0x100 } { @@ -1641,7 +1638,7 @@ proc khim::CMapInteractor {w} { } grid [label $map.l1 -text [mc {Select code page:}]] \ -row 0 -column 0 -sticky e - grid [spinbox $map.spin -textvariable khim::CMapInputCodePage($map) \ + grid [spinbox $map.spin -textvariable ::khim::CMapInputCodePage($map) \ -width 4] \ -row 0 -column 1 -sticky w @@ -2017,10 +2014,10 @@ if {[info exists ::argv0] && ![string compare $::argv0 [info script]]} { -padx 5 -pady 5 proc testLoadConfig {} { - source ~/.khimrc + source $::env(HOME)/.khimrc } proc testSaveConfig {} { - set f [open ~/.khimrc w] + set f [open $::env(HOME)/.khimrc w] puts $f [khim::getConfig] close $f } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/khim/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/pkgIndex.tcl new file mode 100644 index 00000000..b265106a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/pkgIndex.tcl @@ -0,0 +1 @@ +package ifneeded khim 1.0.3 [list source [file join $dir khim.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/pl.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/pl.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/pl.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/pl.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/ru.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/ru.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/ru.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/ru.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/khim/uk.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/khim/uk.msg similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/khim/uk.msg rename to src/vfs/punk9win.vfs/lib/tklib0.9/khim/uk.msg diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-display.tcl new file mode 100644 index 00000000..97426a83 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-display.tcl @@ -0,0 +1,229 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::area::display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a single area definition +# Meta description Widget to display the information of a single area definition +# Meta subject {area display, tabular} +# Meta subject {tabular, area display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +## TODO / focus - active vertex / row map ... + +package provide map::area::display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ +# +## set AREA -> VOID Show this area, or nothing, if empty +# +## -on-selection Report changes to the vertext selection +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export display ; namespace ensemble create } + +debug level tklib/map/area/display +debug prefix tklib/map/area/display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::area::display { + # . . .. ... ..... ........ ............. ..................... + # User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myspec {} ;# Table data derived from the area specification + variable myparts ;# Area statistics: Number of parts + variable myperimeter ;# Area statistics: Perimeter + variable mydiameter ;# Area statistics: Diameter + variable myclat ;# Area statistics: Center Latitude + variable myclon ;# Area statistics: Center Longitude + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {args} { + debug.tklib/map/area/display {} + + $self configurelist $args + + label $win.lcenter -text Center + label $win.clat -textvariable [myvar myclat] + label $win.clon -textvariable [myvar myclon] + label $win.lparts -text Parts + label $win.parts -textvariable [myvar myparts] + label $win.llength -text Perimeter + label $win.length -textvariable [myvar myperimeter] + label $win.ldiameter -text Diameter + label $win.diameter -textvariable [myvar mydiameter] + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 60 \ + -columntitles {\# Latitude Longitude Distance Total} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -side bottom -fill both -expand 1 + + pack $win.lcenter -in $win -side left + pack $win.clat -in $win -side left + pack $win.clon -in $win -side left + pack $win.lparts -in $win -side left + pack $win.parts -in $win -side left + pack $win.llength -in $win -side left + pack $win.length -in $win -side left + pack $win.ldiameter -in $win -side left + pack $win.diameter -in $win -side left + + $win.sa.table configure -listvariable [myvar myspec] + + bind $win.sa.table <> [mymethod SelectionChanged] + return + } + + destructor { + debug.tklib/map/area/display {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {index} { + debug.tklib/map/area/display {} + + $win.sa.table selection clear 0 end + $win.sa.table selection set $index + $win.sa.table see $index + return + } + + method set {geos} { + debug.tklib/map/area/display {} + + if {![llength $geos]} { + set myspec {} + set mydiameter n/a + set myperimeter n/a + set myparts n/a + set myclat n/a + set myclon n/a + return + } + + set parts [llength $geos] ; if {$parts < 3} { incr parts -1 } + set diameter [map slippy geo diameter-list $geos] + set center [map slippy geo center-list $geos] + lassign [map slippy geo limit $center] clat clon + + # Assemble table data + + set last {} + set total 0 + set rows [lmap g $geos { + set dd {} + set dt {} + if {$last ne {}} { + set d [map slippy geo distance $last $g] + set total [expr {$total + $d}] + # Format for display + set dd [map slipp pretty-distance $d] + set dt [map slipp pretty-distance $total] + } + + lassign [map slippy geo limit $g] lat lon + set last $g + + set data {} + lappend data [incr rowid] + lappend data $lat + lappend data $lon + lappend data $dd + lappend data $dt + set data + }] + + # A last line to close the perimeter + set d [map slippy geo distance $last [lindex $geos 0]] + set total [expr {$total + $d}] + # Format for display + set dd [map slipp pretty-distance $d] + set dt [map slipp pretty-distance $total] + + lappend rows [list 1 {} {} $dd $dt] + + # ... and commit + set myparts $parts + set myperimeter $dt + set mydiameter [map slippy pretty-distance $diameter] + set myspec $rows + set myclat $clat + set myclon $clon + return + } + + # . . .. ... ..... ........ ............. ..................... + # Internal + + method SelectionChanged {} { + debug.tklib/map/area/display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/area/display {} + + if {![llength $options(-on-selection)]} return + + set row [$win.sa.table curselection] + if {$row eq {}} return + + set row [lindex $myspec $row 0] + incr row -1 + + uplevel #0 [list {*}$options(-on-selection) $row] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-file.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-file.tcl new file mode 100644 index 00000000..fe8170bc --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-file.tcl @@ -0,0 +1,140 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Filesystem based storage of geo/area information - Independent of AKIS +## Tklib geo/area file format +## +## - Line based +## - Ignores leading and trailing whitespace in lines +## - Ignores empty lines +## - Ignore lines starting with `//` - C++ line comments +## - Ignore lines starting with `#` - Shell et al line comments +## - Magic word in first line identifying the file: "tklib/geo/area" +## - Zero to more non-numeric lines specifying area names +## - Exactly 2 or more numeric lines specifying coordinates, even number +## - Coordinates are validated as lat/lon + +# @@ Meta Begin +# Package map::area::file 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Reading/writing tklib geo/area files +# Meta description Reading/writing tklib geo/area files +# Meta subject map +# Meta subject {file, geo/area} +# Meta subject {geo/area, file} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::area::file 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## read PATH -> INFO :: dict (names, geo) +## write PATH INFO -> VOID +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export file ; namespace ensemble create } +namespace eval map::area::file { namespace export read write ; namespace ensemble create } + +debug level tklib/map/area/file +debug prefix tklib/map/area/file {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### +## API + +proc ::map::area::file::read {path} { + debug.tklib/map/area/file {} + + if {[catch { + set c [open $path r] + }]} return + + set d [::read $c] + close $c + + set names {} + set coordinates [lmap line [split $d \n] { + set line [string trim $line] + if {$line eq {}} continue + if {[string match //* $line]} continue + if {[string match "#*" $line]} continue + if {![string is double -strict $line]} { + lappend names $line + continue + } + set line + }] + + #puts $path\t//$names//$coordinates// + set names [lassign $names magic] + + if {$magic ne "tklib/geo/area"} { + #puts "$path\t/no magic" + return + } + if {[llength $coordinates] < 2} { + #puts "$path\t/bad coordinate count [llength $coordinates]" + return + } + if {[llength $coordinates] % 2 == 1} { + #puts "$path\t/bad coordinate count [llength $coordinates]" + return + } + + set geos [lmap {lat lon} $coordinates { list $lat $lon }] + + if {![map slippy geo valid-list $geos]} return + + # Default name derived from file name, iff no name specified + if {![llength $names]} { lappend names [file rootname [file tail $path]] } + + dict set g names $names + dict set g geo $geos + + return $g +} + +proc ::map::area::file::write {path gdata} { + debug.tklib/map/area/file {} + + set c [open $path w] + + puts $c tklib/geo/area + + foreach name [lsort -dict -unique [dict get $gdata names]] { + puts $c $name + } + + foreach geo [dict get $gdata geo] { + lassign $geo lat lon + puts $c $lat + puts $c $lon + } + + close $c + return +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-map-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-map-display.tcl new file mode 100644 index 00000000..62e6cc70 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-map-display.tcl @@ -0,0 +1,392 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::area::map-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine: Layer to display area definitions +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description Shows a set of area definitions. Areas geo area to ensure +# Meta description that only visible areas use canvas resources (items) +# Meta subject {addon, area display, map display} +# Meta subject {area display, map display, addon} +# Meta subject {map display, addon, area display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require canvas::edit::polyline +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::area::map-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget store +# +## focus ID -> VOID Move map to area with ID +## disable -> VOID Hide areas +## enable -> VOID Show areas +# +## -on-active Command to report changes in the active area +# +## -color Visual options inherited from canvas::edit::polyline +## -hilit-color for full customization of the polyline appearance +## -radius . +## -kind . +## -radius . +## -line-config . +## -create-cmd . +# +# TODO :: Can we get stuff like double-click handling to invoke a area action? +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::polyline ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export map-display ; namespace ensemble create } + +debug level tklib/map/area/map-display +debug prefix tklib/map/area/map-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::area::map-display { + # .................................................................. + # User configuration + + option -on-active -default {} -readonly 1 + + # Visual options passed to the low-level polyline engines + option -color -default {} -readonly 1 + option -hilit-color -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -kind -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -line-config -default {} -readonly 1 + option -create-cmd -default {} -readonly 1 + + # .................................................................. + ## State - Derived from configuration + + variable myactive 0 ;# Active layer? y/n + variable myvisual {} ;# Visual configuration for the polyline engines + variable mymap {} ;# Map the behaviour is attached to + variable mycanvas {} ;# Canvas inside the map + variable mystore {} ;# Area store + variable myviewchain {} ;# Old view reporting callback + + # .................................................................. + # Map state (viewport) + + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + + # .................................................................. + # Display state + + variable myareas {} ;# Cache of area information (area, box, pixels per level) + # ;# dict (id -> 'level' -> level -> list(point...) + # ;# -> 'bbox' -> geobox + # ;# -> 'center' -> geo + variable myvisible {} ;# Set of the visible areas, map from id to manager + # ;# dict (id -> canvas::edit::polyline instance) + variable myrevers {} ;# dict (canvas::edit::polyline instance -> id) + + # .................................................................. + # Object pool - Reusable polyline objects + + variable myfree {} ;# Set of reusable polyline instances + variable myid 0 ;# Id counter for new polyline instances + + # .................................................................. + ## Lifecycle + + constructor {map store args} { + debug.tklib/map/area/map-display {} + + $self configurelist $args + + set mystore $store + set mymap $map + set mycanvas [$map canvas] + + foreach o { + -color + -hilit-color + -radius + -kind + -radius + -line-config + -create-cmd + } { + if {$options($o) eq {}} continue + lappend myvisual $o $options($o) + } + + $self Attach + return + } + + destructor { + debug.tklib/map/area/map-display {} + + if {![winfo exists $mycanvas]} return + $self disable + $self Detach + + # The low-level area managers are auto-destroyed because they are in this + # object's namespace and deleted with it. + return + } + + # .................................................................. + ## API + + method enable {} { + debug.tklib/map/area/map-display {} + + if {$myactive} return + set myactive yes + + # Force visibility processing + $self ViewChanged {*}[$mymap view] + return + } + + method disable {} { + debug.tklib/map/area/map-display {} + + if {!$myactive} return + set myactive no + + # Remove all the visible areas + dict for {id poly} $myvisible { + $self Close $id + } + return + } + + method focus {id} { + debug.tklib/map/area/map-display {} + + $self Load $id + $self Fit $id ;# The viewport change automatically triggers everything + # # needed to show the focus area, and whatever else is + # # visible. + return + } + + # .................................................................. + ## Internal + + # .................................................................. + ## Viewport interception + + method ViewChanged {zoom viewarea geobox} { + debug.tklib/map/area/map-display {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + debug.tklib/map/area/map-display {} + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewarea $geobox] + } + + # Do nothing when disabled + if {!$myactive} return + + set zoomchanged [expr {$zoom != $myzoom}] + + # Update map state (zoom, and canvas dimensions for fitting) + set mycanvasdim [map slippy point box dimensions $viewarea] + set myzoom $zoom + + # Query store for visible areas + set visible [DO visible $geobox] + + set new {} + foreach v $visible { dict set new $v . } + + # Drop all areas which are not visible any longer + dict for {id poly} $myvisible { + if {[dict exists $new $id]} continue + $self Close $id + } + + # For all visible areas, get new, and move existing. move only for zoom changes. + foreach id $visible { + if {[dict exists $myvisible $id]} { + if {$zoomchanged} { $self Show $id } + continue + } + $self Load $id + $self Open $id + $self Show $id + } + return + } + + # .................................................................. + + method Fit {id} { + debug.tklib/map/area/map-display {} + # Already loaded. + + set center [dict get $myareas $id center] + set gbox [dict get $myareas $id bbox] + set zoom [map slippy geo box fit $gbox $mycanvasdim [expr {[$mymap levels]-1}]] + + #puts /area-box/$gbox + #puts /dim/$mycanvasdim + #puts /zom/$zoom + + # And this triggers display of the focused id, being fully visible + $mymap center $center $zoom + return + } + + method Load {id} { + debug.tklib/map/area/map-display {} + + if {[dict exists $myareas $id geo]} return + + set spec [DO get $id] + dict with spec {} + # names, geo, diameter, length, center, bbox, parts + # => center, bbox + + dict set myareas $id bbox $bbox + dict set myareas $id center $center + return + } + + method Show {id} { + debug.tklib/map/area/map-display {} + + # Note: point/marker radius is chosen for best visual appearance. + # Single point => extend size to make it visible + # Multiple points => shrink to nothing so that line display is dominant + + set poly [dict get $myvisible $id] + set points [$self Pixels $id] + set radius [expr { [llength $points] < 2 ? 3 : 0 }] + + $poly configure -radius $radius + $poly set-line $points + return + } + + method Pixels {id} { + debug.tklib/map/area/map-display {} + + if {![dict exists $myareas $id level $myzoom]} { + dict set myareas $id level $myzoom [DO pixels $id $myzoom] + } + return [dict get $myareas $id level $myzoom] + } + + method Open {id} { + debug.tklib/map/area/map-display {} + + if {[llength $myfree]} { + set poly [lindex $myfree end] + set myfree [lreplace $myfree end end] + } else { + set obj AREA_[incr myid] + set poly [canvas::edit polyline \ + ${selfns}::$obj \ + $mycanvas \ + {*}$myvisual \ + -closed yes \ + -active-cmd [mymethod Active] \ + -tag $self//$obj] + # starts disabled + } + + dict set myvisible $id $poly + dict set myrevers $poly $id + return + } + + method Active {poly kind} { + debug.tklib/map/area/map-display {} + + if {![llength $options(-on-active)]} return + if {$kind ne "line"} return + + set id [dict get $myrevers $poly] + uplevel #0 [list {*}$options(-on-active) $id] + return + } + + method Close {id} { + debug.tklib/map/area/map-display {} + + set poly [dict get $myvisible $id] + $poly clear + + dict unset myvisible $id + dict unset myrevers $poly + lappend myfree $poly + return + } + + # .................................................................. + ## Chain management + + method Attach {} { + debug.tklib/map/area/map-display {} + + # Hook into viewport reporting + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + return + } + + method Detach {} { + debug.tklib/map/area/map-display {} + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # .................................................................. + ## Store access + + proc DO {args} { + debug.tklib/map/area/map-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-fs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-fs.tcl new file mode 100644 index 00000000..f3c980af --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-fs.tcl @@ -0,0 +1,157 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::area::store::fs 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Filesystem-based store of geo/area definitions +# Meta description Store loading geo/area definitions from a +# Meta description directory in the filesystem. +# Meta subject map +# Meta subject {filesystem store, geo/area} +# Meta subject {geo/area, filesystem store} +# Meta subject {store, geo/area, filesystem} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::area::store::fs 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ areadirectory +# +## ids -> list (id...) +## get ID -> dict (name -> STRING, geo -> list(geo)) +## visible GEOBOX -> list (id...) +# +## -pattern File pattern for matching geo/area files +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities (inside, visibility) +package require snit ;# - OO system +# +package require map::area::file + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export store ; namespace ensemble create } +namespace eval map::area::store { namespace export fs ; namespace ensemble create } + +debug level tklib/map/area/store/fs +debug prefix tklib/map/area/store/fs {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::area::store::fs { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -pattern -default {*.area} -readonly 1 + + # . . .. ... ..... ........ ............. ..................... + ## State, In-memory cache + # + # - Visibility map :: dict (geo -> id) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> list (geo...)) + + variable mypoints {} + variable myattr {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {directory} { + debug.tklib/map/area/store/fs {} + + $self Load $directory + return + } + + destructor { + debug.tklib/map/area/store/fs {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method ids {} { + debug.tklib/map/area/store/fs {} + + return [lsort -dict [dict keys $myattr]] + } + + method get {id} { + debug.tklib/map/area/store/fs {} + + return [dict get $myattr $id] + } + + method visible {geobox} { + debug.tklib/map/area/store/fs {} + + set ids {} + dict for {geo id} $mypoints { + if {![map slippy geo box inside $geobox $geo]} continue + lappend ids $id + } + set ids [lsort -unique $ids] + #puts (($ids)) + return $ids + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Load {directory} { + debug.tklib/map/area/store/fs {} + + foreach path [glob -nocomplain -directory $directory $options(-pattern)] { + if {![file exists $path]} continue + if {![file isfile $path]} continue + if {![file readable $path]} continue + + set area [map area file read $path] + if {![dict size $area]} continue + # area :: dict (names, geo) + + # Note: file path is used as area ID + + # Update visibility map + foreach p [dict get $area geo] { + dict set mypoints $p $path + } + + # Update base attribute information + dict set myattr $path $area + } + + #array set __ $myattr ; parray __ ; unset __ + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-mem.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-mem.tcl new file mode 100644 index 00000000..a5973155 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-store-mem.tcl @@ -0,0 +1,184 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::area::store::memory 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary In-memory store for geo/area definitions +# Meta description In-memory store for geo/area definitions, with +# Meta description memoized calculation of extended attributes. +# Meta description Base data is taken from a backing store. +# Meta description Anything API-compatible to map::area::store::fs +# Meta subject {center, geo/area} +# Meta subject {diameter, geo/area} +# Meta subject {geo/area pixels, zoom} +# Meta subject {geo/area, center} +# Meta subject {geo/area, diameter} +# Meta subject {geo/area, memory store} +# Meta subject {geo/area, perimeter length} +# Meta subject {length, geo/area, perimeter} +# Meta subject {memory store, geo/area} +# Meta subject {perimeter length, geo/area} +# Meta subject {pixels, zoom, geo/area} +# Meta subject {store, geo/area, memory} +# Meta subject {zoom, geo/area pixels} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::area::store::memory 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ backend-store +# +## ids -> list (id...) +## get ID -> dict (name, geo, diameter, length, parts, center) +## visible GEOBOX -> list (id...) +## pixels ID ZOOM -> list (point...) +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export store ; namespace ensemble create } +namespace eval map::area::store { namespace export memory ; namespace ensemble create } + +debug level tklib/map/area/store/memory +debug prefix tklib/map/area/store/memory {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::area::store::memory { + # .................................................................. + ## System configuration + + typevariable ourmagic 4.5 ;# This 1.5*3, where 3 is the default circle radius used in + # # canvas::edit::points for the display of point markers. + # TODO: synch with area-display configuration, i.e. radius changes. + # YET: Doing at indexing time will require a fixed threshold. + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - Backing store, command prefix + # - Pixel store :: dict (id -> zoom -> list(point...)) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> list (geo...) + # "diameter" -> double + # "perimeter" -> double + # "center" -> geo + # "bbox" -> geobox + # "parts" -> int) + + variable mystore {} + variable myattr {} + variable mypixels {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store} { + debug.tklib/map/area/store/memory {} + + set mystore $store + return + } + + destructor { + debug.tklib/map/area/store/memory {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method * to mystore except get ;# ids, visible + + method get {id} { + debug.tklib/map/area/store/memory {} + + if {![dict exists $myattr $id]} { + dict set myattr $id [$self Attributes $id] + } + return [dict get $myattr $id] + } + + method pixels {id zoom} { + debug.tklib/map/area/store/memory {} + + if {![dict exists $mypixels $id $zoom]} { + dict set mypixels $id $zoom [$self Pixels $zoom $id] + } + return [dict get $mypixels $id $zoom] + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Attributes {id} { + set attr [DO get $id] + set geos [dict get $attr geo] + + set bbox [map slippy geo bbox-list $geos] + set center [map slippy geo center-list $geos] + set diameter [map slippy geo diameter-list $geos] + set perimeter [map slippy geo distance-list 1 $geos] + + set parts [llength $geos] + if {$parts < 3} { incr parts -1 } + + dict set attr bbox $bbox + dict set attr center $center + dict set attr diameter $diameter + dict set attr perimeter $perimeter + dict set attr parts $parts + + #puts |$id|$attr| + + return $attr + } + + method Pixels {zoom id} { + debug.tklib/map/area/store/memory {} + + set attr [DO get $id] + set geos [dict get $attr geo] + set points [map slippy geo 2point-list $zoom $geos] + set points [map slippy point simplify radial $ourmagic 1 $points] + set points [map slippy point simplify rdp $points] + + return $points + } + + proc DO {args} { + debug.tklib/map/area/store/memory {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-table-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-table-display.tcl new file mode 100644 index 00000000..82acacd7 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/area-table-display.tcl @@ -0,0 +1,264 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::area::table-table-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a table of area definitions +# Meta description Widget to display the information of many area definitions +# Meta description in a table +# Meta subject {area display, tabular} +# Meta subject {tabular, area display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +package provide map::area::table-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ store ... +# +## OBJ focus ID +# +## -on-selection Command prefix to report selection changes +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular table-display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export area ; namespace ensemble create } +namespace eval map::area { namespace export table-display ; namespace ensemble create } + +debug level tklib/map/area/table-display +debug prefix tklib/map/area/table-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::area::table-display { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - List of shown area definitions + # (per row: id, name, center (lat/lon separate), parts, diameter, perimeter) + # => 7 columns + # id identifies the row, and is mapped back to the AREA id. + # + # - Backward map from row ids to AREA ids + # NOTE: multiple row ids can map to the same area (multiple names!) + # + # - Forward map from area id to the set of rows showing that area + # (set because multiple names) + # + # - Command to access backing store. + + variable myspec {} ;# Table data derived from the area specifications + variable myrows {} ;# dict (row-id -> area-id) + variable myareas {} ;# dict (area-id -> row-id -> ".") + variable mystore {} ;# Store backing the display + # FUTURE: event: add/remove/change + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store args} { + debug.tklib/map/area/table-display {} + + $self configurelist $args + + set mystore $store + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 90 \ + -columntitles {\# Name Lat Lon Parts Diameter Perimeter} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -fill both -expand 1 + + $win.sa.table configure \ + -listvariable [myvar myspec] \ + -labelcommand tablelist::sortByColumn \ + -labelcommand2 tablelist::addToSortColumns + + bind $win.sa.table <> [mymethod SelectionChanged] + + #DO watch [mymethod StoreChanged] ;# FUTURE: react to edits and + after 100 [mymethod StoreChanged] ;# resulting store changes + return + } + + destructor { + debug.tklib/map/area/table-display {} + + #DO unwatch [mymethod StoreChanged] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {areaid} { + debug.tklib/map/area/table-display {} + + set rowids [dict keys [dict get $myareas $areaid]] + + # Locate the rows in the table bearing the rowids for the area + # Search is required because the table may not be sorted in order + + set rows [lsort -integer [lmap rowid $rowids { + set pos [lsearch -exact -index 0 $myspec $rowid] + if {$pos < 0} continue + set pos + }]] + + # Select all rows, show the highest (by dint of sorting above) + $win.sa.table selection clear 0 end + foreach row $rows { + $win.sa.table selection set $row + $win.sa.table see $row + } + + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internals + + proc DO {args} { + debug.tklib/map/area/table-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + method StoreChanged {args} { + debug.tklib/map/area/table-display {} + + # Local storage to assemble the display information in. + set specs {} + set map {} + set areas {} + + # Note: Areas with multiple names generate multiple entries in the table, one per name. + # Each such row maps to the same area, and the area will know about all its rows. + + foreach areaid [DO ids] { + set spec [DO get $areaid] + # names, geo, center, diameter, perimeter, parts + dict with spec {} + #puts |$areaid|$spec| + + # Formatting for display - Ignores geo + + set diameter [map slippy pretty-distance $diameter] + set perimeter [map slippy pretty-distance $perimeter] + lassign [map slippy geo limit $center] lat lon + + if {![llength $names]} { + # No names, single row with empty name column. + + lappend row [incr rowid] + lappend row {} + lappend row $lat + lappend row $lon + lappend row $parts + lappend row $diameter + lappend row $perimeter + + lappend specs $row + unset row + + dict set map $rowid $areaid + dict set areas $areaid $rowid . + } else { + # One or more names, one row per name + + foreach name $names { + lappend row [incr rowid] + lappend row $name + lappend row $lat + lappend row $lon + lappend row $parts + lappend row $diameter + lappend row $perimeter + + lappend specs $row + unset row + + dict set map $rowid $areaid + dict set areas $areaid $rowid . + } + } + } + + # ... and commit + set myrows $map + set myareas $areas + set myspec $specs + + return + } + + method SelectionChanged {} { + debug.tklib/map/area/table-display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/area/table-display {} + + if {![llength $options(-on-selection)]} return + + # row - index of entry in table, influenced by sorting + # rowid - internal row id as pulled out of entry + # areaid - area id associated to the row id + + set row [$win.sa.table curselection] + if {$row eq {}} return + + #puts row//[lindex $myspec $row]// + + set rowid [lindex $myspec $row 0] + set areaid [dict get $myrows $rowid] + + uplevel #0 [list {*}$options(-on-selection) $areaid] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-display.tcl new file mode 100644 index 00000000..92150120 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-display.tcl @@ -0,0 +1,120 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::box::display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a single box definition +# Meta description Widget to display the information of a single box definition +# Meta subject {box display, tabular} +# Meta subject {tabular, box display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +package provide map::box::display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ +# +## set GEOBOX -> VOID Show this box, or nothing, if empty +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export display ; namespace ensemble create } + +debug level tklib/map/box/display +debug prefix tklib/map/box/display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::box::display { + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myspec {} ;# Table data derived from the box specification + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {} { + debug.tklib/map/box/display {} + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 60 -columntitles {What {} {}} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -fill both -expand 1 + + $win.sa.table configure -listvariable [myvar myspec] + return + } + + destructor { + debug.tklib/map/box/display {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method set {geobox} { + debug.tklib/map/box/display {} + + if {![llength $geobox]} { + set myspec {} + return + } + + # Assemble table data + + lassign [map slippy geo box corners $geobox] tl bl tr br + set center [map slippy geo box center $geobox] + set diameter [map slippy geo box diameter $geobox] + set length [map slippy geo box perimeter $geobox] + + lappend data [list TopLeft {*}[map slippy geo limit $tr]] + lappend data [list BottomLeft {*}[map slippy geo limit $bl]] + lappend data [list TopRight {*}[map slippy geo limit $tr]] + lappend data [list BottomRight {*}[map slippy geo limit $br]] + lappend data [list Center {*}[map slippy geo limit $center]] + lappend data [list Diameter [map slippy pretty-distance $diameter] {}] + lappend data [list Perimeter [map slippy pretty-distance $length] {}] + + # ... and commit + set myspec $data + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-entry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-entry.tcl new file mode 100644 index 00000000..cc7796bc --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-entry.tcl @@ -0,0 +1,242 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::box::entry 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine - Box Entry +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description This attachment enables users to enter a bounding box. +# Meta subject {addon, box entry, map display} +# Meta subject {box entry, map display, addon} +# Meta subject {map display, addon, box entry} +# Meta require {Tcl 8.6-} +# Meta require canvas::edit::rectangle +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::box::entry 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget +# +## active -> VOID Is editing on ? +## box -> VOID Query current box spec +## clear -> VOID Clear box spec +## disable -> VOID Stop editing +## enable -> VOID Start editing +## fit -> VOID Center and fit current box +## set GEOBOX -> VOID Set box spec into editor +# +## -on-box-change Report changes to the box definition +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::rectangle ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export entry ; namespace ensemble create } + +debug level tklib/map/box/entry +debug prefix tklib/map/box/entry {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::box::entry { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-box-change -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myeditor {} ;# Core rectangle editor + variable mymap {} ;# Map display the behaviour is attached to + variable mycanvas {} ;# Canvas internal to the map display + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + variable mybox {} ;# Box specification + variable myignore no ;# Internal flag to control handling of Points callback + variable myviewchain {} ;# Old view reporting callback + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {map args} { + debug.tklib/map/box/entry {} + + $self configurelist $args + + set mymap $map + set mycanvas [$map canvas] + set mybox {} + set myignore no + set myeditor \ + [canvas::edit rectangle ${selfns}::RECT $mycanvas \ + -radius 6 \ + -add-remove-point 1 \ + -drag-point 2 \ + -data-cmd [mymethod BoxChanged]] + + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + return + } + + destructor { + debug.tklib/map/box/entry {} + return + + if {![winfo exists $mycanvas]} return + $self disable + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method disable to myeditor + delegate method enable to myeditor + delegate method active to myeditor + + method box {} { + debug.tklib/map/box/entry {} + + return $mybox + } + + method clear {} { + debug.tklib/map/box/entry {} + + set mybox {} + ${selfns}::RECT clear + return + } + + method fit {} { + debug.tklib/map/box/entry {} + + $self Fit + return + } + + method set {geobox} { + debug.tklib/map/box/entry {} + + $self Set $geobox + $self Fit + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internal + + method Set {geobox} { + debug.tklib/map/box/entry {} + + set mybox $geobox + if {![llength $mybox]} return + + # Load base editor with pixel positions of the geobox, from the geo box + $self Ignore yes + + set pbox [map slippy geo box 2point $myzoom $geobox] + ${selfns}::RECT set {*}$pbox + + $self Ignore no + return + } + + method Fit {} { + debug.tklib/map/box/entry {} + + if {[llength $mybox] < 2} return + + set zoom [map slippy geo box fit $mybox $mycanvasdim [expr {[$mymap levels]-1}]] + set center [map slippy geo box center $mybox] + + $mymap center $center $zoom + return + } + + method ViewChanged {zoom viewbox geobox} { + debug.tklib/map/box/entry {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + debug.tklib/map/box/entry {} + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewbox $geobox] + } + + # Update the canvas dimensions, needed for fitting. + set mycanvasdim [map slippy point box dimensions $viewbox] + + # Ignore panning + if {$zoom == $myzoom} return + + # For zoom changes regenerate the pixel positions from the geo locations. We are using the + # core function because here because performing a fitting here is incorrect. + set myzoom $zoom + $self Set $mybox + return + } + + method BoxChanged {_ pbox} { + debug.tklib/map/box/entry {} + + # Compute geo locations from pixel positions, if not suppressed (See set) + if {$myignore} return + + if {![llength $pbox]} { + set mybox {} + } else { + set mybox [map slippy geo box limit [map slippy point box 2geo $myzoom $pbox]] + } + + # Report changes further, if requested + if {![llength $options(-on-box-change)]} return + uplevel 1 [list {*}$options(-on-box-change) $mybox] + return + } + + method Ignore {x} { + debug.tklib/map/box/entry {} + + set myignore $x + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-file.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-file.tcl new file mode 100644 index 00000000..f547c78f --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-file.tcl @@ -0,0 +1,131 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Filesystem based storage of geo/box information - Independent of AKIS +## Tklib geo/box file format +## +## - Line based +## - Ignores leading and trailing whitespace in lines +## - Ignores empty lines +## - Ignore lines starting with `//` - C++ line comments +## - Ignore lines starting with `#` - Shell et al line comments +## - Magic word in first line identifying the file: "tklib/geo/box" +## - Zero to more non-numeric lines specifying box names +## - Exactly 4 numeric lines specifying coordinates +## - Coordinates are validated as lat/lon + +# @@ Meta Begin +# Package map::box::file 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Reading/writing tklib geo/box files +# Meta description Reading/writing tklib geo/box files +# Meta subject map +# Meta subject {file, geo/box} +# Meta subject {geo/box, file} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::box::file 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## read PATH -> INFO :: dict (names, geo) +## write PATH INFO -> VOID +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export file ; namespace ensemble create } +namespace eval map::box::file { namespace export read write ; namespace ensemble create } + +debug level tklib/map/box/file +debug prefix tklib/map/box/file {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### +## API + +proc ::map::box::file::read {path} { + debug.tklib/map/box/file {} + + if {[catch { + set c [open $path r] + }]} return + + set d [::read $c] + close $c + + set names {} + set coordinates [lmap line [split $d \n] { + set line [string trim $line] + if {$line eq {}} continue + if {[string match //* $line]} continue + if {[string match "#*" $line]} continue + if {![string is double -strict $line]} { + lappend names $line + continue + } + set line + }] + + #puts $path\t//$names//$coordinates// + set names [lassign $names magic] + + if {$magic ne "tklib/geo/box"} { + #puts "$path\t/no magic" + return + } + if {[llength $coordinates] != 4} { + #puts "$path\t/bad coordinate count [llength $coordinates]" + return + } + + if {![map slippy geo box valid $coordinates]} return + + if {![llength $names]} { lappend names [file rootname [file tail $path]] } + + dict set g names $names + dict set g geo $coordinates + + return $g +} + +proc ::map::box::file::write {path gdata} { + debug.tklib/map/box/file {} + + set c [open $path w] + + puts $c tklib/geo/box + + foreach name [lsort -dict -unique [dict get $gdata names]] { + puts $c $name + } + + foreach coordinate [dict get $gdata geo] { + puts $c $coordinate + } + + close $c + return +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-map-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-map-display.tcl new file mode 100644 index 00000000..a69f7f38 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-map-display.tcl @@ -0,0 +1,390 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::box::map-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine: Layer to display box definitions +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description Shows a set of box definitions. Tracks geo area to ensure +# Meta description that only visible boxes use canvas resources (items) +# Meta subject {addon, box display, map display} +# Meta subject {box display, map display, addon} +# Meta subject {map display, addon, box display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require canvas::edit::rectangle +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::box::map-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget store +# +## focus ID -> VOID Move map to box with ID +## disable -> VOID Hide boxes +## enable -> VOID Show boxes +# +## -on-active Command to report changes in the active box +# +## -color Visual options inherited from canvas::edit::rectangle +## -hilit-color for full customization of the rectangle appearance +## -radius . +## -kind . +## -radius . +## -rect-config . +## -create-cmd . +# +# TODO :: Can we get stuff like double-click handling to invoke a box action? +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::rectangle ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export map-display ; namespace ensemble create } + +debug level tklib/map/box/map-display +debug prefix tklib/map/box/map-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::box::map-display { + # .................................................................. + # User configuration + + option -on-active -default {} -readonly 1 + + # Visual options passed to the low-level rectangle engines + option -color -default {} -readonly 1 + option -hilit-color -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -kind -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -rect-config -default {} -readonly 1 + option -create-cmd -default {} -readonly 1 + + # .................................................................. + ## State - Derived from configuration + + variable myactive 0 ;# Active layer? y/n + variable myvisual {} ;# Visual configuration for the rectangle engines + variable mymap {} ;# Map the behaviour is attached to + variable mycanvas {} ;# Canvas inside the map + variable mystore {} ;# Box store + variable myviewchain {} ;# Old view reporting callback + + # .................................................................. + # Map state (viewport) + + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + + # .................................................................. + # Display state + + variable myboxes {} ;# Cache of box information (geobox, pixels per level) + # ;# dict (id -> 'level' -> level -> pointbox + # ;# -> 'bbox' -> geobox) + # ;# -> 'center' -> geo) + variable myvisible {} ;# Set of the visible boxes, map from id to manager + # ;# dict (id -> canvas::edit::rectangle instance) + variable myrevers {} ;# dict (canvas::edit::rectangle instance -> id) + + # .................................................................. + # Object pool - Reusable polyline objects + + variable myfree {} ;# Set of reusable rectangle instances + variable myid 0 ;# Id counter for new rectangle instances + + # .................................................................. + ## Lifecycle + + constructor {map store args} { + debug.tklib/map/box/map-display {} + + $self configurelist $args + + set mystore $store + set mymap $map + set mycanvas [$map canvas] + + foreach o { + -color + -hilit-color + -radius + -kind + -radius + -rect-config + -create-cmd + } { + if {$options($o) eq {}} continue + lappend myvisual $o $options($o) + } + + $self Attach + return + } + + destructor { + debug.tklib/map/box/map-display {} + + if {![winfo exists $mycanvas]} return + $self disable + $self Detach + + # The low-level box managers are auto-destroyed because they are in this + # object's namespace and deleted with it. + return + } + + # .................................................................. + ## API + + method enable {} { + debug.tklib/map/box/map-display {} + + if {$myactive} return + set myactive yes + + # Force visibility processing + $self ViewChanged {*}[$mymap view] + return + } + + method disable {} { + debug.tklib/map/box/map-display {} + + if {!$myactive} return + set myactive no + + # Remove all the visible boxes + dict for {id boxy} $myvisible { + $self Close $id + } + return + } + + method focus {id} { + debug.tklib/map/box/map-display {} + + $self Load $id + $self Fit $id ;# The viewport change automatically triggers everything + # # needed to show the focus box, and whatever else is + # # visible. + return + } + + # .................................................................. + ## Internal + + # .................................................................. + ## Viewport interception + + method ViewChanged {zoom viewbox geobox} { + debug.tklib/map/box/map-display {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + debug.tklib/map/box/map-display {} + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewbox $geobox] + } + + # Do nothing when disabled + if {!$myactive} return + + set zoomchanged [expr {$zoom != $myzoom}] + + # Update map state (zoom, and canvas dimensions for fitting) + set mycanvasdim [map slippy point box dimensions $viewbox] + set myzoom $zoom + + # Query store for visible boxes + set visible [DO visible $geobox] + + set new {} + foreach v $visible { dict set new $v . } + + # Drop all boxes which are not visible any longer + dict for {id boxy} $myvisible { + if {[dict exists $new $id]} continue + $self Close $id + } + + # For all visible boxes, get new, and move existing. move only for zoom changes. + foreach id $visible { + if {[dict exists $myvisible $id]} { + if {$zoomchanged} { $self Show $id } + continue + } + $self Load $id + $self Open $id + $self Show $id + } + return + } + + # .................................................................. + + method Fit {id} { + debug.tklib/map/box/map-display {} + # Already loaded. + + set center [dict get $myboxes $id center] + set gbox [dict get $myboxes $id bbox] + set zoom [map slippy geo box fit $gbox $mycanvasdim [expr {[$mymap levels]-1}]] + + #puts /box/$gbox + #puts /dim/$mycanvasdim + #puts /zom/$zoom + + # And this triggers display of the focused id, being fully visible + $mymap center $center $zoom + return + } + + method Load {id} { + debug.tklib/map/box/map-display {} + + if {[dict exists $myboxes $id geo]} return + + set spec [DO get $id] + dict with spec {} + # names, geo, diameter, perimeter, center + # => geo, center + + dict set myboxes $id bbox $geo + dict set myboxes $id center $center + return + } + + method Show {id} { + debug.tklib/map/box/map-display {} + + # Note: point/marker radius is chosen for best visual appearance. + # Single point => extend size to make it visible + # Multiple points => shrink to nothing so that line display is dominant + + set boxy [dict get $myvisible $id] + set pointbox [$self Pixels $id] + + $boxy configure -radius 0 + $boxy set {*}$pointbox + return + } + + method Pixels {id} { + debug.tklib/map/box/map-display {} + + if {![dict exists $myboxes $id level $myzoom]} { + dict set myboxes $id level $myzoom [DO pixels $id $myzoom] + } + return [dict get $myboxes $id level $myzoom] + } + + method Open {id} { + debug.tklib/map/box/map-display {} + + if {[llength $myfree]} { + set boxy [lindex $myfree end] + set myfree [lreplace $myfree end end] + } else { + set obj RECT_[incr myid] + set boxy [canvas::edit rectangle \ + ${selfns}::$obj \ + $mycanvas \ + {*}$myvisual \ + -active-cmd [mymethod Active] \ + -tag $self//$obj] + # starts disabled + } + + dict set myvisible $id $boxy + dict set myrevers $boxy $id + return + } + + method Active {boxy kind} { + debug.tklib/map/box/map-display {} + + if {![llength $options(-on-active)]} return + if {$kind ne "rect"} return + + set id [dict get $myrevers $boxy] + uplevel #0 [list {*}$options(-on-active) $id] + return + } + + method Close {id} { + debug.tklib/map/box/map-display {} + + set boxy [dict get $myvisible $id] + $boxy clear + + dict unset myvisible $id + dict unset myrevers $boxy + lappend myfree $boxy + return + } + + # .................................................................. + ## Chain management + + method Attach {} { + debug.tklib/map/box/map-display {} + + # Hook into viewport reporting + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + return + } + + method Detach {} { + debug.tklib/map/box/map-display {} + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # .................................................................. + ## Store access + + proc DO {args} { + debug.tklib/map/box/map-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-fs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-fs.tcl new file mode 100644 index 00000000..7c5a2f1b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-fs.tcl @@ -0,0 +1,170 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Filesystem based storage of geo/box information - Independent of AKIS + +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::box::store::fs 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Filesystem-based store of geobox definitions +# Meta description Store loading geobox definitions from a +# Meta description directory in the filesystem. +# Meta subject map +# Meta subject {filesystem store, geobox} +# Meta subject {geobox, filesystem store} +# Meta subject {store, geobox, filesystem} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::box::store::fs 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ boxdirectory +# +## ids -> list (id...) +## get ID -> dict (name -> STRING, geobox -> GEOBOX) +## visible GEOBOX -> list (id...) +# +## -pattern File pattern for matching geobox files +# +## Box file format specification: +## - Line oriented +## - No comments, no empty lines +## - Leading/trailing white allowed, not recommended +## - 4 lines, each a raw geo coordinate value +## - Order as expected for a geobox: lat min, lon min, lat max, lon max +# +## BEWARE - Reader in this package does not validate the coordinates +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities (inside, visibility) +package require snit ;# - OO system +# +package require map::box::file + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export store ; namespace ensemble create } +namespace eval map::box::store { namespace export fs ; namespace ensemble create } + +debug level tklib/map/box/store/fs +debug prefix tklib/map/box/store/fs {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::box::store::fs { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -pattern -default {*.box} -readonly 1 + + # . . .. ... ..... ........ ............. ..................... + ## State, In-memory cache + # + # - Visibility map :: dict (geo -> id) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> geobox) + + variable mypoints {} + variable myattr {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {directory} { + debug.tklib/map/box/store/fs {} + + $self Load $directory + return + } + + destructor { + debug.tklib/map/box/store/fs {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method ids {} { + debug.tklib/map/box/store/fs {} + + return [lsort -dict [dict keys $myattr]] + } + + method get {id} { + debug.tklib/map/box/store/fs {} + + return [dict get $myattr $id] + } + + method visible {geobox} { + debug.tklib/map/box/store/fs {} + + # Consider visibility through box overlap instead of box corners visisble + + set ids {} + dict for {geo id} $mypoints { + if {![map slippy geo box inside $geobox $geo]} continue + lappend ids $id + } + set ids [lsort -unique $ids] + #puts (($ids)) + return $ids + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Load {directory} { + debug.tklib/map/box/store/fs {} + + foreach path [glob -nocomplain -directory $directory $options(-pattern)] { + if {![file exists $path]} continue + if {![file isfile $path]} continue + if {![file readable $path]} continue + + set box [map box file read $path] + if {![dict size $box]} continue + # box :: dict (names, geo) + + # Note: file path is used as box ID + + # Update visibility map + foreach p [map slippy geo box corners [dict get $box geo]] { + dict set mypoints $p $path + } + + # Update base attribute information + dict set myattr $path $box + } + + #array set __ $myattr ; parray __ ; unset __ + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-mem.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-mem.tcl new file mode 100644 index 00000000..7947601d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-store-mem.tcl @@ -0,0 +1,167 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::box::store::memory 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary In-memory store for geo/box definitions +# Meta description In-memory store for geo/box definitions, with +# Meta description memoized calculation of extended attributes. +# Meta description Base data is taken from a backing store. +# Meta description Anything API-compatible to map::box::store::fs +# Meta subject {center, geo/box} +# Meta subject {diameter, geo/box} +# Meta subject {geo/box pixels, zoom} +# Meta subject {geo/box, center} +# Meta subject {geo/box, diameter} +# Meta subject {geo/box, memory store} +# Meta subject {geo/box, perimeter length} +# Meta subject {length, geo/box, perimeter} +# Meta subject {memory store, geo/box} +# Meta subject {perimeter length, geo/box} +# Meta subject {pixels, zoom, geo/box} +# Meta subject {store, geo/box, memory} +# Meta subject {zoom, geo/box pixels} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::box::store::memory 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ backend-store +# +## ids -> list (id...) +## get ID -> dict (names, geo, diameter, perimeter, center) +## visible GEOBOX -> list (id...) +## pixels ID ZOOM -> pointbox +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export store ; namespace ensemble create } +namespace eval map::box::store { namespace export memory ; namespace ensemble create } + +debug level tklib/map/box/store/memory +debug prefix tklib/map/box/store/memory {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::box::store::memory { + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - Backing store, command prefix + # - Pixel store :: dict (id -> zoom -> pointbox) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> geobox + # "diameter" -> double + # "perimeter" -> double + # "center" -> geo) + + variable mystore {} + variable myattr {} + variable mypixels {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store} { + debug.tklib/map/box/store/memory {} + + set mystore $store + return + } + + destructor { + debug.tklib/map/box/store/memory {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method * to mystore except get ;# ids, visible + + method get {id} { + debug.tklib/map/box/store/memory {} + + if {![dict exists $myattr $id]} { + dict set myattr $id [$self Attributes $id] + } + return [dict get $myattr $id] + } + + method pixels {id zoom} { + debug.tklib/map/box/store/memory {} + + if {![dict exists $mypixels $id $zoom]} { + dict set mypixels $id $zoom [$self Pixels $zoom $id] + } + return [dict get $mypixels $id $zoom] + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Attributes {id} { + set attr [DO get $id] + set gbox [dict get $attr geo] + + set center [map slippy geo box center $gbox] + set diameter [map slippy geo box diameter $gbox] + set perimeter [map slippy geo box perimeter $gbox] + + dict set attr center $center + dict set attr diameter $diameter + dict set attr perimeter $perimeter + + #puts |$id|$attr| + + return $attr + } + + method Pixels {zoom id} { + debug.tklib/map/box/store/memory {} + + set attr [DO get $id] + set gbox [dict get $attr geo] + set pbox [map slippy geo box 2point $zoom $gbox] + + return $pbox + } + + proc DO {args} { + debug.tklib/map/box/store/memory {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-table-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-table-display.tcl new file mode 100644 index 00000000..f440c6dd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/box-table-display.tcl @@ -0,0 +1,261 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::box::table-table-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a table of box definitions +# Meta description Widget to display the information of many box definitions +# Meta description in a table +# Meta subject {box display, tabular} +# Meta subject {tabular, box display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +package provide map::box::table-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ store ... +# +## OBJ focus ID +# +## -on-selection Command prefix to report selection changes +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular table-display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export box ; namespace ensemble create } +namespace eval map::box { namespace export table-display ; namespace ensemble create } + +debug level tklib/map/box/table-display +debug prefix tklib/map/box/table-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::box::table-display { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - List of shown box definitions + # (per row: id, name, center (lat/lon separate), diameter, perimeter) + # => 6 columns + # id identifies the row, and is mapped back to the BOX id. + # + # - Backward map from row ids to BOX ids + # NOTE: multiple row ids can map to the same box (multiple names!) + # + # - Forward map from box id to the set of rows showing that box + # (set because multiple names) + # + # - Command to access backing store. + + variable myspec {} ;# Table data derived from the box specifications + variable myrows {} ;# dict (row-id -> box-id) + variable myboxes {} ;# dict (box-id -> row-id -> ".") + variable mystore {} ;# Store backing the display + # FUTURE: event: add/remove/change + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store args} { + debug.tklib/map/box/table-display {} + + $self configurelist $args + + set mystore $store + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 70 \ + -columntitles {\# Name Lat Lon Diameter Perimeter} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -fill both -expand 1 + + $win.sa.table configure \ + -listvariable [myvar myspec] \ + -labelcommand tablelist::sortByColumn \ + -labelcommand2 tablelist::addToSortColumns + + bind $win.sa.table <> [mymethod SelectionChanged] + + #DO watch [mymethod StoreChanged] ;# FUTURE: react to edits and + after 100 [mymethod StoreChanged] ;# resulting store changes + return + } + + destructor { + debug.tklib/map/box/table-display {} + + #DO unwatch [mymethod StoreChanged] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {boxid} { + debug.tklib/map/box/table-display {} + + set rowids [dict keys [dict get $myboxes $boxid]] + + # Locate the rows in the table bearing the rowids for the box + # Search is required because the table may not be sorted in order + + set rows [lsort -integer [lmap rowid $rowids { + set pos [lsearch -exact -index 0 $myspec $rowid] + if {$pos < 0} continue + set pos + }]] + + # Select all rows, show the highest (by dint of sorting above) + $win.sa.table selection clear 0 end + foreach row $rows { + $win.sa.table selection set $row + $win.sa.table see $row + } + + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internals + + proc DO {args} { + debug.tklib/map/box/table-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + method StoreChanged {args} { + debug.tklib/map/box/table-display {} + + # Local storage to assemble the display information in. + set specs {} + set map {} + set boxes {} + + # Note: Boxes with multiple names generate multiple entries in the table, one per name. + # Each such row maps to the same box, and the box will know about all its rows. + + foreach boxid [DO ids] { + set spec [DO get $boxid] + # names, geo, center, diameter, perimeter + dict with spec {} + #puts |$boxid|$spec| + + # Formatting for display - Ignores geobox + + set diameter [map slippy pretty-distance $diameter] + set perimeter [map slippy pretty-distance $perimeter] + lassign [map slippy geo limit $center] lat lon + + if {![llength $names]} { + # No names, single row with empty name column. + + lappend row [incr rowid] + lappend row {} + lappend row $lat + lappend row $lon + lappend row $diameter + lappend row $perimeter + + lappend specs $row + unset row + + dict set map $rowid $boxid + dict set boxes $boxid $rowid . + } else { + # One or more names, one row per name + + foreach name $names { + lappend row [incr rowid] + lappend row $name + lappend row $lat + lappend row $lon + lappend row $diameter + lappend row $perimeter + + lappend specs $row + unset row + + dict set map $rowid $boxid + dict set boxes $boxid $rowid . + } + } + } + + # ... and commit + set myrows $map + set myboxes $boxes + set myspec $specs + return + } + + method SelectionChanged {} { + debug.tklib/map/box/table-display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/box/table-display {} + + if {![llength $options(-on-selection)]} return + + # row - index of entry in table, influenced by sorting + # rowid - internal row id as pulled out of entry + # boxid - box id associated to the row id + + set row [$win.sa.table curselection] + if {$row eq {}} return + + #puts row//[lindex $myspec $row]// + + set rowid [lindex $myspec $row 0] + set boxid [dict get $myrows $rowid] + + uplevel #0 [list {*}$options(-on-selection) $boxid] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/display.tcl new file mode 100644 index 00000000..757ed264 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/display.tcl @@ -0,0 +1,665 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Display Widget +# Meta description Map Display Widget with basic behaviour (Drag, Center, Zoom +/-) +# Meta description Configured with tile provider. +# Meta description Extensible with attachable engines providing additional behaviours. + +# Meta subject {map display} {display, map} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require canvas::sqmap +# Meta require canvas::zoom +# Meta require crosshair +# Meta require debug +# Meta require debug::caller +# Meta require snit +# Meta require widget::scrolledwindow +# @@ Meta End + +## Map Display. Multiple Modes ... +# +## Manages a center location +## - Set initially +## - Set by mouse click (Button 3) - Implied panning +# +## When the map is not locked the user can pan freely. +# +## A locked map on the other hand cannot deviate from the specified center location. The desired +## center can only be set from the outside (initial, and method). The user cannot change it. +# +## Bindings +## <1> Drag (Press, Motion, release) - Panning +## <3> Center to crosshair, report - Panning +## <4/5> Zoom +/- [Mousewheel] + +package provide map::display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ +# +## levels -> int (#map levels) +## zoom-to ZOOM -> VOID +## center GEO ?ZOOM? -> VOID +## canvas -> tk window handle of internal canvas +## at -> geo (crosshair location) +## view -> list (zoom pointbox geobox) +# +## -provider Tile provider engine. REQUIRED +## -on-view-change Callback reporting changes to the shown geo area +## -initial-geo Initial geo location to show in map center +## -initial-zoom Initial magnification +## -locked Flag to lock map against changing the center by the user +## -center-mark Handle of photo image to show at the map center +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Slippy Utilities (Geo conversion, etc) +package require snit ;# - OO system +# ;# Tklib +package require canvas::sqmap ;# - Base map engine, tile display +package require canvas::zoom ;# - Zoom controller +package require crosshair ;# - Crosshair controller +package require tooltip ;# Tklib +package require widget::scrolledwindow ;# ditto + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export display ; namespace ensemble create } + +debug level tklib/map/display +debug prefix tklib/map/display {<[pid]> [debug caller] | } + +# Report tile ops in spearate channel to prevent spamming the main channel +debug level tklib/map/display/tiles +debug prefix tklib/map/display/tiles {<[pid]> [debug caller] | } + +# Report crosshair in spearate channel to prevent spamming the main channel +debug level tklib/map/display/track +debug prefix tklib/map/display/track {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::display { + + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -provider -default {} -configuremethod Provider + option -on-view-change -default {} + option -initial-geo -default {} -readonly 1 + option -initial-zoom -default 12 -readonly 1 + option -locked -default 0 -configuremethod Lock + option -center-mark -default {} -configuremethod CenterMark + + # . . .. ... ..... ........ ............. ..................... + ## Widget state + + variable myprovider {} ;# Backing store of -provider, for delegation + variable myzoom {} ;# Current zoom level + variable mypzoom {} ;# Previous zoom level, to infer direction of changes + variable mycenter {} ;# Current map center (geo location) + variable mycross {} ;# Current crosshair (geo location) + variable myview {} ;# Canvas viewport (point box) + variable mycrossdisplay {} ;# Text for crosshair location display + variable mydragstart {} ;# Viewport at start of drag operation + variable mydragskip 1 ;# Prevent DragDone from execution where necessary + variable myectimer {} ;# EnsureCenter timer + + typevariable ourcenterdelay 200 ;# Delay from viewport change to EnsureCenter for a locked map + typevariable ourinitdelay 100 ;# Delay from construction to setting the initial center + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {args} { + debug.tklib/map/display {} + + $self configurelist $args + + if {![llength $myprovider]} { + return -code error "-provider is not specified, is required" + } + + set myzoom $options(-initial-zoom) + set mypzoom $myzoom + set mycrossdisplay location + + $self Elements + $self Layout + $self StaticBehaviour + $self Behaviour ;# Main user interactions - Lock state dependent + $self VisualGridHack + + # Force the initial region as the zoom control will not call us initially, only on future + # changes. + $self SetRegionAndCenter + + # Move map to the requested center, if specified + if {$options(-initial-geo) eq {}} return + after $ourinitdelay [mymethod Goto $options(-initial-geo)] + return + } + + destructor { + debug.tklib/map/display {} + return + } + + # . . .. ... ..... ........ ............. ..................... + # API + + delegate method levels to myprovider + + method zoom-to {new} { + debug.tklib/map/display {} + + if {$new < 0} return + if {$new >= $levels} return + + set myzoom $new + $self ZoomSet _ + return + } + + method center {geo {newzoom {}}} { + debug.tklib/map/display {} + # This is the only way to change a locked map, outside of zooming. + + $self Goto $geo $newzoom + return + } + + method canvas {} { + debug.tklib/map/display {} + return $win.map + } + + method at {} { + debug.tklib/map/display {} + lassign $mycross lat lon + return [list [6digits $lat] [6digits $lon]] + } + + proc 6digits {x} { + return [expr {[string is int -strict $x] + ? $x + : [string trimright [format %.6f $x] 0]}] + } + + method view {} { + debug.tklib/map/display {} + + set geoport [::map slippy point box 2geo $myzoom $myview] + + #puts "GP: $myzoom | $geoport" + return [list $myzoom $myview $geoport] + } + + # . . .. ... ..... ........ ............. ..................... + ## Internals + ## - Setup + ## - Configuration hooks + ## - Component callbacks + ## - Display Management + + # . . .. ... ..... ........ ............. ..................... + ## Setup + + method VisualGridHack {} { + debug.tklib/map/display {} + + # Hack to get display to show nicely while the initial maps are loading + set gridInfo [grid info $win.sw] + grid forget $win.sw + update + grid $win.sw {*}$gridInfo + return + } + + method Elements {} { + debug.tklib/map/display {} + + set th [$myprovider tileheight] + set tw [$myprovider tilewidth] + set zm [$myprovider levels] ; incr zm -1 + + # Display elements + + widget::scrolledwindow $win.sw + + canvas::sqmap $win.map \ + -bg yellow \ + -closeenough 3 \ + -grid-cell-width $tw \ + -grid-cell-height $th + + # Create after map engine, to be placed on top in the drawing order + canvas::zoom $win.z -levels $zm -orient vertical \ + -variable [myvar myzoom] \ + -command [mymethod ZoomSet] + + label $win.crosshair \ + -bd 2 -relief sunken \ + -bg white -width 20 \ + -anchor w + + return + } + + method Layout {} { + debug.tklib/map/display {} + + $win.sw setwidget $win.map + place $win.z -in $win.map -anchor nw -x .2i -y .2i + + grid $win.crosshair -row 0 -column 0 -sticky wen + grid $win.sw -row 1 -column 0 -sticky swen -columnspan 2 + + grid rowconfigure $win 0 -weight 0 + grid rowconfigure $win 1 -weight 1 + + grid columnconfigure $win 0 -weight 0 + grid columnconfigure $win 1 -weight 1 + + $self HandleCenterMark + return + } + + method StaticBehaviour {} { + debug.tklib/map/display {} + + $win.map configure \ + -cursor tcross \ + -viewport-command [mymethod ViewportHasChanged] \ + -grid-cell-command [mymethod TileRequest] + + crosshair::crosshair $win.map -width 0 -fill \#999999 -dash {.} + crosshair::track on $win.map [mymethod CrosshairLocation] + + $win.crosshair configure \ + -textvariable [myvar mycrossdisplay] \ + + # Zoom change via the mouse wheel + bind $win.map [mymethod ZoomBy 1] + bind $win.map [mymethod ZoomBy -1] + + return + } + + method Behaviour {} { + debug.tklib/map/display {} + + if {$options(-locked)} { + # Disable most interaction, notably panning, direct, or implied. See the other branch + # for more detailed explanations of what each binding would have done + + bind $win.map {} + bind $win.map {} + bind $win.map {} + bind $win.map {} + + } else { + # Enable user interaction + + # Panning via right button + bind $win.map [mymethod DragStart %W %x %y] + bind $win.map {%W scan dragto %x %y} + bind $win.map [mymethod DragDone] + + # Single-clicking right button centers map to mouse location. + bind $win.map [mymethod DragToPoint] + } + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Configuration hooks - Reporting + + method Lock {o v} { + debug.tklib/map/display {} + + if {$v eq $options($o)} return + set options($o) $v + + # During object initialization, state is just recorded + if {![winfo exists $win.map]} return + + # Locking state changed, always set behaviours + $self Behaviour + if {!$options($o)} return + + # When going locked ensure display of chosen center, if known + + if {$mycenter eq {}} return + $self EnsureCenter + return + } + + method CenterMark {o v} { + debug.tklib/map/display {} + + if {$v eq $options($o)} return + set options($o) $v + + # During object initialization, state is just recorded + if {![winfo exists $win.map]} return + + $self HandleCenterMark + return + } + + method Provider {o v} { + debug.tklib/map/display {} + + if {$v eq $myprovider} return + + if {![llength $v]} { + return -code error "Cannot unset -provider, is required" + } + + set myprovider $v + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Component callbacks + # + ## - Viewport Tracking + ## - Crosshair Tracking + ## - Tile Retrieval + ## - Zoom Changes + ## - Drag Operation Reports + + # . . .. ... ..... ........ ............. ..................... + ## Viewport Tracking (map -viewport-command) + + method ViewportHasChanged {xl yt xr yb} { + debug.tklib/map/display {} + # args = viewport in pixels coordinates as per canvas::sqmap, SetPixelView. + # (point box) + + set newport [list $xl $yt $xr $yb] + + # Ignore calls without change since the last call + + # Required because the EnsureCenter/Goto/Jigger combination causes pseudo events. + # See also the use in Goto/Jigger. + + # NOTE: Iffy comparison, we have floating point here + # NOTE: Looks to work due to truly identical FP numbers coming through. + if {$newport eq $myview} return + + # Compare old and new viewport a bit deeper. We are in particular interested in size + # changes, vs panning, i.e. movement. + set resized 0 + if {[llength $myview]} { + # TODO :: map slippy point box dimensions + lassign $myview xlo yto xro ybo + set wo [expr {$xro - $xlo}] + set ho [expr {$ybo - $yto}] + set wn [expr {$xr - $xl}] + set hn [expr {$yb - $yt}] + + set resized [expr {($hn != $ho) || ($wn != $wo)}] + } + + #puts [list $myview $newport] + + set myview $newport + + # When locked keep the desired center. Note that viewport changes in locked mode can only + # come from changes to the canvas' size. Panning is disabled. + ## + # However, keep the center also when the visible area is resized (contrary to panned) + + if {$resized || $options(-locked)} { + debug.tklib/map/display/tiles { resized or locked } + + if {$mycenter eq {}} return + if {$myectimer ne {}} { after cancel $myectimer } + set timeout [after $ourcenterdelay [mymethod EnsureCenter]] + } + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Crosshair Tracking + + method CrosshairLocation {_ x y args} { + debug.tklib/map/display/track {} + # args = viewport in pixels, as per canvas::sqmap, SetPixelView. + + # Convert pixels to geographic location. + set mycross [::map slippy point 2geo $myzoom [list $x $y]] + + # Update entry field. + set mycrossdisplay [$self PrettyLatLon $mycross] + return + } + + method PrettyLatLon {geo} { + debug.tklib/map/display/track {} + # Consider DMS formatting (degree, minute, seconds) + lassign $geo lat lon + return [format "%.6f %.6f" $lat $lon] + } + + # . . .. ... ..... ........ ............. ..................... + ## Tile Retrieval (map -grid-cell-command) + + method TileRequest {_ at donecmd} { + debug.tklib/map/display/tiles {} + + # Add zoom level to map request + set tile [linsert $at 0 $myzoom] + + $myprovider get $tile [mymethod TileReport $donecmd] + return + } + + method TileReport {donecmd action tile args} { + debug.tklib/map/display/tiles {} + + # Strip zoom information from returned tile before handing to the map + set at [lrange $tile 1 end] + uplevel #0 [list {*}$donecmd $action $at {*}$args] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Zoom Changes (zoom controller -command, Mouse Wheel) + + method ZoomBy {increment} { + debug.tklib/map/display {} + + set new [expr {$myzoom + $increment}] + if {$new < 0} return + if {$new >= [$myprovider levels]} return + + set myzoom $new + $self ZoomSet _ _ + return + } + + method ZoomSet {_ _} { + debug.tklib/map/display {} + # The variable 'myzoom' is already set to the new level, as the zoom controller's -variable + + # Infer direction by comparison against last value + if {$mypzoom < $myzoom} { + # Zooming in. Use the crosshair position as the center of zooming. I.e. while zooming + # we can point with the mouse to the region of interest. I.e. the zoom is combined with + # an implied drag-to. + + set mycenter $mycross + } ;# zooming out - stay on the current center + + set mypzoom $myzoom + $self SetRegionAndCenter + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Drag Operation Reports + + method DragToPoint {} { + debug.tklib/map/display {} + set mydragskip 1 + + # Center the mouse location + $self Goto $mycross + return + } + + method DragStart {w x y} { + debug.tklib/map/display {} + set mydragstart $myview + $w scan mark $x $y + return + } + + method DragDone {} { + debug.tklib/map/display {} + + if {$mydragskip} { set mydragskip 0 ; return } + if {$myview eq $mydragstart} return + + lassign [$self view] _ _ geoport + + # TODO :: map slippy - geo/point box center direct! + set mycenter [::map slippy geo center-list \ + [::map slippy geo box opposites $geoport]] + + $self ReportViewChange + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Display Management (invoked by API and callbacks) + + method HandleCenterMark {} { + debug.tklib/map/display {} + + if {[winfo exists $win.center]} { + destroy $win.center + } + + if {$options(-center-mark) ne {}} { + label $win.center -image $options(-center-mark) ;# -width 2m -height 2m + place $win.center -in $win.map -anchor c -relx 0.5 -rely 0.5 + return + } + + return + } + + method ReportViewChange {} { + debug.tklib/map/display {} + #puts VP:$myview + + if {![llength $options(-on-view-change)]} return + + uplevel #0 [list {*}$options(-on-view-change) {*}[$self view]] + return + } + + method EnsureCenter {} { + debug.tklib/map/display {} + + set myectimer {} + $self Goto $mycenter + return + } + + method Goto {geo {newzoom {}}} { + debug.tklib/map/display {} + + if {($newzoom ne {}) && + ($newzoom >= 0) && + ($newzoom < [$myprovider levels])} { + # Inlined zoom-to/ZOOM, with + set myzoom $newzoom + $self SetRegion + } + + # The geo location is first converted to pixels (x, y), and then to a fraction of the + # scrollregion (ofx, ofy). This is adjusted so that the fraction specifies the center of the + # viewed region, and not the upper left corner. For this translation we need the viewport + # data of ViewportHasChanged. + + # Remember new desired center location + set mycenter $geo + + set point [::map slippy geo 2point $myzoom $geo] + after $ourcenterdelay [mymethod Jigger $myzoom $point] + return + } + + method Jigger {z point} { + debug.tklib/map/display {} + + set len [::map slippy length $z] + lassign $myview l t r b + + # +-----------+ B > T, R > R + # | T | + # |L ....... R| + # | B V + # +---------->+ + + lassign $point x y + set ofy [expr {($y - ($b - $t)/2.0)/$len}] + set ofx [expr {($x - ($r - $l)/2.0)/$len}] + + #puts [list moveto $ofx $ofy] + + $win.map xview moveto $ofx + $win.map yview moveto $ofy + + $self ReportViewChange + return + } + + method SetRegionAndCenter {} { + debug.tklib/map/display {} + + $self SetRegion + if {$mycenter eq {}} return + $self EnsureCenter + return + } + + method SetRegion {} { + debug.tklib/map/display {} + + set rlength [::map slippy length $myzoom] + set region [list 0 0 $rlength $rlength] + + $win.map configure -scrollregion $region + return + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/mark.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/mark.tcl new file mode 100644 index 00000000..5a1fce58 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/mark.tcl @@ -0,0 +1,140 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::mark 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine: Mark A Point +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description Enables user to mark locations. Marked locations are reported +# Meta description via callback. +# Meta subject map {location marking} {mark location} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require snit +# @@ Meta End + +package provide map::mark 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ MAP +# +## disable -> VOID +## enable -> VOID +## active -> bool +# +## -command Callback reporting the marks +## -on-event Event spec for triggering a mark, only at construction-time +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export mark ; namespace ensemble create } + +debug level tklib/map/mark +debug prefix tklib/map/mark {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::mark { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -command -default {} + option -on-event -default Double-Button-1 -readonly 1 + + # .................................................................. + ## State + + variable mymap {} ;# The map::display (*) the instance is attached to + variable mycanvas {} ;# The canvas internal to the map display + variable myactive 0 ;# State flag + + ## (*) Or API compatible widget. This class uses the map display methods + # + ## - canvas (once, retrieve map internal canvas, for binding) + ## - at (at each mark, retrieve crosshair location (geo)) + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {map args} { + debug.tklib/map/mark {} + + $self configurelist $args + + set mymap $map + set mycanvas [$map canvas] + set myactive no + + $self enable + return + } + + destructor { + debug.tklib/map/mark {} + + if {![winfo exists $mycanvas]} return + $self disable + return + } + + # .................................................................. + ## API + + method disable {} { + debug.tklib/map/mark {} + + if {!$myactive} return + bind $mycanvas <$options(-on-event)> {} + set myactive no + return + } + + method enable {} { + debug.tklib/map/mark {} + + if {$myactive} return + bind $mycanvas <$options(-on-event)> [mymethod MarkTriggered] + set myactive yes + return + } + + method active {} { + debug.tklib/map/mark {} + return $myactive + } + + # .................................................................. + ## Internal + + method MarkTriggered {} { + debug.tklib/map/mark {} + + if {![llength $options(-command)]} return + uplevel #0 [list {*}$options(-command) [$mymap at]] + return + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/pkgIndex.tcl new file mode 100644 index 00000000..bd9fa43b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/pkgIndex.tcl @@ -0,0 +1,36 @@ +if {![package vsatisfies [package provide Tcl] 8.6-]} { return } +# +package ifneeded map::area::display 0.1 [list source [file join $dir area-display.tcl]] +package ifneeded map::area::file 0.1 [list source [file join $dir area-file.tcl]] +package ifneeded map::area::map-display 0.1 [list source [file join $dir area-map-display.tcl]] +package ifneeded map::area::store::fs 0.1 [list source [file join $dir area-store-fs.tcl]] +package ifneeded map::area::store::memory 0.1 [list source [file join $dir area-store-mem.tcl]] +package ifneeded map::area::table-display 0.1 [list source [file join $dir area-table-display.tcl]] +# +package ifneeded map::box::display 0.1 [list source [file join $dir box-display.tcl]] +package ifneeded map::box::entry 0.1 [list source [file join $dir box-entry.tcl]] +package ifneeded map::box::file 0.1 [list source [file join $dir box-file.tcl]] +package ifneeded map::box::map-display 0.1 [list source [file join $dir box-map-display.tcl]] +package ifneeded map::box::store::fs 0.1 [list source [file join $dir box-store-fs.tcl]] +package ifneeded map::box::store::memory 0.1 [list source [file join $dir box-store-mem.tcl]] +package ifneeded map::box::table-display 0.1 [list source [file join $dir box-table-display.tcl]] +# +package ifneeded map::display 0.1 [list source [file join $dir display.tcl]] +package ifneeded map::mark 0.1 [list source [file join $dir mark.tcl]] +package ifneeded map::provider::osm 0.1 [list source [file join $dir provider-osm.tcl]] +# +package ifneeded map::track::display 0.1 [list source [file join $dir track-display.tcl]] +package ifneeded map::track::file 0.1 [list source [file join $dir track-file.tcl]] +package ifneeded map::track::map-display 0.1 [list source [file join $dir track-map-display.tcl]] +package ifneeded map::track::store::fs 0.1 [list source [file join $dir track-store-fs.tcl]] +package ifneeded map::track::store::memory 0.1 [list source [file join $dir track-store-mem.tcl]] +package ifneeded map::track::table-display 0.1 [list source [file join $dir track-table-display.tcl]] +package ifneeded map::track::entry 0.1 [list source [file join $dir track-entry.tcl]] +# +package ifneeded map::point::file 0.1 [list source [file join $dir point-file.tcl]] +package ifneeded map::point::map-display 0.1 [list source [file join $dir point-map-display.tcl]] +package ifneeded map::point::store::fs 0.1 [list source [file join $dir point-store-fs.tcl]] +package ifneeded map::point::store::memory 0.1 [list source [file join $dir point-store-mem.tcl]] +package ifneeded map::point::table-display 0.1 [list source [file join $dir point-table-display.tcl]] +# +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-file.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-file.tcl new file mode 100644 index 00000000..b0598752 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-file.tcl @@ -0,0 +1,182 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Filesystem based storage of geo/point information - Independent of AKIS +## Tklib geo/point file format +## +## - Line based +## - Ignores leading and trailing whitespace in lines +## - Ignores empty lines +## - Ignore lines starting with `//` - C++ line comments +## - Ignore lines starting with `#` - Shell et al line comments +## - Magic word in first line identifying the file: "tklib/geo/point" + +## - Multiple points allowed. Per point +## - Zero! to more non-numeric lines specifying point kind, and names +## - The kind is detected by having the prefix `kind:` +## - In case of multiple kinds the last wins +## - Exactly 2 numeric lines specifying coordinates +## - Coordinates are validated as lat/lon +## +## If no kind is specified it is `point`. +## If no name is specified it is the name of the file, plus a sequence number. + +# @@ Meta Begin +# Package map::point::file 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Reading/writing tklib geo/point files +# Meta description Reading/writing tklib geo/point files +# Meta subject map +# Meta subject {file, geo/point} +# Meta subject {geo/point, file} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::point::file 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## read PATH -> INFO :: list (dict (names, kind, geo)...) +## write PATH INFO -> VOID +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export point ; namespace ensemble create } +namespace eval map::point { namespace export file ; namespace ensemble create } +namespace eval map::point::file { namespace export read write ; namespace ensemble create } + +debug level tklib/map/point/file +debug prefix tklib/map/point/file {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### +## API + +proc ::map::point::file::read {path} { + debug.tklib/map/point/file {} + + if {[catch { + set c [open $path r] + }]} return + + set d [::read $c] + close $c + + set points {} + set names {} + set geo {} + set kind {} + + set seq 0 + set head 1 + foreach line [split $d \n] { + set line [string trim $line] + # ignore empty lines and comments + if {$line eq {}} continue + if {[string match //* $line]} continue + if {[string match "#*" $line]} continue + + # first line has to be magic + if {$head} { set magic $line ; set head 0 ; continue } + + # collect names for current point + if {![string is double -strict $line]} { + if {[string match kind:* $line]} { + regexp {kind:(.*)$} $line -> kind + set kind [string trim $kind] + continue + } + + lappend names $line + continue + } + + # collect coordinate for current point + lappend geo $line + + # save completed point and start next + if {[llength $geo] == 2} { + if {![map slippy geo valid $geo]} { + puts "$path/bad geo $geo" + return + } + + # Default name derived from file name, iff no name specified, with sequence number + if {![llength $names]} { lappend names [file rootname [file tail $path]]/[incr seq] } + + if {$kind eq {}} { set kind point } + + lappend points [dict create names $names geo $geo kind $kind] + set names {} + set geo {} + set kind {} + } + + # collect more + } + + if {(([llength $geo] == 0) && [llength $names]) || ([llength $geo] == 1)} { + puts "$path\t/incomplete point at end" + return + } + + if {$magic ne "tklib/geo/point"} { + puts "$path\t/no magic/bad magic" + return + } + + return $points +} + +proc ::map::point::file::write {path gdata} { + debug.tklib/map/point/file {} + + # gdata :: list (dict (names, kind, geo)...) + + set c [open $path w] + + puts $c tklib/geo/point + + foreach point [lsort -dict -unique $data] { + dict with point {} + # names, kind, geo + + if {$kind ne {}} { + puts $c kind:$kind + } + + foreach name [lsort -dict -unique $names] { + puts $c $name + } + + lassign $geo lat lon + puts $c $lat + puts $c $lon + + unset names kind geo + } + + close $c + return +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-map-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-map-display.tcl new file mode 100644 index 00000000..46371cfd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-map-display.tcl @@ -0,0 +1,498 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022-2023 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::point::map-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine: Layer to display point definitions +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description Shows a set of point definitions. Tracks geo area to ensure +# Meta description that only visible points use canvas resources (items) +# Meta subject {addon, point display, map display} +# Meta subject {point display, map display, addon} +# Meta subject {map display, addon, point display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require canvas::edit::points +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::point::map-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget store +# +## focus ID -> VOID Move map to point with ID +## disable -> VOID Hide points +## enable -> VOID Show points +## add-style NAME ... -> VOID Register a named style +# +## -on-active Command to report changes in the active point +# +# TODO :: Can we get stuff like double-click handling to invoke a point action? +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::points ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export point ; namespace ensemble create } +namespace eval map::point { namespace export map-display ; namespace ensemble create } + +debug level tklib/map/point/map-display +debug prefix tklib/map/point/map-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::point::map-display { + # .................................................................. + # User configuration + + option -on-active -default {} -readonly 1 + + # .................................................................. + ## State - Derived from configuration, and style registry + + variable myactive 0 ;# Active layer? y/n + variable mymap {} ;# Map the behaviour is attached to + variable mycanvas {} ;# Canvas inside the map + variable mystore {} ;# Point store + variable myviewchain {} ;# Old view reporting callback + + variable mystyle {} ;# dict (style name -> options) + + # .................................................................. + # Map state (viewport) + + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + + # .................................................................. + # Display state + + variable mypoints {} ;# Cache of point information (style, pixel per level) + # ;# dict (id -> 'level' -> level -> point + # ;# -> 'geo' -> geo + # ;# -> 'bbox' -> geobox + # ;# -> 'style' -> string) + + variable myengine {} ;# dict (style name -> canvas::edit::points instance) + variable myhide {} ;# dict (style -> hide command prefix) + variable myunhide {} ;# dict (style -> unhide command prefix) + variable mylocation {} ;# dict (tag -> point) + + variable myvisible {} ;# Set of the visible points, map from id to manager + # ;# dict (id -> tag) + variable myrevers {} ;# dict (tag -> id) + + # .................................................................. + # Object pool - Reusable point items + + variable myfree {} ;# dict (style -> list (itemid...)) + + # .................................................................. + ## Lifecycle + + constructor {map store args} { + debug.tklib/map/point/map-display {} + + $self configurelist $args + + set mystore $store + set mymap $map + set mycanvas [$map canvas] + + $self Attach + + # Standard styles - Note! No item un/hiding + $self add-style point -color red -hilit-color SkyBlue2 -radius 4 + $self add-style feature -color red -hilit-color SkyBlue2 -radius 6 + $self add-style cluster -create-cmd [mymethod DefaultCluster] + return + } + + destructor { + debug.tklib/map/point/map-display {} + + if {![winfo exists $mycanvas]} return + $self disable + $self Detach + + # The low-level point managers are auto-destroyed because they are in this + # object's namespace and deleted with it. + return + } + + # .................................................................. + ## API + + method add-style {style args} { + debug.tklib/map/point/map-display {} + + # Note! It is possible to override an existing style, provided no point uses them already + # for rendering. + + if {[dict exists $mystyle $style] && + [dict exists $myengine $style]} { + return -code error "Unable to redefine style '$style', already in use" + } + + dict set mystyle $style $args + return + } + + method enable {} { + debug.tklib/map/point/map-display {} + + if {$myactive} return + set myactive yes + + # Force visibility processing + $self ViewChanged {*}[$mymap view] + return + } + + method disable {} { + debug.tklib/map/point/map-display {} + + if {!$myactive} return + set myactive no + + # Remove all the visible points + dict for {id _} $myvisible { + $self Close $id + } + return + } + + method focus {id} { + debug.tklib/map/point/map-display {} + + $self Load $id + $self Fit $id ;# The viewport change automatically triggers everything + # # needed to show the focus point, and whatever else is + # # visible. + return + } + + # .................................................................. + ## Internal + + # .................................................................. + ## Viewport interception + + method ViewChanged {zoom viewpoint geobox} { + debug.tklib/map/point/map-display {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + debug.tklib/map/point/map-display {} + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewpoint $geobox] + } + + # Do nothing when disabled + if {!$myactive} return + + set zoomchanged [expr {$zoom != $myzoom}] + + # Update map state (zoom, and canvas dimensions for fitting) + set mycanvasdim [map slippy point box dimensions $viewpoint] + set myzoom $zoom + + # Query store for visible points + set visible [DO visible $geobox $myzoom] + + set new {} + foreach v $visible { dict set new $v . } + + # Drop all points which are not visible any longer + dict for {id _} $myvisible { + if {[dict exists $new $id]} continue + $self Close $id + } + + # For all visible points, get new, and move existing. Move only for zoom changes. + foreach id $visible { + if {[dict exists $myvisible $id]} { + if {$zoomchanged} { $self Show $id } + continue + } + $self Load $id + $self Open $id + $self Show $id + } + return + } + + # .................................................................. + + method Fit {id} { + debug.tklib/map/point/map-display {} + # Already loaded. + + set center [dict get $mypoints $id geo] + set gbox [dict get $mypoints $id bbox] + set zoom [map slippy geo box fit $gbox $mycanvasdim [expr {[$mymap levels]-1}]] + + #puts /point-box/$gbox + #puts /dim/$mycanvasdim + #puts /zom/$zoom + + # And this triggers display of the focused id, being fully visible + $mymap center $center $zoom + return + } + + method Load {id} { + debug.tklib/map/point/map-display {} + + if {[dict exists $mypoints $id geo]} return + + set spec [DO get $id] + dict with spec {} + # names, geo, kind, ... + + dict unset spec names + dict unset spec geo + dict unset spec kind + # spec :: Remaining (kind dependent) point attributes + + set bbox [map slippy geo bbox $geo] + + dict set mypoints $id bbox $bbox + dict set mypoints $id style $kind + dict set mypoints $id geo $geo + dict set mypoints $id attr $spec + return + } + + method Show {id} { + debug.tklib/map/point/map-display {} + + set point [$self Pixels $id] + + set details [dict get $mypoints $id attr] + set style [dict get $mypoints $id style] + set engine [dict get $myengine $style] + set tag [dict get $myvisible $id] + + lassign $point x y + lassign [dict get $mylocation $tag] ox oy + set dx [expr {$x - $ox}] + set dy [expr {$y - $oy}] + + $engine move-by $tag $dx $dy + + dict set mylocation $tag $point + + if {![dict exists $myunhide $style]} return + + set cmd [dict get $myunhide $style] + lappend cmd $engine $tag $details + + uplevel #0 $cmd + return + } + + method Pixels {id} { + debug.tklib/map/point/map-display {} + + if {![dict exists $mypoints $id level $myzoom]} { + set point [DO pixels $id $myzoom] + + dict set mypoints $id level $myzoom $point + } + return [dict get $mypoints $id level $myzoom] + } + + method Open {id} { + debug.tklib/map/point/map-display {} + + set style [dict get $mypoints $id style] + set engine [$self Engine $style] + set usable [dict get $myfree $style] + + if {[llength $usable]} { + set tag [lindex $usable end] + set usable [lreplace $usable end end] + dict set myfree style $usable + } else { + # Pass attributes to tag creator command, if any + # Default `cluster` style will look for a `count` attribute. + set mydetails [dict get $mypoints $id attr] + set tag [$engine add 0 0] + set mydetails {} + + dict set mylocation $tag {0 0} + } + + dict set myvisible $id $tag + dict set myrevers $tag $id + return + } + + method Active {engine tag} { + debug.tklib/map/point/map-display {} + + if {![llength $options(-on-active)]} return + if {$tag eq {}} return + + set id [dict get $myrevers $tag] + uplevel #0 [list {*}$options(-on-active) $id] + return + } + + method Close {id} { + debug.tklib/map/point/map-display {} + + set tag [dict get $myvisible $id] + set style [dict get $mypoints $id style] + set engine [dict get $myengine $style] + + dict unset myvisible $id + dict unset myrevers $tag + + if {[dict exists $myhide $style]} { + # Style with un/hide commands. Use it to hide the point item from display and make it + # available for reuse by a different point of that style. + + set details [dict get $mypoints $id attr] + + set cmd [dict get $myhide $style] + lappend cmd $engine $tag $details + + uplevel #0 $cmd + + dict lappend myfree $style $tag + return + } + + # A style without a clear command cannot reuse point items. + # Remove them entirely, as per their tag + + $engine remove $tag + return + } + + method Engine {style} { + debug.tklib/map/point/map-display {} + + if {![dict exists $myengine $style]} { + set visual [dict get $mystyle $style] + + if {[dict exists $visual -hide-cmd]} { + dict set myhide $style [dict get $visual -hide-cmd] + dict unset visual -hide-cmd + + dict set myunhide $style [dict get $visual -unhide-cmd] + dict unset visual -unhide-cmd + } + + set obj POINT_$style + set engine [canvas::edit points \ + ${selfns}::$obj \ + $mycanvas \ + {*}$visual \ + -active-cmd [mymethod Active] \ + -tag $self//$obj] + # starts disabled + + dict set myfree $style {} + dict set myengine $style $engine + } + + return [dict get $myengine $style] + } + + # .................................................................. + ## Default style support: Cluster - + + variable mydetails {} + + method DefaultCluster {c x y} { + # Default cluster is circle with text (indicating number of aggregated points) + set color orange + set hilit green + set radius 20 + + # Create a circle marker in the default style + set r $radius + set w [expr {$x - $r}] + set n [expr {$y - $r}] + set e [expr {$x + $r}] + set s [expr {$y + $r}] + lappend items [$c create oval $w $n $e $s \ + -width 1 \ + -outline black \ + -activefill $hilit \ + -fill $color] + + # If a count attribute is present use it as text in the circle marker. + if {[dict exists $mydetails count]} { + lappend items [$c create text $x $y \ + -activefill $hilit \ + -text [dict get $mydetails count]] + } + + return $items + } + + # .................................................................. + ## Chain management + + method Attach {} { + debug.tklib/map/point/map-display {} + + # Hook into viewport reporting + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + return + } + + method Detach {} { + debug.tklib/map/point/map-display {} + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # .................................................................. + ## Store access + + proc DO {args} { + debug.tklib/map/point/map-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-fs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-fs.tcl new file mode 100644 index 00000000..6d6510f3 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-fs.tcl @@ -0,0 +1,165 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::point::store::fs 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Filesystem-based store of geo/point definitions +# Meta description Store loading geo/point definitions from a +# Meta description directory in the filesystem. +# Meta subject map +# Meta subject {filesystem store, geo/point} +# Meta subject {geo/point, filesystem store} +# Meta subject {store, geo/point, filesystem} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::point::store::fs 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ pointdirectory +# +## ids -> list (id...) +## get ID -> dict (name -> STRING, geo -> list(geo)) +## visible GEOBOX -> list (id...) +# +## -pattern File pattern for matching geo/point files +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities (inside, visibility) +package require snit ;# - OO system +# +package require map::point::file + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export point ; namespace ensemble create } +namespace eval map::point { namespace export store ; namespace ensemble create } +namespace eval map::point::store { namespace export fs ; namespace ensemble create } + +debug level tklib/map/point/store/fs +debug prefix tklib/map/point/store/fs {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::point::store::fs { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -pattern -default {*.points} -readonly 1 + + # . . .. ... ..... ........ ............. ..................... + ## State, In-memory cache + # + # - Visibility map :: dict (geo -> id) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> geo + # "kind" -> string) + + variable mypoints {} + variable myattr {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {directory} { + debug.tklib/map/point/store/fs {} + + $self Load $directory + return + } + + destructor { + debug.tklib/map/point/store/fs {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method ids {} { + debug.tklib/map/point/store/fs {} + + return [lsort -dict [dict keys $myattr]] + } + + method get {id} { + debug.tklib/map/point/store/fs {} + + return [dict get $myattr $id] + } + + method visible {geobox zoom} { + # zoom - ignored + debug.tklib/map/point/store/fs {} + + set ids {} + dict for {geo id} $mypoints { + #puts $id//$geo + if {![map slippy geo box inside $geobox $geo]} continue + lappend ids $id + } + set ids [lsort -unique $ids] + #puts (($ids)) + return $ids + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Load {directory} { + debug.tklib/map/point/store/fs {} + + foreach path [glob -nocomplain -directory $directory $options(-pattern)] { + if {![file exists $path]} continue + if {![file isfile $path]} continue + if {![file readable $path]} continue + + set points [map point file read $path] + # list (dict (names, kind, geo)...) + if {![llength $points]} continue + + #puts ++//[llength $points] + + # Note: file path and sequence number are used as point ID + + set seq 0 + foreach point $points { + # point :: dict (names, geo, kind) + + set key $path/[incr seq] + + # Update visibility map and attribute information + dict set mypoints [dict get $point geo] $key + dict set myattr $key $point + } + } + + #array set __ $myattr ; parray __ ; unset __ + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-mem.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-mem.tcl new file mode 100644 index 00000000..d0e118c1 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-store-mem.tcl @@ -0,0 +1,284 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022-2023 Andreas Kupries + +# @@ Meta Begin +# Package map::point::store::memory 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary In-memory store for geo/point definitions +# Meta description In-memory store for geo/point definitions, with +# Meta description memoized calculation of extended attributes. +# Meta description Base data is taken from a backing store. +# Meta description Anything API-compatible to map::point::store::fs +# Meta subject {center, geo/point} +# Meta subject {diameter, geo/point} +# Meta subject {geo/point pixels, zoom} +# Meta subject {geo/point, center} +# Meta subject {geo/point, diameter} +# Meta subject {geo/point, memory store} +# Meta subject {geo/point, perimeter length} +# Meta subject {length, geo/point, perimeter} +# Meta subject {memory store, geo/point} +# Meta subject {perimeter length, geo/point} +# Meta subject {pixels, zoom, geo/point} +# Meta subject {store, geo/point, memory} +# Meta subject {zoom, geo/point pixels} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::point::store::memory 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ backend-store +# +## ids -> list (id...) +## get ID -> dict (name, geo, kind) +## visible GEOBOX ZOOM -> list (id...) +## pixels ID ZOOM -> list (point...) +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export point ; namespace ensemble create } +namespace eval map::point { namespace export store ; namespace ensemble create } +namespace eval map::point::store { namespace export memory ; namespace ensemble create } + +debug level tklib/map/point/store/memory +debug prefix tklib/map/point/store/memory {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::point::store::memory { + # .................................................................. + ## System configuration + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - Backing store, command prefix + # - Pixel store :: dict (id -> zoom -> point) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> geo + # "kind" -> string) + + variable mystore {} + variable mypixels {} + variable myattr {} + + # Visibility data based on zoom level (in the lower levels clusters begin to replace points). + # Note that cluster geo information is stored in myattr also. + + variable myids {} ;# :: dict (zoom -> list (id...)) + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store maxzoom} { + debug.tklib/map/point/store/memory {} + + set mystore $store + + # This package computes the clustering on construction time, from the geo locations found in + # the backing store. A better system would be able to get the clustering directly from the + # store, without any investment of runtime. IOW the clustering would be pre-computed + # somewhere else, ahead of time. Further, the algorithm's core complexity likely is + # O(n**2). More complex data structures (rtree or similar) are needed for a better O. + + # This package however is mainly for demonstration purposes, for use on/with data sets where + # the scaling issues of this approach do not appear yet. + + $self LoadAndCluster $maxzoom + return + } + + destructor { + debug.tklib/map/point/store/memory {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method * to mystore except get ;# ids, visible + + method get {id} { + debug.tklib/map/point/store/memory {} + return [dict get $myattr $id] + } + + method pixels {id zoom} { + debug.tklib/map/point/store/memory {} + return [dict get $mypixels $id $zoom] + } + + method visible {geobox zoom} { + debug.tklib/map/point/store/memory {} + + # visible, taking zoom into account - i.e. deliver clusters as necessary. + + set ids {} + foreach id [dict get $myids $zoom] { + set geo [dict get $myattr $id geo] + #puts $id//$geo + if {![map slippy geo box inside $geobox $geo]} continue + + lappend ids $id + } + set ids [lsort -unique $ids] + #puts (($ids)) + return $ids + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method LoadAndCluster {maxzoom} { + debug.tklib/map/point/store/memory {} + + # pins :: dict (zoom -> list (pin...)) + # pin :: list (point id) + # point :: list (x y) + + foreach id [DO ids] { + set attr [DO get $id] + set geo [dict get $attr geo] + set bbox [map slippy geo bbox $geo] + + dict set attr bbox $bbox + dict set myattr $id $attr + + # Compute points per zoom level, collect for clustering, and fill base layer of the + # pixel cache. + for {set z 0} {$z <= $maxzoom} {incr z} { + set point [map slippy geo 2point $z $geo] + dict lappend pins $z [list $point $id] + dict set mypixels $id $z $point + } + } + + # Pins gives us the pixel data (including id), per zoom level. (Origin was per + # location). This is now clustered and then converted to the final pixel and visibility + # data. + + dict for {z pins} $pins { + dict set myids $z [Cluster $z $pins] + } + + return + } + + proc Cluster {z pins} { + # pins :: list (pin...) + # pin :: list (point id) + # point :: list (x y) + upvar 1 counter counter mypixels mypixels myattr myattr + + # At levels with suitable detail we forego any kind of clustering. + # We simply use the points as they are. + if {$z >= 18} { + return [lsort -unique [lmap pin $pins { + # pin :: list (point id) + lindex $pin end + }]] + } + + set clusters {} ;# :: dict (point -> list(point...)) + set map {} ;# :: dict (point -> id) + + foreach pin [lsort -dict $pins] { + lassign $pin point id + dict set map $point $id + + if {[FindCluster $clusters $point center]} { + # Extend found cluster + # - ATTENTION - This may move the cluster center. + set points [dict get $clusters $center] + dict unset clusters $center + lappend points $point + set center [map slippy point center-list $points] + dict set clusters $center $points + + } else { + # Start a new cluster + dict set clusters $point [list $point] + } + } + + # Convert the clusters into fake geo locations, pixel data, and the list of ids to consider + # at the level. + + dict for {center points} $clusters { + if {[llength $points] < 2} { + # Cluster is actually single point, center is the point. + # Reuse the point itself. + set id [lindex [dict get $map $center] 0] + } else { + # Multiple points are an actual cluster. + set id c/[incr counter] + + # Create the necessary attribute data for this fake. + dict set myattr $id names {} + dict set myattr $id geo [map slippy point 2geo $z $center] + dict set myattr $id kind cluster + dict set myattr $id count [llength $points] ;# Data for default cluster style + + # And extend the pixel cache for it + dict set mypixels $id $z $center + } + + lappend ids $id + } + + return $ids + } + + proc FindCluster {clusters point cv} { + upvar $cv center + + set best Inf + dict for {centroid points} $clusters { + set d [map slippy point distance $centroid $point] + if {$d >= $best} continue + set best $d + set center $centroid + } + + # Check if we can place the pointo into the nearest cluster, and return the result of that + # check. The chosen threshold is 1.5x the circle radius for default cluster style in + # `map::point::map-display`. This reduces the probability of neighbouring clusters visually + # overlapping (too much). + return [expr {$best <= 30}] + } + + proc DO {args} { + debug.tklib/map/point/store/memory {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-table-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-table-display.tcl new file mode 100644 index 00000000..2b777c32 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/point-table-display.tcl @@ -0,0 +1,254 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::point::table-table-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a table of point definitions +# Meta description Widget to display the information of many point definitions +# Meta description in a table +# Meta subject {point display, tabular} +# Meta subject {tabular, point display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +package provide map::point::table-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ store ... +# +## OBJ focus ID +# +## -on-selection Command prefix to report selection changes +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular table-display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export point ; namespace ensemble create } +namespace eval map::point { namespace export table-display ; namespace ensemble create } + +debug level tklib/map/point/table-display +debug prefix tklib/map/point/table-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::point::table-display { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - List of shown point definitions + # (per row: id, name, kind, location (lat/lon separate)) + # => 5 columns + # id identifies the row, and is mapped back to the POINT id. + # + # - Backward map from row ids to POINT ids + # NOTE: multiple row ids can map to the same point (multiple names!) + # + # - Forward map from point id to the set of rows showing that point + # (set because multiple names) + # + # - Command to access backing store. + + variable myspec {} ;# Table data derived from the point specifications + variable myrows {} ;# dict (row-id -> point-id) + variable mypoints {} ;# dict (point-id -> row-id -> ".") + variable mystore {} ;# Store backing the display + # FUTURE: event: add/remove/change + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store args} { + debug.tklib/map/point/table-display {} + + $self configurelist $args + + set mystore $store + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 50 \ + -columntitles {\# Name Kind Lat Lon} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -fill both -expand 1 + + $win.sa.table configure \ + -listvariable [myvar myspec] \ + -labelcommand tablelist::sortByColumn \ + -labelcommand2 tablelist::addToSortColumns + + bind $win.sa.table <> [mymethod SelectionChanged] + + #DO watch [mymethod StoreChanged] ;# FUTURE: react to edits and + after 100 [mymethod StoreChanged] ;# resulting store changes + return + } + + destructor { + debug.tklib/map/point/table-display {} + + #DO unwatch [mymethod StoreChanged] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {pointid} { + debug.tklib/map/point/table-display {} + + set rowids [dict keys [dict get $mypoints $pointid]] + + # Locate the rows in the table bearing the rowids for the point + # Search is required because the table may not be sorted in order + + set rows [lsort -integer [lmap rowid $rowids { + set pos [lsearch -exact -index 0 $myspec $rowid] + if {$pos < 0} continue + set pos + }]] + + # Select all rows, show the highest (by dint of sorting above) + $win.sa.table selection clear 0 end + foreach row $rows { + $win.sa.table selection set $row + $win.sa.table see $row + } + + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internals + + proc DO {args} { + debug.tklib/map/point/table-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + method StoreChanged {args} { + debug.tklib/map/point/table-display {} + + # Local storage to assemble the display information in. + set specs {} + set map {} + set points {} + + # Note: Points with multiple names generate multiple entries in the table, one per name. + # Each such row maps to the same point, and the point will know about all its rows. + + foreach pointid [DO ids] { + set spec [DO get $pointid] + # names, kind, geo + dict with spec {} + #puts |$pointid|$spec| + + # Formatting for display - Ignores geopoint + + lassign [map slippy geo limit $geo] lat lon + + if {![llength $names]} { + lappend row [incr rowid] + lappend row {} + lappend row $kind + lappend row $lat + lappend row $lon + + lappend specs $row + unset row + + dict set map $rowid $pointid + dict set points $pointid $rowid . + } else { + foreach name $names { + lappend row [incr rowid] + lappend row $name + lappend row $kind + lappend row $lat + lappend row $lon + + lappend specs $row + unset row + + dict set map $rowid $pointid + dict set points $pointid $rowid . + } + } + } + + # ... and commit + set myrows $map + set mypoints $points + set myspec $specs + + return + } + + method SelectionChanged {} { + debug.tklib/map/point/table-display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/point/table-display {} + + if {![llength $options(-on-selection)]} return + + # row - index of entry in table, influenced by sorting + # rowid - internal row id as pulled out of entry + # pointid - point id associated to the row id + + set row [$win.sa.table curselection] + if {$row eq {}} return + + #puts row//[lindex $myspec $row]// + + set rowid [lindex $myspec $row 0] + set pointid [dict get $myrows $rowid] + + uplevel #0 [list {*}$options(-on-selection) $pointid] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/provider-osm.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/provider-osm.tcl new file mode 100644 index 00000000..2cf87f15 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/provider-osm.tcl @@ -0,0 +1,142 @@ +## -*- mode: tcl; fill-column: 90 -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::provider::osm 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tlib +# Meta platform tcl +# Meta summary Tile provider using OpenStreetMap Mapnik as origin +# Meta description Tile provider using OpenStreetMap Mapnik as origin and +# Meta description caching tiles in the local filesystem. +# Meta subject map {tile provider} {provider, tiles} openstreetmap mapnik +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require map::slippy::cache +# Meta require map::slippy::fetcher +# Meta require snit +# @@ Meta End + +package provide map::provider::osm 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ cachedir +# +## levels +## get TILE DONECMD +## tileheight +## tilewidth +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib... +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Slippy Utilities - Latest API +package require map::slippy::cache ;# Tile cache +package require map::slippy::fetcher ;# Server access +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export provider ; namespace ensemble create } +namespace eval map::provider { namespace export osm ; namespace ensemble create } + +debug level tklib/map/provider/osm +debug prefix tklib/map/provider/osm {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::provider::osm { + # . . .. ... ..... ........ ............. ..................... + ## Configuration + # - OpenStreetMap. Mapnik Tile Set + # - Alternative: http://tah.openstreetmap.org/Tiles/tile + + typevariable ourtileset http://tile.openstreetmap.org + typevariable ourlevels 20 + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {cachedir} { + debug.tklib/map/provider/osm {} + + map::slippy::fetcher ${selfns}::TILE $ourlevels $ourtileset + map::slippy::cache ${selfns}::FETCH $cachedir ${selfns}::TILE + + set myfetcher ${selfns}::FETCH + return + } + + destructor { + debug.tklib/map/provider/osm {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myfetcher + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method tileheight to myfetcher + delegate method tilewidth to myfetcher + + method levels {} { + debug.tklib/map/provider/osm {} + return $ourlevels + } + + method get {tile donecmd} { + debug.tklib/map/provider/osm {} + # tile = (zoom row col) + + # The standard fetcher throws errors on invalid tiles. Here this is modified to + # report the bad tile as 'not set' + + # Regard of tile validity, result reporting runs through our local receiver to + # capture and report issues in the user-specified callback + + if {![::map slippy tile valid {*}$tile $ourlevels]} { + $self GOT $donecmd unset $tile + return + } + + ${selfns}::FETCH get $tile [mymethod GOT $donecmd] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internal + + method GOT {donecmd action tile args} { + debug.tklib/map/provider/osm {} + + # Intercalated local tile receiver. Intercepts backend reporting (requested tile + # is available, is invalid, etc). Passes to the actual receiver and reports issues + # with it (error stack to stdout). + + if {[catch { + uplevel #0 [list {*}$donecmd $action $tile {*}$args] + }]} { puts $::errorInfo } + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-display.tcl new file mode 100644 index 00000000..421a8094 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-display.tcl @@ -0,0 +1,217 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::track::display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a single track definition +# Meta description Widget to display the information of a single track definition +# Meta subject {track display, tabular} +# Meta subject {tabular, track display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +## TODO / focus - active vertex / row map ... + +package provide map::track::display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ +# +## set TRACK -> VOID Show this track, or nothing, if empty +# +## -on-selection Report changes to the vertext selection +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export display ; namespace ensemble create } + +debug level tklib/map/track/display +debug prefix tklib/map/track/display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::track::display { + # . . .. ... ..... ........ ............. ..................... + # User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myspec {} ;# Table data derived from the track specification + variable myparts ;# Track statistics: Number of parts + variable mylength ;# Track statistics: Length/Perimeter + variable mydiameter ;# Track statistics: Diameter + variable myclat ;# Track statistics: Center Latitude + variable myclon ;# Track statistics: Center Longitude + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {args} { + debug.tklib/map/track/display {} + + $self configurelist $args + + label $win.lcenter -text Center + label $win.clat -textvariable [myvar myclat] + label $win.clon -textvariable [myvar myclon] + label $win.lparts -text Parts + label $win.parts -textvariable [myvar myparts] + label $win.llength -text Length + label $win.length -textvariable [myvar mylength] + label $win.ldiameter -text Diameter + label $win.diameter -textvariable [myvar mydiameter] + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 60 \ + -columntitles {\# Latitude Longitude Distance Total} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -side bottom -fill both -expand 1 + + pack $win.lcenter -in $win -side left + pack $win.clat -in $win -side left + pack $win.clon -in $win -side left + pack $win.lparts -in $win -side left + pack $win.parts -in $win -side left + pack $win.llength -in $win -side left + pack $win.length -in $win -side left + pack $win.ldiameter -in $win -side left + pack $win.diameter -in $win -side left + + $win.sa.table configure -listvariable [myvar myspec] + + bind $win.sa.table <> [mymethod SelectionChanged] + return + } + + destructor { + debug.tklib/map/track/display {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {index} { + debug.tklib/map/track/display {} + + $win.sa.table selection clear 0 end + $win.sa.table selection set $index + $win.sa.table see $index + return + } + + method set {geos} { + debug.tklib/map/track/display {} + + if {![llength $geos]} { + set myspec {} + set mydiameter n/a + set mylength n/a + set myparts n/a + set myclat n/a + set myclon n/a + return + } + + set parts [expr { max(0, [llength $geos] - 1) }] + set diameter [map slippy geo diameter-list $geos] + set center [map slippy geo center-list $geos] + lassign [map slippy geo limit $center] clat clon + + # Assemble table data + + set last {} + set total 0 + set rows [lmap g $geos { + set dd {} + set dt {} + if {$last ne {}} { + set d [map slippy geo distance $last $g] + set total [expr {$total + $d}] + # Format for display + set dd [map slipp pretty-distance $d] + set dt [map slipp pretty-distance $total] + } + + lassign [map slippy geo limit $g] lat lon + set last $g + + set data {} + lappend data [incr rowid] + lappend data $lat + lappend data $lon + lappend data $dd + lappend data $dt + set data + }] + + # ... and commit + set myparts $parts + set mylength $dt + set mydiameter [map slippy pretty-distance $diameter] + set myspec $rows + set myclat $clat + set myclon $clon + return + } + + # . . .. ... ..... ........ ............. ..................... + # Internal + + method SelectionChanged {} { + debug.tklib/map/track/display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/track/display {} + + if {![llength $options(-on-selection)]} return + + set row [$win.sa.table curselection] + if {$row eq {}} return + + uplevel #0 [list {*}$options(-on-selection) $row] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-entry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-entry.tcl new file mode 100644 index 00000000..1b59bbe8 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-entry.tcl @@ -0,0 +1,273 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::track::entry 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine - Track Entry +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description This attachment enabless user to enter an open series of +# Meta description points, i.e. a track. +# Meta subject {addon, track entry, map display} +# Meta subject {track entry, map display, addon} +# Meta subject {map display, addon, track entry} +# Meta subject +# Meta require {Tcl 8.6-} +# Meta require canvas::edit::polyline +# Meta require debug +# Meta require debug::caller +# Meta require snit +# Meta require {map::slippy 0.8} +# @@ Meta End + +package provide map::track::entry 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget +# +## active -> VOID Is editing on ? +## track -> VOID Query current track spec +## clear -> VOID Clear track spec +## disable -> VOID Stop editing +## enable -> VOID Start editing +## fit -> VOID Center and fit current track +## set GEOS -> VOID Set track spec into editor +## focus INDEX -> VOID Move map to indicated vertex of the track +# +## -on-track-change Report changes to the track definition +## -on-active Report changes to the active point/vertex of the track +## -closed Flag indicating of the edited track is closed or not +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::polyline ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export entry ; namespace ensemble create } + +debug level tklib/map/track/entry +debug prefix tklib/map/track/entry {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::track::entry { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-active -default {} -readonly 1 + option -on-track-change -default {} -readonly 1 + option -closed -default 0 -readonly 1 + + # . . .. ... ..... ........ ............. ..................... + ## State + + variable myeditor {} ;# Core poly line editor + variable mymap {} ;# Map the behaviour is attached to + variable mycanvas {} ;# Canvas inside the map + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + variable mygeos {} ;# Track, geo locations + variable myignore no ;# Flag to ignore Points callback + variable myviewchain {} ;# Old view reporting callback + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {map args} { + debug.tklib/map/track/entry {} + + $self configurelist $args + + set addons {} + if {[llength $options(-on-active)]} { lappend addons -active-cmd $options(-on-active) } + + set mymap $map + set mycanvas [$map canvas] + set mygeos {} + set myignore no + set myeditor \ + [canvas::edit polyline ${selfns}::LINE $mycanvas \ + -closed $options(-closed) \ + -radius 6 \ + -add-remove-point 1 \ + -drag-point 2 \ + {*}$addons \ + -data-cmd [mymethod PointsChanged]] + + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + + # editor started disabled, activate + $self enable + return + } + + destructor { + debug.tklib/map/track/entry {} + return + + if {![winfo exists $mycanvas]} return + $self disable + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method fit {} { + debug.tklib/map/track/entry {} + + $self Fit + return + } + + method set {points} { + debug.tklib/map/track/entry {} + + $self Set $points + $self Fit + return + } + + method track {} { + debug.tklib/map/track/entry {} + + return $mygeos + } + + delegate method disable to myeditor + delegate method enable to myeditor + delegate method active to myeditor + + method clear {} { + debug.tklib/map/track/entry {} + + set mygeos {} + ${selfns}::LINE clear + return + } + + method focus {index} { + debug.tklib/map/track/entry {} + + # Determine focus point and its immediate neighbours in the track order + # This provides us with the bounding box to center the map on. + set min $index ; incr min -1 + set max $index ; incr max + set hood {} + for {set i $min} {$i <= $max} {incr i} { + set g [lindex $mygeos $i] + if {![llength $g]} continue + lappend hood $g + } + + set focus [lindex $mygeos $index] + set bbox [map slippy geo bbox-list $hood] + set zoom [map slippy geo box fit $bbox $mycanvasdim [expr {[$mymap levels]-1}]] + + $mymap center $focus $zoom + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internal + + method Set {geos} { + debug.tklib/map/track/entry {} + + set mygeos $geos + + # Load base editor with pixel positions of the line, from the geo location track + $self Ignore yes + + set points [::map slippy geo 2point-list $myzoom $geos] + ${selfns}::LINE set-line $points + + $self Ignore no + return + } + + method Fit {} { + debug.tklib/map/track/entry {} + + if {[llength $mygeos] < 2} return + + set center [map slippy geo center-list $mygeos] + set bbox [map slippy geo bbox-list $mygeos] + set zoom [map slippy geo box fit $bbox $mycanvasdim [expr {[$mymap levels]-1}]] + + $mymap center $center $zoom + return + } + + method ViewChanged {zoom viewbox geobox} { + debug.tklib/map/track/entry {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewbox $geobox] + } + + # Update the canvas dimensions, needed for fitting. + set mycanvasdim [map slippy point box dimensions $viewbox] + + # Ignore panning + if {$zoom == $myzoom} return + + # For zoom changes regenerate the pixel positions from the geo locations. We are using the + # core function because here because performing a fitting here is incorrect. + set myzoom $zoom + $self Set $mygeos + return + } + + method PointsChanged {_ points} { + debug.tklib/map/track/entry {} + + # Compute geo locations from pixel positions, if not suppressed (See set) + if {$myignore} return + + set mygeos [map slippy point 2geo-list $myzoom $points] + + # Report changes further, if requested + if {![llength $options(-on-track-change)]} return + uplevel 1 [list {*}$options(-on-track-change) $mygeos] + return + } + + method Ignore {x} { + debug.tklib/map/track/entry {} + + set myignore $x + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-file.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-file.tcl new file mode 100644 index 00000000..264cb004 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-file.tcl @@ -0,0 +1,140 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Filesystem based storage of geo/track information - Independent of AKIS +## Tklib geo/track file format +## +## - Line based +## - Ignores leading and trailing whitespace in lines +## - Ignores empty lines +## - Ignore lines starting with `//` - C++ line comments +## - Ignore lines starting with `#` - Shell et al line comments +## - Magic word in first line identifying the file: "tklib/geo/track" +## - Zero to more non-numeric lines specifying track names +## - Exactly 2 or more numeric lines specifying coordinates, even number +## - Coordinates are validated as lat/lon + +# @@ Meta Begin +# Package map::track::file 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Reading/writing tklib geo/track files +# Meta description Reading/writing tklib geo/track files +# Meta subject map +# Meta subject {file, geo/track} +# Meta subject {geo/track, file} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::track::file 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## read PATH -> INFO :: dict (names, geo) +## write PATH INFO -> VOID +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export file ; namespace ensemble create } +namespace eval map::track::file { namespace export read write ; namespace ensemble create } + +debug level tklib/map/track/file +debug prefix tklib/map/track/file {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### +## API + +proc ::map::track::file::read {path} { + debug.tklib/map/track/file {} + + if {[catch { + set c [open $path r] + }]} return + + set d [::read $c] + close $c + + set names {} + set coordinates [lmap line [split $d \n] { + set line [string trim $line] + if {$line eq {}} continue + if {[string match //* $line]} continue + if {[string match "#*" $line]} continue + if {![string is double -strict $line]} { + lappend names $line + continue + } + set line + }] + + #puts $path\t//$names//$coordinates// + set names [lassign $names magic] + + if {$magic ne "tklib/geo/track"} { + #puts "$path\t/no magic" + return + } + if {[llength $coordinates] < 2} { + #puts "$path\t/bad coordinate count [llength $coordinates]" + return + } + if {[llength $coordinates] % 2 == 1} { + #puts "$path\t/bad coordinate count [llength $coordinates]" + return + } + + set geos [lmap {lat lon} $coordinates { list $lat $lon }] + + if {![map slippy geo valid-list $geos]} return + + # Default name derived from file name, iff no name specified + if {![llength $names]} { lappend names [file rootname [file tail $path]] } + + dict set g names $names + dict set g geo $geos + + return $g +} + +proc ::map::track::file::write {path gdata} { + debug.tklib/map/track/file {} + + set c [open $path w] + + puts $c tklib/geo/track + + foreach name [lsort -dict -unique [dict get $gdata names]] { + puts $c $name + } + + foreach geo [dict get $gdata geo] { + lassign $geo lat lon + puts $c $lat + puts $c $lon + } + + close $c + return +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-map-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-map-display.tcl new file mode 100644 index 00000000..2f9da2ad --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-map-display.tcl @@ -0,0 +1,391 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::track::map-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Map Action Engine: Layer to display track definitions +# Meta description Attachment to map display widgets providing custom behaviour. +# Meta description Shows a set of track definitions. Tracks geo area to ensure +# Meta description that only visible tracks use canvas resources (items) +# Meta subject {addon, track display, map display} +# Meta subject {track display, map display, addon} +# Meta subject {map display, addon, track display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require canvas::edit::polyline +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::track::map-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ map-widget store +# +## focus ID -> VOID Move map to track with ID +## disable -> VOID Hide tracks +## enable -> VOID Show tracks +# +## -on-active Command to report changes in the active track +# +## -color Visual options inherited from canvas::edit::polyline +## -hilit-color for full customization of the polyline appearance +## -radius . +## -kind . +## -radius . +## -line-config . +## -create-cmd . +# +# TODO :: Can we get stuff like double-click handling to invoke a track action? +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib. +package require canvas::edit::polyline ;# - Pixel level editor + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export map-display ; namespace ensemble create } + +debug level tklib/map/track/map-display +debug prefix tklib/map/track/map-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::track::map-display { + # .................................................................. + # User configuration + + option -on-active -default {} -readonly 1 + + # Visual options passed to the low-level polyline engines + option -color -default {} -readonly 1 + option -hilit-color -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -kind -default {} -readonly 1 + option -radius -default {} -readonly 1 + option -line-config -default {} -readonly 1 + option -create-cmd -default {} -readonly 1 + + # .................................................................. + ## State - Derived from configuration + + variable myactive 0 ;# Active layer? y/n + variable myvisual {} ;# Visual configuration for the polyline engines + variable mymap {} ;# Map the behaviour is attached to + variable mycanvas {} ;# Canvas inside the map + variable mystore {} ;# Track store + variable myviewchain {} ;# Old view reporting callback + + # .................................................................. + # Map state (viewport) + + variable myzoom {} ;# Map zoom level + variable mycanvasdim {} ;# Canvas viewport dimensions + + # .................................................................. + # Display state + + variable mytracks {} ;# Cache of track information (track, box, pixels per level) + # ;# dict (id -> 'level' -> level -> list(point...) + # ;# -> 'bbox' -> geobox + # ;# -> 'center' -> geo + variable myvisible {} ;# Set of the visible tracks, map from id to manager + # ;# dict (id -> canvas::edit::polyline instance) + variable myrevers {} ;# dict (canvas::edit::polyline instance -> id) + + # .................................................................. + # Object pool - Reusable polyline objects + + variable myfree {} ;# Set of reusable polyline instances + variable myid 0 ;# Id counter for new polyline instances + + # .................................................................. + ## Lifecycle + + constructor {map store args} { + debug.tklib/map/track/map-display {} + + $self configurelist $args + + set mystore $store + set mymap $map + set mycanvas [$map canvas] + + foreach o { + -color + -hilit-color + -radius + -kind + -radius + -line-config + -create-cmd + } { + if {$options($o) eq {}} continue + lappend myvisual $o $options($o) + } + + $self Attach + return + } + + destructor { + debug.tklib/map/track/map-display {} + + if {![winfo exists $mycanvas]} return + $self disable + $self Detach + + # The low-level track managers are auto-destroyed because they are in this + # object's namespace and deleted with it. + return + } + + # .................................................................. + ## API + + method enable {} { + debug.tklib/map/track/map-display {} + + if {$myactive} return + set myactive yes + + # Force visibility processing + $self ViewChanged {*}[$mymap view] + return + } + + method disable {} { + debug.tklib/map/track/map-display {} + + if {!$myactive} return + set myactive no + + # Remove all the visible tracks + dict for {id poly} $myvisible { + $self Close $id + } + return + } + + method focus {id} { + debug.tklib/map/track/map-display {} + + $self Load $id + $self Fit $id ;# The viewport change automatically triggers everything + # # needed to show the focus track, and whatever else is + # # visible. + return + } + + # .................................................................. + ## Internal + + # .................................................................. + ## Viewport interception + + method ViewChanged {zoom viewtrack geobox} { + debug.tklib/map/track/map-display {} + + # Note that the viewport is reported twice, as both pixel and geo coordinates. + # We are only interested in the pixel coordinates, coming first. + + debug.tklib/map/track/map-display {} + + # Pass view change reporting to old callback, if any + if {[llength $myviewchain]} { + uplevel 1 [list {*}$myviewchain $zoom $viewtrack $geobox] + } + + # Do nothing when disabled + if {!$myactive} return + + set zoomchanged [expr {$zoom != $myzoom}] + + # Update map state (zoom, and canvas dimensions for fitting) + set mycanvasdim [map slippy point box dimensions $viewtrack] + set myzoom $zoom + + # Query store for visible tracks + set visible [DO visible $geobox] + + set new {} + foreach v $visible { dict set new $v . } + + # Drop all tracks which are not visible any longer + dict for {id poly} $myvisible { + if {[dict exists $new $id]} continue + $self Close $id + } + + # For all visible tracks, get new, and move existing. move only for zoom changes. + foreach id $visible { + if {[dict exists $myvisible $id]} { + if {$zoomchanged} { $self Show $id } + continue + } + $self Load $id + $self Open $id + $self Show $id + } + return + } + + # .................................................................. + + method Fit {id} { + debug.tklib/map/track/map-display {} + # Already loaded. + + set center [dict get $mytracks $id center] + set gbox [dict get $mytracks $id bbox] + set zoom [map slippy geo box fit $gbox $mycanvasdim [expr {[$mymap levels]-1}]] + + #puts /track-box/$gbox + #puts /dim/$mycanvasdim + #puts /zom/$zoom + + # And this triggers display of the focused id, being fully visible + $mymap center $center $zoom + return + } + + method Load {id} { + debug.tklib/map/track/map-display {} + + if {[dict exists $mytracks $id geo]} return + + set spec [DO get $id] + dict with spec {} + # names, geo, diameter, length, center, bbox, parts + # => center, bbox + + dict set mytracks $id bbox $bbox + dict set mytracks $id center $center + return + } + + method Show {id} { + debug.tklib/map/track/map-display {} + + # Note: point/marker radius is chosen for best visual appearance. + # Single point => extend size to make it visible + # Multiple points => shrink to nothing so that line display is dominant + + set poly [dict get $myvisible $id] + set points [$self Pixels $id] + set radius [expr { [llength $points] < 2 ? 3 : 0 }] + + $poly configure -radius $radius + $poly set-line $points + return + } + + method Pixels {id} { + debug.tklib/map/track/map-display {} + + if {![dict exists $mytracks $id level $myzoom]} { + dict set mytracks $id level $myzoom [DO pixels $id $myzoom] + } + return [dict get $mytracks $id level $myzoom] + } + + method Open {id} { + debug.tklib/map/track/map-display {} + + if {[llength $myfree]} { + set poly [lindex $myfree end] + set myfree [lreplace $myfree end end] + } else { + set obj TRACK_[incr myid] + set poly [canvas::edit polyline \ + ${selfns}::$obj \ + $mycanvas \ + {*}$myvisual \ + -active-cmd [mymethod Active] \ + -tag $self//$obj] + # starts disabled + } + + dict set myvisible $id $poly + dict set myrevers $poly $id + return + } + + method Active {poly kind} { + debug.tklib/map/track/map-display {} + + if {![llength $options(-on-active)]} return + if {$kind ne "line"} return + + set id [dict get $myrevers $poly] + uplevel #0 [list {*}$options(-on-active) $id] + return + } + + method Close {id} { + debug.tklib/map/track/map-display {} + + set poly [dict get $myvisible $id] + $poly clear + + dict unset myvisible $id + dict unset myrevers $poly + lappend myfree $poly + return + } + + # .................................................................. + ## Chain management + + method Attach {} { + debug.tklib/map/track/map-display {} + + # Hook into viewport reporting + set myviewchain [$mymap cget -on-view-change] + $mymap configure -on-view-change [mymethod ViewChanged] + return + } + + method Detach {} { + debug.tklib/map/track/map-display {} + + # Restore old view port reporting + $mymap configure -on-view-change $myviewchain + return + } + + # .................................................................. + ## Store access + + proc DO {args} { + debug.tklib/map/track/map-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # .................................................................. +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-fs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-fs.tcl new file mode 100644 index 00000000..ef90b807 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-fs.tcl @@ -0,0 +1,157 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::track::store::fs 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Filesystem-based store of geo/track definitions +# Meta description Store loading geo/track definitions from a +# Meta description directory in the filesystem. +# Meta subject map +# Meta subject {filesystem store, geo/track} +# Meta subject {geo/track, filesystem store} +# Meta subject {store, geo/track, filesystem} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::track::store::fs 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ trackdirectory +# +## ids -> list (id...) +## get ID -> dict (name -> STRING, geo -> list(geo)) +## visible GEOBOX -> list (id...) +# +## -pattern File pattern for matching geo/track files +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities (inside, visibility) +package require snit ;# - OO system +# +package require map::track::file + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export store ; namespace ensemble create } +namespace eval map::track::store { namespace export fs ; namespace ensemble create } + +debug level tklib/map/track/store/fs +debug prefix tklib/map/track/store/fs {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::track::store::fs { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -pattern -default {*.track} -readonly 1 + + # . . .. ... ..... ........ ............. ..................... + ## State, In-memory cache + # + # - Visibility map :: dict (geo -> id) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> list (geo...)) + + variable mypoints {} + variable myattr {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {directory} { + debug.tklib/map/track/store/fs {} + + $self Load $directory + return + } + + destructor { + debug.tklib/map/track/store/fs {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method ids {} { + debug.tklib/map/track/store/fs {} + + return [lsort -dict [dict keys $myattr]] + } + + method get {id} { + debug.tklib/map/track/store/fs {} + + return [dict get $myattr $id] + } + + method visible {geobox} { + debug.tklib/map/track/store/fs {} + + set ids {} + dict for {geo id} $mypoints { + if {![map slippy geo box inside $geobox $geo]} continue + lappend ids $id + } + set ids [lsort -unique $ids] + #puts (($ids)) + return $ids + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Load {directory} { + debug.tklib/map/track/store/fs {} + + foreach path [glob -nocomplain -directory $directory $options(-pattern)] { + if {![file exists $path]} continue + if {![file isfile $path]} continue + if {![file readable $path]} continue + + set track [map track file read $path] + if {![dict size $track]} continue + # track :: dict (names, geo) + + # Note: file path is used as track ID + + # Update visibility map + foreach p [dict get $track geo] { + dict set mypoints $p $path + } + + # Update base attribute information + dict set myattr $path $track + } + + #array set __ $myattr ; parray __ ; unset __ + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-mem.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-mem.tcl new file mode 100644 index 00000000..85a1caf3 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-store-mem.tcl @@ -0,0 +1,182 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries + +# @@ Meta Begin +# Package map::track::store::memory 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary In-memory store for geo/track definitions +# Meta description In-memory store for geo/track definitions, with +# Meta description memoized calculation of extended attributes. +# Meta description Base data is taken from a backing store. +# Meta description Anything API-compatible to map::track::store::fs +# Meta subject {center, geo/track} +# Meta subject {diameter, geo/track} +# Meta subject {geo/track pixels, zoom} +# Meta subject {geo/track, center} +# Meta subject {geo/track, diameter} +# Meta subject {geo/track, memory store} +# Meta subject {geo/track, perimeter length} +# Meta subject {length, geo/track, perimeter} +# Meta subject {memory store, geo/track} +# Meta subject {perimeter length, geo/track} +# Meta subject {pixels, zoom, geo/track} +# Meta subject {store, geo/track, memory} +# Meta subject {zoom, geo/track pixels} +# Meta require {Tcl 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require snit +# @@ Meta End + +package provide map::track::store::memory 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ backend-store +# +## ids -> list (id...) +## get ID -> dict (name, geo, diameter, length, parts, center, box) +## visible GEOBOX -> list (id...) +## pixels ID ZOOM -> list (point...) +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +# +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export store ; namespace ensemble create } +namespace eval map::track::store { namespace export memory ; namespace ensemble create } + +debug level tklib/map/track/store/memory +debug prefix tklib/map/track/store/memory {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::type ::map::track::store::memory { + # .................................................................. + ## System configuration + + typevariable ourmagic 4.5 ;# This 1.5*3, where 3 is the default circle radius used in + # # canvas::edit::points for the display of point markers. + # TODO: synch with track-display configuration, i.e. radius changes. + # YET: Doing at indexing time will require a fixed threshold. + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - Backing store, command prefix + # - Pixel store :: dict (id -> zoom -> list(point...)) + # - Attribute store :: dict (id -> attr) + # attr :: dict ("names" -> list (string...) + # "geo" -> list (geo...) + # "diameter" -> double + # "length" -> double + # "center" -> geo + # "bbox" -> geobox + # "parts" -> int) + + variable mystore {} + variable myattr {} + variable mypixels {} + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store} { + debug.tklib/map/track/store/memory {} + + set mystore $store + return + } + + destructor { + debug.tklib/map/track/store/memory {} + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + delegate method * to mystore except get ;# ids, visible + + method get {id} { + debug.tklib/map/track/store/memory {} + + if {![dict exists $myattr $id]} { + dict set myattr $id [$self Attributes $id] + } + return [dict get $myattr $id] + } + + method pixels {id zoom} { + debug.tklib/map/track/store/memory {} + + if {![dict exists $mypixels $id $zoom]} { + dict set mypixels $id $zoom [$self Pixels $zoom $id] + } + return [dict get $mypixels $id $zoom] + } + + # . . .. ... ..... ........ ............. ..................... + ## Helpers + + method Attributes {id} { + set attr [DO get $id] + set geos [dict get $attr geo] + + set bbox [map slippy geo bbox-list $geos] + set center [map slippy geo center-list $geos] + set diameter [map slippy geo diameter-list $geos] + set length [map slippy geo distance-list 0 $geos] + set parts [expr { max(0, [llength $geos] - 1) }] + + dict set attr bbox $bbox + dict set attr center $center + dict set attr diameter $diameter + dict set attr length $length + dict set attr parts $parts + + #puts |$id|$attr| + + return $attr + } + + method Pixels {zoom id} { + debug.tklib/map/track/store/memory {} + + set attr [DO get $id] + set geos [dict get $attr geo] + set points [map slippy geo 2point-list $zoom $geos] + set points [map slippy point simplify radial $ourmagic 0 $points] + set points [map slippy point simplify rdp $points] + + return $points + } + + proc DO {args} { + debug.tklib/map/track/store/memory {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-table-display.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-table-display.tcl new file mode 100644 index 00000000..20589e3a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/map/track-table-display.tcl @@ -0,0 +1,264 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ###################### +## (c) 2022 Andreas Kupries +## +## Originally developed within the AKIS project (c) Andreas Kupries + +# @@ Meta Begin +# Package map::track::table-table-display 0.1 +# Meta author {Andreas Kupries} +# Meta location https://core.tcl.tk/tklib +# Meta platform tcl +# Meta summary Widget to display a table of track definitions +# Meta description Widget to display the information of many track definitions +# Meta description in a table +# Meta subject {track display, tabular} +# Meta subject {tabular, track display} +# Meta require {Tcl 8.6-} +# Meta require {Tk 8.6-} +# Meta require debug +# Meta require debug::caller +# Meta require {map::slippy 0.8} +# Meta require scrollutil +# Meta require snit +# Meta require tablelist +# @@ Meta End + +package provide map::track::table-display 0.1 + +# # ## ### ##### ######## ############# ###################### +## API +# +## OBJ store ... +# +## OBJ focus ID +# +## -on-selection Command prefix to report selection changes +# +# # ## ### ##### ######## ############# ###################### +## Requirements + +package require Tcl 8.6- +package require Tk 8.6- +# ;# Tcllib +package require debug ;# - Narrative Tracing +package require debug::caller ;# +package require map::slippy 0.8 ;# - Map utilities +package require snit ;# - OO system +# ;# Tklib +package require scrollutil ;# - Scroll framework +package require tablelist ;# - Tabular table-display + +# # ## ### ##### ######## ############# ###################### +## Ensemble setup. + +namespace eval map { namespace export track ; namespace ensemble create } +namespace eval map::track { namespace export table-display ; namespace ensemble create } + +debug level tklib/map/track/table-display +debug prefix tklib/map/track/table-display {<[pid]> [debug caller] | } + +# # ## ### ##### ######## ############# ###################### + +snit::widget ::map::track::table-display { + # . . .. ... ..... ........ ............. ..................... + ## User configuration + + option -on-selection -default {} + + # . . .. ... ..... ........ ............. ..................... + ## State + # + # - List of shown track definitions + # (per row: id, name, center (lat/lon separate), parts, diameter, length) + # => 7 columns + # id identifies the row, and is mapped back to the TRACK id. + # + # - Backward map from row ids to TRACK ids + # NOTE: multiple row ids can map to the same track (multiple names!) + # + # - Forward map from track id to the set of rows showing that track + # (set because multiple names) + # + # - Command to access backing store. + + variable myspec {} ;# Table data derived from the track specifications + variable myrows {} ;# dict (row-id -> track-id) + variable mytracks {} ;# dict (track-id -> row-id -> ".") + variable mystore {} ;# Store backing the display + # FUTURE: event: add/remove/change + + # . . .. ... ..... ........ ............. ..................... + ## Lifecycle + + constructor {store args} { + debug.tklib/map/track/table-display {} + + $self configurelist $args + + set mystore $store + + scrollutil::scrollarea $win.sa + tablelist::tablelist $win.sa.table -width 90 \ + -columntitles {\# Name Lat Lon Parts Diameter Length} + $win.sa setwidget $win.sa.table + + pack $win.sa -in $win -fill both -expand 1 + + $win.sa.table configure \ + -listvariable [myvar myspec] \ + -labelcommand tablelist::sortByColumn \ + -labelcommand2 tablelist::addToSortColumns + + bind $win.sa.table <> [mymethod SelectionChanged] + + #DO watch [mymethod StoreChanged] ;# FUTURE: react to edits and + after 100 [mymethod StoreChanged] ;# resulting store changes + return + } + + destructor { + debug.tklib/map/track/table-display {} + + #DO unwatch [mymethod StoreChanged] + return + } + + # . . .. ... ..... ........ ............. ..................... + ## API + + method focus {trackid} { + debug.tklib/map/track/table-display {} + + set rowids [dict keys [dict get $mytracks $trackid]] + + # Locate the rows in the table bearing the rowids for the track + # Search is required because the table may not be sorted in order + + set rows [lsort -integer [lmap rowid $rowids { + set pos [lsearch -exact -index 0 $myspec $rowid] + if {$pos < 0} continue + set pos + }]] + + # Select all rows, show the highest (by dint of sorting above) + $win.sa.table selection clear 0 end + foreach row $rows { + $win.sa.table selection set $row + $win.sa.table see $row + } + + return + } + + # . . .. ... ..... ........ ............. ..................... + ## Internals + + proc DO {args} { + debug.tklib/map/track/table-display {} + + upvar 1 mystore mystore + return [uplevel #0 [list {*}$mystore {*}$args]] + } + + method StoreChanged {args} { + debug.tklib/map/track/table-display {} + + # Local storage to assemble the display information in. + set specs {} + set map {} + set tracks {} + + # Note: Tracks with multiple names generate multiple entries in the table, one per name. + # Each such row maps to the same track, and the track will know about all its rows. + + foreach trackid [DO ids] { + set spec [DO get $trackid] + # names, geo, center, diameter, length, parts + dict with spec {} + #puts |$trackid|$spec| + + # Formatting for display - Ignores geotrack + + set diameter [map slippy pretty-distance $diameter] + set length [map slippy pretty-distance $length] + lassign [map slippy geo limit $center] lat lon + + if {![llength $names]} { + # No names, single row with empty name column. + + lappend row [incr rowid] + lappend row {} + lappend row $lat + lappend row $lon + lappend row $parts + lappend row $diameter + lappend row $length + + lappend specs $row + unset row + + dict set map $rowid $trackid + dict set tracks $trackid $rowid . + } else { + # One or more names, one row per name + + foreach name $names { + lappend row [incr rowid] + lappend row $name + lappend row $lat + lappend row $lon + lappend row $parts + lappend row $diameter + lappend row $length + + lappend specs $row + unset row + + dict set map $rowid $trackid + dict set tracks $trackid $rowid . + } + } + } + + # ... and commit + set myrows $map + set mytracks $tracks + set myspec $specs + + return + } + + method SelectionChanged {} { + debug.tklib/map/track/table-display {} + + after idle [mymethod ReportSelectionChange] + return + } + + method ReportSelectionChange {} { + debug.tklib/map/track/table-display {} + + if {![llength $options(-on-selection)]} return + + # row - index of entry in table, influenced by sorting + # rowid - internal row id as pulled out of entry + # trackid - track id associated to the row id + + set row [$win.sa.table curselection] + if {$row eq {}} return + + #puts row//[lindex $myspec $row]// + + set rowid [lindex $myspec $row 0] + set trackid [dict get $myrows $rowid] + + uplevel #0 [list {*}$options(-on-selection) $trackid] + return + } + + # . . .. ... ..... ........ ............. ..................... +} + +# # ## ### ##### ######## ############# ###################### +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry.tcl similarity index 85% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry.tcl index fad4b731..2b930d2e 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry.tcl @@ -4,8 +4,7 @@ # Copyright (c) 1999-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- -package require -exact mentry::common 4.1 +package require -exact mentry::common 4.3.1 package provide mentry $::mentry::version package provide Mentry $::mentry::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentryCommon.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentryCommon.tcl similarity index 79% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentryCommon.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentryCommon.tcl index 74c79a46..788e1c8f 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentryCommon.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentryCommon.tcl @@ -4,16 +4,25 @@ # Copyright (c) 1999-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -if {[catch {package require Wcb 3.1-} result1] != 0 && - [catch {package require wcb 3.1-} result2] != 0} { - error "$result1; $result2" -} - namespace eval ::mentry { + proc - {} { return [expr {$::tcl_version >= 8.5 ? "-" : ""}] } + + package require Tk 8.4[-] + + proc loadWcb {} { + if {[catch {package require Wcb 4.0[-]} result1] && + [catch {package require wcb 4.0[-]} result2] && + [catch {package require Wcb 3.1[-]} result3] && + [catch {package require wcb 3.1[-]} result4]} { + error "$result1; $result2; $result3; $result4" + } + } + loadWcb + # # Public variables: # - variable version 4.1 + variable version 4.3.1 variable library [file dirname [file normalize [info script]]] # @@ -94,8 +103,11 @@ lappend auto_path [file join $::mentry::library scripts] # Load the package mwutil from the directory "scripts/mwutil". Take # into account that it is also included in Scrollutil and Tablelist. # -if {[catch {package present mwutil} version] == 0 && - [package vcompare $version 2.22] < 0} { - package forget mwutil +proc ::mentry::loadUtil {} { + if {[catch {package present mwutil} version] == 0 && + [package vcompare $version 2.23] < 0} { + package forget mwutil + } + package require mwutil 2.23[-] } -package require mwutil 2.22- +::mentry::loadUtil diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry_tile.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry_tile.tcl similarity index 86% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry_tile.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry_tile.tcl index 03498a20..09a90b45 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/mentry_tile.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/mentry_tile.tcl @@ -4,11 +4,11 @@ # Copyright (c) 1999-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +package require -exact mentry::common 4.3.1 + if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[::mentry::-] } -package require -exact mentry::common 4.1 package provide mentry_tile $::mentry::version package provide Mentry_tile $::mentry::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/pkgIndex.tcl similarity index 62% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/pkgIndex.tcl index 5ac02c89..a6d905e6 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/pkgIndex.tcl @@ -7,21 +7,21 @@ # # Regular packages: # -package ifneeded mentry 4.1 \ +package ifneeded mentry 4.3.1 \ [list source [file join $dir mentry.tcl]] -package ifneeded mentry_tile 4.1 \ +package ifneeded mentry_tile 4.3.1 \ [list source [file join $dir mentry_tile.tcl]] # # Aliases: # -package ifneeded Mentry 4.1 \ - [list package require -exact mentry 4.1] -package ifneeded Mentry_tile 4.1 \ - [list package require -exact mentry_tile 4.1] +package ifneeded Mentry 4.3.1 \ + [list package require -exact mentry 4.3.1] +package ifneeded Mentry_tile 4.3.1 \ + [list package require -exact mentry_tile 4.3.1] # # Code common to all packages: # -package ifneeded mentry::common 4.1 \ +package ifneeded mentry::common 4.3.1 \ [list source [file join $dir mentryCommon.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryDateTime.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryDateTime.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryDateTime.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryDateTime.tcl index ef1e0963..63825c61 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryDateTime.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryDateTime.tcl @@ -127,16 +127,16 @@ namespace eval mentry { variable touchpadScrollSupport if {$touchpadScrollSupport} { bind MentryDateTime { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0 && [expr {%# %% 12}] == 0} { - mentry::incrDateTimeComp %W [expr {$deltaY > 0 ? -1 : 1}] + lassign [tk::PreciseScrollDeltas %D] mentry::dX mentry::dY + if {$mentry::dY != 0 && [expr {%# %% 12}] == 0} { + mentry::incrDateTimeComp %W [expr {$mentry::dY > 0 ? -1 : 1}] } } bind MentryMeridian { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0 && [expr {%# %% 12}] == 0} { - mentry::setMeridian %W [expr {$deltaY > 0 ? "A" : "P"}] + lassign [tk::PreciseScrollDeltas %D] mentry::dX mentry::dY + if {$mentry::dY != 0 && [expr {%# %% 12}] == 0} { + mentry::setMeridian %W [expr {$mentry::dY > 0 ? "A" : "P"}] } } } @@ -387,6 +387,7 @@ proc mentry::putClockVal {clockVal win args} { # # Check whether clockVal is an integer number # + ##nagelfar ignore if {[catch {format "%d" $clockVal} res] != 0} { return -code error $res } @@ -485,6 +486,7 @@ proc mentry::getClockVal {win args} { # # Check whether val is an integer number # + ##nagelfar ignore if {[catch {format "%d" $val} res] != 0} { return -code error $res } @@ -556,6 +558,7 @@ proc mentry::getClockValFromDateMentry {win base useGMT} { focus $w return -code error EMPTY } + ##nagelfar ignore scan $str "%d" vals($n) set field [string index $fmt $n] if {$vals($n) < $dateTimeMins($field)} { @@ -640,6 +643,7 @@ proc mentry::getClockValFromTimeMentry {win base useGMT} { } } if {$n == 0 && $meridianFlag} { + ##nagelfar ignore scan $str "%d" val if {$val < 1} { tabToEntry $w @@ -710,6 +714,7 @@ proc mentry::getClockValFromDateTimeMentry {win base useGMT} { focus $w return -code error EMPTY } + ##nagelfar ignore scan $str "%d" vals($n) set field [string index $fmt $n] if {$vals($n) < $dateTimeMins($field)} { @@ -772,6 +777,7 @@ proc mentry::getClockValFromDateTimeMentry {win base useGMT} { } } if {$n == 3 && $meridianFlag} { + ##nagelfar ignore scan $str "%d" val if {$val < 1} { tabToEntry $w @@ -855,6 +861,7 @@ proc mentry::incrDateTimeComp {w amount} { # # Increment the entry's value by the given amount if allowed # + ##nagelfar ignore scan $str "%d" val if {$amount > 0} { variable dateTimeMaxs diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryFixedPoint.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryFixedPoint.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryFixedPoint.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryFixedPoint.tcl index 932229a9..9161f7c3 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryFixedPoint.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryFixedPoint.tcl @@ -22,9 +22,11 @@ proc mentry::fixedPointMentry {win cnt1 cnt2 args} { # # Check the arguments # + ##nagelfar ignore if {[catch {format "%d" $cnt1}] != 0 || $cnt1 <= 0} { return -code error "expected positive integer but got \"$cnt1\"" } + ##nagelfar ignore if {[catch {format "%d" $cnt2}] != 0 || $cnt2 <= 0} { return -code error "expected positive integer but got \"$cnt2\"" } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPAddr.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPAddr.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPAddr.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPAddr.tcl index b0d761fa..98800e4c 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPAddr.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPAddr.tcl @@ -77,9 +77,9 @@ namespace eval mentry { variable touchpadScrollSupport if {$touchpadScrollSupport} { bind MentryIPAddr { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0 && [expr {%# %% 12}] == 0} { - mentry::incrIPAddrComp %W [expr {$deltaY > 0 ? -1 : 1}] + lassign [tk::PreciseScrollDeltas %D] mentry::dX mentry::dY + if {$mentry::dY != 0 && [expr {%# %% 12}] == 0} { + mentry::incrIPAddrComp %W [expr {$mentry::dY > 0 ? -1 : 1}] } } } @@ -142,6 +142,7 @@ proc mentry::putIPAddr {addr win} { # for {set n 0} {$n < 4} {incr n} { set val [lindex $lst $n] + ##nagelfar ignore if {[catch {format "%d" $val} str$n] != 0 || $val < 0 || $val > 255} { return -code error $errorMsg } @@ -170,6 +171,7 @@ proc mentry::getIPAddr win { focus $w return -code error EMPTY } + ##nagelfar ignore scan $str "%d" val$n } @@ -216,6 +218,7 @@ proc mentry::incrIPAddrComp {w amount} { # # Increment the entry's value by the given amount if allowed # + ##nagelfar ignore scan $str "%d" val if {$amount > 0} { if {$val < 255} { @@ -236,6 +239,7 @@ proc mentry::incrIPAddrComp {w amount} { return "" } } + ##nagelfar ignore set str [format "%d" $val] set oldPos [$w index insert] _$w delete 0 end diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPv6Addr.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPv6Addr.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPv6Addr.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPv6Addr.tcl index 05cc5f20..8d350dee 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryIPv6Addr.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryIPv6Addr.tcl @@ -77,9 +77,9 @@ namespace eval mentry { variable touchpadScrollSupport if {$touchpadScrollSupport} { bind MentryIPv6Addr { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0 && [expr {%# %% 12}] == 0} { - mentry::incrIPv6AddrComp %W [expr {$deltaY > 0 ? -1 : 1}] + lassign [tk::PreciseScrollDeltas %D] mentry::dX mentry::dY + if {$mentry::dY != 0 && [expr {%# %% 12}] == 0} { + mentry::incrIPv6AddrComp %W [expr {$mentry::dY > 0 ? -1 : 1}] } } } @@ -181,6 +181,7 @@ proc mentry::putIPv6Addr {addr win} { # for {set n 0} {$n < 8} {incr n} { set val 0x[lindex $lst $n] + ##nagelfar ignore if {[catch {format "%x" $val} str$n] != 0 | $val > 65535} { return -code error $errorMsg } @@ -209,6 +210,7 @@ proc mentry::getIPv6Addr win { } ::$win getarray strs + ##nagelfar ignore return [format "%x:%x:%x:%x:%x:%x:%x:%x" \ 0x$strs(0) 0x$strs(1) 0x$strs(2) 0x$strs(3) \ 0x$strs(4) 0x$strs(5) 0x$strs(6) 0x$strs(7)] @@ -254,6 +256,7 @@ proc mentry::incrIPv6AddrComp {w amount} { # # Increment the entry's value by the given amount if allowed # + ##nagelfar ignore scan $str "%x" val if {$amount > 0} { if {$val < 65535} { @@ -274,6 +277,7 @@ proc mentry::incrIPv6AddrComp {w amount} { return "" } } + ##nagelfar ignore set str [format "%x" $val] set oldPos [$w index insert] _$w delete 0 end diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryThemes.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryThemes.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryThemes.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryThemes.tcl index 9bf0988a..8c6f1e9d 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryThemes.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryThemes.tcl @@ -7,7 +7,7 @@ # - Private procedures related to tile themes # - Private procedures related to global KDE configuration options # -# Copyright (c) 2006-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2006-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # @@ -181,6 +181,7 @@ proc mentry::aquaTheme {} { } if {$extendedAquaSupport} { + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion set labelPadY [expr {$majorOSVersion >= 18 ? {4 7} : {4 5}}] } else { @@ -357,10 +358,18 @@ proc mentry::classicTheme {} { -disabledforeground #a3a3a3 \ -selectbackground #c3c3c3 \ -selectforeground #000000 \ - -selectborderwidth 1 \ - -borderwidth 3 \ - -labelpady {3 3} \ ] + + set val [styleConfig . -selectborderwidth] + set themeDefaults(-selectborderwidth) [expr {$val eq "" ? 0 : $val}] + + if {[styleConfig . -borderwidth] == 1} { + set themeDefaults(-borderwidth) 2 + set themeDefaults(-labelpady) {2 2} + } else { + set themeDefaults(-borderwidth) 3 + set themeDefaults(-labelpady) {3 3} + } } #------------------------------------------------------------------------------ @@ -391,12 +400,13 @@ proc mentry::defaultTheme {} { -selectforeground #ffffff \ ] + set val [styleConfig . -selectborderwidth] + set themeDefaults(-selectborderwidth) [expr {$val eq "" ? 0 : $val}] + if {[styleConfig TEntry -focuswidth] eq ""} { - set themeDefaults(-selectborderwidth) 1 set themeDefaults(-borderwidth) 1 set themeDefaults(-labelpady) {1 1} } else { - set themeDefaults(-selectborderwidth) 0 set themeDefaults(-borderwidth) 2 set themeDefaults(-labelpady) {2 2} } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryWidget.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryWidget.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryWidget.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryWidget.tcl index df2edab2..f8d8b5cf 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mentryWidget.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mentryWidget.tcl @@ -183,6 +183,7 @@ namespace eval mentry { variable currentTheme if {$currentTheme eq "aqua"} { variable newAquaSupport + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$newAquaSupport && $majorOSVersion >= 18} { ;# OS X 10.14+ update idletasks ;# needed for the isdark query @@ -751,6 +752,7 @@ proc mentry::createChildren {win body} { return -code error "expected at least one entry child width" } foreach {width text} $body { + ##nagelfar ignore if {[catch {format "%d" $width}] != 0 || $width <= 0} { return -code error "expected positive integer but got \"$width\"" } @@ -791,6 +793,7 @@ proc mentry::createChildren {win body} { # Append the properly formatted value # of width to the list data(-body) # + ##nagelfar ignore lappend data(-body) [format "%d" $width] # @@ -1299,21 +1302,6 @@ proc mentry::adjustentrySubCmd {win index chars1 chars2} { proc mentry::putSubCmd {win startIdx strList} { upvar ::mentry::ns${win}::data data - # - # If the focus is currently on one of win's children then set it - # temporarily to the top-level window containing win, to make sure - # that the after-insert callback condTabToNext will not change it - # - set focus [focus -displayof $win] - if {$focus ne "" && $focus ne "." && - ([winfo parent $focus] eq $win || - [winfo parent [winfo parent $focus]] eq $win)} { - focus [winfo toplevel $win] - set focusChanged 1 - } else { - set focusChanged 0 - } - # # Attempt to replace the texts of the entry children whose indices are # >= startIdx with the given strings, until either the entries or the @@ -1339,7 +1327,25 @@ proc mentry::putSubCmd {win startIdx strList} { break } + if {[set focus [focus -displayof $w]] eq $w} { + # + # Temporarily remove the procedure mentry::condTabToNext from + # the list of after-insert callbacks of this entry, because + # it might move the focus to the next enabled entry child + # + set callbackList [wcb::callback $w after insert] + set idx [lsearch -glob $callbackList "mentry::condTabToNext *"] + set callbackList2 [lreplace $callbackList $idx $idx ""] + eval wcb::callback [list $w] after insert $callbackList2 + } $w insert 0 $str + if {$focus eq $w} { + # + # Restore the after-insert callbacks of this entry + # + eval wcb::callback [list $w] after insert $callbackList + } + if {[wcb::canceled $w insert]} { set undo 1 break @@ -1364,12 +1370,6 @@ proc mentry::putSubCmd {win startIdx strList} { incr n } - # - # Reset the focus if needed and return the negation of $undo - # - if {$focusChanged} { - focus $focus - } return [expr {!$undo}] } @@ -1463,6 +1463,7 @@ proc mentry::setentrywidthSubCmd {win index width} { proc mentry::childIndex {n max} { if {[string first $n "end"] == 0} { return $max + ##nagelfar ignore } elseif {[catch {format "%d" $n} index] != 0} { return -code error \ "bad index \"$n\": must be end or a number" @@ -1485,9 +1486,9 @@ proc mentry::childIndex {n max} { # # This after-insert callback checks whether the insertion cursor in the n'th # entry child of the mentry widget win is just behind the character having the -# index width; if this is the case, it moves the focus to the next enabled -# entry child, selects the content of that widget, and sets the insertion -# cursor to its end. +# index width and the focus is on that entry; if this is the case, it moves the +# focus to the next enabled entry child, selects the content of that widget, +# and sets the insertion cursor to its end. #------------------------------------------------------------------------------ proc mentry::condTabToNext {width win n w idx str} { if {[$w index insert] == $width && diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/mwutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/mwutil.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/mwutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/mwutil.tcl index c245eaca..fbe155e9 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/mwutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/mwutil.tcl @@ -8,7 +8,9 @@ # Copyright (c) 2000-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} # # Namespace initialization @@ -19,7 +21,7 @@ namespace eval mwutil { # # Public variables: # - variable version 2.22 + variable version 2.23 variable library [file dirname [file normalize [info script]]] # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/pkgIndex.tcl similarity index 81% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/pkgIndex.tcl index 849cc89d..31343e0f 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/mwutil/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/mwutil/pkgIndex.tcl @@ -4,4 +4,4 @@ # Copyright (c) 2020-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package ifneeded mwutil 2.22 [list source [file join $dir mwutil.tcl]] +package ifneeded mwutil 2.23 [list source [file join $dir mwutil.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/tclIndex similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/mentry/scripts/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/mentry/scripts/tclIndex diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/debug.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/debug.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/menubar/debug.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/menubar/debug.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/menubar.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/menubar.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/menubar/menubar.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/menubar/menubar.tcl index 7eaaa24d..0580748e 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/menubar.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/menubar.tcl @@ -8,15 +8,13 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: menubar.tcl,v 1.6 2010/01/09 20:41:29 tomk Exp $ package require Tk package require TclOO package require menubar::tree -package provide menubar 0.5 +package provide menubar 0.5.1 # -------------------------------------------------- # DESIGN NOTES @@ -1049,6 +1047,7 @@ oo::class create ::menubar { } -bind { lassign ${value} uline accel sequence + ##nagelfar ignore if { ${uline} eq "" || [string is integer ${uline}] } { ${mtree} key.set ${node} -underline [expr {(${uline} eq "") ? -1 : ${uline}}] } else { @@ -1717,6 +1716,7 @@ oo::class create ::menubar { } -bind { lassign ${value} uline accel sequence + ##nagelfar ignore if { ${uline} eq "" || [string is integer ${uline}] } { ${mtree} key.set ${name} -underline [expr {(${uline} eq "") ? -1 : ${uline}}] } else { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/node.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/node.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/menubar/node.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/menubar/node.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/pkgIndex.tcl similarity index 75% rename from src/vfs/punk9win.vfs/lib/tklib0.8/menubar/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/menubar/pkgIndex.tcl index 37baf222..e3b3c9ad 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/pkgIndex.tcl @@ -1,4 +1,4 @@ package ifneeded menubar::node 0.5 [list source [file join $dir node.tcl]] package ifneeded menubar::tree 0.5 [list source [file join $dir tree.tcl]] -package ifneeded menubar 0.5 [list source [file join $dir menubar.tcl]] +package ifneeded menubar 0.5.1 [list source [file join $dir menubar.tcl]] package ifneeded menubar::debug 0.5 [list source [file join $dir debug.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/menubar/tree.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/menubar/tree.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/menubar/tree.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/menubar/tree.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/notifywindow.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/notifywindow.tcl new file mode 100644 index 00000000..44b535ef --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/notifywindow.tcl @@ -0,0 +1,96 @@ +#notifywindow.tcl: provides routines for posting a Growl-style "notification window" in the upper right corner of the screen, fading in and out in an unobtrusive fashion + +#(c) 2015-2019 Kevin Walzer/WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html + +package provide notifywindow 1.0.1 + +namespace eval notifywindow { + namespace export * +} + +#Main procedure for window + +proc notifywindow::notifywindow {msg img} { + set w [toplevel ._notify] + if {[tk windowingsystem] eq "aqua"} { + ::tk::unsupported::MacWindowStyle style $w utility {hud + closeBox resizable} + wm title $w "Alert" + } + if {[tk windowingsystem] eq "win32"} { + wm attributes $w -toolwindow true + wm title $w "Alert" + } + if {[lsearch [image names] $img] > -1} { + label $w.l -bg gray30 -fg white -image $img + pack $w.l -fill both -expand yes -side left + } + message $w.message -aspect 150 -bg gray30 -fg white -aspect 150 -text $msg -width 280 + pack $w.message -side right -fill both -expand yes + if {[tk windowingsystem] eq "x11"} { + wm overrideredirect $w true + } + wm attributes $w -alpha 0.0 + set xpos [expr [winfo screenwidth $w] - 325] + wm geometry $w +$xpos+30 + notifywindow::fade_in $w + after 3000 notifywindow::fade_out $w +} + +#Fade and destroy window +proc notifywindow::fade_out {w} { + catch { + set prev_degree [wm attributes $w -alpha] + set new_degree [expr $prev_degree - 0.05] + set current_degree [wm attributes $w -alpha $new_degree] + if {$new_degree > 0.0 && $new_degree != $prev_degree} { + after 10 [list notifywindow::fade_out $w] + } else { + destroy $w + } + + } +} + +#Fade the window into view +proc notifywindow::fade_in {w} { + catch { + raise $w + wm attributes $w -topmost 1 + set prev_degree [wm attributes $w -alpha] + set new_degree [expr $prev_degree + 0.05] + set current_degree [wm attributes $w -alpha $new_degree] + focus -force $w + if {$new_degree < 0.9 && $new_degree != $prev_degree} { + after 10 [list notifywindow::fade_in $w] + } else { + return + } + } +} + +#The obligatory demo +proc notifywindow::demo {} { + image create photo flag -data { + R0lGODlhFAAUAPcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8P/w1Pjisd/UjtHJ + a8O4SL2qJcWqAK+SAJN6AGJiAEpKADIyAP/j1P/Hsf+rjv+Pa/9zSP9XJf9VANxJALk9AJYx + AHMlAFAZAP/U1P+xsf+Ojv9ra/9ISP8lJf4AANwAALkAAJYAAHMAAFAAAP/U4/+xx/+Oq/9r + j/9Ic/8lV/8AVdwASbkAPZYAMXMAJVAAGf/U8P+x4v+O1P9rxv9IuP8lqv8AqtwAkrkAepYA + YnMASlAAMv/U//+x//+O//9r//9I//8l//4A/twA3LkAuZYAlnMAc1AAUPDU/+Kx/9SO/8Zr + /7hI/6ol/6oA/5IA3HoAuWIAlkoAczIAUOPU/8ex/6uO/49r/3NI/1cl/1UA/0kA3D0AuTEA + liUAcxkAUNTU/7Gx/46O/2tr/0hI/yUl/wAA/gAA3AAAuQAAlgAAcwAAUNTj/7HH/46r/2uP + /0hz/yVX/wBV/wBJ3AA9uQAxlgAlcwAZUNTw/7Hi/47U/2vG/0i4/yWq/wCq/wCS3AB6uQBi + lgBKcwAyUNT//7H//47//2v//0j//yX//wD+/gDc3AC5uQCWlgBzcwBQUNT/8LH/4o7/1Gv/ + xkj/uCX/qgD/qgDckgC5egCWYgBzSgBQMtT/47H/x47/q2v/j0j/cyX/VwD/VQDcSQC5PQCW + MQBzJQBQGdT/1LH/sY7/jmv/a0j/SCX/JQD+AADcAAC5AACWAABzAABQAOP/1Mf/sav/jo// + a3P/SFf/JVX/AEncAD25ADGWACVzABlQAPD/1OL/sdT/jsb/a7j/SKr/Jar/AJLcAHq5AGKW + AEpzADJQAP//1P//sf//jv//a///SP//Jf7+ANzcALm5AJaWAHNzAFBQAPLy8ubm5tra2s7O + zsLCwra2tqqqqp6enpKSkoaGhnp6em5ubmJiYlZWVkpKSj4+PjIyMiYmJhoaGg4ODv/78KCg + pICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAEAAAEALAAAAAAUABQAAAiZAAMIHEhQoLqD + CAsqFAigIQB3Dd0tNKjOXSxXrmABWBABgLqCByECuAir5EYJHimKvOgqFqxXrzZ2lBhgJUaY + LV/GOpkSIqybOF3ClPlQIEShMF/lfLVzAcqPRhsKXRqTY1GCFaUy1ckTKkiRGhtapTkxa82u + ExUSJZs2qtOUbQ2ujTsQ4luvbdXNpRtA712+UeEC7ou3YEAAADt= + } + + notifywindow::notifywindow "Man page for Message\n\nSpecifies a non-negative integer value indicating desired aspect ratio for the text. The aspect ratio is specified as 100*width/height. 100 means the text should be as wide as it is tall, 200 means the text should be twice as wide as it is tall, 50 means the text should be twice as tall as it is wide, and so on. Used to choose line length for text if -width option is not specified. Defaults to 150." flag +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/pkgIndex.tcl new file mode 100644 index 00000000..7e4f66c0 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/notifywindow/pkgIndex.tcl @@ -0,0 +1 @@ +package ifneeded notifywindow 1.0.1 [list source [file join $dir notifywindow.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/ntext/ntext.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ntext/ntext.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/ntext/ntext.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/ntext/ntext.tcl index 2d49f4ec..c7a92b1e 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/ntext/ntext.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ntext/ntext.tcl @@ -2174,9 +2174,9 @@ proc ::ntext::TextResetAnchor {w index} { $w mark gravity $anchorname right return } - scan $a "%d.%d" lineA chA - scan $b "%d.%d" lineB chB - scan $c "%d.%d" lineC chC + scan $a "%lld.%lld" lineA chA + scan $b "%lld.%lld" lineB chB + scan $c "%lld.%lld" lineC chC if {$lineB < $lineC + 2} { set total [string length [$w get $b $c]] if {$total <= 2} { @@ -3691,4 +3691,5 @@ proc ::ntext::syncIndentColor {w} { ::ntext::initializeMatchPatterns -package provide ntext 1.0b6 +package provide ntext 1.0 + diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/ntext/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/ntext/pkgIndex.tcl new file mode 100644 index 00000000..11ffad1c --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/ntext/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} +package ifneeded ntext 1.0 [list source [file join $dir ntext.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/persistentSelection/persistentSelection.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/persistentSelection/persistentSelection.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/persistentSelection/persistentSelection.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/persistentSelection/persistentSelection.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/persistentSelection/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/persistentSelection/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/persistentSelection/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/persistentSelection/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/pkgIndex.tcl similarity index 91% rename from src/vfs/punk9win.vfs/lib/tklib0.8/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/pkgIndex.tcl index f5f2d18c..256ca816 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/pkgIndex.tcl @@ -1,6 +1,6 @@ # Tcl package index file, version 1.1 # Do NOT edit by hand. Let tklib install generate this file. -# Generated by tklib installer for version 0.8 +# Generated by tklib installer for version 0.9 # All tklib packages need Tcl 8- (use [namespace])if {![package vsatisfies [package provide Tcl] 8-]} {return} # Extend the auto_path to make tklib packages availableif {[lsearch -exact $::auto_path $dir] == -1} { lappend ::auto_path $dir} # For Tcl 8.3.1 and later, that's all we needif {[package vsatisfies [package provide Tcl] 8.4-]} {return}if {(0 == [catch { package vcompare [info patchlevel] [info patchlevel]}]) && ([package vcompare [info patchlevel] 8.3.1] >= 0)} {return} @@ -23,6 +23,7 @@ set dir [file join $maindir history] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir ico] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir ipentry] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir khim] ; source [file join $dir pkgIndex.tcl] +set dir [file join $maindir map] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir mentry] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir menubar] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir notifywindow] ; source [file join $dir pkgIndex.tcl] @@ -34,8 +35,10 @@ set dir [file join $maindir shtmlview] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir style] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir swaplist] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir tablelist] ; source [file join $dir pkgIndex.tcl] +set dir [file join $maindir text] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir tkpiechart] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir tooltip] ; source [file join $dir pkgIndex.tcl] +set dir [file join $maindir treeview] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir wcb] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir widget] ; source [file join $dir pkgIndex.tcl] set dir [file join $maindir widgetPlus] ; source [file join $dir pkgIndex.tcl] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/pkgIndex.tcl similarity index 80% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/pkgIndex.tcl index 2104f677..1fcd53a5 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/pkgIndex.tcl @@ -2,6 +2,6 @@ if {![package vsatisfies [package provide Tcl] 8.5-]} { # PRAGMA: returnok return } -package ifneeded Plotchart 2.6.1 [list source [file join $dir plotchart.tcl]] +package ifneeded Plotchart 2.7.0 [list source [file join $dir plotchart.tcl]] package ifneeded xyplot 1.0.1 [list source [file join $dir xyplot.tcl]] package ifneeded plotanim 0.2 [list source [file join $dir plotanim.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plot3d.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plot3d.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plot3d.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plot3d.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotanim.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotanim.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotanim.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotanim.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotannot.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotannot.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotannot.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotannot.tcl index 497c8bab..b7299757 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotannot.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotannot.tcl @@ -10,7 +10,10 @@ # # Static data # -namespace eval ::Plotchart { +proc ::Plotchart::InitAnnot {} { + variable BalloonDir + variable TextDir + # Index, three pairs of scale factors to determine xy-coordinates set BalloonDir(north-west) {0 0 1 -2 -2 1 0} set BalloonDir(north) {1 -1 0 0 -3 1 0} @@ -42,6 +45,11 @@ namespace eval ::Plotchart { set TextDir(east) e } +namespace eval ::Plotchart { + InitAnnot + rename InitAnnot {} +} + # DefaultBalloon -- # Set the default properties of balloon text and other types of annotation # Arguments: @@ -390,7 +398,7 @@ proc ::Plotchart::DrawGradientBackground { w colour dir intensity {rect {}} } { if { $dir == "h" } { set nmax [expr {ceil($n*($rxmax-$rxmin)/double($pxmax-$pxmin))}] } else { - set nmax [expr {ceil($n*($rymin-$rymax)/double($pymin-$pymax))}] + set nmax [expr {ceil($n*($rymin-$rymax)/double($pymax-$pymin))}] } for { set i 0 } { $i < $nmax } { incr i } { set factor [expr {($first*$i+$last*($n-$i-1))/double($n)}] @@ -404,9 +412,9 @@ proc ::Plotchart::DrawGradientBackground { w colour dir intensity {rect {}} } { } } else { set y1 $y2 - set y2 [expr {$rymax+($i+1)*$fac}] + set y2 [expr {$rymin+$i*$fac}] if { $i == $nmax-1 } { - set y2 $rymin + set y2 $rymax } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotaxis.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotaxis.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotaxis.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotaxis.tcl index d74b23f2..f4955c8d 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotaxis.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotaxis.tcl @@ -497,6 +497,7 @@ proc ::Plotchart::DrawXaxis { w xmin xmax xdelt args } { set xbackup {} set numeric 1 set gmt 0 + set locale {} if { $xdelt eq {} } { set numeric 1 @@ -552,6 +553,9 @@ proc ::Plotchart::DrawXaxis { w xmin xmax xdelt args } { -gmt { set gmt $val } + -locale { + set locale $val + } } } } @@ -580,7 +584,7 @@ proc ::Plotchart::DrawXaxis { w xmin xmax xdelt args } { set xlabel [FormatNumber $format $xt] } } else { - set xlabel [clock format [expr {int($xt)}] -format $timeformat -gmt $gmt] + set xlabel [clock format [expr {int($xt)}] -format $timeformat -gmt $gmt -locale $locale] } } else { set xlabel $xt diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotbind.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotbind.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotbind.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotbind.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotbusiness.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotbusiness.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotbusiness.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotbusiness.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotchart.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotchart.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotchart.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotchart.tcl index 7202dedb..d9ef0795 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotchart.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotchart.tcl @@ -1200,6 +1200,7 @@ proc ::Plotchart::CreateXYPlotImpl {prefix c xscale yscale argv} { switch -exact -- $arg { -xlabels - -timeformat - + -locale - -gmt { lappend known_args $arg $val } @@ -1326,8 +1327,6 @@ proc ::Plotchart::createIsometricPlot { c xscale yscale stepsize args } { } else { set pxmin 0 set pymin 0 - #set pxmax [$w cget -width] - #set pymax [$w cget -height] set pxmax [WidthCanvas $w] set pymax [HeightCanvas $w] } @@ -2765,7 +2764,7 @@ proc ::Plotchart::createWindRose { c radius_data {sectors 16} args} { variable data_series variable scaling - if { ![string is integer $sectors] } { + if { ![string is integer -strict $sectors] } { set args [concat $sectors $args] set sectors 16 } @@ -3478,4 +3477,4 @@ source [file join [file dirname [info script]] "plotdendrogram.tcl"] # Announce our presence # -package provide Plotchart 2.6.1 +package provide Plotchart 2.7.0 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotcombined.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotcombined.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotcombined.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotcombined.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotconfig.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotconfig.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotconfig.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotconfig.tcl index 4790e82b..a5ed246a 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotconfig.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotconfig.tcl @@ -84,7 +84,7 @@ proc ::Plotchart::plotstyle {cmd {stylename default} args} { } } -namespace eval ::Plotchart { +proc ::Plotchart::InitConfig {} { variable config # FontMetrics -- @@ -160,7 +160,7 @@ namespace eval ::Plotchart { 3dbars {title subtitle margin text legend leftaxis rightaxis bottomaxis background} radialchart {title subtitle margin text legend leftaxis rightaxis bottomaxis background} txplot {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask} - 3dribbon {title subtitle margin text legend leftaxis rightaxis bottomaxis background} + 3dribbon {title subtitle margin text legend xaxis yaxis zaxis leftaxis rightaxis bottomaxis background} boxplot {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask bar} windrose {title subtitle margin text legend axis background} targetdiagram {title subtitle margin text legend leftaxis rightaxis bottomaxis background mask limits} @@ -311,6 +311,11 @@ namespace eval ::Plotchart { plotstyle load default } +namespace eval ::Plotchart { + InitConfig + rename InitConfig {} +} + # plotconfig -- # Set or query general configuration options of Plotchart # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotcontour.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotcontour.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotcontour.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotcontour.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotdendrogram.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotdendrogram.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotdendrogram.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotdendrogram.tcl index 82ab3045..558a48f3 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotdendrogram.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotdendrogram.tcl @@ -72,8 +72,8 @@ proc ::Plotchart::DrawDendrogram {w series treedata} { set dir $scaling($w,direction) - set canvaswidth [$w cget -width] - set canvasheight [$w cget -height] + set canvaswidth [WidthCanvas $w] + set canvasheight [HeightCanvas $w] set width [expr {$canvaswidth - 10}] set height [expr {$canvasheight - $scaling($w,pymin)}] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotgantt.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotgantt.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotgantt.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotgantt.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotobject.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotobject.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotobject.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotobject.tcl index d0fec221..2bb190b4 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotobject.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotobject.tcl @@ -2,7 +2,7 @@ # Routine to plot arbitrary canvas items into plots # -namespace eval ::Plotchart { +proc ::Plotchart::InitObject {} { # # Settings and variable for the DrawObject method # @@ -104,6 +104,11 @@ namespace eval ::Plotchart { } } +namespace eval ::Plotchart { + InitObject + rename InitObject {} +} + # DrawObject -- # Draw some canvas item onto the chart using chart coordinates diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotpack.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotpack.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotpack.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotpack.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotpriv.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotpriv.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotpriv.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotpriv.tcl index 0cbe9fcc..a440a135 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotpriv.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotpriv.tcl @@ -35,10 +35,10 @@ proc ::Plotchart::WidthCanvas {w {useref 1}} { set width [winfo width $w] if { $width < 10 } { - set width [$w cget -width] + set width [winfo pixels $w [$w cget -width]] } } - incr width -[$w cget -borderwidth] + incr width -[winfo pixels $w [$w cget -borderwidth]] return $width } @@ -65,10 +65,10 @@ proc ::Plotchart::HeightCanvas {w {useref 1}} { } else { set height [winfo height $w] if { $height < 10 } { - set height [$w cget -height] + set height [winfo pixels $w [$w cget -height]] } } - incr height -[$w cget -borderwidth] + incr height -[winfo pixels $w [$w cget -borderwidth]] return $height } @@ -279,7 +279,7 @@ proc ::Plotchart::MarginsRectangle { w argv {notext 2.0} {text_width 8}} { if { $pxmin < $config($w,margin,left) } { set pxmin $config($w,margin,left) } - set pymin [expr {int($char_height*$notext) + [$w cget -borderwidth]}] + set pymin [expr {int($char_height*$notext) + [winfo pixels $c [$c cget -borderwidth]]}] if { $pymin < $config($w,margin,top) } { set pymin $config($w,margin,top) } @@ -297,7 +297,7 @@ proc ::Plotchart::MarginsRectangle { w argv {notext 2.0} {text_width 8}} { if {[info exists options(-box)]} { foreach {offx offy width height} $options(-box) {break} if { $offy == 0 } { - set offy [$w cget -borderwidth] + set offy [winfo pixels $c [$c cget -borderwidth]] } set scaling($w,reference) $w set scaling($w,refx) $offx @@ -307,7 +307,7 @@ proc ::Plotchart::MarginsRectangle { w argv {notext 2.0} {text_width 8}} { } elseif {[info exists options(-axesbox)]} { foreach {offx offy width height} [DetermineFromAxesBox $options(-axesbox) $pxmin $pymin $margin_right $margin_bottom] {break} if { $offy == 0 } { - set offy [$w cget -borderwidth] + set offy [winfo pixels $c [$c cget -borderwidth]] } set ref_plot [lindex $options(-axesbox) 0] set pos [string first _ $ref_plot] @@ -316,7 +316,7 @@ proc ::Plotchart::MarginsRectangle { w argv {notext 2.0} {text_width 8}} { } else { set scaling($w,reference) $w set offx 0 - set offy [$w cget -borderwidth] + set offy [winfo pixels $c [$c cget -borderwidth]] set width [WidthCanvas $w] set height [HeightCanvas $w] set scaling($w,refx) 0 @@ -388,9 +388,15 @@ proc ::Plotchart::MarginsSquare { w {notext 2.0} {text_width 8}} { variable config variable scaling + if { [string match {[0-9]*} $w] } { + set c [string range $w 2 end] + } else { + set c $w + } + set scaling($w,reference) $w set scaling($w,refx) 0 - set scaling($w,refy) [$w cget -borderwidth] + set scaling($w,refy) [winfo pixels $c [$c cget -borderwidth]] set scaling($w,refwidth) [WidthCanvas $w] set scaling($w,refheight) [HeightCanvas $w] @@ -443,6 +449,12 @@ proc ::Plotchart::MarginsSquare { w {notext 2.0} {text_width 8}} { proc ::Plotchart::MarginsCircle { w args } { variable scaling + if { [string match {[0-9]*} $w] } { + set c [string range $w 2 end] + } else { + set c $w + } + array set options $args if { [info exists options(-box)] } { set scaling($w,reference) $w @@ -459,8 +471,6 @@ proc ::Plotchart::MarginsCircle { w args } { set pymin 30 set pxmax [expr {[WidthCanvas $w] - 80}] set pymax [expr {[HeightCanvas $w] - 30}] - #set pxmax [expr {[$w cget -width] - 80}] - #set pymax [expr {[$w cget -height] - 30}] # width (dx) and height (dy) of plot region in pixels: if {[info exists options(-units)]} { @@ -517,14 +527,14 @@ proc ::Plotchart::MarginsCircle { w args } { lassign $options(-box) pxmin pymin width height if {$height >= $width} { # place vertically in the middle of the -box - if { $pxmin == 0 } {set pxmin [$w cget -borderwidth]} + if { $pxmin == 0 } {set pxmin [winfo pixels $c [$c cget -borderwidth]]} set pymin [expr {$pymin + ($height-$width)/2.0}] - if { $pymin == 0 } {set pymin [$w cget -borderwidth]} + if { $pymin == 0 } {set pymin [winfo pixels $c [$c cget -borderwidth]]} } else { # place horizontally in the middle of the -box - if { $pymin == 0 } {set pymin [$w cget -borderwidth]} + if { $pymin == 0 } {set pymin [winfo pixels $c [$c cget -borderwidth]]} set pxmin [expr {$pxmin + ($width-$height)/2.0}] - if { $pxmin == 0 } {set pxmin [$w cget -borderwidth]} + if { $pxmin == 0 } {set pxmin [winfo pixels $c [$c cget -borderwidth]]} } # only take the smallest dimension to keep the pie a circle: if {$width < $height} {set height $width} @@ -538,12 +548,12 @@ proc ::Plotchart::MarginsCircle { w args } { set scaling($w,refheight) [expr {$pymin + $height}] } else { set scaling($w,refx) 0 - set scaling($w,refy) [$w cget -borderwidth] + set scaling($w,refy) [winfo pixels $c [$c cget -borderwidth]] set scaling($w,refwidth) [WidthCanvas $w] set scaling($w,refheight) [HeightCanvas $w] - } + } - return [list $pxmin $pymin $pxmax $pymax] + return [list $pxmin $pymin $pxmax $pymax] } # Margins3DPlot -- @@ -554,39 +564,42 @@ proc ::Plotchart::MarginsCircle { w args } { # List of four values # proc ::Plotchart::Margins3DPlot { w } { - variable scaling + variable scaling - set scaling($w,reference) $w - set scaling($w,refx) 0 - set scaling($w,refy) [$w cget -borderwidth] - set scaling($w,refwidth) [WidthCanvas $w] - set scaling($w,refheight) [HeightCanvas $w] + if { [string match {[0-9]*} $w] } { + set c [string range $w 2 end] + } else { + set c $w + } - set yfract 0.33 - set zfract 0.50 - if { [info exists scaling($w,yfract)] } { - set yfract $scaling($w,yfract) - } else { - set scaling($w,yfract) $yfract - } - if { [info exists scaling($w,zfract)] } { - set zfract $scaling($w,zfract) - } else { - set scaling($w,zfract) $zfract - } + set scaling($w,reference) $w + set scaling($w,refx) 0 + set scaling($w,refy) [winfo pixels $c [$c cget -borderwidth]] + set scaling($w,refwidth) [WidthCanvas $w] + set scaling($w,refheight) [HeightCanvas $w] - set yzwidth [expr {(-120+[WidthCanvas $w])/(1.0+$yfract)}] - set yzheight [expr {(-60+[HeightCanvas $w])/(1.0+$zfract)}] - #set yzwidth [expr {(-120+[$w cget -width])/(1.0+$yfract)}] - #set yzheight [expr {(-60+[$w cget -height])/(1.0+$zfract)}] + set yfract 0.33 + set zfract 0.50 + if { [info exists scaling($w,yfract)] } { + set yfract $scaling($w,yfract) + } else { + set scaling($w,yfract) $yfract + } + if { [info exists scaling($w,zfract)] } { + set zfract $scaling($w,zfract) + } else { + set scaling($w,zfract) $zfract + } + + set yzwidth [expr {(-120+[WidthCanvas $w])/(1.0+$yfract)}] + set yzheight [expr {(-60+[HeightCanvas $w])/(1.0+$zfract)}] - set pxmin [expr {60+$yfract*$yzwidth}] - set pxmax [expr {[WidthCanvas $w] - 60}] - #set pxmax [expr {[$w cget -width] - 60}] - set pymin 30 - set pymax [expr {30+$yzheight}] + set pxmin [expr {60+$yfract*$yzwidth}] + set pxmax [expr {[WidthCanvas $w] - 60}] + set pymin 30 + set pymax [expr {30+$yzheight}] - return [list $pxmin $pymin $pxmax $pymax] + return [list $pxmin $pymin $pxmax $pymax] } # MarginsTernary -- @@ -972,11 +985,16 @@ proc ::Plotchart::DrawTitle { w title {position center}} { variable scaling variable config + if { [string match {[0-9]*} $w] } { + set c [string range $w 2 end] + } else { + set c $w + } + set ref $scaling($w,reference) set offx $scaling($ref,refx) set offy $scaling($ref,refy) set width [WidthCanvas $w] - #set width [$w cget -width] set pymin $scaling($w,pymin) switch -- $position { @@ -995,7 +1013,7 @@ proc ::Plotchart::DrawTitle { w title {position center}} { } $w delete "title_$anchor && $ref" - set obj [$w create text $tx [expr {$offy + 3 + [$w cget -borderwidth]}] -text $title \ + set obj [$w create text $tx [expr {$offy + 3 + [winfo pixels $c [$c cget -borderwidth]]}] -text $title \ -tags [list title title_$anchor $ref] -font $config($w,title,font) \ -fill $config($w,title,textcolor) -anchor $anchor] @@ -1025,6 +1043,12 @@ proc ::Plotchart::DrawSubtitle { w title } { variable scaling variable config + if { [string match {[0-9]*} $w] } { + set c [string range $w 2 end] + } else { + set c $w + } + set ref $scaling($w,reference) set offx $scaling($ref,refx) set width [WidthCanvas $w] @@ -1037,7 +1061,7 @@ proc ::Plotchart::DrawSubtitle { w title } { } $w delete "subtitle && $ref" - set obj [$w create text $tx [expr {$offy + 3 + [$w cget -borderwidth]}] -text $title \ + set obj [$w create text $tx [expr {$offy + 3 + [winfo pixels $c [$c cget -borderwidth]]}] -text $title \ -tags [list subtitle $ref] -font $config($w,subtitle,font) \ -fill $config($w,subtitle,textcolor) -anchor n] @@ -2632,14 +2656,16 @@ proc ::Plotchart::DrawTimePeriod { w text time_begin time_end {colour black}} { foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break} foreach {x2 y2} [coordsToPixel $w $xmax $ybott ] {break} - $w create rectangle $x1 $y1 $x2 $y2 -fill $colour \ - -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] + set items [$w create rectangle $x1 $y1 $x2 $y2 -fill $colour \ + -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]] ReorderChartItems $w set scaling($w,current) [expr {$scaling($w,current)-1.0}] RescaleChart $w + + return $items } # DrawAdditionalPeriod -- @@ -2670,14 +2696,16 @@ proc ::Plotchart::DrawAdditionalPeriod { w time_begin time_end {colour black}} { foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break} foreach {x2 y2} [coordsToPixel $w $xmax $ybott ] {break} - $w create rectangle $x1 $y1 $x2 $y2 -fill $colour \ - -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] + set items [$w create rectangle $x1 $y1 $x2 $y2 -fill $colour \ + -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]] ReorderChartItems $w set scaling($w,current) [expr {$scaling($w,current)-1.0}] RescaleChart $w + + return $items } # DrawTimeVertLine -- @@ -2704,7 +2732,7 @@ proc ::Plotchart::DrawTimeVertLine { w text time {colour black}} { foreach {x y} [coordsToPixel $w $xtime $ytext] {break} set y [expr {$y-5}] - $w create text $x $y -text $text -anchor sw -tags [list $w horizscroll timeline] + lappend items [$w create text $x $y -text $text -anchor sw -tags [list $w horizscroll timeline]] # # Draw the line @@ -2712,9 +2740,11 @@ proc ::Plotchart::DrawTimeVertLine { w text time {colour black}} { foreach {x1 y1} [coordsToPixel $w $xtime $scaling($w,ymin)] {break} foreach {x2 y2} [coordsToPixel $w $xtime $scaling($w,ymax)] {break} - $w create line $x1 $y1 $x2 $y2 -fill $colour -tags [list $w horizscroll timeline tline] + lappend items [$w create line $x1 $y1 $x2 $y2 -fill $colour -tags [list $w horizscroll timeline tline]] $w raise topmask + + return $items } # DrawTimeMilestone -- @@ -2739,8 +2769,8 @@ proc ::Plotchart::DrawTimeMilestone { w text time {colour black}} { set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}] foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break} - $w create text 5 $y -text $text -anchor w \ - -tags [list vertscroll above item_[expr {int($scaling($w,current))}]] + lappend items [$w create text 5 $y -text $text -anchor w \ + -tags [list vertscroll above item_[expr {int($scaling($w,current))}]]] # # Draw an upside-down triangle to indicate the time @@ -2756,14 +2786,16 @@ proc ::Plotchart::DrawTimeMilestone { w text time {colour black}} { set x3 [expr {$x1+0.4*($y1-$y2)}] set y3 $y2 - $w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \ - -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] + lappend items [$w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \ + -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]] ReorderChartItems $w set scaling($w,current) [expr {$scaling($w,current)-1.0}] RescaleChart $w + + return $items } # DrawAdditionalMilestone -- @@ -2797,14 +2829,16 @@ proc ::Plotchart::DrawAdditionalMilestone { w time {colour black}} { set x3 [expr {$x1+0.4*($y1-$y2)}] set y3 $y2 - $w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \ - -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]] + set items [$w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \ + -tags [list $w vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]] ReorderChartItems $w set scaling($w,current) [expr {$scaling($w,current)-1.0}] RescaleChart $w + + return $items } # ScaleItems -- @@ -4091,7 +4125,7 @@ proc ::Plotchart::DrawFunction { w series xargs function args } { if { [lindex $args end-1] != "-samples" } { return -code error "plotfunc: unknown option - [lindex $args end-1]" } - if { ! [string is integer [lindex $args end]] } { + if { ! [string is integer -strict [lindex $args end]] } { return -code error "plotfunc: number of samples must be an integer - is instead \"[lindex $args end]\"" } set number [lindex $args end] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotscada.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotscada.tcl similarity index 95% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotscada.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotscada.tcl index d6ab6217..9a223e89 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotscada.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotscada.tcl @@ -7,13 +7,19 @@ source plotchart.tcl -namespace eval ::Plotchart { +proc ::Plotchart::InitScada {} { + variable methodProc + + set methodProc(scada,scaling) ScadaScaling + set methodProc(scada,axis) ScadaAxis + set methodProc(scada,object) ScadaObject + set methodProc(scada,plot) ScadaPlot + set methodProc(scada,angular-scaling) ScadaAngularScaling +} - set methodProc(scada,scaling) ScadaScaling - set methodProc(scada,axis) ScadaAxis - set methodProc(scada,object) ScadaObject - set methodProc(scada,plot) ScadaPlot - set methodProc(scada,angular-scaling) ScadaAngularScaling +namespace eval ::Plotchart { + InitScada + rename InitScada {} } # createScada -- diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotspecial.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotspecial.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotspecial.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotspecial.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotstatustimeline.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotstatustimeline.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plotstatustimeline.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plotstatustimeline.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plottable.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plottable.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/plottable.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/plottable.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/scaling.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/scaling.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/scaling.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/scaling.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/xyplot.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/xyplot.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/plotchart/xyplot.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/plotchart/xyplot.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/pkgIndex.tcl similarity index 62% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/pkgIndex.tcl index 9ec78d75..21c2bc32 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/pkgIndex.tcl @@ -7,21 +7,21 @@ # # Regular packages: # -package ifneeded scrollutil 2.2 \ +package ifneeded scrollutil 2.4 \ [list source [file join $dir scrollutil.tcl]] -package ifneeded scrollutil_tile 2.2 \ +package ifneeded scrollutil_tile 2.4 \ [list source [file join $dir scrollutil_tile.tcl]] # # Aliases: # -package ifneeded Scrollutil 2.2 \ - [list package require -exact scrollutil 2.2] -package ifneeded Scrollutil_tile 2.2 \ - [list package require -exact scrollutil_tile 2.2] +package ifneeded Scrollutil 2.4 \ + [list package require -exact scrollutil 2.4] +package ifneeded Scrollutil_tile 2.4 \ + [list package require -exact scrollutil_tile 2.4] # # Code common to all packages: # -package ifneeded scrollutil::common 2.2 \ +package ifneeded scrollutil::common 2.4 \ [list source [file join $dir scrollutilCommon.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/attrib.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/attrib.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/attrib.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/attrib.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/notebookImages.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/notebookImages.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/notebookImages.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/notebookImages.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/pagesman.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/pagesman.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/pagesman.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/pagesman.tcl index 63c19a64..c37a664a 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/pagesman.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/pagesman.tcl @@ -443,6 +443,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -503,6 +504,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -525,8 +527,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { return -code error "bad window path name \"$widget\"" } - set idx [lsearch -exact $data(pageList) $widget] - if {$idx < 0} { + if {[set idx [lsearch -exact $data(pageList) $widget]] < 0} { return -code error "window \"$widget\" is not managed by $win" } @@ -540,6 +541,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg set widget [lindex $args 2] @@ -593,6 +595,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -609,6 +612,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -626,6 +630,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -656,6 +661,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" @@ -699,6 +705,7 @@ proc scrollutil::pm::pagesmanWidgetCmd {win args} { } set pageIdx [lindex $args 1] + ##nagelfar ignore set pageIdx [format "%d" $pageIdx] ;# integer check with error msg if {$pageIdx < 0 || $pageIdx >= $data(pageCount)} { return -code error "page index $pageIdx out of bounds" diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/plainnotebook.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/plainnotebook.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/plainnotebook.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/plainnotebook.tcl index 0c7eaa66..d03b51ba 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/plainnotebook.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/plainnotebook.tcl @@ -10,7 +10,7 @@ # - Private procedures used in bindings # - Private utility procedures # -# Copyright (c) 2021-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2021-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # @@ -363,19 +363,21 @@ proc scrollutil::pnb::createBindings {} { if {$touchpadScrollSupport} { bind PnbTab { if {%# %% 15 == 0} { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0} { + lassign [tk::PreciseScrollDeltas %D] \ + scrollutil::dX scrollutil::dY + if {$scrollutil::dY != 0} { scrollutil::pnb::cycleTab [scrollutil::pnb::tabToPnb %W] \ - "" [expr {$deltaY < 0 ? -1 : 1}] + "" [expr {$scrollutil::dY < 0 ? -1 : 1}] } } } bind PnbMiddleFrame { if {%# %% 15 == 0} { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0} { + lassign [tk::PreciseScrollDeltas %D] \ + scrollutil::dX scrollutil::dY + if {$scrollutil::dY != 0} { scrollutil::pnb::cycleTab [scrollutil::pnb::mfToPnb %W] \ - "" [expr {$deltaY < 0 ? -1 : 1}] + "" [expr {$scrollutil::dY < 0 ? -1 : 1}] } } } @@ -567,9 +569,9 @@ proc scrollutil::plainnotebook args { if {%# %% 5 != 0} { break } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaY != 0} { - {*}[%W cget -command] scroll [expr {-$deltaY}] units + lassign [tk::PreciseScrollDeltas %D] scrollutil::dX scrollutil::dY + if {$scrollutil::dY != 0} { + {*}[%W cget -command] scroll [expr {-$scrollutil::dY}] units } break } @@ -625,6 +627,7 @@ proc scrollutil::pnb::doConfig {win opt val} { w { switch -- $opt { -caller { + ##nagelfar ignore if {![string is integer -strict $val]} { return -code error "bad page index $val" } @@ -768,6 +771,7 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { return -code error "\"$pm\" is not a pagesman widget" } foreach {pageIdx text img} $argList {} + ##nagelfar ignore if {![string is integer -strict $pageIdx] || $pageIdx < 0} { return -code error "bad page index $pageIdx" } @@ -955,6 +959,7 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { } set tabId [lindex $args 1] + ##nagelfar ignore if {[scan $tabId "@%d,%d%n" x y count] == 3 && $count == [string length $tabId]} { set cf $data(cf) @@ -1025,6 +1030,7 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { return -code error "\"$pm\" is not a pagesman widget" } foreach {pageIdx text img} [lrange $args 2 end] {} + ##nagelfar ignore if {![string is integer -strict $pageIdx] || $pageIdx < 0} { return -code error "bad page index $pageIdx" } @@ -1176,8 +1182,10 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { tab { if {[catch {::$win index [lindex $args 1]} tabIdx] == 0} { set widget [lindex [$nb tabs] $tabIdx] - set tabPath [widgetToTab $win $widget] - set class [winfo class $tabPath] + if {$widget ne ""} { + set tabPath [widgetToTab $win $widget] + set tabClass [winfo class $tabPath] + } } if {[catch {eval [list $nb $cmd] $argList} result] != 0} { return -code error $result @@ -1186,7 +1194,7 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { if {$argCount == 2} { set idx [expr {[lsearch -exact $result "-state"] + 1}] set state [lindex $result $idx] - if {$state eq "disabled" && $class ne "TRadiobutton"} { + if {$state eq "disabled" && $tabClass ne "TRadiobutton"} { set state [expr {[$tabPath instate disabled] ? "disabled" : "normal"}] set result [lreplace $result $idx $idx $state] @@ -1194,12 +1202,12 @@ proc scrollutil::pnb::plainnotebookWidgetCmd {win args} { } elseif {$argCount == 3 && [string match "-sta*" [lindex $args 2]]} { set state [$nb tab $tabIdx -state] - if {$state eq "disabled" && $class ne "TRadiobutton"} { + if {$state eq "disabled" && $tabClass ne "TRadiobutton"} { set result [expr {[$tabPath instate disabled] ? "disabled" : "normal"}] } } elseif {$argCount > 3} { - if {$class ne "TRadiobutton"} { + if {$tabClass ne "TRadiobutton"} { foreach {opt val} [lrange $args 2 end] { if {[string match "-sta*" $opt]} { set state [mwutil::fullOpt "state" $val \ @@ -1310,19 +1318,19 @@ proc scrollutil::pnb::adjustsizeSubCmd win { # associated with a given page of the plainnotebook widget win. #------------------------------------------------------------------------------ proc scrollutil::pnb::configTab {win tabIdx tabPath} { - set class [winfo class $tabPath] + set tabClass [winfo class $tabPath] foreach {opt val} [$win.nb tab $tabIdx] { switch -- $opt { -compound - -image - -text { - if {$class ne "TSeparator"} { + if {$tabClass ne "TSeparator"} { $tabPath configure $opt $val } } -underline { - if {$class eq "TRadiobutton"} { + if {$tabClass eq "TRadiobutton"} { $tabPath configure $opt $val } } @@ -1331,7 +1339,7 @@ proc scrollutil::pnb::configTab {win tabIdx tabPath} { switch $val { hidden { grid remove $tabPath } normal { - if {$class eq "TRadiobutton"} { + if {$tabClass eq "TRadiobutton"} { $tabPath configure $opt $val } else { $win.nb tab $tabIdx -state disabled @@ -1339,7 +1347,7 @@ proc scrollutil::pnb::configTab {win tabIdx tabPath} { grid $tabPath -sticky we } disabled { - if {$class eq "TRadiobutton"} { + if {$tabClass eq "TRadiobutton"} { $tabPath configure $opt $val } grid $tabPath -sticky we diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollableframe.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollableframe.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollableframe.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollableframe.tcl index 7cded4d7..8643a3e4 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollableframe.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollableframe.tcl @@ -629,7 +629,9 @@ proc scrollutil::sf::scanSubCmd {win argList} { variable scanOpts set opt [mwutil::fullOpt "option" [lindex $argList 0] $scanOpts] + ##nagelfar ignore set x [format "%d" [lindex $argList 1]] + ##nagelfar ignore set y [format "%d" [lindex $argList 2]] upvar ::scrollutil::ns${win}::data data @@ -646,6 +648,7 @@ proc scrollutil::sf::scanSubCmd {win argList} { if {$argCount == 3} { set gain 10 } elseif {$argCount == 4} { + ##nagelfar ignore set gain [format "%d" [lindex $argList 3]] } else { mwutil::wrongNumArgs "$win scan dragto x y ?gain?" @@ -719,9 +722,13 @@ proc scrollutil::sf::seerectSubCmd {win argList} { mwutil::wrongNumArgs "$win seerect x1 y1 x2 y2 ?nw|ne|sw|se?" } + ##nagelfar ignore set x1 [format "%d" [lindex $argList 0]] + ##nagelfar ignore set y1 [format "%d" [lindex $argList 1]] + ##nagelfar ignore set x2 [format "%d" [lindex $argList 2]] + ##nagelfar ignore set y2 [format "%d" [lindex $argList 3]] if {$x1 > $x2} { set tmp $x1; set x1 $x2; set x2 $temp @@ -851,6 +858,7 @@ proc scrollutil::sf::xviewSubCmd {win argList} { # # Command: $win xview # + ##nagelfar ignore set units [format "%d" [lindex $argList 0]] set xScrlIncr $data(-xscrollincrement) if {$xScrlIncr > 0} { @@ -924,6 +932,7 @@ proc scrollutil::sf::yviewSubCmd {win argList} { # # Command: $win yview # + ##nagelfar ignore set units [format "%d" [lindex $argList 0]] set yScrlIncr $data(-yscrollincrement) if {$yScrlIncr > 0} { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollarea.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollarea.tcl similarity index 89% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollarea.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollarea.tcl index 167621c1..2f5a68fe 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollarea.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollarea.tcl @@ -11,7 +11,7 @@ # - Private procedures used in bindings # - Private utility procedures # -# Copyright (c) 2019-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2019-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # @@ -180,9 +180,8 @@ proc scrollutil::sa::createBindings {} { focus [%W widget] } } - bind Scrollarea { - after 1 [list scrollutil::sa::updateScrollbars %W] - after 300 [list scrollutil::sa::updateScrollbars %W] + bind Scrollarea { + scrollutil::sa::onScrollareaConfigure %W %w %h } bind Scrollarea { scrollutil::sa::onScrollareaEnter %W } bind Scrollarea { scrollutil::sa::onScrollareaLeave %W } @@ -191,6 +190,9 @@ proc scrollutil::sa::createBindings {} { catch {rename %W ""} } + bind ScrollareaTop { + after 100 [list set scrollutil::sa::topWidthArr(%W) %w] + } bind ScrollareaTop { after 100 [list scrollutil::sa::onToplevelFocusIn %W] } @@ -205,8 +207,16 @@ proc scrollutil::sa::createBindings {} { scrollutil::sa::onScrollbarClicked %W } - bind DynamicHScrollbar { scrollutil::sa::onDynamicHScrollbarMap %W } + bind DynamicHScrollbar { + scrollutil::sa::onDynamicHScrollbarMap %W + } + bind DynamicHScrollbar { + scrollutil::sa::onDynamicHScrollbarUnmap %W + } + bind WidgetOfScrollarea { + scrollutil::sa::onWidgetOfScrollareaMap %W + } bind WidgetOfScrollarea { scrollutil::sa::onWidgetOfScrollareaDestroy %W } @@ -259,6 +269,8 @@ proc scrollutil::scrollarea args { # variable data array set data { + height 1 + width 1 hsbManaged 0 vsbManaged 0 hsbLocked 0 @@ -287,13 +299,6 @@ proc scrollutil::scrollarea args { foreach opt $configOpts { set data($opt) [lindex $configSpecs($opt) 3] } - set data(inNotebook) 0 - foreach class {TNotebook Scrollednotebook Plainnotebook Pagesman} { - if {[mwutil::getAncestorByClass $win $class] ne ""} { - set data(inNotebook) 1 - break - } - } # # Create two scrollbars as children of the frame @@ -352,7 +357,10 @@ proc scrollutil::scrollarea args { rename ::$win sa::$win interp alias {} ::$win {} scrollutil::sa::scrollareaWidgetCmd $win + variable sa::topWidthArr set top [winfo toplevel $win] + set topWidthArr($top) [winfo width $top] + set tagList [bindtags $top] if {[lsearch -exact $tagList "ScrollareaTop"] < 0} { bindtags $top [linsert $tagList 1 ScrollareaTop] @@ -370,10 +378,10 @@ proc scrollutil::scrollarea args { proc scrollutil::getscrollarea widget { variable sa::scrollareaArr if {[info exists scrollareaArr($widget)]} { - set win $scrollareaArr($widget) - if {[winfo exists $win] && [winfo class $win] eq "Scrollarea"} { - return $win - } + set win $scrollareaArr($widget) + if {[winfo exists $win] && [winfo class $win] eq "Scrollarea"} { + return $win + } } return "" @@ -439,6 +447,7 @@ proc scrollutil::sa::doConfig {win opt val} { } } -lockinterval { + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error msg if {$val < 0} { set val 0 @@ -486,17 +495,6 @@ proc scrollutil::sa::doConfig {win opt val} { } set data($opt) $val - set tagList [bindtags $win.hsb] - set idx [lsearch -exact $tagList "DynamicHScrollbar"] - if {$val eq "dynamic"} { - if {$idx < 0} { - bindtags $win.hsb \ - [linsert $tagList 1 DynamicHScrollbar] - } - } else { - bindtags $win.hsb [lreplace $tagList $idx $idx] - } - switch $val { static { showHScrollbar $win } dynamic { @@ -705,6 +703,13 @@ proc scrollutil::sa::setwidgetSubCmd {win widget} { grid $widget -in $win -row 0 -rowspan 2 -column 0 -columnspan 2 -sticky news raise $widget + set tagList [bindtags $widget] + if {[lsearch -exact $tagList "WidgetOfScrollarea"] < 0} { + bindtags $widget [linsert $tagList 1 WidgetOfScrollarea] + } + + set scrollareaArr($widget) $win + catch {::$widget configure -highlightthickness 0} if {[winfo pixels $win $data(-borderwidth)] > 0 && $data(-relief) ne "flat"} { @@ -735,15 +740,10 @@ proc scrollutil::sa::setwidgetSubCmd {win widget} { onTitleColsWidthChanged $widget } - set tagList [bindtags $widget] - set idx [lsearch -exact $tagList "WidgetOfScrollarea"] - if {$idx < 0} { - bindtags $widget [linsert $tagList 1 WidgetOfScrollarea] - } - - set scrollareaArr($widget) $win - set data(widget) $widget + eval setHScrollbar [list $win] [$widget xview] + eval setVScrollbar [list $win] [$widget yview] + return $oldWidget } @@ -808,12 +808,21 @@ proc scrollutil::sa::setVScrollbar {win first last} { # #------------------------------------------------------------------------------ -# scrollutil::sa::updateScrollbars +# scrollutil::sa::onScrollareaConfigure #------------------------------------------------------------------------------ -proc scrollutil::sa::updateScrollbars win { - if {[winfo exists $win] && [winfo class $win] eq "Scrollarea"} { +proc scrollutil::sa::onScrollareaConfigure {win width height} { + upvar ::scrollutil::ns${win}::data data + + if {$width != $data(width)} { + set data(width) $width updateHScrollbar $win + after 300 [list scrollutil::sa::updateHScrollbar $win] + } + + if {$height != $data(height)} { + set data(height) $height updateVScrollbar $win + after 300 [list scrollutil::sa::updateVScrollbar $win] } } @@ -937,26 +946,64 @@ proc scrollutil::sa::onScrollbarClicked sb { # scrollutil::sa::onDynamicHScrollbarMap #------------------------------------------------------------------------------ proc scrollutil::sa::onDynamicHScrollbarMap hsb { - foreach {first last} [$hsb get] {} - set win [winfo parent $hsb] - if {($first == 0 && $last == 1) || ![protectGeometry $win]} { + set top [winfo toplevel $hsb] + if {![winfo ismapped $top]} { return "" } + # + # Make sure that showing the horizontal scrollbar by decreasing + # the toplevel window's width won't make the toplevel higher + # + set win [winfo parent $hsb] + upvar ::scrollutil::ns${win}::data data + variable topWidthArr + if {[winfo reqheight $win] >= $data(height) && + ([winfo width $top] < $topWidthArr($top) || [wrapsTextWidget $win])} { + wm geometry $top [wm geometry $top] + } +} + +#------------------------------------------------------------------------------ +# scrollutil::sa::onDynamicHScrollbarUnmap +#------------------------------------------------------------------------------ +proc scrollutil::sa::onDynamicHScrollbarUnmap hsb { set top [winfo toplevel $hsb] if {![winfo ismapped $top]} { return "" } # - # Guard against a potential endless loop by making sure that - # showing the horizontal scrollbar won't make the toplevel higher + # Make sure that hiding the horizontal scrollbar by increasing + # the toplevel window's width won't make the toplevel higher # - if {[winfo reqheight $win] == [winfo height $win] + [winfo height $hsb]} { + set win [winfo parent $hsb] + upvar ::scrollutil::ns${win}::data data + variable topWidthArr + if {[winfo reqheight $win] >= $data(height) && + [winfo width $top] > $topWidthArr($top) && ![wrapsTextWidget $win]} { wm geometry $top [wm geometry $top] } } +#------------------------------------------------------------------------------ +# scrollutil::sa::onWidgetOfScrollareaMap +#------------------------------------------------------------------------------ +proc scrollutil::sa::onWidgetOfScrollareaMap widget { + set win [::scrollutil::getscrollarea $widget] + set tagList [bindtags $win.hsb] + set idx [lsearch -exact $tagList "DynamicHScrollbar"] + if {[::$win cget -xscrollbarmode] eq "dynamic"} { + if {$idx < 0} { + set delay [expr {[wrapsTextWidget $win] ? 0 : 300}] + after $delay [list bindtags $win.hsb \ + [linsert $tagList 1 DynamicHScrollbar]] + } + } else { + bindtags $win.hsb [lreplace $tagList $idx $idx] + } +} + #------------------------------------------------------------------------------ # scrollutil::sa::onWidgetOfScrollareaDestroy #------------------------------------------------------------------------------ @@ -977,7 +1024,7 @@ proc scrollutil::sa::onWidgetOfScrollareaDestroy widget { # scrollutil::sa::onHeaderHeightChanged #------------------------------------------------------------------------------ proc scrollutil::sa::onHeaderHeightChanged tbl { - set win [lindex [grid info $tbl] 1] + set win [::scrollutil::getscrollarea $tbl] upvar ::scrollutil::ns${win}::data data set newHeight [winfo reqheight $data(cf-ne)] @@ -994,7 +1041,7 @@ proc scrollutil::sa::onHeaderHeightChanged tbl { # scrollutil::sa::onTitleColsWidthChanged #------------------------------------------------------------------------------ proc scrollutil::sa::onTitleColsWidthChanged tbl { - set win [lindex [grid info $tbl] 1] + set win [::scrollutil::getscrollarea $tbl] upvar ::scrollutil::ns${win}::data data set newWidth [winfo reqwidth $data(cf-sw)] @@ -1069,18 +1116,28 @@ proc scrollutil::sa::hideHScrollbar win { # scrollutil::sa::updateHScrollbar #------------------------------------------------------------------------------ proc scrollutil::sa::updateHScrollbar win { + if {![winfo exists $win] || [winfo class $win] ne "Scrollarea"} { + return "" + } + + upvar ::scrollutil::ns${win}::data data + if {$data(-xscrollbarmode) ne "dynamic"} { + return "" + } + # # Handle the case that the last showHScrollbar or hideHScrollbar # invocation returned prematurely because of the scrollbar lock # - upvar ::scrollutil::ns${win}::data data - if {$data(-xscrollbarmode) eq "dynamic"} { - foreach {first last} [$win.hsb get] {} + if {[winfo exists $data(widget)]} { + foreach {first last} [$data(widget) xview] {} if {$first == 0 && $last == 1} { hideHScrollbar $win } elseif {[winfo width $data(widget)] > 1} { showHScrollbar $win } + } else { + hideHScrollbar $win } } @@ -1092,7 +1149,7 @@ proc scrollutil::sa::unlockHScrollbar win { upvar ::scrollutil::ns${win}::data data set data(hsbLocked) 0 - if {$data(-lockinterval) <= 1 && ![protectGeometry $win]} { + if {$data(-lockinterval) <= 1 && ![wrapsTextWidget $win]} { updateHScrollbar $win } } @@ -1155,18 +1212,28 @@ proc scrollutil::sa::hideVScrollbar win { # scrollutil::sa::updateVScrollbar #------------------------------------------------------------------------------ proc scrollutil::sa::updateVScrollbar win { + if {![winfo exists $win] || [winfo class $win] ne "Scrollarea"} { + return "" + } + + upvar ::scrollutil::ns${win}::data data + if {$data(-yscrollbarmode) ne "dynamic"} { + return "" + } + # # Handle the case that the last showVScrollbar or hideVScrollbar # invocation returned prematurely because of the scrollbar lock # - upvar ::scrollutil::ns${win}::data data - if {$data(-yscrollbarmode) eq "dynamic"} { - foreach {first last} [$win.vsb get] {} + if {[winfo exists $data(widget)]} { + foreach {first last} [$data(widget) yview] {} if {$first == 0 && $last == 1} { hideVScrollbar $win } elseif {[winfo height $data(widget)] > 1} { showVScrollbar $win } + } else { + hideVScrollbar $win } } @@ -1213,13 +1280,10 @@ proc scrollutil::sa::unobscureScrollbars win { } #------------------------------------------------------------------------------ -# scrollutil::sa::protectGeometry +# scrollutil::sa::wrapsTextWidget #------------------------------------------------------------------------------ -proc scrollutil::sa::protectGeometry win { +proc scrollutil::sa::wrapsTextWidget win { upvar ::scrollutil::ns${win}::data data - if {$data(inNotebook)} { - return 0 ;# in order to keep the notebook programmaticaly resizable - } else { set widget [::$win widget] set class [winfo class $widget] if {$class eq "Text" || $class eq "Ctext"} { @@ -1227,12 +1291,13 @@ proc scrollutil::sa::protectGeometry win { } elseif {$class eq "Scrollsync"} { foreach w [::$widget widgets] { set class [winfo class $w] - if {$class eq "Text" || $class eq "Ctext"} { + if {($class eq "Text" || $class eq "Ctext") && + ([lindex [grid info $w] 1] eq $widget || + [lindex [pack info $w] 1] eq $widget)} { return 1 } } } return 0 - } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollednotebook.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollednotebook.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollednotebook.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollednotebook.tcl index 1582eabf..49ca378c 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollednotebook.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollednotebook.tcl @@ -1301,15 +1301,14 @@ proc scrollutil::snb::onButton1 {nb x y} { [::scrollutil::closetabstate $nb $tabIdx] eq "normal"} { $nb state pressed set stateArr(closeIdx) $tabIdx - - # - # The following trick activates the closetab element's - # dark red background color corresponding to the - # "pressed" state, which is necessary on some desktops - # if the notebook's toplevel is not the topmost one: - # - event generate $nb -x $x -y $y } + + # + # The following trick activates the closetab element's + # dark red background color corresponding to the + # "pressed" state, which is necessary on some desktops: + # + event generate $nb -x $x -y $y return "" } @@ -1984,6 +1983,7 @@ proc scrollutil::snb::destroyed win { proc scrollutil::snb::snbTabIdToNbTabId {win tabId} { upvar ::scrollutil::ns${win}::data data + ##nagelfar ignore if {[scan $tabId "@%d,%d%n" x y count] == 3 && $count == [string length $tabId]} { foreach {first last} [$data(sf) xview] {} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollsync.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollsync.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollsync.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollsync.tcl index 50b1b9ea..3f1e9e12 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/scrollsync.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/scrollsync.tcl @@ -409,8 +409,7 @@ proc scrollutil::ss::setwidgetsSubCmd {win widgetList} { foreach w $widgetList { set tagList [bindtags $w] - set idx [lsearch -exact $tagList "WidgetOfScrollsync"] - if {$idx < 0} { + if {[lsearch -exact $tagList "WidgetOfScrollsync"] < 0} { bindtags $w [linsert $tagList 1 WidgetOfScrollsync] } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/tclIndex similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/tclIndex index 65cacf16..430f9c36 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/tclIndex +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/tclIndex @@ -112,13 +112,15 @@ set auto_index(::scrollutil::sa::scrollareaWidgetCmd) [list source [file join $d set auto_index(::scrollutil::sa::setwidgetSubCmd) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::setHScrollbar) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::setVScrollbar) [list source [file join $dir scrollarea.tcl]] -set auto_index(::scrollutil::sa::updateScrollbars) [list source [file join $dir scrollarea.tcl]] +set auto_index(::scrollutil::sa::onScrollareaConfigure) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onScrollareaEnter) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onScrollareaLeave) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onToplevelFocusIn) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onToplevelFocusOut) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onScrollbarClicked) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onDynamicHScrollbarMap) [list source [file join $dir scrollarea.tcl]] +set auto_index(::scrollutil::sa::onDynamicHScrollbarUnmap) [list source [file join $dir scrollarea.tcl]] +set auto_index(::scrollutil::sa::onWidgetOfScrollareaMap) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onWidgetOfScrollareaDestroy) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onHeaderHeightChanged) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::onTitleColsWidthChanged) [list source [file join $dir scrollarea.tcl]] @@ -132,7 +134,7 @@ set auto_index(::scrollutil::sa::updateVScrollbar) [list source [file join $dir set auto_index(::scrollutil::sa::unlockVScrollbar) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::obscureScrollbars) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::sa::unobscureScrollbars) [list source [file join $dir scrollarea.tcl]] -set auto_index(::scrollutil::sa::protectGeometry) [list source [file join $dir scrollarea.tcl]] +set auto_index(::scrollutil::sa::wrapsTextWidget) [list source [file join $dir scrollarea.tcl]] set auto_index(::scrollutil::snb::createClosetabElement) [list source [file join $dir scrollednotebook.tcl]] set auto_index(::scrollutil::snb::createBindings) [list source [file join $dir scrollednotebook.tcl]] set auto_index(::scrollutil::scrollednotebook) [list source [file join $dir scrollednotebook.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl similarity index 89% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl index 6cad0284..125195dc 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl @@ -1152,213 +1152,246 @@ proc themepatch::default::createCheckbtnIndImgs_gif pct { switch $pct { 100 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhEAAQAMIEAIiIiImJiePj4+Tk5P///////////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMLAIiIiIyMjI2NjY6Ojo+Pj5CQkJGRkcbGxsfHx/Ly8vPz8/////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ+8L0igL1WGPkCUksohsoRTMioigcFrqpSwbBFr/Y95nrI +9z9d8DakAQQvXWJgOPQWB0LnkFQlTBwKBiOQPiIAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhEAAQAMIFAIiIiImJicbGxsfHx9nZ2f///////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMKAIiIiIuLi4yMjI2NjY6OjrKysrOzs9DQ0NHR0dnZ2f////////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ98L0hgL1WEPmCQUkohkgRTMaoigUFrioSADBs1euNj/oe +9j7gTogj1gCC1+6gKfgSrU5BqTqYOBQMRiOJAAA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhEAAQAMIFAIiIiImJibW1tba2tsPDw////////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMJAIiIiIqKiouLi4yMjKenp6ioqLy8vL29vcPDw/////////////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ+8L0hgL1WDPkCOUgohgcRTMWoigQFruoRADBs1euNj/oe +9j7gTogj1gCC186gIfgQBEHnUzOYOBQMRiB9RAAAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhEAAQAKECAEpohUpphP///////yH5BAEKAAMALAAAAAAQABAAAAIYXI6JMKAPo5y02puE -3jpyjoXiODpXYw0FADs=}] +R0lGODlhEAAQAMIEAElphEpphEpphUpqg////////////////yH5BAEKAAcALAAAAAAQABAAAAMf +eBfcHkKtR9msOOvNOydgCGKi6J1oSgnecGmAtLlHAgA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhEAAQAKECAKKioqOjo////////yH5BAEKAAMALAAAAAAQABAAAAIXXI6Zpo3gopy02iuy -znHvC4biSAIMZRYAOw==}] +R0lGODlhEAAQAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAQABAAAAMd +SBTczoqAR2G94urNu39DKIbXOH5oqq7O4kXZpiQAOw==}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAKEBAFiVvP///////////yH5BAEKAAIALAAAAAAQABAAAAIWFI6Zpu0Po5y0poAz -flrbD4aixUxCAQA7}] +R0lGODlhEAAQAMIGAFeUvFiUvFeVvFiVvFiVvVmVvP///////yH5BAEKAAcALAAAAAAQABAAAAMl +eAc1/q4IdQK8cOE9SuNgKI7kY5zoyaVp6b7bRwolcZSUvNlHAgA7}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhEAAQAIQPAEpohUpphFx4kX+VqICWqYSZrIecrY2gsZWnt8bQ2MnS2uTp7fP19/b3+f7+ -/////////////////////////////////////////////////////////////////////yH5BAEK -ABAALAAAAAAQABAAAAU4IBSMZEkCEGCubOu+cGA0QywwTxEnj8IODcTo8GAIWASHA3F7HFwI5aIH -ixaP1YYhxu2quikuJAQAOw==}] +R0lGODlhEAAQAIQRAElphEpphEpphUpqg1x4kX+VqICWqYSZrIecrY2gsZWnt8bQ2MnS2uTp7fP1 +9/b3+f7+/////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAQABAAAAU/4PcFZGkGgjieLLm2cCyzyFPMAeFEB75EjFbhoSAlIg5CywCBKHSRREzR +bABnVKQS+0DgZoJvYPCSAVQz8icEADs=}] set ckIndArr(sel_disabled) [image create photo -format gif -data { -R0lGODlhEAAQAOMNAKKioqOjo6ysrL6+vsHBwcLCwsXFxcnJyeLi4uTk5PHx8fn5+fr6+v////// -/////yH5BAEKAA8ALAAAAAAQABAAAAQz8IVJa5U2U6C7/13BDGAgLA1RIk2iDcwxGc0ivE1znI3h -HTlFCwSs3YiMQmnJbAIwoGcEADs=}] +R0lGODlhEAAQAOMOAKKioqOjo6SkpKysrL6+vsHBwcLCwsXFxcnJyeLi4uTk5PHx8fn5+fr6+v// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ38L1Aq6Xygctx/8InikZDjNTAOAUaJI7SEQ1CHQ4zzI6D +qI6DCNFbxFDE3A7ZMLie0MkzExpJIgA7}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAOMOAFiVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f6+bv9fT4+/b6/P7///// -/////yH5BAEKAA8ALAAAAAAQABAAAAQy8IFJa5U26827BwUjfMHiEB/iJJrAHJPhLIE2NM1ROgZ3 -4IqV5zerDRmFj3LJBGA+jwgAOw==}] +R0lGODlhEAAQAIQTAFeUvFiUvFeVvFiVvFiVvVmVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f +6+bv9fT4+/b6/P7//////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAQABAAAAVH4PcBxWCeZiGIX4C+6AjPQ1HS+KxER24akEnCN2hMHLNDhGFaTCCGGUIi +YQAnCxyD+jj6ts/oN6KY3YgDAXpA+KxZ51n7EwIAOw==}] } 125 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhFAAUAOMHAIiIiKenp6ioqKmpqfLy8vT09PX19f////////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAARFEIFJq6VyEMO790QwEUdpnuhBTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoDA5sPlFAQAyWVcQUQAADs=}] +R0lGODlhFAAUAOMNAIiIiImJiYqKiouLi4yMjLe3t7i4uNra2tvb297e3t/f3+Dg4OHh4f////// +/////yH5BAEKAA8ALAAAAAAUABQAAARc8EkigL1YECmHMIgijiRiBIIkLE3rvq8SPIMB33DhIXjf +HBWGD8ewCIewIuCIdCmZzcYz6jRSW9NrlrqNdptFAe8KJNiuhU1AQU3MHoKA4UCqKw6FwHtSwfg1 +HBEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhFAAUAOMIAIiIiJ2dnZ6enp+fn9DQ0NHR0dLS0tnZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAAREEIFJq6VyFMO790UwFUdpnuhRTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoAA4cP1CACSi7iCiAAAOw==}] +R0lGODlhFAAUAOMOAIeHh4iIiImJiYqKiouLi6ioqKmpqcDAwMHBwcLCwsPDw8TExMXFxdnZ2f// +/////yH5BAEKAA8ALAAAAAAUABQAAARb8Ekigr1YECnFMIgijiRiWNKwNGzrukrwfG/9FoOA2Hxz +DAFGz8awCIevYhCZNDJdyuOzEZ2yqlbsVPvkMos6q29AMIgNm4BimpA9LIYDaa44nACcBwXDD5A5 +EQA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhFAAUAOMIAIiIiJeXl5iYmJmZmby8vL29vb6+vsPDw/////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAAREEIFJq6VyEMO790QwEUdpnuhBTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoBA4cP1CACSi7iCiAAAOw==}] +R0lGODlhFAAUAOMLAIeHh4iIiImJiYqKiouLi6CgoLGxsbKysrOzs7S0tMPDw/////////////// +/////yH5BAEKAA8ALAAAAAAUABQAAARa8Mkhgr1YDCl1MUgojkZhTYmiriyLBM9QtHRbUEatK0aV +7rSE5QdkCQPEouqYVDKVxiF09ZwqqlMsVOsMCHLWnsyqKBAeAcT0AEMHPqM4ohQAcB6ECmYvOEsi +ADs=}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhFAAUAMIEAEtohEpphEpqhHePo////////////////yH5BAEKAAcALAAAAAAUABQAAAMl -eBDc/kzB+QS9OOvNu/9DKI4YYZ5oia7Y6A5fLM90bTvCYXlHAgA7}] +R0lGODlhFAAUAMIGAElpg0lphEppg0pphEtphHePo////////yH5BAEKAAcALAAAAAAUABQAAAMy +eCrT/i0oBaCFRN3tDuMcAY5kaZ5coa4saLxw7MY0yN4Fqu+muAe8w07hO02ExYtokgAAOw==}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhFAAUAMIEAKOjo6SkpODg4Ovr6////////////////yH5BAEKAAQALAAAAAAUABQAAAMg -SLDcvkG9Sau9OOvNu6fCII6iYIXkaH5s677wFnwSRyQAOw==}] +R0lGODlhFAAUAMIEAKKioqOjo6SkpLq6uv///////////////yH5BAEKAAcALAAAAAAUABQAAAMq +eBrc7mq9OSW94eANtv9gKG5DaZ4boa5syr7kKY90bd+iRluhEB2dTyQBADs=}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhFAAUAMIGAFiUvFiVu1iVvFiVvVmVvIKwzf///////yH5BAEKAAcALAAAAAAUABQAAAMs -eAPS/g8QBasV7Oqsu/9gKI5OYZ5oZ6xsq7Zwh84Fad943nEjcR+YECBwSAAAOw==}] +R0lGODlhFAAUAOMIAFiUu1iUvFiVvFiVvVmVvFiWvFiWvYKwzf////////////////////////// +/////yH5BAEKAA8ALAAAAAAUABQAAAQ38Mkhqr21SAmwx9rzjdZDkSOBkurqvjB8zHSNIniu33qP +1sBDbEgsGgvFgIgoQcYMm0cLpZREAAA7}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhFAAUAKUgAEtohEpphEpqhEtqhEtqhVBuiFVyi1ZzjFd0jV15kV96km2GnH+VqIKXqoaa -rY6hspytvJ2uvK27yK68yLbCzbzH0bzI0sPN1srT293j6N7j6Ovv8e3w8vT29/T2+PX3+P////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZUwB8g -QCwaj0QhcnkUMJ/QqHQKnXwaVCIDBJJkDRuQR8EcLArGCvfxhIAyCC0XA41wNYgDB9RJQAkWdxdr -UoBcc1SGfH6JFB8OWZGSk5RFAj9OkT9BADs=}] +R0lGODlhFAAUAKUiAElpg0lphEppg0pphEtphEtqhEtqhVBuiFVyi1ZzjFd0jV15kV96km2GnH+V +qIKXqoaarY6hspytvJ2uvK27yK68yLbCzbzH0bzI0sPN1srT293j6N7j6Ovv8e3w8vT29/T2+PX3 ++P////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZnwJ9Q +MCgaj8WAUAhAOpEE4XNq/BGpVAJ2u62EHtyjQySihIuIjgjEmBYah+OFHKFKRBtFcSzSYCdkHAoJ +HiIfC1gGGIEZdFyKZGR+YZCGiGcGFiEQWWdIAZ5HP6FFQlqhS6OnU1pLQQA7}] set ckIndArr(sel_disabled) [image create photo -format gif -data { -R0lGODlhFAAUAIQWAKOjo6SkpKWlpaampqenp6ysrLCwsLGxsbKysrS0tMDAwMLCwtnZ2dvb2+Hh -4eTk5Ofn5+jo6PHx8ff39/v7+/7+/v///////////////////////////////////////yH5BAEK -AB8ALAAAAAAUABQAAAVC4AeMZGmOgXiubOu+cCzPa2Mh9GJVRSsMJYPFonBNKocRgWJhvBzDBEBi -kcQiO4iFQpBphwbag0grm8/nwFlF+4QAADs=}] +R0lGODlhFAAUAIQYAKKioqOjo6SkpKampqioqKmpqaqqqq2trbW1tb6+vr+/v8HBwcbGxs3NzdbW +1tra2t3d3eDg4OTk5O7u7vX19fb29vn5+fr6+v///////////////////////////////yH5BAEK +AB8ALAAAAAAUABQAAAVT4CcGZGma4niuq8q+wQfPwGzfzqXcZoJhDh6JQMFcDjDEwAT5MWANzMRA +8mEks6jUUKhgLEiYoCmNOG/j3w/LS3/D7cdlIazbUfeYzC5IfWo3KSEAOw==}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhFAAUAKUgAFiUvFiVu1iVvFiVvVmVvFmWvV6ZvmKbwGOcwGSdwWqgw2uhxHipyYm00Iy2 -0Y+40pe91aTF2qXG27TP4bTQ4bzU5MHY5sfc6c/g7ODr8uDr8+3z+O70+PX4+/X5+/b5+/////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZgwN8A -ICgaj0cAQYhsOgXEpzQqrVqvUsrHgTU2QKBJV3DYgDyLJ4FhOFrAEGkElEkUvyBMVQLWJBAcIB0K -VQVvIBoXcFeGYGB6WI2ChF0FFR8PY5qbUJwCBJ4/nVgAAT9BADs=}] +R0lGODlhFAAUAKUiAFiUu1iUvFiVvFiVvVmVvFiWvFiWvVmWvV6ZvmKbwGOcwGSdwWqgw2uhxHip +yYm00Iy20Y+40pe91aTF2qXG27TP4bTQ4bzU5MHY5sfc6c/g7ODr8uDr8+3z+O70+PX4+/X5+/b5 ++/////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZqwJ9w +ICgaj8WCUAhAOpHK33Nq/BGpUwKWqt0KLCGI9/gQiSrjYqIjAjWyDsQRY5ZQJ6LNolgWabAUZhwL +Ch4iHwxYB3QiHBl1XotmZn9jkoeJaQcXIRFpnwWfRgFSogJCoZ8GSz9dWKRCQQA7}] } 150 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhGAAYAOMHAIiIiImJibKysrOzs8DAwMTExMfHx/////////////////////////////// -/////yH5BAEKAAgALAAAAAAYABgAAARTEIFJq70BhTCI/2D4DUAADEeqriwrTEUrywU832oNxPit -8z2aLSjcEYvAY26oXBqbzmTzB41WU9RrtrqFdqdMbxh8uh5eJoFhzW672S+A5kKnZyIAOw==}] +R0lGODlhGAAYAIQPAIiIiImJiYqKio6OjqCgoKGhoaKior29vb6+vsDAwMPDw8fHx9vb29zc3N3d +3f///////////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAYABgAAAV9ICRCQQCcaHoGwjiaxpHMdD0fBdCKweA8wKBw+GgMAiLAj8gUNgAkQ3Ma +LJQQVOrBpMhOFaeulwkGiMfD8hkdVLPT4bfQLQfS63d5/r1n99FgAVh1D1sCBYQPBC0ADXUMUBAC +A45sDEcvAAQHC52en50HBABILpImKqksLiEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhGAAYAOMIAIiIiImJiaSkpKWlpa6urrGxsbOzs9nZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAYABgAAARTEIFJq70BhTCI/2D4DUAADEeqriwrTEUrywU832oNxPit -8z2aLSjcEYvAY26oXBqbzmTzB41WU9RrtrqFdqdMbxh8uh5eJoFhzW672SSA5kKnZyIAOw==}] +R0lGODlhGAAYAIQQAIiIiImJiYqKioyMjJiYmJmZmZqamqysrK2tra6urrCwsLOzs8DAwMHBwcLC +wtnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAYABgAAAV6ICRCQQCcaHoGwjiexpHMdD0fBRC8g/P8wKDw0RgARADfcBlsHAMGphRY +KCGm08NJgZUqtl3mF8AND8dlcxCtFrLbwDf8IYfX23d13rwPj69zDwcsBYEPBC0ADXMMRyQDi2oM +AztIAAQHC5qbnJoHBDouIgImKqYsLiEAOw==}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhGAAYAMIHAIiIiImJiZ2dnaSkpKampqenp8PDw////yH5BAEKAAcALAAAAAAYABgAAANQ -eLDc/uGEIIa9OF8BAhBGKI4kyQFEqarEkq5w2KJxPL816+brzeu0H8knHBGLsh0yGVwekc9iVDj9 -VXnXXLY2Ay0NHI+gQC6bz+WT5MFmRxIAOw==}] +R0lGODlhGAAYAOMOAIiIiImJiYqKiouLi5SUlJWVlaKioqOjo6SkpKWlpaenp7GxsbKyssPDw/// +/////yH5BAEKAA8ALAAAAAAYABgAAARx8MkXArg43yDmvIWBjGQ5GgQQfAPTvHAsN8wASIA77zFz +BwWeEEaoHIZDwyWBFCaWTd4TwIzOplVrDKuVcbuwL7ghBpe7Z23auo5Oj+OGgUOINwid3Hhxo7S6 +CwMrOAAEBgqIiYqIKCoeEgIWGpMcHhEAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhGAAYAMIGAEpohElpg0lphUpphEpqhKW0wv///////yH5BAEKAAcALAAAAAAYABgAAAMx -eDDc/k6EE6C9o+LNu/9gKI5kaTJFqq5pZ7xw/Lpy3bF4ce587/8/wU5TIlCEIskhAQA7}] +R0lGODlhGAAYAMIFAEpphEpphUtphElqg6W0wv///////////yH5BAEKAAcALAAAAAAYABgAAAM6 +eHoB/hCGtaK9ruINFf/AAYLCuJVmqq5s6xBwLMNgYd+4Xec8OP8El3BIVKGKQlFS6dKwKJ7jaUBJ +AAA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhGAAYAMIEAKKioqOjo6SkpNHR0f///////////////yH5BAEKAAcALAAAAAAYABgAAAMp -eBLc/vDASau9OOvNu/9gCA1kaZIYoa6smrYwds6DaN94ru98B0ihQwIAOw==}] +R0lGODlhGAAYAMIEAKKioqOjo6SkpNHR0f///////////////yH5BAEKAAcALAAAAAAYABgAAAM0 +eHrR/jCsFWulNj+luwReKI5kaZ4oNKxsu3pELM8xTN+eqw9p7//ADqjHSHGMR9Mk6RFMEgA7}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhGAAYAMIFAFiUu1eVvFiVvFmVvazK3v///////////yH5BAEKAAcALAAAAAAYABgAAAMt -eCHc/g8cAKsV9OrNu/9gKI5kyRBoqqJc4b6w28Y0t96Eqe987/+6DGkwIUkSADs=}] +R0lGODlhGAAYAMIGAFiUvFeVvFiVu1iVvFiWvKzK3v///////yH5BAEKAAcALAAAAAAYABgAAAM7 +eHoy/hCKtUi8OFTMoz5d+ByAaJ5oqq5sixZwLMOmYd+4Xee8Of8Fl3BILKpKQ5BQEXB9Ds3Vc6Gi +JAAAOw==}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhGAAYAKUfAEpohElpg0lphUpphEpqhEtqhFBuiFFviVNxild0jV96knSMoHePo4OYq4aa -rY2hspCjs5CjtJiqua68yLnF0MrT28zV3M/X3s/Y39DY39zi5+Tp7fT2+PX3+P7+/v////////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKACAALAAAAAAYABgAAAZvQBBg -QCwaj0ZBABRAOp+DJnRKrVqv2OzUgOk0tMXJ51MBDxae8QN82IwvhSlCwjiKPxwFlfLxQIpoYxFV -fH1/Bm4fFnFUCRpjfnd5V46QaR+DWJVjioyaj3h6YAkZHQ5mqKmqAwKrUqgETK1aSiBBADs=}] +R0lGODlhGAAYAIQeAEpphEpphUtphElqg0tqhFBuiFFviVNxild0jV96knSMoHePo4OYq4aarY2h +spCjs5CjtJiqua68yLnF0MrT28zV3M/X3s/Y39DY39zi5+Tp7fT2+PX3+P7+/v///////yH5BAEK +AB8ALAAAAAAYABgAAAVy4Cd+AWCeKBqMY+q+ZgvPqEjfwIfjwj73vsKFw/C5JB4PxYhSdJIOpsmg +SVoItENkkUJ6NonbxNN5nJxJCG5MNheqngr2hsgky16wr35/etRGfElxc4F2X2FSAAgYHA03QIqS +MDqTOZWTMoosNpE/AywhADs=}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhGAAYAIQaAKKioqOjo6SkpKampqenp6ioqKmpqa2trbi4uLq6usDAwMHBwcXFxcbGxsfH x8vLy9bW1tzc3OTk5OXl5ebm5ufn5+3t7fHx8fr6+v7+/v///////////////////////yH5BAEK -AB8ALAAAAAAYABgAAAVY4CcEZGme6IeubOu+cCzPtDxUmFKXkKZJuwAi42PsCBcf5VV4JE49Debw -imgyjdLQ54BZr9lBUjOJGSw+bHQqO6eJmu7M7SPv6Ow7bhHs+/+AgQEAKn4fIQA7}] +AB8ALAAAAAAYABgAAAVl4Cd+QWmeaDCOaduybnyKcq0Cdq7v7lBhCt4JotFIhCVEpshAEi5FSq3w +SKCIGsyhFtFkGiZl0WHresEDqGaSM1iKX6xW54YvNeRdvbhG7ud+PwtIQjiEJiSHKomHMEgrNDoC +KyEAOw==}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAOMOAFiVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f6+bv9fT4+/b6/P7///// -/////yH5BAEKAA8ALAAAAAAQABAAAAQy8IFJa5U26827BwUjfMHiEB/iJJrAHJPhLIE2NM1ROgZ3 -4IqV5zerDRmFj3LJBGA+jwgAOw==}] +R0lGODlhGAAYAKUfAFiUvFeVvFiVu1iVvFmVvFiWvF6Zvl+Zv2Gav2ScwWuhxH+uy4KwzYy20Y+4 +0pa81Zi+1pm+1qDD2bTQ4b/W5c7g69Dh7NLj7dPj7dTk7t7q8ubv9fX5+/b5+/7+/v////////// +//////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKACAALAAAAAAYABgAAAZ5QJAQ +JBgYj0ikYDgsJJ/QQBNKTUpB1ewRBNB6v2CvAdNphJOTz6dyPi486kd7cNioL4QsQsJAqzkKWhQf +HhBucB8RXoOEhgZ2HxZ5WgkaaoVpH4BglZeIimGdapGToZaagXMJGR0Oc21dr1uyRkIBslcgt225 +Q2dMQQA7}] } 175 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhHAAcAOMIAIiIiIyMjKOjo6SkpKampqioqOrq6uvr6/////////////////////////// -/////yH5BAEKAA8ALAAAAAAcABwAAARk8D1Aq724yhlG+WAoikMAcAeirmzrIoYJCG9tCxRh7y2R -80CED6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wABwzd2wntG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQRAIeHh4iIiImJiY2NjY6Ojo+Pj5+fn6CgoKGhoaampqioqM3Nzc7Ozs/Pz+np +6erq6vv7+////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAcABwAAAWS4Cd+QGCeaIqOrDkcSizP8zEEAvsFRQNFwKBwGIEwCoER70FsNh+FXKnh +rA4ZAQCA8LN6ITcBwkuOHASBRNmbMKnX1XYaHnfTnfL3fZjfE/t+QoCBQIOEhoGIfop7jHeOdG0C +B4RBBgIAA12BYCcMlVhJAgVMfg4ESSI8DJtlEAuoOmgvNLUyNiY6IiVoKr69LCEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhHAAcAOMIAIiIiIuLi5qampubm5ycnJ6ensvLy9nZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAcABwAAARkECFAq724yhlG+WAoikMAcMahrmzrHoYJCG9tDxRh7y2R -88CDD6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wCBFDd2wntG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQQAIeHh4iIiImJiYuLi4yMjI2NjZiYmJmZmZycnJ6enre3t7i4uMrKysvLy9bW +1tnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAcABwAAAWOICRCQGCeaIqOrEkYSSzPs0EEAgsFxeI8wKBw+HAoCoERr0FsNhuFXGnh +rA4XAQCA8LN6HQPcwUt+GAQBRNmLMKnX1XYaHnfTnfL3fZjfE/t+QoCBQIOEhoGIfop7jHeOdG0C +BoRBZ1tdgQ43JgqVWEkCBUx+DDdKPZllRqcsaC80sTI2JjoiJWgqurksIQA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhHAAcAOMJAIiIiIqKipWVlZaWlpeXl5iYmLi4uLm5ucPDw/////////////////////// -/////yH5BAEKAA8ALAAAAAAcABwAAARk8D1Aq724yhlG+WAoikMAcAeirmzrIoYJCG9tDxRh7y2R -80CED6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wABw/dg4nhG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQQAIeHh4iIiImJiYuLi4yMjJOTk5SUlJWVlZeXl5iYmKqqqqurq7i4uLm5ucHB +wcPDw////////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAcABwAAAWOICRCQGCeaIqOrDkYSSzPszEEAgsFw+I8wKBw+HAoCIFRgNAgOp0NQq60 +eFqHiwAAMPhdv46b4PAtPwyCAML8RZjWbKtbHZe/6885HD/U84l+f0KBgkCEhYeCiX+LfI14j3Vu +AgaFQQUCXF6CYScKlllJAkyCDDdKBD51RqcsaS80sTI2JjoiJWkqurksIQA7}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhHAAcAMIEAEpphEpphUpqhNLa4f///////////////yH5BAEKAAcALAAAAAAcABwAAAM1 -eBfQ/jCCoI68uB2Ru/9gKI5kaZ5oqq7R4L4wDBJ0bdvzrdNg7L+soHBILBqPKQ7LsqqoFAkAOw==}] +R0lGODlhHAAcAOMHAElog0lohElphEpphEtphEtqg9La4f////////////////////////////// +/////yH5BAEKAAgALAAAAAAcABwAAARGEEkEhr0448m1/wOHgGQ2lehFpWnBssQrz3Rt33h+GXzv ++6yDcEgkBotIIevH7Ome0Kh0Sq2SBKPnKSfCiSSFQCxFCGAnEQA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhHAAcAMIDAKKioqOjo+jo6P///////////////////yH5BAEKAAQALAAAAAAcABwAAAM1 -SBTc/rCpFasN9GoHtv9gKI5kaZ5oqgps67rfIM80Hde4/L18q/7AoHBILBpVgAxq0jElCQkAOw==}] +R0lGODlhHAAcAMIEAKKioqOjo6SkpOjo6P///////////////yH5BAEKAAcALAAAAAAcABwAAAM+ +eHoQ/jA+saq8ONSTe1xe+DBiaZ5oqq5s677YIM80XRJ4ruv37uOlmnAGKxqPyKTyIigCODCQa9Pa +KFTPRQIAOw==}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhHAAcAMIDAFiUvFiVvNbl7v///////////////////yH5BAEKAAQALAAAAAAcABwAAAM7 -SBQQ/jDGppa8GNrMJWhdKI5kaZ5oqq5sGwpwLMvjYN84Xue8Pc7AmGtILBqPyOQDpEQBNqzKJ/VR -JAAAOw==}] +R0lGODlhHAAcAOMIAFmUvFeVvFiVvFmVu1mVvFiWvFiWvdbl7v////////////////////////// +/////yH5BAEKAA8ALAAAAAAcABwAAARK8Mk3grg462umJ1sYEt4jnuEEoixGtfBVxHR9rnau73zv +a4egcDiMIY7IZNKobB5jxKjwR61arzbcz1I1VAEPLW/yK/VKEh14EgEAOw==}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhHAAcAKUiAEpphEpphUpqhEtqhE1rhlVyi1VyjF97kmV/lmaAl2eBmGmDmWqDmmuEmoKX -qoOZq5GktJKktaGxv7TBzMLM1sPN1s7W3tPb4dng5drg5t7j6N7k6eLn6+7x8/Hz9fX3+Pn6+/r7 -/P////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAZ8wN8v -ACgaj8gkICD8KZ/Q4k8QrVqv2Kx2y+1aERyPw2skZEQiDbkoQYsoawUI/TmQCRg35JqoTApIbWgW -A1cXaBgGRgshdHaGbokAZm4RWQwekQaCIoRaDZloG40idVwKHW56XqCqnqyhpmsLYQ9rt7i5ukhU -uk65TbhCQQA7}] +R0lGODlhHAAcAKUlAElog0lohElphEpphEtphEtqg0tqhE1rhlVyi1VyjF97kmV/lmaAl2eBmGmD +mWqDmmuEmoKXqoOZq5GktJKktaGxv7TBzMLM1sPN1s7W3tPb4dng5drg5t7j6N7k6eLn6+7x8/Hz +9fX3+Pn6+/r7/P////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaMwJ/w +BxgYj8gkcshUOp8D5g9KTQ6r2CMxmy1wuYSvmLv4hCJj5YFTKnXSyUq7dIEfG6O2SGEfHDZzE1kM +GBYIcXMZBlkabRsJRw4kenyMc49+bG0UXw8hlwlybYpiEJ9tHpMle2kNIHOBdqawpLKnrH0DDmYS +ub6/wEYCU8BXvlK5UkIFAWFZBAHDQ0EAOw==}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhHAAcAIQZAKKioqOjo6SkpKioqKmpqa6urrGxsbKysrOzs7S0tL+/v8DAwMfHx8/Pz9nZ 2eDg4Obm5unp6ezs7O7u7vDw8Pb29vj4+Pr6+vz8/P///////////////////////////yH5BAEK -AB8ALAAAAAAcABwAAAVy4PcFZGmeaCmOaesG7CubwGzfeK7vPGpQFkWvJJBkMpMhqXHMPJQHzPFS -GBabDJvh4RicmEfILXKUEEoIaYY6bpoD12P2hrC4CeCMOJewHydqbDoHFU1YPX2Ge4h+gkMIQAtK -k5SVlpcnADGTKzVDmh8hADs=}] +AB8ALAAAAAAcABwAAAV74Cd+QGCeaHoKY6u+cNB+cZ2Odn6Seu//wCDMQLEohCiBJJOZIE8NZubx +DBwwzEvhqZQydIaHY5CKMiG9CFNCOCGwGW1ayg50md8ewkInmDNoPwl8TBNwckAHFVJeSIOMgY6E +iE8IRQtVmZoCmiYANJ04mTNVMyJCnyMhADs=}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhHAAcAKUgAFiUvFiVvFmVvFuXvWKbwGKcwGyhxHGlxnKlxnOmx3WnyHWoyHaoyIy20Y23 -0Zm/1pq/16nI3LrT48fb6Mfc6dLi7dbl79zp8d3p8eDr8+Hs8+Tu9O/1+fL3+vb5+/r8/f////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaBwN8v -AAgYj8hksigcKp9QpDNKVQKK1ax2y+16v9nDptMAIwcYEChjPkbUoEk7kPioPYb24AJ/aBEUEgRJ -b2oVAloWahcFRwp2IHhbiouNaHAQXAsdcIyFIIddDJxqGpCSXgkccH1mo6yhrqSobQpjDnO5urtH -WLy8AFO5TVdmV0JBADs=}] +R0lGODlhHAAcAKUkAFmUvFeVvFiVvFmVu1mVvFiWvFiWvVuXvWKbwGKcwGyhxHGlxnKlxnOmx3Wn +yHWoyHaoyIy20Y230Zm/1pq/16nI3LrT48fb6Mfc6dLi7dbl79zp8d3p8eDr8+Hs8+Tu9O/1+fL3 ++vb5+/r8/f////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaQwJ/w +NwgIjsik8mgYOgnLaJTg/Emv0SEUy0USu+BjIUwuX7flxScUMS8PHBKp41ZW5KRLHdkYyUUKewIH +G3gTYAwYFgh2eBloWBpyGwlIDn4kgGGSk5VweBRkDyF4lHdyj2UQpHIemJpmDSB4hnurtKm2rLCC +DmsSYJCCR0bDSQbGSAA/wntDyVXDVUJ1y0NBADs=}] } 200 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAIiIiImJiaqqqqurq/Hx8fLy8v///////yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9dBTDu/9gVwhAwGxhqhqEs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7NRSN32EYOO6VdedbmraeOVDSVkMATxJIAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQRAIeHh4iIiImJiYuLi4yMjJWVlbq6uru7u7y8vOTk5OXl5ebm5unp6erq6vj4 ++Pn5+fr6+v///////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWZ4CeKQWmeaBqM7CeocAy05XAoUKTvfB9BisOgNHoVGr6kMsIoED8BAnJJ +5TGG0ACiyt0ZTotuVxF4BR5i7uOU7rLb1Td8KZ8n6/YePr/b8yN+fIF5g3aFc4dwiW2LaY1ij24m +aH87DicKlTsJZSUHmjpfKwEDDJpXKx8AAQWmfE0BMySkBgmUYg8JBkOpIzG/Ki2+ZsAoLy0hADs=}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhIAAgAMIHAIiIiImJiZ+fn6CgoM/Pz9DQ0NnZ2f///yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9dBTDu/9gVwhAwGxhqhqEs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7NRSN32EYOO6VdedbmraeOVDSVkMATxJIAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQQAIeHh4iIiImJiYqKipGRkaqqqqurq8bGxsfHx8jIyMrKysvLy9TU1NXV1dbW +1tnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAgACAAAAWYICSKQWmeaBqMLCSocAy05WAgzqPvfP84CMOgNHoRFr6k8qEgECGBAXJJ +5SmG0IChyt0VToluFxF4BRpibuOU7rLb1Td8KZ8n6/YePr/b8x9+fIF5g3aFc4dwiW2LaY1ij24m +aH87DCcIlTsHZSVbmg9fK1EKmlcrEAABBKV8TQEzJFEFB5RiDQcFQ6gjMb4qLb1mvygvLSEAOw==}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAIiIiImJiZmZmby8vL29vcPDw////////yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9VIzCu/9gRwhAwBBhqnKDs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7LRSN32EYOO6VdedbmraeOVDVVkMAZw5IAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQRAIeHh4iIiImJiYqKio6Ojo+Pj6GhoaKiorW1tba2tre3t7i4uLm5ub+/v8DA +wMHBwcPDw////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWV4CeKQWmeaBqM7CeocAy0pWAkD6TvfA89CcNrJXoRGL6kErIglEgD5HLK +W7w+pQN1uzOcFFxuIjB0hLeO05mrXlPb7iU8npzTe/b7Lq+H8PV/d4F0g3GFbodriWeLYY1sJmZ9 +Ow0nCZM7CGQlBpg6XitkC5hWRAABBKN6CwUBMyRkBgiSYQ4IQk8sMbsqLSObvClXLCEAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhIAAgAMIEAElphEpphEpphUpqg////////////////yH5BAEKAAcALAAAAAAgACAAAAM4 -eBfc/hAKtaK9r+LNu/9gKI5kaZ5oqq5sS7xwLBPgbMP1bee63P7AoHBILBqPKcFvoFEBKCvmIQEA -Ow==}] +R0lGODlhIAAgAOMIAEpohUtohEpphEpphUtphEtphUpqhEtqhP////////////////////////// +/////yH5BAEKAA8ALAAAAAAgACAAAART8ElpiLg4a0zA/E+xjSQ2gGVaTmq7HZIrY48xz8B9W3rv +/8CgcEgszhDIpHKJuDGfSSf0KZ0ujdisdsvten857UP8GGANk4ARdBiiQZIcT8YDRQAAOw==}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhIAAgAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAgACAAAAM3 -SBTc/jAqAqK9b+F9Bf9gKI5kaZ5oqq5s65pDLM/0INa4fOf4ztOvoHBILBqPyKSSpHFNPCxFAgA7}] +R0lGODlhIAAgAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAgACAAAANF +SKoi8TBK6JYlM+soLtigtjhhKSlmChGk6r5wLM90bd94Lg987/8DF3DYExKHxuNPx2w6n9CodCpq +MnQdFC67uHEvtEsCADs=}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAFeUvFiUvFeVvFiVvFiVvVmVvP///////yH5BAEKAAcALAAAAAAgACAAAAM/ -eAc1/jDKV4Q6YeodF/9b0YBkaZ5oqq5s675wLM+pYd94bpx6f/O+HjCYoxmPyKRyyWweRzSBkXAw -XqAu6iEBADs=}] +R0lGODlhIAAgAOMHAFiUvFmUvFiVu1iVvFiVvVmVvFiWvf////////////////////////////// +/////yH5BAEKAAgALAAAAAAgACAAAARXEEk5qr04l8mRyWBoAV0hniApCWiLCZQrV8hsE4EtE7ps +9sCgcEgsGo+Dg3LJbB5szugSKo1Sq02kdsvteom/bW5LCCMDta0EoJbwjBsOq9iZEN43NCcCADs=}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhIAAgAIQYAElphEpphEpphUpqg0tqhGB7k2J9lICWqYGWqYOZq4WarIaarYicrpKltZOm -tpusu83V3c/X3tDY3+zv8u3w8vb3+ff5+vz9/f///////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAWG4PcFZGmeKCqIY+q+ZwvPdG3feK7vfO+XCArl8DMVKhjMpEgiRJJKZsAB -xTSYR6iEUCRAoBbD7SBUoKhQB26SvDCMyGSEe2O33wEntFLIKS5QblNVajoMgG0PcRhzPAuIVRhh -PoeRGIWUkIx0P49Jk1IJQghSpaanqKkmAqgDMlIALKWuHyEAOw==}] +R0lGODlhIAAgAIQbAEpohUtohEpphEpphUtphEtphUpqhEtqhGB7k2J9lICWqYGWqYOZq4WarIaa +rYicrpKltZOmtpusu83V3c/X3tDY3+zv8u3w8vb3+ff5+vz9/f///////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWj4CeKBiGcaKqiBDC+X7HONDrAdV6Per8eIp8Q9TEMh4Dj0aRsHheXi8JJ +Q2A2Gwv1R8Fmt6qIdwMBo6zeysEsOEy8mcRQEW2sxN7I0YLVPFJoWBRrQ3x9f21dWBgISg0aXn4C +eFh6TQ+QfRJXgoRNDpljG3FgmKIblqWhG4NsAqBYpK4CDFELs7izSbknH7wCIgO5BiMBuDCeW8Qw +IklMQkwwIQA7}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhIAAgAIQUAKKioqOjo6SkpK6urq+vr76+vr+/v8DAwMHBwcLCwsjIyMzMzOXl5ebm5ufn 5/X19fb29vr6+vv7+/7+/v///////////////////////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAV/4PcFZGmeaCp+QOq+5wjPr0DfeK7vfO//OgMEUgCeBhEK5WE0NZTLJkkB -pSikSKhDGmBAJYRcYYhAUaHX3EM5SZiyysZuzXaTnsrIYIeYQNsBZ0ppOwl+bAtJcT99VV9hP4aO -Vk2SUHJSjRRgXAEHQwadoqOkpaakMqIrNlwiIQA7}] +AB8ALAAAAAAgACAAAAWQ4CeKghCcaKqi5uh+ayynwgvMuDyaea+KviDqwxMaj8ikcmaAQArL1SBC +oTyiqkbVikUpthRFNzDdOsYBxlZCEBaciNV3KxY+qpNEqlxtHO94eidaVREDRwgTW3kBc1V1RwmK +eAtUfUuJYGttS5KaYV2eW35jmRRsaAEHTgaprq+pMK8krjVAaLYjY7kvUS8hADs=}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhIAAgAIQYAFeUvFiUvFeVvFiVvFiVvVmVvGyixG6jxYq10I230Y630o+40pG505u/15vA -16PE2tDh7NLj7dTk7u30+O70+Pb6/Pj6/Pz9/v///////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAWP4PcBxWCeaKqehSB+wSrP6Ujfc1HifO//wKBwSOwhKBREMWWoYDCTJSvy -hEpNjiqmcW1WJbtiAVK1HHxHikKVrTp+k+eFgfI+I2FeXE4fFKhPFQZAChdVcwNtT29BDIZyD053 -eT8Lj1oYZkWOmBiMm5cYeFeWT5pXAwlISqitrq+wJpSoArAEH7Avs0O3HyEAOw==}] +R0lGODlhIAAgAIQZAFiUvFmUvFiVu1iVvFiVvVmVvFiWvWyixG6jxYq10I230Y630o+40pG505u/ +15vA16PE2tDh7NLj7dTk7u30+O70+Pb6/Pj6/Pz9/v///////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWo4CeKQ2meaFqM7GekcGwCbSHfMC0KeI8KJJ+w9BkaCQGjkKAU2pqlRKWS +gMYOlkyGYlVJtNsu6gHOOMQmLHjyFBci4AtiKK0sUmTww0jRYhonaloSbT59foADBV9aFgdKCxhg +fwN5WntNDZJ+EFmDhUYMm2UZcmKapBmYp6MZhGglolqmsCUKU1VOtSlJuyYEoLUBRb5EHwDFAyNM +tSssPLAty8xHwywhADs=}] } } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl index f09fbda8..84544ab4 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl @@ -3,7 +3,7 @@ # Checkbutton.image_ind and Radiobutton.image_ind of the alt, clam, and default # themes. # -# Copyright (c) 2022-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2022-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== #------------------------------------------------------------------------------ @@ -260,52 +260,52 @@ proc themepatch::default::createCheckbtnIndImgs_svg fmt { variable ckIndArr set ckIndArr(default) [image create photo -format $fmt -data { - + }] set ckIndArr(disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(pressed) [image create photo -format $fmt -data { - + }] set ckIndArr(alternate) [image create photo -format $fmt -data { - + }] set ckIndArr(alt_disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(alt_pressed) [image create photo -format $fmt -data { - + }] set ckIndArr(selected) [image create photo -format $fmt -data { - + }] set ckIndArr(sel_disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(sel_pressed) [image create photo -format $fmt -data { - + }] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/tclIndex similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/indicatorImgs/tclIndex diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/mwutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/mwutil.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/mwutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/mwutil.tcl index c245eaca..fbe155e9 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/mwutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/mwutil.tcl @@ -8,7 +8,9 @@ # Copyright (c) 2000-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} # # Namespace initialization @@ -19,7 +21,7 @@ namespace eval mwutil { # # Public variables: # - variable version 2.22 + variable version 2.23 variable library [file dirname [file normalize [info script]]] # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/pkgIndex.tcl similarity index 55% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/pkgIndex.tcl index 7407d501..1b34e0a8 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/pkgIndex.tcl @@ -4,6 +4,6 @@ # Copyright (c) 2020-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package ifneeded mwutil 2.22 [list source [file join $dir mwutil.tcl]] -package ifneeded scaleutil 1.12 [list source [file join $dir scaleutil.tcl]] -package ifneeded themepatch 1.6 [list source [file join $dir themepatch.tcl]] +package ifneeded mwutil 2.23 [list source [file join $dir mwutil.tcl]] +package ifneeded scaleutil 1.14.1 [list source [file join $dir scaleutil.tcl]] +package ifneeded themepatch 1.8 [list source [file join $dir themepatch.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/scaleutil.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/scaleutil.tcl index b4c46110..7b6aafd9 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/scaleutil.tcl @@ -9,7 +9,9 @@ # Copyright (c) 2020-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} # # Namespace initialization @@ -20,7 +22,7 @@ namespace eval scaleutil { # # Public variables: # - variable version 1.12 + variable version 1.14.1 variable library [file dirname [file normalize [info script]]] # @@ -140,6 +142,7 @@ proc scaleutil::scalingPercentage winSys { result] == 0 && [set idx \ [string first "'Gdk/WindowScalingFactor'" $result]] >= 0} { + ##nagelfar ignore scan [string range $result $idx end] "%*s <%d>" winScalingFactor } @@ -388,6 +391,7 @@ proc scaleutil::scaleX11Fonts factor { set str [string range $str $idx end] set idx [string first "size" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 9 : $size}] ;# -12 -> 9, else 10 foreach font {TkDefaultFont TkTextFont TkHeadingFont @@ -396,6 +400,7 @@ proc scaleutil::scaleX11Fonts factor { } set idx [string first "ttsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 8 : $size}] ;# -10 -> 8, else 9 foreach font {TkTooltipFont TkSmallCaptionFont} { @@ -403,11 +408,13 @@ proc scaleutil::scaleX11Fonts factor { } set idx [string first "capsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 11 : $size}] ;# -14 -> 11, else 12 font configure TkCaptionFont -size [expr {$factor * $points}] set idx [string first "fixedsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 9 : $size}] ;# -12 -> 9, else 10 font configure TkFixedFont -size [expr {$factor * $points}] @@ -545,7 +552,11 @@ proc scaleutil::scaleStyles_clam pct { #------------------------------------------------------------------------------ proc scaleutil::scaleStyles_classic pct { ttk::style theme settings classic { - set scrlbarWidth [scale 15 $pct] + if {[ttk::style lookup . -borderwidth] == 1} { + set scrlbarWidth [scale 12 $pct] + } else { + set scrlbarWidth [scale 15 $pct] + } ttk::style configure TScrollbar \ -arrowsize $scrlbarWidth -width $scrlbarWidth diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/themepatch.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/themepatch.tcl similarity index 90% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/themepatch.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/themepatch.tcl index cb74373d..decc508d 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/themepatch.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/utils/themepatch.tcl @@ -10,12 +10,18 @@ # Copyright (c) 2022-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.8- + if {[catch {package require tile 0.8-}]} { + package require tile 0.8 + } } if {![info exists ::tk::scalingPct]} { ;# earlier than Tk 8.7b1 - package require scaleutil 1.10- + if {[catch {package require scaleutil 1.10-}]} { + package require scaleutil 1.10 + } } # @@ -27,7 +33,7 @@ namespace eval themepatch { # # Public variables: # - variable version 1.6 + variable version 1.8 variable library [file dirname [file normalize [info script]]] # @@ -75,6 +81,7 @@ proc themepatch::patch args { } } + set currentTheme [getCurrentTheme] foreach theme $args { if {[lsearch -exact {alt clam default} $theme] < 0} { return -code error \ @@ -110,10 +117,12 @@ proc themepatch::patch args { } } - # - # Send a <> virtual event to all widgets - # - ::ttk::ThemeChanged + if {$theme eq $currentTheme} { + # + # Send a <> virtual event to all widgets + # + ::ttk::ThemeChanged + } } } @@ -133,6 +142,7 @@ proc themepatch::unpatch args { } } + set currentTheme [getCurrentTheme] foreach theme $args { if {[lsearch -exact {alt clam default} $theme] < 0} { return -code error \ @@ -143,10 +153,12 @@ proc themepatch::unpatch args { unpatch_$theme $pct } - # - # Send a <> virtual event to all widgets - # - ::ttk::ThemeChanged + if {$theme eq $currentTheme} { + # + # Send a <> virtual event to all widgets + # + ::ttk::ThemeChanged + } } } @@ -172,6 +184,23 @@ proc themepatch::ispatched theme { # ========================= # +#------------------------------------------------------------------------------ +# themepatch::getCurrentTheme +# +# Returns the current tile theme. +#------------------------------------------------------------------------------ +proc themepatch::getCurrentTheme {} { + if {[catch {ttk::style theme use} result] == 0} { + return $result + } elseif {[info exists ::ttk::currentTheme]} { + return $::ttk::currentTheme + } elseif {[info exists ::tile::currentTheme]} { + return $::tile::currentTheme + } else { ;# this is highly improbable + return "" + } +} + #------------------------------------------------------------------------------ # themepatch::patch_alt # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/wheelEvent.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/wheelEvent.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/wheelEvent.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/wheelEvent.tcl index 8bd115a3..c0614707 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/wheelEvent.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scripts/wheelEvent.tcl @@ -13,7 +13,7 @@ # - Public procedures # - Private procedures # -# Copyright (c) 2019-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2019-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # @@ -173,6 +173,7 @@ proc scrollutil::createBindings {} { foreach event $eventList { if {[string match <*Button-?> $event]} { + ##nagelfar ignore bind WheeleventRedir $event [format { if {![scrollutil::hasFocus %%W] || ![scrollutil::isCompatible %s %%W]} { @@ -182,6 +183,7 @@ proc scrollutil::createBindings {} { } } $event $event] } else { + ##nagelfar ignore bind WheeleventRedir $event [format { if {![scrollutil::hasFocus %%W] || ![scrollutil::isCompatible %s %%W]} { @@ -200,14 +202,15 @@ proc scrollutil::createBindings {} { bind WheeleventRedir { if {![scrollutil::hasFocus %W] || ![scrollutil::isCompatible %W]} { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {%# %% 5 == 0 && $deltaX != 0} { + lassign [tk::PreciseScrollDeltas %D] \ + scrollutil::dX scrollutil::dY + if {%# %% 5 == 0 && $scrollutil::dX != 0} { event generate [winfo toplevel %W] \ - -rootx %X -rooty %Y -delta [expr {40 * $deltaX}] + -rootx %X -rooty %Y -delta [expr {40 * $scrollutil::dX}] } - if {%# %% 5 == 0 && $deltaY != 0} { + if {%# %% 5 == 0 && $scrollutil::dY != 0} { event generate [winfo toplevel %W] \ - -rootx %X -rooty %Y -delta [expr {40 * $deltaY}] + -rootx %X -rooty %Y -delta [expr {40 * $scrollutil::dY}] } break } @@ -332,23 +335,31 @@ proc scrollutil::addMouseWheelSupport {tag {axes "xy"}} { set script "if {%# %% 5 != 0} " append script [expr {$isWindow ? "break" : "return"}] append script { - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY + lassign [tk::PreciseScrollDeltas %D] scrollutil::dX scrollutil::dY } switch $axes { xy { append script { - if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] units } - if {$deltaY != 0} { %W yview scroll [expr {-$deltaY}] units } + if {$scrollutil::dX != 0} { + %W xview scroll [expr {-$scrollutil::dX}] units + } + if {$scrollutil::dY != 0} { + %W yview scroll [expr {-$scrollutil::dY}] units + } } } x { append script { - if {$deltaX != 0} { %W xview scroll [expr {-$deltaX}] units } + if {$scrollutil::dX != 0} { + %W xview scroll [expr {-$scrollutil::dX}] units + } } } y { append script { - if {$deltaY != 0} { %W yview scroll [expr {-$deltaY}] units } + if {$scrollutil::dY != 0} { + %W yview scroll [expr {-$scrollutil::dY}] units + } } } } @@ -455,16 +466,17 @@ proc scrollutil::createWheelEventBindings args { if {$touchpadScrollSupport} { bind $tag { if {%# %% 5 != 0} { - return + continue } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { + lassign [tk::PreciseScrollDeltas %D] \ + scrollutil::dX scrollutil::dY + if {$scrollutil::dX != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaX}] + -delta [expr {40 * $scrollutil::dX}] } - if {$deltaY != 0} { + if {$scrollutil::dY != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaY}] + -delta [expr {40 * $scrollutil::dY}] } } } @@ -538,8 +550,7 @@ proc scrollutil::disableScrollingByWheel args { return -code error "bad window path name \"$swc\"" } - set idx [lsearch -exact $scrlWidgetContList $swc] - if {$idx < 0} { + if {[set idx [lsearch -exact $scrlWidgetContList $swc]] < 0} { continue } @@ -631,8 +642,7 @@ proc scrollutil::adaptWheelEventHandling args { set w2 [expr {$class eq "Ctext" ? "$w.t" : $w}] set tagList [bindtags $w2] foreach tag {WheeleventRedir WheeleventBreak} { - set idx [lsearch -exact $tagList $tag] - if {$idx >= 0} { + if {[set idx [lsearch -exact $tagList $tag]] >= 0} { set tagList [lreplace $tagList $idx $idx] } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil.tcl similarity index 88% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil.tcl index d15d4980..0b08b6c2 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil.tcl @@ -4,8 +4,7 @@ # Copyright (c) 2019-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- -package require -exact scrollutil::common 2.2 +package require -exact scrollutil::common 2.4 package provide scrollutil $::scrollutil::version package provide Scrollutil $::scrollutil::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutilCommon.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutilCommon.tcl similarity index 91% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutilCommon.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutilCommon.tcl index 3acdca44..2544ae43 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutilCommon.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutilCommon.tcl @@ -5,10 +5,14 @@ #============================================================================== namespace eval ::scrollutil { + proc - {} { return [expr {$::tcl_version >= 8.5 ? "-" : ""}] } + + package require Tk 8.4[-] + # # Public variables: # - variable version 2.2 + variable version 2.4 variable library [file dirname [file normalize [info script]]] # @@ -85,15 +89,15 @@ lappend auto_path [file join $::scrollutil::library scripts] # proc ::scrollutil::loadUtils {} { if {[catch {package present mwutil} version] == 0 && - [package vcompare $version 2.22] < 0} { + [package vcompare $version 2.23] < 0} { package forget mwutil } - package require mwutil 2.22- + package require mwutil 2.23[-] if {[catch {package present scaleutil} version] == 0 && - [package vcompare $version 1.12] < 0} { + [package vcompare $version 1.14.1] < 0} { package forget scaleutil } - package require scaleutil 1.12- + package require scaleutil 1.14.1[-] } ::scrollutil::loadUtils diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil_tile.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil_tile.tcl similarity index 90% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil_tile.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil_tile.tcl index 43810c33..44f8d3d7 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scrollutil_tile.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/scrollutil/scrollutil_tile.tcl @@ -4,11 +4,11 @@ # Copyright (c) 2019-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +package require -exact scrollutil::common 2.4 + if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.8- + package require tile 0.6[::scrollutil::-] } -package require -exact scrollutil::common 2.2 package provide scrollutil_tile $::scrollutil::version package provide Scrollutil_tile $::scrollutil::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/pkgIndex.tcl new file mode 100644 index 00000000..0735929f --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/pkgIndex.tcl @@ -0,0 +1,3 @@ +package ifneeded shtmlview::shtmlview 1.1.2 [list source [file join $dir shtmlview.tcl]] +package ifneeded shtmlview::doctools 0.1 [list source [file join $dir shtmlview-doctools.tcl]] +package ifneeded shtmlview::mkdoc 0.1 [list source [file join $dir shtmlview-mkdoc.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview-doctools.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview-doctools.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview-doctools.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview-doctools.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview-mkdoc.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview-mkdoc.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview-mkdoc.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview-mkdoc.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview.tcl index c59c9bf8..8cebd831 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/shtmlview/shtmlview.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/shtmlview/shtmlview.tcl @@ -106,7 +106,7 @@ package require Tcl 8.5- package require Tk package require snit -package provide shtmlview::shtmlview 1.1.0 +package provide shtmlview::shtmlview 1.1.2 # Optional packages supporting various features (jpeg images, tile/themes) # Markdown support - See bottom @@ -385,7 +385,7 @@ namespace eval ::shtmlview { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } } - if {$tcl_platform(platform) != "windows"} { + if {$::tcl_platform(platform) != "windows"} { bind HelpText { if {!$tk_strictMotif} { tk::TextScrollPages %W 1 @@ -415,7 +415,7 @@ namespace eval ::shtmlview { # Macintosh only bindings: # if text black & highlight black -> text white, other text the same - if {$tcl_platform(platform) == "macintosh"} { + if {$::tcl_platform(platform) == "macintosh"} { bind HelpText { %W tag configure sel -borderwidth 0 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText @@ -1907,7 +1907,7 @@ namespace eval ::shtmlview { set var(tabletext) "" set var(tablecols) [list] set var(tablemode) false - } + } proc HMtag_tr {selfns win param text} { upvar #0 HM$win var upvar $text data @@ -3248,32 +3248,37 @@ namespace eval ::svgconvert { package require critcl } if {[info command ::critcl::compiling] ne "" && [critcl::compiling]} { + # ensure that these are in the namespace, and not global + variable options + variable dirs + variable dir + variable i + catch { - set options [regsub -all -- -I [exec pkg-config --cflags --libs cairo --libs librsvg-2.0] "I "] - set dirs [list] - foreach {i dir} $options { - if {$i eq "I"} { - lappend dirs $dir - } - } - critcl::clibraries -lrsvg-2 -lm -lgio-2.0 -lgdk_pixbuf-2.0 -lgobject-2.0 -lglib-2.0 -lcairo -pthread - critcl::config I $dirs - critcl::ccode { - #include - #include - #include - #include - #include - #include - } - - - critcl::cproc svgconvert {char* svgfile char* outfile double scalex double scaley} void { - // new - char *epdf = ".pdf"; - char *esvg = ".svg"; - char *pdf = strstr(outfile, epdf); - char *svg = strstr(outfile, esvg); + set options [regsub -all -- -I [exec pkg-config --cflags --libs cairo --libs librsvg-2.0] "I "] + set dirs [list] + foreach {i dir} $options { + if {$i eq "I"} { + lappend dirs $dir + } + } + critcl::clibraries -lrsvg-2 -lm -lgio-2.0 -lgdk_pixbuf-2.0 -lgobject-2.0 -lglib-2.0 -lcairo -pthread + critcl::config I $dirs + critcl::ccode { + #include + #include + #include + #include + #include + #include + } + + critcl::cproc svgconvert {char* svgfile char* outfile double scalex double scaley} void { + // new + char *epdf = ".pdf"; + char *esvg = ".svg"; + char *pdf = strstr(outfile, epdf); + char *svg = strstr(outfile, esvg); RsvgHandle *handle; //RsvgDimensionData dimension_data; // deprecated diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/style/as.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/style/as.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/style/as.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/style/as.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/style/lobster.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/style/lobster.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/style/lobster.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/style/lobster.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/style/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/style/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/style/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/style/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/style/style.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/style/style.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/style/style.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/style/style.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/swaplist/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/swaplist/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/swaplist/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/swaplist/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/swaplist/swaplist.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/swaplist/swaplist.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/swaplist/swaplist.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/swaplist/swaplist.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/pkgIndex.tcl similarity index 61% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/pkgIndex.tcl index ad5797c3..7dd1779c 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/pkgIndex.tcl @@ -7,21 +7,21 @@ # # Regular packages: # -package ifneeded tablelist 7.2 \ +package ifneeded tablelist 7.4.1 \ [list source [file join $dir tablelist.tcl]] -package ifneeded tablelist_tile 7.2 \ +package ifneeded tablelist_tile 7.4.1 \ [list source [file join $dir tablelist_tile.tcl]] # # Aliases: # -package ifneeded Tablelist 7.2 \ - [list package require -exact tablelist 7.2] -package ifneeded Tablelist_tile 7.2 \ - [list package require -exact tablelist_tile 7.2] +package ifneeded Tablelist 7.4.1 \ + [list package require -exact tablelist 7.4.1] +package ifneeded Tablelist_tile 7.4.1 \ + [list package require -exact tablelist_tile 7.4.1] # # Code common to all packages: # -package ifneeded tablelist::common 7.2 \ +package ifneeded tablelist::common 7.4.1 \ [list source [file join $dir tablelistCommon.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/pencil.cur b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/pencil.cur similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/pencil.cur rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/pencil.cur diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistBind.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistBind.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistBind.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistBind.tcl index d58e42e5..955d143a 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistBind.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistBind.tcl @@ -109,6 +109,7 @@ proc tablelist::delaySashPosUpdates {w ms} { # # Check the second argument # + ##nagelfar ignore if {[catch {format "%d" $ms} result] != 0} { ;# integer check with error msg return -code error $result } @@ -449,17 +450,22 @@ proc tablelist::updateFonts win { doConfig $win -labelfont $data(-labelfont) foreach name [array names data ?*-font] { + ##nagelfar ignore if {[scan $name "%d-%s" col dummy] == 2} { doColConfig $col $win -font $data($col-font) + ##nagelfar ignore } elseif {[scan $name "k%d-%s" num dummy] == 2} { set row [keyToRow $win [set key k$num]] doRowConfig $row $win -font $data($key-font) + ##nagelfar ignore } elseif {[scan $name "hk%d-%s" num dummy] == 2} { set row [hdr_keyToRow $win [set key hk$num]] doRowConfig h$row $win -font $data($key-font) + ##nagelfar ignore } elseif {[scan $name "k%d,%d-%s" num col dummy] == 3} { set row [keyToRow $win [set key k$num]] doCellConfig $row $col $win -font $data($key,$col-font) + ##nagelfar ignore } elseif {[scan $name "hk%d,%d-%s" num col dummy] == 3} { set row [hdr_keyToRow $win [set key hk$num]] doCellConfig h$row $col $win -font $data($key,$col-font) @@ -467,6 +473,7 @@ proc tablelist::updateFonts win { } foreach name [array names data ?*-labelfont] { + ##nagelfar ignore if {[scan $name "%d-%s" col dummy] == 2} { doColConfig $col $win -labelfont $data($col-labelfont) } @@ -592,7 +599,7 @@ proc tablelist::updateConfiguration win { foreach opt {-background -foreground -disabledforeground -stripebackground -selectbackground -selectforeground -selectborderwidth -font -labelforeground -labelfont - -labelborderwidth -labelpady -treestyle} { + -labelborderwidth -labelpady -treestyle -targetcolor} { if {$data($opt) eq $tmp($opt)} { doConfig $win $opt $themeDefaults($opt) } @@ -780,7 +787,8 @@ proc tablelist::updateAppearance win { # variable themeDefaults foreach opt {-background -foreground -disabledforeground -stripebackground - -selectbackground -selectforeground -labelforeground} { + -selectbackground -selectforeground -labelforeground + -targetcolor} { if {$data($opt) eq $tmp($opt)} { doConfig $win $opt $themeDefaults($opt) } @@ -831,6 +839,7 @@ proc tablelist::updateAppearance win { # corresponding to systemSelectedTextBackgroundColor on the Mac. #------------------------------------------------------------------------------ proc tablelist::condOpenPipeline {} { + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$majorOSVersion < 18 || ($::tk_patchLevel ne "8.6.10" && $::tk_patchLevel ne "8.7a3")} { @@ -908,7 +917,16 @@ proc tablelist::defineTablelistBody {} { clickedExpCollCtrl 0 } + bind TablelistBody { + tablelist::addActiveTag [tablelist::getTablelistPath %W] + } + bind TablelistBody { + if {"%d" ne "NotifyInferior"} { + tablelist::removeActiveTag [tablelist::getTablelistPath %W] + } + } foreach event { } { + ##nagelfar ignore bind TablelistBody $event [format { tablelist::handleMotionDelayed %%W %%x %%y %%X %%Y %%m %s } $event] @@ -1278,16 +1296,16 @@ proc tablelist::defineTablelistBody {} { if {[llength [info commands ::tk::PreciseScrollDeltas]] != 0} { bind TablelistBody { if {%# %% 5 != 0} { - return + continue } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { + lassign [tk::PreciseScrollDeltas %D] tablelist::dX tablelist::dY + if {$tablelist::dX != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaX}] + -delta [expr {40 * $tablelist::dX}] } - if {$deltaY != 0} { + if {$tablelist::dY != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaY}] + -delta [expr {40 * $tablelist::dY}] } } } @@ -1317,6 +1335,7 @@ proc tablelist::defineTablelistBody {} { } [bind Listbox $event]] if {$script ne ""} { + ##nagelfar ignore bind TablelistBody $event [format { if {[winfo exists %%W]} { foreach {tablelist::W tablelist::x tablelist::y} \ @@ -1748,6 +1767,7 @@ proc tablelist::condEditContainingCell {win x y} { set w $data(body) incr x -[winfo x $w] incr y -[winfo y $w] + ##nagelfar ignore scan [$w index @$x,$y] "%d.%d" line charPos doEditCell $win $row $col 0 "" $charPos } else { @@ -2171,6 +2191,7 @@ proc tablelist::motion {win row col {checkIfDragSrc 0}} { if {[::$win cget -showbusycursor]} { ::$win setbusycursor } foreach cellIdx $priv(selection) { ;# can take long + ##nagelfar ignore scan $cellIdx "%d,%d" r c if {([cellInRect $r $c $rMin1 $cMin1 $rMax1 $cMax1] || [cellInRect $r $c $rMin2 $cMin2 $rMax2 $cMax2]) && @@ -2300,7 +2321,8 @@ proc tablelist::condShowTarget {win y} { if {$data(targetChildIdx) == 0} { place $data(rowGap) -anchor w -y $gapY -height $lineHeight -width 6 } else { - place $data(rowGap) -anchor w -y $gapY -height 4 \ + variable scaled4 + place $data(rowGap) -anchor w -y $gapY -height $scaled4 \ -width [winfo width $data(hdrTxtFrm)] } raise $data(rowGap) @@ -3449,6 +3471,7 @@ proc tablelist::handleWheelEvent {event axis W X Y delta divisor} { #------------------------------------------------------------------------------ proc tablelist::defineTablelistHeader {} { foreach event { } { + ##nagelfar ignore bind TablelistHeader $event [format { tablelist::hdr_handleMotionDelayed %%W %%x %%y %%X %%Y %s } $event] @@ -3625,6 +3648,7 @@ proc tablelist::defineTablelistSubLabel {} { "%W" "$tablelist::W" "%x" "$tablelist::x" "%y" "$tablelist::y" } [bind TablelistLabel $event]] + ##nagelfar ignore bind TablelistSubLabel $event [format { set tablelist::W \ [string range %%W 0 [expr {[string length %%W] - 4}]] @@ -3652,6 +3676,7 @@ proc tablelist::defineTablelistArrow {} { "%W" "$tablelist::W" "%x" "$tablelist::x" "%y" "$tablelist::y" } [bind TablelistLabel $event]] + ##nagelfar ignore bind TablelistArrow $event [format { set tablelist::W \ [winfo parent %%W].l[string range [winfo name %%W] 1 end] @@ -3969,6 +3994,7 @@ proc tablelist::labelB1Motion {w X x y} { } place forget $data(colGap) + lower $data(colGap) ;# necessary on aqua } else { # # The following code is needed because the event @@ -4029,6 +4055,7 @@ proc tablelist::labelB1Motion {w X x y} { configLabel $w -cursor $data(-cursor) $data(hdrTxtFrmCanv)$col configure -cursor $data(-cursor) place forget $data(colGap) + lower $data(colGap) ;# necessary on aqua } else { set data(targetCol) $targetCol set data(master) $master @@ -4053,6 +4080,7 @@ proc tablelist::labelB1Motion {w X x y} { place $data(colGap) -in $master -anchor n \ -bordermode outside -height $height -relheight 1.0 \ -relx $relx -y $y + raise $data(colGap) ;# necessary on aqua } } } @@ -4230,6 +4258,7 @@ proc tablelist::labelB1Up {w X} { } bind $data(topWin) $data(topEscBinding) place forget $data(colGap) + lower $data(colGap) ;# necessary on aqua } if {$data(inClickedLabel)} { @@ -4377,6 +4406,7 @@ proc tablelist::escape {win col} { } bind $data(topWin) $data(topEscBinding) place forget $data(colGap) + lower $data(colGap) ;# necessary on aqua array unset data targetCol if {[info exists data(X)]} { unset data(X) diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistConfig.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistConfig.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistConfig.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistConfig.tcl index 83d7a988..09712422 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistConfig.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistConfig.tcl @@ -66,7 +66,6 @@ proc tablelist::extendConfigSpecs {} { lappend configSpecs(-stripebackground) {} lappend configSpecs(-stripeforeground) {} lappend configSpecs(-stripeheight) 1 - lappend configSpecs(-targetcolor) black lappend configSpecs(-tight) 0 lappend configSpecs(-titlecolumns) 0 lappend configSpecs(-tooltipaddcommand) {} @@ -115,6 +114,7 @@ proc tablelist::extendConfigSpecs {} { variable currentTheme if {$currentTheme eq "aqua"} { variable newAquaSupport + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$newAquaSupport && $majorOSVersion >= 18} { ;# OS X 10.14+ update idletasks ;# needed for the isdark query @@ -160,6 +160,8 @@ proc tablelist::extendConfigSpecs {} { } } } else { + lappend configSpecs(-targetcolor) [lindex $configSpecs(-foreground) 3] + # # Append the default values of some configuration options # of an invisible label widget to the values of the @@ -288,6 +290,7 @@ proc tablelist::extendConfigSpecs {} { } aqua { + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$majorOSVersion >= 20} { ;# macOS 11.0 or higher set arrowColor #878787 @@ -814,6 +817,7 @@ proc tablelist::doConfig {win opt val} { # and of the listbox child, and save the # properly formatted value of val in data($opt) # + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error msg if {$val <= 0} { set viewableRowCount [expr \ @@ -1079,6 +1083,7 @@ proc tablelist::doConfig {win opt val} { # Save the properly formatted value of val in # data($opt) and draw the stripes if necessary # + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error msg set data($opt) $val makeStripesWhenIdle $win @@ -1119,11 +1124,11 @@ proc tablelist::doConfig {win opt val} { } -titlecolumns { # - # Update the value of the -xscrollcommand option, save - # the properly formatted value of val in data($opt), and + # Save the properly formatted value of val in data($opt) and # create or destroy the vertical main separator if needed # set oldVal $data($opt) + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error msg if {$val < 0} { set val 0 @@ -1132,7 +1137,7 @@ proc tablelist::doConfig {win opt val} { set w $data(vsep) if {$val == 0} { $data(hdrTxt) configure -xscrollcommand \ - $data(-xscrollcommand) + [list tablelist::updateHScrlbar $win] if {$oldVal > 0} { destroy $w } @@ -1248,6 +1253,7 @@ proc tablelist::doConfig {win opt val} { # header frame, and listbox child, and save the # properly formatted value of val in data($opt) # + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error msg $data(body) configure $opt $val if {$val <= 0} { @@ -1270,17 +1276,8 @@ proc tablelist::doConfig {win opt val} { } } -xscrollcommand { - # - # Save val in data($opt), and apply it to the header text - # widget if (and only if) no title columns are being used - # set data($opt) $val set data(xView) {-1 -1} - if {$data(-titlecolumns) == 0} { - $data(hdrTxt) configure $opt $val - } else { - $data(hdrTxt) configure $opt "" - } } -yscrollcommand { set data($opt) $val @@ -1854,6 +1851,7 @@ proc tablelist::doColConfig {col win opt val} { # data($col$opt), adjust the columns, and make sure # the specified column will be redisplayed at idle time # + ##nagelfar ignore set val [format "%d" $val] ;# integer check with error message set data($col$opt) $val if {$val > 0} { ;# convention: max. width in characters @@ -2687,11 +2685,27 @@ proc tablelist::doRowConfig {row win opt val} { displayItems $win } + # + # Return if the new item equals the old one + # + set newItem [adjustItem $val $data(colCount)] + set oldItem [lindex $data(${p}itemList) $row] + set equal 1 + set col 0 + foreach newText $newItem oldText $oldItem { + if {$newText ne $oldText && $col < $data(colCount)} { + set equal 0 + break + } + incr col + } + if {$equal} { + return "" + } + set colWidthsChanged 0 set colIdxList {} - set oldItem [lindex $data(${p}itemList) $row] set key [lindex $oldItem end] - set newItem [adjustItem $val $data(colCount)] if {$data(hasFmtCmds)} { set displayedItem [formatItem $win $key $row $newItem] } else { @@ -3137,11 +3151,21 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { } # - # Save the old image or window width + # Return if the new value equals the old one # set item [lindex $data(${p}itemList) $row] set key [lindex $item end] set name $key,$col$opt + set hasImage [info exists data($name)] + set callerProc [lindex [info level -1] 0] + if {$hasImage && $val eq $data($name) && + ![string match "do*Editing" $callerProc]} { + return "" + } + + # + # Save the old image or window width + # getAuxData $win $key $col oldAuxType oldAuxWidth # @@ -3149,7 +3173,7 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { # set imgLabel $w.img_$key,$col if {$val eq ""} { - if {[info exists data($name)]} { + if {$hasImage} { unset data($name) if {$inBody} { incr data(imgCount) -1 @@ -3161,7 +3185,7 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { return -code error $result } - if {$inBody && ![info exists data($name)]} { + if {$inBody && !$hasImage} { incr data(imgCount) } if {[winfo exists $imgLabel] && $val ne $data($name)} { @@ -3303,11 +3327,19 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { displayItems $win # - # Save the old indentation width + # Return if the new value equals the old one # set item [lindex $data(itemList) $row] set key [lindex $item end] set name $key,$col$opt + set hasIndent [info exists data($name)] + if {$hasIndent && $val eq $data($name)} { + return "" + } + + # + # Save the old indentation width + # getIndentData $win $key $col oldIndentWidth # @@ -3315,13 +3347,13 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { # set indentLabel $w.ind_$key,$col if {$val eq ""} { - if {[info exists data($name)]} { + if {$hasIndent} { unset data($name) incr data(indentCount) -1 destroy $indentLabel } } else { - if {![info exists data($name)]} { + if {!$hasIndent} { incr data(indentCount) } if {[winfo exists $indentLabel] && $val ne $data($name)} { @@ -3555,7 +3587,7 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { } -text { - if {$data(isDisabled)} { + if {$data(isDisabled) || ($inBody && $data($col-showlinenumbers))} { return "" } @@ -3563,10 +3595,19 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { displayItems $win } + # + # Return if the new value equals the old one + # + set oldItem [lindex $data(${p}itemList) $row] + set oldText [lindex $oldItem $col] + set callerProc [lindex [info level -1] 0] + if {$val eq $oldText && ![string match "do*Editing" $callerProc]} { + return "" + } + set pixels [lindex $data(colList) [expr {2*$col}]] set workPixels $pixels set text $val - set oldItem [lindex $data(${p}itemList) $row] set key [lindex $oldItem end] set fmtCmdFlag [lindex $data(fmtCmdFlagList) $col] if {$fmtCmdFlag} { @@ -3675,7 +3716,6 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { adjustColumns $win {} 1 } } else { - set oldText [lindex $oldItem $col] if {$fmtCmdFlag} { set oldText [formatElem $win $key $row $col $oldText] } @@ -3695,9 +3735,6 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { } } - if {$inBody} { - showLineNumbersWhenIdle $win - } updateViewWhenIdle $win } @@ -3733,11 +3770,22 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { } # - # Save the old image or window width + # Return if the new value equals the old one # set item [lindex $data(${p}itemList) $row] set key [lindex $item end] set name $key,$col$opt + set hasWindow [info exists data($name)] + set callerProc [lindex [info level -1] 0] + if {$hasWindow && $val eq $data($name) && + ![string match "do*Editing" $callerProc] && + $callerProc ne "tablelist::reconfigWindows"} { + return "" + } + + # + # Save the old image or window width + # getAuxData $win $key $col oldAuxType oldAuxWidth getIndentData $win $key $col oldIndentWidth @@ -3746,7 +3794,7 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { # set aux $w.frm_$key,$col if {$val eq ""} { - if {[info exists data($name)]} { + if {$hasWindow} { unset data($name) unset data($key,$col-reqWidth) unset data($key,$col-reqHeight) @@ -3766,10 +3814,10 @@ proc tablelist::doCellConfig {row col win opt val {skipParts 0}} { destroy $aux } } else { - if {$inBody && ![info exists data($name)]} { + if {$inBody && !$hasWindow} { incr data(winCount) } - if {[info exists data($name)] && $val ne $data($name)} { + if {$hasWindow && $val ne $data($name)} { destroy $aux } if {![winfo exists $aux]} { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistEdit.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistEdit.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistEdit.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistEdit.tcl index 74ca339d..c8c0a3b0 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistEdit.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistEdit.tcl @@ -1213,7 +1213,7 @@ proc tablelist::postMenuCmd w { #------------------------------------------------------------------------------ proc tablelist::createTileEntry {w args} { if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[-] } createTileAliases @@ -1265,7 +1265,7 @@ proc tablelist::createTileEntry {w args} { #------------------------------------------------------------------------------ proc tablelist::createTileSpinbox {w args} { if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.8.3- + package require tile 0.8.3[-] } createTileAliases @@ -1324,7 +1324,7 @@ proc tablelist::createTileSpinbox {w args} { #------------------------------------------------------------------------------ proc tablelist::createTileCombobox {w args} { if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[-] } createTileAliases @@ -1377,7 +1377,7 @@ proc tablelist::createTileCheckbutton {w args} { #------------------------------------------------------------------------------ proc tablelist::createTileMenubutton {w args} { if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[-] } createTileAliases @@ -1803,6 +1803,7 @@ proc tablelist::doEditCell {win row col restore {cmd ""} {charPos -1}} { [info exists data($key,$col-image)] || [info exists data($key,$col-window)]}] if {$alignment eq "right"} { + ##nagelfar ignore scan $tabIdx2 "%d.%d" line tabCharIdx2 if {$isMentry} { set len [string length [$w getstring]] @@ -1814,6 +1815,7 @@ proc tablelist::doEditCell {win row col restore {cmd ""} {charPos -1}} { incr number 2 } } else { + ##nagelfar ignore scan $tabIdx1 "%d.%d" line tabCharIdx1 set number [expr {$charPos - $tabCharIdx1 - 1}] if {$hasAuxObject} { @@ -2702,6 +2704,7 @@ proc tablelist::defineTablelistEdit {} { } } foreach dir {Left Right} amount {-1 1} { + ##nagelfar ignore bind TablelistEdit <$dir> [format { if {![tablelist::isKeyReserved %%W %%K]} { tablelist::goLeftRight %%W %d @@ -2709,6 +2712,7 @@ proc tablelist::defineTablelistEdit {} { } $amount] } foreach dir {Up Down} amount {-1 1} { + ##nagelfar ignore bind TablelistEdit <$dir> [format { if {![tablelist::isKeyReserved %%W %%K]} { tablelist::goUpDown %%W %d @@ -2716,6 +2720,7 @@ proc tablelist::defineTablelistEdit {} { } $amount] } foreach page {Prior Next} amount {-1 1} { + ##nagelfar ignore bind TablelistEdit <$page> [format { if {![tablelist::isKeyReserved %%W %%K]} { tablelist::goToPriorNextPage %%W %d @@ -2750,6 +2755,7 @@ proc tablelist::defineTablelistEdit {} { # Define some emacs-like key bindings for the binding tag TablelistEdit # foreach pattern {Meta-b Meta-f} amount {-1 1} { + ##nagelfar ignore bind TablelistEdit <$pattern> [format { if {!$tk_strictMotif && ![tablelist::isKeyReserved %%W %s]} { tablelist::goLeftRight %%W %d @@ -2757,6 +2763,7 @@ proc tablelist::defineTablelistEdit {} { } $pattern $amount] } foreach pattern {Control-p Control-n} amount {-1 1} { + ##nagelfar ignore bind TablelistEdit <$pattern> [format { if {!$tk_strictMotif && ![tablelist::isKeyReserved %%W %s]} { tablelist::goUpDown %%W %d @@ -2861,6 +2868,7 @@ proc tablelist::defineTablelistEdit {} { } if {$winSys eq "x11"} { foreach detail {4 5} { + ##nagelfar ignore bind TablelistEdit [format { if {[tablelist::hasMouseWheelBindings %%W y]} { set tablelist::W [tablelist::getTablelistPath %%W] @@ -2880,6 +2888,7 @@ proc tablelist::defineTablelistEdit {} { } $detail $detail] bind TablelistEditBreak { break } + ##nagelfar ignore bind TablelistEdit [format { if {[tablelist::hasMouseWheelBindings %%W x]} { set tablelist::W [tablelist::getTablelistPath %%W] @@ -2902,6 +2911,7 @@ proc tablelist::defineTablelistEdit {} { if {$::tk_patchLevel eq "8.7a3"} { foreach detail {6 7} { + ##nagelfar ignore bind TablelistEdit [format { if {[tablelist::hasMouseWheelBindings %%W x]} { set tablelist::W [tablelist::getTablelistPath %%W] @@ -2926,16 +2936,16 @@ proc tablelist::defineTablelistEdit {} { if {[llength [info commands ::tk::PreciseScrollDeltas]] != 0} { bind TablelistEdit { if {%# %% 5 != 0} { - return + continue } - lassign [tk::PreciseScrollDeltas %D] deltaX deltaY - if {$deltaX != 0} { + lassign [tk::PreciseScrollDeltas %D] tablelist::dX tablelist::dY + if {$tablelist::dX != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaX}] + -delta [expr {40 * $tablelist::dX}] } - if {$deltaY != 0} { + if {$tablelist::dY != 0} { event generate %W -rootx %X -rooty %Y \ - -delta [expr {40 * $deltaY}] + -delta [expr {40 * $tablelist::dY}] } } bind TablelistEditBreak { break } @@ -3026,6 +3036,7 @@ proc tablelist::finishEditing {w sequence} { switch [lindex $lst end] { Return - KP_Enter { ;# fill the column's selected cells foreach cellIdx [curCellSelection $win 0] { + ##nagelfar ignore scan $cellIdx "%d,%d" row col if {$col == $editCol} { doCellConfig $row $col $win -text $text @@ -3295,7 +3306,7 @@ proc tablelist::hasMouseWheelBindings {w axis} { [lsearch -exact $bindTags "MentryMeridian"] >= 0 || [lsearch -exact $bindTags "MentryIPAddr"] >= 0 || [lsearch -exact $bindTags "MentryIPv6Addr"] >= 0) && - ($mentry::version >= 3.2)}] + ($::mentry::version >= 3.2)}] } } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistImages.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistImages.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistImages.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistImages.tcl index bddbaead..2d58b0ec 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistImages.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistImages.tcl @@ -1262,6 +1262,7 @@ proc tablelist::aquaTreeImgs {} { variable pngSupported variable winSys + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$winSys eq "aqua" && $majorOSVersion > 10} { set osVerPost10 1 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistMove.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistMove.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistMove.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistMove.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistSort.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistSort.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistSort.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistSort.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistThemes.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistThemes.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistThemes.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistThemes.tcl index 7185f05a..1beb8003 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistThemes.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistThemes.tcl @@ -104,11 +104,14 @@ proc tablelist::setThemeDefaults {} { set themeDefaults(-arrowdisabledcolor) $themeDefaults(-labeldisabledFg) } + set themeDefaults(-targetcolor) $themeDefaults(-foreground) + variable configSpecs foreach opt {-background -foreground -disabledforeground -stripebackground -selectbackground -selectforeground -selectborderwidth -font -labelforeground -labelfont -labelborderwidth -labelpady - -arrowcolor -arrowdisabledcolor -arrowstyle -treestyle} { + -arrowcolor -arrowdisabledcolor -arrowstyle -treestyle + -targetcolor} { if {[llength $configSpecs($opt)] < 4} { lappend configSpecs($opt) $themeDefaults($opt) } else { @@ -214,6 +217,7 @@ proc tablelist::aquaTheme {} { set disabledFg #b1b1b1 } + ##nagelfar ignore scan $::tcl_platform(osVersion) "%d" majorOSVersion if {$majorOSVersion >= 14} { ;# OS X 10.10 or later if {$newAquaSupport} { @@ -687,7 +691,6 @@ proc tablelist::classicTheme {} { -stripebackground #f0f0f0 \ -selectbackground #c3c3c3 \ -selectforeground #000000 \ - -selectborderwidth 1 \ -labelbackground #d9d9d9 \ -labeldeactivatedBg #d9d9d9 \ -labeldisabledBg #d9d9d9 \ @@ -701,6 +704,9 @@ proc tablelist::classicTheme {} { -treestyle gtk \ ] + set val [styleConfig . -selectborderwidth] + set themeDefaults(-selectborderwidth) [expr {$val eq "" ? 0 : $val}] + if {[info exists ::tile::version] && [string compare $::tile::version "0.8"] < 0} { set themeDefaults(-font) TkClassicDefaultFont @@ -742,7 +748,6 @@ proc tablelist::defaultTheme {} { -stripebackground #e8e8e8 \ -selectbackground #4a6984 \ -selectforeground #ffffff \ - -selectborderwidth 1 \ -labelbackground #d9d9d9 \ -labeldeactivatedBg #d9d9d9 \ -labeldisabledBg #d9d9d9 \ @@ -754,6 +759,9 @@ proc tablelist::defaultTheme {} { -arrowstyle [defaultX11ArrowStyle] \ -treestyle gtk \ ] + + set val [styleConfig . -selectborderwidth] + set themeDefaults(-selectborderwidth) [expr {$val eq "" ? 0 : $val}] } #------------------------------------------------------------------------------ @@ -1714,6 +1722,7 @@ proc tablelist::tileqtTheme {} { } if {$val eq "" || [string index $val 0] eq "#"} { set stripeBg $val + ##nagelfar ignore } elseif {[scan $val "%d,%d,%d" r g b] == 3} { set stripeBg [format "#%02x%02x%02x" $r $g $b] } else { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistUtil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistUtil.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistUtil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistUtil.tcl index a101ae46..58235a50 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistUtil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistUtil.tcl @@ -118,6 +118,7 @@ proc tablelist::rowIndex {win idx endIsSize {checkRange 0}} { set index $data(activeRow) } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { set index $data(anchorRow) + ##nagelfar ignore } elseif {[scan $idx "@%d,%d%n" x y count] == 3 && $count == [string length $idx]} { synchronize $win @@ -129,6 +130,7 @@ proc tablelist::rowIndex {win idx endIsSize {checkRange 0}} { if {$index > $data(lastRow)} { set index $data(lastRow) } + ##nagelfar ignore } elseif {[scan $idx "k%d%n" num count] == 2 && $count == [string length $idx]} { set index [keyToRow $win k$num] @@ -182,6 +184,7 @@ proc tablelist::hdr_rowIndex {win idx endIsSize {checkRange 0}} { } } elseif {[string first $idx "last"] == 0} { set index $data(hdr_lastRow) + ##nagelfar ignore } elseif {[scan $idx "@%d,%d%n" x y count] == 3 && $count == [string length $idx]} { incr x -[winfo x $data(hdr)] @@ -197,6 +200,7 @@ proc tablelist::hdr_rowIndex {win idx endIsSize {checkRange 0}} { if {$index > $data(hdr_lastRow)} { set index $data(hdr_lastRow) } + ##nagelfar ignore } elseif {[scan $idx "hk%d%n" num count] == 2 && $count == [string length $idx]} { set index [hdr_keyToRow $win hk$num] @@ -250,6 +254,7 @@ proc tablelist::colIndex {win idx checkRange {decrX 1}} { set index $data(activeCol) } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { set index $data(anchorCol) + ##nagelfar ignore } elseif {[scan $idx "@%d,%d%n" x y count] == 3 && $count == [string length $idx]} { synchronize $win @@ -338,6 +343,7 @@ proc tablelist::colIndex2 {win idx} { return $data(activeCol) } elseif {[string first $idx "anchor"] == 0 && [string length $idx] >= 2} { return $data(anchorCol) + ##nagelfar ignore } elseif {[scan $idx "@%d,%d%n" x y count] == 3 && $count == [string length $idx]} { return [colIndex $win @$x,$y 0 1] @@ -2323,6 +2329,7 @@ proc tablelist::setupColumns {win columns createLabels} { # Get the column width # set width [lindex $columns $n] + ##nagelfar ignore set width [format "%d" $width] ;# integer check with error message # @@ -3845,6 +3852,7 @@ proc tablelist::updateColors {win {fromTextIdx ""} {toTextIdx ""}} { set colorizeCmd $data(-colorizecommand) } + variable disp set rightCol [colIndex $win @$data(rightX),0 0 0] set topLine [expr {int($topTextIdx)}] set btmLine [expr {int($btmTextIdx)}] @@ -3852,7 +3860,7 @@ proc tablelist::updateColors {win {fromTextIdx ""} {toTextIdx ""}} { set btmLine $data(itemCount) } for {set line $topLine} {$line <= $btmLine} \ - {set line [expr {int([$w index "$line.end + 1 display c"])}]} { + {set line [expr {int([$w index "$line.end + 1 $disp c"])}]} { if {![findTabs $win $w $line $leftCol $leftCol tabIdx1 tabIdx2]} { continue } @@ -4086,7 +4094,10 @@ proc tablelist::updateColors {win {fromTextIdx ""} {toTextIdx ""}} { } } if {[$path cget -background] ne $bg} { - $path configure -background $bg + # + # Guard against the deletion of embedded images + # + catch {$path configure -background $bg} } if {$isMessage && [$path cget -foreground] ne $fg} { $path configure -foreground $fg @@ -4257,7 +4268,10 @@ proc tablelist::hdr_updateColors win { } } if {[$path cget -background] ne $bg} { - $path configure -background $bg + # + # Guard against the deletion of embedded images + # + catch {$path configure -background $bg} } if {$isMessage && [$path cget -foreground] ne $fg} { $path configure -foreground $fg @@ -4333,22 +4347,28 @@ proc tablelist::updateHScrlbarWhenIdle win { # Updates the horizontal scrollbar associated with the tablelist widget win by # invoking the command specified as the value of the -xscrollcommand option. #------------------------------------------------------------------------------ -proc tablelist::updateHScrlbar win { +proc tablelist::updateHScrlbar {win args} { upvar ::tablelist::ns${win}::data data if {[info exists data(hScrlbarId)]} { after cancel $data(hScrlbarId) unset data(hScrlbarId) } - if {$data(-titlecolumns) > 0 && $data(-xscrollcommand) ne ""} { - set xView [xviewSubCmd $win {}] - foreach {frac1 frac2} $xView {} - foreach {frac1Old frac2Old} $data(xView) {} - if {$frac1 != $frac1Old || $frac2 != $frac2Old} { - set data(xView) $xView + set xView [expr {[llength $args] == 0 ? [xviewSubCmd $win {}] : $args}] + foreach {frac1 frac2} $xView {} + foreach {frac1Old frac2Old} $data(xView) {} + set leftCol [columnindexSubCmd $win left] + set rightCol [columnindexSubCmd $win right] + if {$frac1 != $frac1Old || $frac2 != $frac2Old} { + if {$data(-xscrollcommand) ne ""} { eval $data(-xscrollcommand) $frac1 $frac2 } + + genVirtualEvent $win <> [list $leftCol $rightCol] + } elseif {$frac1 == 0 && $frac2 == 1 && $rightCol != $data(rightCol)} { + genVirtualEvent $win <> [list $leftCol $rightCol] } + array set data [list xView $xView rightCol $rightCol] } #------------------------------------------------------------------------------ @@ -4382,15 +4402,21 @@ proc tablelist::updateVScrlbar win { unset data(vScrlbarId) } - if {$data(-yscrollcommand) ne ""} { - set yView [yviewSubCmd $win {}] - foreach {frac1 frac2} $yView {} - foreach {frac1Old frac2Old} $data(yView) {} - if {$frac1 != $frac1Old || $frac2 != $frac2Old} { - set data(yView) $yView + set yView [yviewSubCmd $win {}] + foreach {frac1 frac2} $yView {} + foreach {frac1Old frac2Old} $data(yView) {} + set topRow [indexSubCmd $win top] + set btmRow [indexSubCmd $win bottom] + if {$frac1 != $frac1Old || $frac2 != $frac2Old} { + if {$data(-yscrollcommand) ne ""} { eval $data(-yscrollcommand) $frac1 $frac2 } + + genVirtualEvent $win <> [list $topRow $btmRow] + } elseif {$frac1 == 0 && $frac2 == 1 && $btmRow != $data(btmRow)} { + genVirtualEvent $win <> [list $topRow $btmRow] } + array set data [list yView $yView btmRow $btmRow] if {[winfo viewable $win] && ![info exists data(colBeingResized)] && ![info exists data(redrawId)]} { @@ -4468,6 +4494,7 @@ proc tablelist::adjustElidedText win { # Add the "hiddenCol" tag to the contents of the hidden # columns from the top to the bottom window line # + variable disp variable pu if {$data(hiddenColCount) > 0 && $data(itemCount) > 0} { set topLine [expr {int([$w index @0,0])}] @@ -4476,7 +4503,7 @@ proc tablelist::adjustElidedText win { set btmLine $data(itemCount) } for {set line $topLine} {$line <= $btmLine} \ - {set line [expr {int([$w index "$line.end + 1 display c"])}]} { + {set line [expr {int([$w index "$line.end + 1 $disp c"])}]} { set textIdx1 $line.0 for {set col 0; set count 0} \ {$col < $data(colCount) && $count < $data(hiddenColCount)} \ @@ -4505,7 +4532,7 @@ proc tablelist::adjustElidedText win { if {[lindex [$w yview] 1] == 1} { for {set line $btmLine} {$line >= $topLine} \ - {set line [expr {int([$w index "$line.0 - 1 display c"])}]} { + {set line [expr {int([$w index "$line.0 - 1 $disp c"])}]} { set textIdx1 $line.0 for {set col 0; set count 0} \ {$col < $data(colCount) && $count < $data(hiddenColCount)} \ @@ -4584,7 +4611,7 @@ proc tablelist::adjustElidedText win { set btmLine $data(itemCount) } for {set line $topLine} {$line <= $btmLine} \ - {set line [expr {int([$w index "$line.end + 1 display c"])}]} { + {set line [expr {int([$w index "$line.end + 1 $disp c"])}]} { if {[findTabs $win $w $line $firstCol $lastCol \ tabIdx1 tabIdx2]} { $w tag add elidedCol $tabIdx1 $tabIdx2+1$pu @@ -4601,7 +4628,7 @@ proc tablelist::adjustElidedText win { if {[lindex [$w yview] 1] == 1} { for {set line $btmLine} {$line >= $topLine} \ - {set line [expr {int([$w index "$line.0 - 1 display c"])}]} { + {set line [expr {int([$w index "$line.0 - 1 $disp c"])}]} { if {[findTabs $win $w $line $firstCol $lastCol \ tabIdx1 tabIdx2]} { $w tag add elidedCol $tabIdx1 $tabIdx2+1$pu @@ -5097,6 +5124,7 @@ proc tablelist::redisplayVisibleItems win { return "" } + variable disp variable snipSides variable pu @@ -5109,7 +5137,7 @@ proc tablelist::redisplayVisibleItems win { set snipStr $data(-snipstring) for {set line $topLine} {$line <= $btmLine} \ - {set line [expr {int([$w index "$line.end + 1 display c"])}]} { + {set line [expr {int([$w index "$line.end + 1 $disp c"])}]} { if {![findTabs $win $w $line $leftCol $leftCol tabIdx1 tabIdx2]} { continue } @@ -5660,16 +5688,22 @@ proc tablelist::purgeWidgets win { } upvar ::tablelist::ns${win}::data data - if {$data(winSizeChanged)} { + if {$data(topRowChanged)} { + set data(topRowChanged) 0 + } elseif {$data(winSizeChanged)} { set data(winSizeChanged) 0 - after 5000 [list tablelist::purgeWidgets $win] } else { set w $data(body) set fromTextIdx "[$w index @0,0] linestart" set toTextIdx "[$w index @0,$data(btmY)] lineend" set winList {} + set count 0 foreach {dummy path textIdx} [$w dump -window 1.0 end] { + if {$count == 50} { + break + } + if {$path eq ""} { continue } @@ -5683,18 +5717,20 @@ proc tablelist::purgeWidgets win { [$w compare $textIdx > $toTextIdx]} { $w tag add elidedWin $textIdx lappend winList $path + incr count } else { set tagNames [$w tag names $textIdx] if {[lsearch -glob $tagNames hidden*] >= 0 || [lsearch -glob $tagNames elided*] >= 0} { lappend winList $path + incr count } } } eval destroy $winList - - after 1000 [list tablelist::purgeWidgets $win] } + + after 1000 [list tablelist::purgeWidgets $win] } #------------------------------------------------------------------------------ @@ -6633,6 +6669,7 @@ proc tablelist::createCkbtn {cmd win row col w} { $w.ckbtn configure -variable ::tablelist::ns${win}::checkStates($key,$col) if {$cmd ne ""} { + ##nagelfar ignore $w.ckbtn configure -command [format { after idle [list %s %s [%s index %s] %d] } $cmd $win $win $key $col] @@ -6658,6 +6695,7 @@ proc tablelist::hdr_createCkbtn {cmd win row col w} { $w.ckbtn configure -variable ::tablelist::ns${win}::checkStates($key,$col) if {$cmd ne ""} { + ##nagelfar ignore $w.ckbtn configure -command [format { after idle [list %s %s [%s header index %s] %d] } $cmd $win $win $key $col] @@ -6679,14 +6717,16 @@ proc tablelist::makeCkbtn w { x11 { variable checkedImg variable uncheckedImg - variable tristateImg if {![info exists checkedImg]} { createCheckbuttonImgs } - $w configure -borderwidth 0 -indicatoron 0 \ - -image $uncheckedImg -offrelief sunken \ - -selectimage $checkedImg -tristateimage $tristateImg + $w configure -borderwidth 0 -indicatoron 0 -image $uncheckedImg \ + -offrelief sunken -selectimage $checkedImg + if {$::tk_version >= 8.5} { + variable tristateImg + $w configure -tristateimage $tristateImg + } pack $w return [list [winfo reqwidth $w] [winfo reqheight $w]] } @@ -6694,14 +6734,16 @@ proc tablelist::makeCkbtn w { win32 { variable checkedImg variable uncheckedImg - variable tristateImg if {![info exists checkedImg]} { createCheckbuttonImgs } - $w configure -borderwidth 0 -indicatoron 0 \ - -image $uncheckedImg -offrelief sunken \ - -selectimage $checkedImg -tristateimage $tristateImg + $w configure -borderwidth 0 -indicatoron 0 -image $uncheckedImg \ + -offrelief sunken -selectimage $checkedImg + if {$::tk_version >= 8.5} { + variable tristateImg + $w configure -tristateimage $tristateImg + } pack $w return [list [winfo reqwidth $w] [winfo reqheight $w]] } @@ -6739,6 +6781,7 @@ proc tablelist::createTtkCkbtn {cmd win row col w} { $w.ckbtn configure -variable ::tablelist::ns${win}::checkStates($key,$col) if {$cmd ne ""} { + ##nagelfar ignore $w.ckbtn configure -command [format { after idle [list %s %s [%s index %s] %d] } $cmd $win $win $key $col] @@ -6764,6 +6807,7 @@ proc tablelist::hdr_createTtkCkbtn {cmd win row col w} { $w.ckbtn configure -variable ::tablelist::ns${win}::checkStates($key,$col) if {$cmd ne ""} { + ##nagelfar ignore $w.ckbtn configure -command [format { after idle [list %s %s [%s header index %s] %d] } $cmd $win $win $key $col] @@ -6778,7 +6822,7 @@ proc tablelist::hdr_createTtkCkbtn {cmd win row col w} { #------------------------------------------------------------------------------ proc tablelist::makeTtkCkbtn w { if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[-] } createTileAliases diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistWidget.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistWidget.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistWidget.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistWidget.tcl index 6a789626..c0fd857e 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tablelistWidget.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tablelistWidget.tcl @@ -135,6 +135,8 @@ namespace eval tablelist { ($::tk_version >= 8.7 && [package vcompare $::tk_patchLevel "8.7a3"] >= 0)}] + variable disp [expr {$::tk_version >= 8.5 ? "display" : ""}] + variable scaled4 [::scaleutil::scale 4 $::scaleutil::scalingPct] # @@ -675,7 +677,6 @@ proc tablelist::createBindings {} { # bind Tablelist continue bind Tablelist { - tablelist::addActiveTag %W if {[focus -lastfor %W] eq "%W"} { if {[winfo exists [%W editwinpath]]} { focus [set tablelist::ns%W::data(editFocus)] @@ -685,7 +686,6 @@ proc tablelist::createBindings {} { } } bind Tablelist { - tablelist::removeActiveTag %W if {[%W cget -editendonfocusout]} { tablelist::finishEditingOnFocusOut %W } @@ -837,6 +837,7 @@ proc tablelist::tablelist args { colCount 0 lastCol -1 treeCol 0 + topRowChanged 0 winSizeChanged 0 rightX 0 btmY 0 @@ -884,6 +885,8 @@ proc tablelist::tablelist args { y "" xView {-1 -1} yView {-1 -1} + rightCol -1 + btmRow -1 } # @@ -1142,10 +1145,11 @@ proc tablelist::tablelist args { # Create two frames used to display a gap between two consecutive # rows/columns when moving a row/column interactively # + variable scaled4 tk::frame $data(rowGap) -borderwidth 1 -container 0 -highlightthickness 0 \ - -relief sunken -takefocus 0 -height 4 + -relief sunken -takefocus 0 -height $scaled4 tk::frame $data(colGap) -borderwidth 1 -container 0 -highlightthickness 0 \ - -relief sunken -takefocus 0 -width 4 + -relief sunken -takefocus 0 -width $scaled4 # # Create an unmanaged listbox child, used to handle the -setgrid option @@ -1316,7 +1320,9 @@ proc tablelist::autoscrolltargetSubCmd {win argList} { } set event [lindex $argList 0] + ##nagelfar ignore set x [format "%d" [lindex $argList 1]] + ##nagelfar ignore set y [format "%d" [lindex $argList 2]] synchronize $win @@ -1750,6 +1756,11 @@ proc tablelist::collapseSubCmd {win argList} { adjustRowIndex $win activeRow 1 set data(activeRow) $activeRow + update idletasks + if {[destroyed $win]} { + return "" + } + hdr_adjustElidedText $win hdr_updateColors $win adjustElidedText $win @@ -2000,6 +2011,7 @@ proc tablelist::containingSubCmd {win argList} { mwutil::wrongNumArgs "$win containing y" } + ##nagelfar ignore set y [format "%d" [lindex $argList 0]] synchronize $win displayItems $win @@ -2014,7 +2026,9 @@ proc tablelist::containingcellSubCmd {win argList} { mwutil::wrongNumArgs "$win containingcell x y" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] + ##nagelfar ignore set y [format "%d" [lindex $argList 1]] synchronize $win displayItems $win @@ -2029,6 +2043,7 @@ proc tablelist::containingcolumnSubCmd {win argList} { mwutil::wrongNumArgs "$win containingcolumn x" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] synchronize $win displayItems $win @@ -3704,6 +3719,7 @@ proc tablelist::header_containingSubCmd {win argList} { mwutil::wrongNumArgs "$win header containing y" } + ##nagelfar ignore set y [format "%d" [lindex $argList 0]] return [hdr_containingRow $win $y] } @@ -3716,7 +3732,9 @@ proc tablelist::header_containingcellSubCmd {win argList} { mwutil::wrongNumArgs "$win header containingcell x y" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] + ##nagelfar ignore set y [format "%d" [lindex $argList 1]] return [hdr_containingRow $win $y],[containingCol $win $x] } @@ -4594,6 +4612,7 @@ proc tablelist::header_nearestSubCmd {win argList} { mwutil::wrongNumArgs "$win header nearest y" } + ##nagelfar ignore set y [format "%d" [lindex $argList 0]] return [hdr_rowIndex $win @0,$y 0] } @@ -4606,7 +4625,9 @@ proc tablelist::header_nearestcellSubCmd {win argList} { mwutil::wrongNumArgs "$win header nearestcell x y" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] + ##nagelfar ignore set y [format "%d" [lindex $argList 1]] return [join [hdr_cellIndex $win @$x,$y 0] ","] } @@ -5383,6 +5404,7 @@ proc tablelist::nearestSubCmd {win argList} { mwutil::wrongNumArgs "$win nearest y" } + ##nagelfar ignore set y [format "%d" [lindex $argList 0]] return [rowIndex $win @0,$y 0] } @@ -5395,7 +5417,9 @@ proc tablelist::nearestcellSubCmd {win argList} { mwutil::wrongNumArgs "$win nearestcell x y" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] + ##nagelfar ignore set y [format "%d" [lindex $argList 1]] return [join [cellIndex $win @$x,$y 0] ","] } @@ -5408,6 +5432,7 @@ proc tablelist::nearestcolumnSubCmd {win argList} { mwutil::wrongNumArgs "$win nearestcolumn x" } + ##nagelfar ignore set x [format "%d" [lindex $argList 0]] return [colIndex $win @$x,0 0] } @@ -5587,7 +5612,9 @@ proc tablelist::scanSubCmd {win argList} { variable scanOpts set opt [mwutil::fullOpt "option" [lindex $argList 0] $scanOpts] + ##nagelfar ignore set x [format "%d" [lindex $argList 1]] + ##nagelfar ignore set y [format "%d" [lindex $argList 2]] synchronize $win displayItems $win @@ -6019,7 +6046,8 @@ proc tablelist::showtargetmarkSubCmd {win argList} { set y [lindex $dlineinfo 1] } - place $data(rowGap) -anchor w -y $y -height 4 \ + variable scaled4 + place $data(rowGap) -anchor w -y $y -height $scaled4 \ -width [winfo width $data(hdrTxtFrm)] } @@ -6225,6 +6253,7 @@ proc tablelist::targetmarkposSubCmd {win argList} { mwutil::wrongNumArgs "$win targetmarkpos y ?-any|-horizontal|-vertical?" } + ##nagelfar ignore set y [format "%d" [lindex $argList 0]] if {$argCount == 1} { set opt -any @@ -6578,6 +6607,7 @@ proc tablelist::xviewSubCmd {win argList} { # # Command: $win xview # + ##nagelfar ignore set units [format "%d" [lindex $argList 0]] if {$data(-titlecolumns) == 0} { foreach w [list $data(hdrTxt) $data(body)] { @@ -6743,6 +6773,7 @@ proc tablelist::yviewSubCmd {win argList} { # Command: $win yview # set w $data(body) + ##nagelfar ignore set units [format "%d" [lindex $argList 0]] set row [viewableRowOffsetToRowIndex $win $units] $w yview $row @@ -6814,6 +6845,7 @@ proc tablelist::yviewSubCmd {win argList} { $w yview $row } + set data(topRowChanged) 1 adjustElidedText $win redisplayVisibleItems $win if {$::tk_version >= 8.5 && $absNumber != 0} { @@ -7771,6 +7803,9 @@ proc tablelist::insertRows {win index argList updateListVar parentKey \ } elseif {$index > $data(itemCount)} { set index $data(itemCount) } + if {$index < $data(itemCount)} { + displayItems $win + } set childCount [llength $data($parentKey-childList)] if {$childIdx < 0} { @@ -8393,6 +8428,7 @@ proc tablelist::insertCols {win colIdx argList} { # # Check the column width # + ##nagelfar ignore format "%d" [lindex $argList $n] ;# integer check with error message # @@ -9021,6 +9057,7 @@ proc tablelist::vertMoveTo win { set offset [expr {int($data(vertFraction)*$totalViewableCount + 0.5)}] set row [viewableRowOffsetToRowIndex $win $offset] $data(body) yview $row + set data(topRowChanged) 1 updateView $win $row updateIdletasksDelayed @@ -9041,6 +9078,7 @@ proc tablelist::vertScrollByUnits win { set offset [expr {$upperViewableCount + $data(vertUnits)}] set row [viewableRowOffsetToRowIndex $win $offset] $data(body) yview $row + set data(topRowChanged) 1 updateView $win $row updateIdletasksDelayed @@ -9109,6 +9147,7 @@ proc tablelist::dragTo win { set row [viewableRowOffsetToRowIndex $win $newTopRowOffset] $w yview $row + set data(topRowChanged) 1 hdr_adjustElidedText $win hdr_updateColors $win @@ -9164,12 +9203,12 @@ proc tablelist::seeTextIdx {win textIdx} { #------------------------------------------------------------------------------ # tablelist::updateIdletasksDelayed # -# Schedules the execution of "update idletasks" 100 ms later. +# Schedules the execution of "update idletasks" 50 ms later. #------------------------------------------------------------------------------ proc tablelist::updateIdletasksDelayed {} { variable idletasksId if {![info exists idletasksId]} { - set idletasksId [after 100 [list tablelist::updateIdletasks]] + set idletasksId [after 50 [list tablelist::updateIdletasks]] } } @@ -9246,6 +9285,7 @@ proc tablelist::fetchSelection {win offset maxChars} { set selection "" set prevRow -1 foreach cellIdx [curCellSelection $win 2] { + ##nagelfar ignore scan $cellIdx "%d,%d" row col if {$row != $prevRow} { if {$prevRow != -1} { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tclIndex similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/tclIndex diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl similarity index 89% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl index 6cad0284..125195dc 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/gifIndicatorImgs.tcl @@ -1152,213 +1152,246 @@ proc themepatch::default::createCheckbtnIndImgs_gif pct { switch $pct { 100 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhEAAQAMIEAIiIiImJiePj4+Tk5P///////////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMLAIiIiIyMjI2NjY6Ojo+Pj5CQkJGRkcbGxsfHx/Ly8vPz8/////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ+8L0igL1WGPkCUksohsoRTMioigcFrqpSwbBFr/Y95nrI +9z9d8DakAQQvXWJgOPQWB0LnkFQlTBwKBiOQPiIAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhEAAQAMIFAIiIiImJicbGxsfHx9nZ2f///////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMKAIiIiIuLi4yMjI2NjY6OjrKysrOzs9DQ0NHR0dnZ2f////////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ98L0hgL1WEPmCQUkohkgRTMaoigUFrioSADBs1euNj/oe +9j7gTogj1gCC1+6gKfgSrU5BqTqYOBQMRiOJAAA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhEAAQAMIFAIiIiImJibW1tba2tsPDw////////////yH5BAEKAAcALAAAAAAQABAAAAMn -eLDcrYPISaUIoOq59u5eBYZcRpYnmhLj2ZJvGHvzBwjppTg8EBwJADs=}] +R0lGODlhEAAQAOMJAIiIiIqKiouLi4yMjKenp6ioqLy8vL29vcPDw/////////////////////// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ+8L0hgL1WDPkCOUgohgcRTMWoigQFruoRADBs1euNj/oe +9j7gTogj1gCC186gIfgQBEHnUzOYOBQMRiB9RAAAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhEAAQAKECAEpohUpphP///////yH5BAEKAAMALAAAAAAQABAAAAIYXI6JMKAPo5y02puE -3jpyjoXiODpXYw0FADs=}] +R0lGODlhEAAQAMIEAElphEpphEpphUpqg////////////////yH5BAEKAAcALAAAAAAQABAAAAMf +eBfcHkKtR9msOOvNOydgCGKi6J1oSgnecGmAtLlHAgA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhEAAQAKECAKKioqOjo////////yH5BAEKAAMALAAAAAAQABAAAAIXXI6Zpo3gopy02iuy -znHvC4biSAIMZRYAOw==}] +R0lGODlhEAAQAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAQABAAAAMd +SBTczoqAR2G94urNu39DKIbXOH5oqq7O4kXZpiQAOw==}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAKEBAFiVvP///////////yH5BAEKAAIALAAAAAAQABAAAAIWFI6Zpu0Po5y0poAz -flrbD4aixUxCAQA7}] +R0lGODlhEAAQAMIGAFeUvFiUvFeVvFiVvFiVvVmVvP///////yH5BAEKAAcALAAAAAAQABAAAAMl +eAc1/q4IdQK8cOE9SuNgKI7kY5zoyaVp6b7bRwolcZSUvNlHAgA7}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhEAAQAIQPAEpohUpphFx4kX+VqICWqYSZrIecrY2gsZWnt8bQ2MnS2uTp7fP19/b3+f7+ -/////////////////////////////////////////////////////////////////////yH5BAEK -ABAALAAAAAAQABAAAAU4IBSMZEkCEGCubOu+cGA0QywwTxEnj8IODcTo8GAIWASHA3F7HFwI5aIH -ixaP1YYhxu2quikuJAQAOw==}] +R0lGODlhEAAQAIQRAElphEpphEpphUpqg1x4kX+VqICWqYSZrIecrY2gsZWnt8bQ2MnS2uTp7fP1 +9/b3+f7+/////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAQABAAAAU/4PcFZGkGgjieLLm2cCyzyFPMAeFEB75EjFbhoSAlIg5CywCBKHSRREzR +bABnVKQS+0DgZoJvYPCSAVQz8icEADs=}] set ckIndArr(sel_disabled) [image create photo -format gif -data { -R0lGODlhEAAQAOMNAKKioqOjo6ysrL6+vsHBwcLCwsXFxcnJyeLi4uTk5PHx8fn5+fr6+v////// -/////yH5BAEKAA8ALAAAAAAQABAAAAQz8IVJa5U2U6C7/13BDGAgLA1RIk2iDcwxGc0ivE1znI3h -HTlFCwSs3YiMQmnJbAIwoGcEADs=}] +R0lGODlhEAAQAOMOAKKioqOjo6SkpKysrL6+vsHBwcLCwsXFxcnJyeLi4uTk5PHx8fn5+fr6+v// +/////yH5BAEKAA8ALAAAAAAQABAAAAQ38L1Aq6Xygctx/8InikZDjNTAOAUaJI7SEQ1CHQ4zzI6D +qI6DCNFbxFDE3A7ZMLie0MkzExpJIgA7}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAOMOAFiVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f6+bv9fT4+/b6/P7///// -/////yH5BAEKAA8ALAAAAAAQABAAAAQy8IFJa5U26827BwUjfMHiEB/iJJrAHJPhLIE2NM1ROgZ3 -4IqV5zerDRmFj3LJBGA+jwgAOw==}] +R0lGODlhEAAQAIQTAFeUvFiUvFeVvFiVvFiVvVmVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f +6+bv9fT4+/b6/P7//////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAQABAAAAVH4PcBxWCeZiGIX4C+6AjPQ1HS+KxER24akEnCN2hMHLNDhGFaTCCGGUIi +YQAnCxyD+jj6ts/oN6KY3YgDAXpA+KxZ51n7EwIAOw==}] } 125 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhFAAUAOMHAIiIiKenp6ioqKmpqfLy8vT09PX19f////////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAARFEIFJq6VyEMO790QwEUdpnuhBTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoDA5sPlFAQAyWVcQUQAADs=}] +R0lGODlhFAAUAOMNAIiIiImJiYqKiouLi4yMjLe3t7i4uNra2tvb297e3t/f3+Dg4OHh4f////// +/////yH5BAEKAA8ALAAAAAAUABQAAARc8EkigL1YECmHMIgijiRiBIIkLE3rvq8SPIMB33DhIXjf +HBWGD8ewCIewIuCIdCmZzcYz6jRSW9NrlrqNdptFAe8KJNiuhU1AQU3MHoKA4UCqKw6FwHtSwfg1 +HBEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhFAAUAOMIAIiIiJ2dnZ6enp+fn9DQ0NHR0dLS0tnZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAAREEIFJq6VyFMO790UwFUdpnuhRTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoAA4cP1CACSi7iCiAAAOw==}] +R0lGODlhFAAUAOMOAIeHh4iIiImJiYqKiouLi6ioqKmpqcDAwMHBwcLCwsPDw8TExMXFxdnZ2f// +/////yH5BAEKAA8ALAAAAAAUABQAAARb8Ekigr1YECnFMIgijiRiWNKwNGzrukrwfG/9FoOA2Hxz +DAFGz8awCIevYhCZNDJdyuOzEZ2yqlbsVPvkMos6q29AMIgNm4BimpA9LIYDaa44nACcBwXDD5A5 +EQA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhFAAUAOMIAIiIiJeXl5iYmJmZmby8vL29vb6+vsPDw/////////////////////////// -/////yH5BAEKAAgALAAAAAAUABQAAAREEIFJq6VyEMO790QwEUdpnuhBTEbqmgb7vjHQzml946fO -o74fTCYsBYtHYfK35DVxz1mUNiqWVoBA4cP1CACSi7iCiAAAOw==}] +R0lGODlhFAAUAOMLAIeHh4iIiImJiYqKiouLi6CgoLGxsbKysrOzs7S0tMPDw/////////////// +/////yH5BAEKAA8ALAAAAAAUABQAAARa8Mkhgr1YDCl1MUgojkZhTYmiriyLBM9QtHRbUEatK0aV +7rSE5QdkCQPEouqYVDKVxiF09ZwqqlMsVOsMCHLWnsyqKBAeAcT0AEMHPqM4ohQAcB6ECmYvOEsi +ADs=}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhFAAUAMIEAEtohEpphEpqhHePo////////////////yH5BAEKAAcALAAAAAAUABQAAAMl -eBDc/kzB+QS9OOvNu/9DKI4YYZ5oia7Y6A5fLM90bTvCYXlHAgA7}] +R0lGODlhFAAUAMIGAElpg0lphEppg0pphEtphHePo////////yH5BAEKAAcALAAAAAAUABQAAAMy +eCrT/i0oBaCFRN3tDuMcAY5kaZ5coa4saLxw7MY0yN4Fqu+muAe8w07hO02ExYtokgAAOw==}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhFAAUAMIEAKOjo6SkpODg4Ovr6////////////////yH5BAEKAAQALAAAAAAUABQAAAMg -SLDcvkG9Sau9OOvNu6fCII6iYIXkaH5s677wFnwSRyQAOw==}] +R0lGODlhFAAUAMIEAKKioqOjo6SkpLq6uv///////////////yH5BAEKAAcALAAAAAAUABQAAAMq +eBrc7mq9OSW94eANtv9gKG5DaZ4boa5syr7kKY90bd+iRluhEB2dTyQBADs=}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhFAAUAMIGAFiUvFiVu1iVvFiVvVmVvIKwzf///////yH5BAEKAAcALAAAAAAUABQAAAMs -eAPS/g8QBasV7Oqsu/9gKI5OYZ5oZ6xsq7Zwh84Fad943nEjcR+YECBwSAAAOw==}] +R0lGODlhFAAUAOMIAFiUu1iUvFiVvFiVvVmVvFiWvFiWvYKwzf////////////////////////// +/////yH5BAEKAA8ALAAAAAAUABQAAAQ38Mkhqr21SAmwx9rzjdZDkSOBkurqvjB8zHSNIniu33qP +1sBDbEgsGgvFgIgoQcYMm0cLpZREAAA7}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhFAAUAKUgAEtohEpphEpqhEtqhEtqhVBuiFVyi1ZzjFd0jV15kV96km2GnH+VqIKXqoaa -rY6hspytvJ2uvK27yK68yLbCzbzH0bzI0sPN1srT293j6N7j6Ovv8e3w8vT29/T2+PX3+P////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZUwB8g -QCwaj0QhcnkUMJ/QqHQKnXwaVCIDBJJkDRuQR8EcLArGCvfxhIAyCC0XA41wNYgDB9RJQAkWdxdr -UoBcc1SGfH6JFB8OWZGSk5RFAj9OkT9BADs=}] +R0lGODlhFAAUAKUiAElpg0lphEppg0pphEtphEtqhEtqhVBuiFVyi1ZzjFd0jV15kV96km2GnH+V +qIKXqoaarY6hspytvJ2uvK27yK68yLbCzbzH0bzI0sPN1srT293j6N7j6Ovv8e3w8vT29/T2+PX3 ++P////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZnwJ9Q +MCgaj8WAUAhAOpEE4XNq/BGpVAJ2u62EHtyjQySihIuIjgjEmBYah+OFHKFKRBtFcSzSYCdkHAoJ +HiIfC1gGGIEZdFyKZGR+YZCGiGcGFiEQWWdIAZ5HP6FFQlqhS6OnU1pLQQA7}] set ckIndArr(sel_disabled) [image create photo -format gif -data { -R0lGODlhFAAUAIQWAKOjo6SkpKWlpaampqenp6ysrLCwsLGxsbKysrS0tMDAwMLCwtnZ2dvb2+Hh -4eTk5Ofn5+jo6PHx8ff39/v7+/7+/v///////////////////////////////////////yH5BAEK -AB8ALAAAAAAUABQAAAVC4AeMZGmOgXiubOu+cCzPa2Mh9GJVRSsMJYPFonBNKocRgWJhvBzDBEBi -kcQiO4iFQpBphwbag0grm8/nwFlF+4QAADs=}] +R0lGODlhFAAUAIQYAKKioqOjo6SkpKampqioqKmpqaqqqq2trbW1tb6+vr+/v8HBwcbGxs3NzdbW +1tra2t3d3eDg4OTk5O7u7vX19fb29vn5+fr6+v///////////////////////////////yH5BAEK +AB8ALAAAAAAUABQAAAVT4CcGZGma4niuq8q+wQfPwGzfzqXcZoJhDh6JQMFcDjDEwAT5MWANzMRA +8mEks6jUUKhgLEiYoCmNOG/j3w/LS3/D7cdlIazbUfeYzC5IfWo3KSEAOw==}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhFAAUAKUgAFiUvFiVu1iVvFiVvVmVvFmWvV6ZvmKbwGOcwGSdwWqgw2uhxHipyYm00Iy2 -0Y+40pe91aTF2qXG27TP4bTQ4bzU5MHY5sfc6c/g7ODr8uDr8+3z+O70+PX4+/X5+/b5+/////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZgwN8A -ICgaj0cAQYhsOgXEpzQqrVqvUsrHgTU2QKBJV3DYgDyLJ4FhOFrAEGkElEkUvyBMVQLWJBAcIB0K -VQVvIBoXcFeGYGB6WI2ChF0FFR8PY5qbUJwCBJ4/nVgAAT9BADs=}] +R0lGODlhFAAUAKUiAFiUu1iUvFiVvFiVvVmVvFiWvFiWvVmWvV6ZvmKbwGOcwGSdwWqgw2uhxHip +yYm00Iy20Y+40pe91aTF2qXG27TP4bTQ4bzU5MHY5sfc6c/g7ODr8uDr8+3z+O70+PX4+/X5+/b5 ++/////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAUABQAAAZqwJ9w +ICgaj8WCUAhAOpHK33Nq/BGpUwKWqt0KLCGI9/gQiSrjYqIjAjWyDsQRY5ZQJ6LNolgWabAUZhwL +Ch4iHwxYB3QiHBl1XotmZn9jkoeJaQcXIRFpnwWfRgFSogJCoZ8GSz9dWKRCQQA7}] } 150 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhGAAYAOMHAIiIiImJibKysrOzs8DAwMTExMfHx/////////////////////////////// -/////yH5BAEKAAgALAAAAAAYABgAAARTEIFJq70BhTCI/2D4DUAADEeqriwrTEUrywU832oNxPit -8z2aLSjcEYvAY26oXBqbzmTzB41WU9RrtrqFdqdMbxh8uh5eJoFhzW672S+A5kKnZyIAOw==}] +R0lGODlhGAAYAIQPAIiIiImJiYqKio6OjqCgoKGhoaKior29vb6+vsDAwMPDw8fHx9vb29zc3N3d +3f///////////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAYABgAAAV9ICRCQQCcaHoGwjiaxpHMdD0fBdCKweA8wKBw+GgMAiLAj8gUNgAkQ3Ma +LJQQVOrBpMhOFaeulwkGiMfD8hkdVLPT4bfQLQfS63d5/r1n99FgAVh1D1sCBYQPBC0ADXUMUBAC +A45sDEcvAAQHC52en50HBABILpImKqksLiEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhGAAYAOMIAIiIiImJiaSkpKWlpa6urrGxsbOzs9nZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAYABgAAARTEIFJq70BhTCI/2D4DUAADEeqriwrTEUrywU832oNxPit -8z2aLSjcEYvAY26oXBqbzmTzB41WU9RrtrqFdqdMbxh8uh5eJoFhzW672SSA5kKnZyIAOw==}] +R0lGODlhGAAYAIQQAIiIiImJiYqKioyMjJiYmJmZmZqamqysrK2tra6urrCwsLOzs8DAwMHBwcLC +wtnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAYABgAAAV6ICRCQQCcaHoGwjiexpHMdD0fBRC8g/P8wKDw0RgARADfcBlsHAMGphRY +KCGm08NJgZUqtl3mF8AND8dlcxCtFrLbwDf8IYfX23d13rwPj69zDwcsBYEPBC0ADXMMRyQDi2oM +AztIAAQHC5qbnJoHBDouIgImKqYsLiEAOw==}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhGAAYAMIHAIiIiImJiZ2dnaSkpKampqenp8PDw////yH5BAEKAAcALAAAAAAYABgAAANQ -eLDc/uGEIIa9OF8BAhBGKI4kyQFEqarEkq5w2KJxPL816+brzeu0H8knHBGLsh0yGVwekc9iVDj9 -VXnXXLY2Ay0NHI+gQC6bz+WT5MFmRxIAOw==}] +R0lGODlhGAAYAOMOAIiIiImJiYqKiouLi5SUlJWVlaKioqOjo6SkpKWlpaenp7GxsbKyssPDw/// +/////yH5BAEKAA8ALAAAAAAYABgAAARx8MkXArg43yDmvIWBjGQ5GgQQfAPTvHAsN8wASIA77zFz +BwWeEEaoHIZDwyWBFCaWTd4TwIzOplVrDKuVcbuwL7ghBpe7Z23auo5Oj+OGgUOINwid3Hhxo7S6 +CwMrOAAEBgqIiYqIKCoeEgIWGpMcHhEAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhGAAYAMIGAEpohElpg0lphUpphEpqhKW0wv///////yH5BAEKAAcALAAAAAAYABgAAAMx -eDDc/k6EE6C9o+LNu/9gKI5kaTJFqq5pZ7xw/Lpy3bF4ce587/8/wU5TIlCEIskhAQA7}] +R0lGODlhGAAYAMIFAEpphEpphUtphElqg6W0wv///////////yH5BAEKAAcALAAAAAAYABgAAAM6 +eHoB/hCGtaK9ruINFf/AAYLCuJVmqq5s6xBwLMNgYd+4Xec8OP8El3BIVKGKQlFS6dKwKJ7jaUBJ +AAA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhGAAYAMIEAKKioqOjo6SkpNHR0f///////////////yH5BAEKAAcALAAAAAAYABgAAAMp -eBLc/vDASau9OOvNu/9gCA1kaZIYoa6smrYwds6DaN94ru98B0ihQwIAOw==}] +R0lGODlhGAAYAMIEAKKioqOjo6SkpNHR0f///////////////yH5BAEKAAcALAAAAAAYABgAAAM0 +eHrR/jCsFWulNj+luwReKI5kaZ4oNKxsu3pELM8xTN+eqw9p7//ADqjHSHGMR9Mk6RFMEgA7}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhGAAYAMIFAFiUu1eVvFiVvFmVvazK3v///////////yH5BAEKAAcALAAAAAAYABgAAAMt -eCHc/g8cAKsV9OrNu/9gKI5kyRBoqqJc4b6w28Y0t96Eqe987/+6DGkwIUkSADs=}] +R0lGODlhGAAYAMIGAFiUvFeVvFiVu1iVvFiWvKzK3v///////yH5BAEKAAcALAAAAAAYABgAAAM7 +eHoy/hCKtUi8OFTMoz5d+ByAaJ5oqq5sixZwLMOmYd+4Xee8Of8Fl3BILKpKQ5BQEXB9Ds3Vc6Gi +JAAAOw==}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhGAAYAKUfAEpohElpg0lphUpphEpqhEtqhFBuiFFviVNxild0jV96knSMoHePo4OYq4aa -rY2hspCjs5CjtJiqua68yLnF0MrT28zV3M/X3s/Y39DY39zi5+Tp7fT2+PX3+P7+/v////////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKACAALAAAAAAYABgAAAZvQBBg -QCwaj0ZBABRAOp+DJnRKrVqv2OzUgOk0tMXJ51MBDxae8QN82IwvhSlCwjiKPxwFlfLxQIpoYxFV -fH1/Bm4fFnFUCRpjfnd5V46QaR+DWJVjioyaj3h6YAkZHQ5mqKmqAwKrUqgETK1aSiBBADs=}] +R0lGODlhGAAYAIQeAEpphEpphUtphElqg0tqhFBuiFFviVNxild0jV96knSMoHePo4OYq4aarY2h +spCjs5CjtJiqua68yLnF0MrT28zV3M/X3s/Y39DY39zi5+Tp7fT2+PX3+P7+/v///////yH5BAEK +AB8ALAAAAAAYABgAAAVy4Cd+AWCeKBqMY+q+ZgvPqEjfwIfjwj73vsKFw/C5JB4PxYhSdJIOpsmg +SVoItENkkUJ6NonbxNN5nJxJCG5MNheqngr2hsgky16wr35/etRGfElxc4F2X2FSAAgYHA03QIqS +MDqTOZWTMoosNpE/AywhADs=}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhGAAYAIQaAKKioqOjo6SkpKampqenp6ioqKmpqa2trbi4uLq6usDAwMHBwcXFxcbGxsfH x8vLy9bW1tzc3OTk5OXl5ebm5ufn5+3t7fHx8fr6+v7+/v///////////////////////yH5BAEK -AB8ALAAAAAAYABgAAAVY4CcEZGme6IeubOu+cCzPtDxUmFKXkKZJuwAi42PsCBcf5VV4JE49Debw -imgyjdLQ54BZr9lBUjOJGSw+bHQqO6eJmu7M7SPv6Ow7bhHs+/+AgQEAKn4fIQA7}] +AB8ALAAAAAAYABgAAAVl4Cd+QWmeaDCOaduybnyKcq0Cdq7v7lBhCt4JotFIhCVEpshAEi5FSq3w +SKCIGsyhFtFkGiZl0WHresEDqGaSM1iKX6xW54YvNeRdvbhG7ud+PwtIQjiEJiSHKomHMEgrNDoC +KyEAOw==}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhEAAQAOMOAFiVvGmgw4i0z4q10I630pC505a81Z3B2Mve6s3f6+bv9fT4+/b6/P7///// -/////yH5BAEKAA8ALAAAAAAQABAAAAQy8IFJa5U26827BwUjfMHiEB/iJJrAHJPhLIE2NM1ROgZ3 -4IqV5zerDRmFj3LJBGA+jwgAOw==}] +R0lGODlhGAAYAKUfAFiUvFeVvFiVu1iVvFmVvFiWvF6Zvl+Zv2Gav2ScwWuhxH+uy4KwzYy20Y+4 +0pa81Zi+1pm+1qDD2bTQ4b/W5c7g69Dh7NLj7dPj7dTk7t7q8ubv9fX5+/b5+/7+/v////////// +//////////////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKACAALAAAAAAYABgAAAZ5QJAQ +JBgYj0ikYDgsJJ/QQBNKTUpB1ewRBNB6v2CvAdNphJOTz6dyPi486kd7cNioL4QsQsJAqzkKWhQf +HhBucB8RXoOEhgZ2HxZ5WgkaaoVpH4BglZeIimGdapGToZaagXMJGR0Oc21dr1uyRkIBslcgt225 +Q2dMQQA7}] } 175 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhHAAcAOMIAIiIiIyMjKOjo6SkpKampqioqOrq6uvr6/////////////////////////// -/////yH5BAEKAA8ALAAAAAAcABwAAARk8D1Aq724yhlG+WAoikMAcAeirmzrIoYJCG9tCxRh7y2R -80CED6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wABwzd2wntG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQRAIeHh4iIiImJiY2NjY6Ojo+Pj5+fn6CgoKGhoaampqioqM3Nzc7Ozs/Pz+np +6erq6vv7+////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAcABwAAAWS4Cd+QGCeaIqOrDkcSizP8zEEAvsFRQNFwKBwGIEwCoER70FsNh+FXKnh +rA4ZAQCA8LN6ITcBwkuOHASBRNmbMKnX1XYaHnfTnfL3fZjfE/t+QoCBQIOEhoGIfop7jHeOdG0C +B4RBBgIAA12BYCcMlVhJAgVMfg4ESSI8DJtlEAuoOmgvNLUyNiY6IiVoKr69LCEAOw==}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhHAAcAOMIAIiIiIuLi5qampubm5ycnJ6ensvLy9nZ2f////////////////////////// -/////yH5BAEKAAgALAAAAAAcABwAAARkECFAq724yhlG+WAoikMAcMahrmzrHoYJCG9tDxRh7y2R -88CDD6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wCBFDd2wntG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQQAIeHh4iIiImJiYuLi4yMjI2NjZiYmJmZmZycnJ6enre3t7i4uMrKysvLy9bW +1tnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAcABwAAAWOICRCQGCeaIqOrEkYSSzPs0EEAgsFxeI8wKBw+HAoCoERr0FsNhuFXGnh +rA4XAQCA8LN6HQPcwUt+GAQBRNmLMKnX1XYaHnfTnfL3fZjfE/t+QoCBQIOEhoGIfop7jHeOdG0C +BoRBZ1tdgQ43JgqVWEkCBUx+DDdKPZllRqcsaC80sTI2JjoiJWgqurksIQA7}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhHAAcAOMJAIiIiIqKipWVlZaWlpeXl5iYmLi4uLm5ucPDw/////////////////////// -/////yH5BAEKAA8ALAAAAAAcABwAAARk8D1Aq724yhlG+WAoikMAcAeirmzrIoYJCG9tDxRh7y2R -80CED6AL7oZFYw2ptDGbrye095tSidZrMiuscrvYL3iblXLNZe9ZnQ5/0Vb4dEgT4wABw/dg4nhG -gCMlJxIZhocSEQA7}] +R0lGODlhHAAcAIQQAIeHh4iIiImJiYuLi4yMjJOTk5SUlJWVlZeXl5iYmKqqqqurq7i4uLm5ucHB +wcPDw////////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAcABwAAAWOICRCQGCeaIqOrDkYSSzPszEEAgsFw+I8wKBw+HAoCIFRgNAgOp0NQq60 +eFqHiwAAMPhdv46b4PAtPwyCAML8RZjWbKtbHZe/6885HD/U84l+f0KBgkCEhYeCiX+LfI14j3Vu +AgaFQQUCXF6CYScKlllJAkyCDDdKBD51RqcsaS80sTI2JjoiJWkqurksIQA7}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhHAAcAMIEAEpphEpphUpqhNLa4f///////////////yH5BAEKAAcALAAAAAAcABwAAAM1 -eBfQ/jCCoI68uB2Ru/9gKI5kaZ5oqq7R4L4wDBJ0bdvzrdNg7L+soHBILBqPKQ7LsqqoFAkAOw==}] +R0lGODlhHAAcAOMHAElog0lohElphEpphEtphEtqg9La4f////////////////////////////// +/////yH5BAEKAAgALAAAAAAcABwAAARGEEkEhr0448m1/wOHgGQ2lehFpWnBssQrz3Rt33h+GXzv ++6yDcEgkBotIIevH7Ome0Kh0Sq2SBKPnKSfCiSSFQCxFCGAnEQA7}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhHAAcAMIDAKKioqOjo+jo6P///////////////////yH5BAEKAAQALAAAAAAcABwAAAM1 -SBTc/rCpFasN9GoHtv9gKI5kaZ5oqgps67rfIM80Hde4/L18q/7AoHBILBpVgAxq0jElCQkAOw==}] +R0lGODlhHAAcAMIEAKKioqOjo6SkpOjo6P///////////////yH5BAEKAAcALAAAAAAcABwAAAM+ +eHoQ/jA+saq8ONSTe1xe+DBiaZ5oqq5s677YIM80XRJ4ruv37uOlmnAGKxqPyKTyIigCODCQa9Pa +KFTPRQIAOw==}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhHAAcAMIDAFiUvFiVvNbl7v///////////////////yH5BAEKAAQALAAAAAAcABwAAAM7 -SBQQ/jDGppa8GNrMJWhdKI5kaZ5oqq5sGwpwLMvjYN84Xue8Pc7AmGtILBqPyOQDpEQBNqzKJ/VR -JAAAOw==}] +R0lGODlhHAAcAOMIAFmUvFeVvFiVvFmVu1mVvFiWvFiWvdbl7v////////////////////////// +/////yH5BAEKAA8ALAAAAAAcABwAAARK8Mk3grg462umJ1sYEt4jnuEEoixGtfBVxHR9rnau73zv +a4egcDiMIY7IZNKobB5jxKjwR61arzbcz1I1VAEPLW/yK/VKEh14EgEAOw==}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhHAAcAKUiAEpphEpphUpqhEtqhE1rhlVyi1VyjF97kmV/lmaAl2eBmGmDmWqDmmuEmoKX -qoOZq5GktJKktaGxv7TBzMLM1sPN1s7W3tPb4dng5drg5t7j6N7k6eLn6+7x8/Hz9fX3+Pn6+/r7 -/P////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAZ8wN8v -ACgaj8gkICD8KZ/Q4k8QrVqv2Kx2y+1aERyPw2skZEQiDbkoQYsoawUI/TmQCRg35JqoTApIbWgW -A1cXaBgGRgshdHaGbokAZm4RWQwekQaCIoRaDZloG40idVwKHW56XqCqnqyhpmsLYQ9rt7i5ukhU -uk65TbhCQQA7}] +R0lGODlhHAAcAKUlAElog0lohElphEpphEtphEtqg0tqhE1rhlVyi1VyjF97kmV/lmaAl2eBmGmD +mWqDmmuEmoKXqoOZq5GktJKktaGxv7TBzMLM1sPN1s7W3tPb4dng5drg5t7j6N7k6eLn6+7x8/Hz +9fX3+Pn6+/r7/P////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaMwJ/w +BxgYj8gkcshUOp8D5g9KTQ6r2CMxmy1wuYSvmLv4hCJj5YFTKnXSyUq7dIEfG6O2SGEfHDZzE1kM +GBYIcXMZBlkabRsJRw4kenyMc49+bG0UXw8hlwlybYpiEJ9tHpMle2kNIHOBdqawpLKnrH0DDmYS +ub6/wEYCU8BXvlK5UkIFAWFZBAHDQ0EAOw==}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhHAAcAIQZAKKioqOjo6SkpKioqKmpqa6urrGxsbKysrOzs7S0tL+/v8DAwMfHx8/Pz9nZ 2eDg4Obm5unp6ezs7O7u7vDw8Pb29vj4+Pr6+vz8/P///////////////////////////yH5BAEK -AB8ALAAAAAAcABwAAAVy4PcFZGmeaCmOaesG7CubwGzfeK7vPGpQFkWvJJBkMpMhqXHMPJQHzPFS -GBabDJvh4RicmEfILXKUEEoIaYY6bpoD12P2hrC4CeCMOJewHydqbDoHFU1YPX2Ge4h+gkMIQAtK -k5SVlpcnADGTKzVDmh8hADs=}] +AB8ALAAAAAAcABwAAAV74Cd+QGCeaHoKY6u+cNB+cZ2Odn6Seu//wCDMQLEohCiBJJOZIE8NZubx +DBwwzEvhqZQydIaHY5CKMiG9CFNCOCGwGW1ayg50md8ewkInmDNoPwl8TBNwckAHFVJeSIOMgY6E +iE8IRQtVmZoCmiYANJ04mTNVMyJCnyMhADs=}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhHAAcAKUgAFiUvFiVvFmVvFuXvWKbwGKcwGyhxHGlxnKlxnOmx3WnyHWoyHaoyIy20Y23 -0Zm/1pq/16nI3LrT48fb6Mfc6dLi7dbl79zp8d3p8eDr8+Hs8+Tu9O/1+fL3+vb5+/r8/f////// -//////////////////////////////////////////////////////////////////////////// -/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaBwN8v -AAgYj8hksigcKp9QpDNKVQKK1ax2y+16v9nDptMAIwcYEChjPkbUoEk7kPioPYb24AJ/aBEUEgRJ -b2oVAloWahcFRwp2IHhbiouNaHAQXAsdcIyFIIddDJxqGpCSXgkccH1mo6yhrqSobQpjDnO5urtH -WLy8AFO5TVdmV0JBADs=}] +R0lGODlhHAAcAKUkAFmUvFeVvFiVvFmVu1mVvFiWvFiWvVuXvWKbwGKcwGyhxHGlxnKlxnOmx3Wn +yHWoyHaoyIy20Y230Zm/1pq/16nI3LrT48fb6Mfc6dLi7dbl79zp8d3p8eDr8+Hs8+Tu9O/1+fL3 ++vb5+/r8/f////////////////////////////////////////////////////////////////// +/////////////////////////////////////////////yH5BAEKAD8ALAAAAAAcABwAAAaQwJ/w +NwgIjsik8mgYOgnLaJTg/Emv0SEUy0USu+BjIUwuX7flxScUMS8PHBKp41ZW5KRLHdkYyUUKewIH +G3gTYAwYFgh2eBloWBpyGwlIDn4kgGGSk5VweBRkDyF4lHdyj2UQpHIemJpmDSB4hnurtKm2rLCC +DmsSYJCCR0bDSQbGSAA/wntDyVXDVUJ1y0NBADs=}] } 200 { set ckIndArr(default) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAIiIiImJiaqqqqurq/Hx8fLy8v///////yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9dBTDu/9gVwhAwGxhqhqEs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7NRSN32EYOO6VdedbmraeOVDSVkMATxJIAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQRAIeHh4iIiImJiYuLi4yMjJWVlbq6uru7u7y8vOTk5OXl5ebm5unp6erq6vj4 ++Pn5+fr6+v///////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWZ4CeKQWmeaBqM7CeocAy05XAoUKTvfB9BisOgNHoVGr6kMsIoED8BAnJJ +5TGG0ACiyt0ZTotuVxF4BR5i7uOU7rLb1Td8KZ8n6/YePr/b8yN+fIF5g3aFc4dwiW2LaY1ij24m +aH87DicKlTsJZSUHmjpfKwEDDJpXKx8AAQWmfE0BMySkBgmUYg8JBkOpIzG/Ki2+ZsAoLy0hADs=}] set ckIndArr(disabled) [image create photo -format gif -data { -R0lGODlhIAAgAMIHAIiIiImJiZ+fn6CgoM/Pz9DQ0NnZ2f///yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9dBTDu/9gVwhAwGxhqhqEs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7NRSN32EYOO6VdedbmraeOVDSVkMATxJIAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQQAIeHh4iIiImJiYqKipGRkaqqqqurq8bGxsfHx8jIyMrKysvLy9TU1NXV1dbW +1tnZ2f///////////////////////////////////////////////////////////////yH5BAEK +ABAALAAAAAAgACAAAAWYICSKQWmeaBqMLCSocAy05WAgzqPvfP84CMOgNHoRFr6k8qEgECGBAXJJ +5SmG0IChyt0VToluFxF4BRpibuOU7rLb1Td8KZ8n6/YePr/b8x9+fIF5g3aFc4dwiW2LaY1ij24m +aH87DCcIlTsHZSVbmg9fK1EKmlcrEAABBKV8TQEzJFEFB5RiDQcFQ6gjMb4qLb1mvygvLSEAOw==}] set ckIndArr(pressed) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAIiIiImJiZmZmby8vL29vcPDw////////yH5BAEKAAcALAAAAAAgACAAAANi -eAfc/jCqFat9VIzCu/9gRwhAwBBhqnKDs76hC8+cTMP2veZ6yvegH9AjHNYaRh8yGVwyic7nkSGF -UqtTADa7LRSN32EYOO6VdedbmraeOVDVVkMAZw5IAMplL1GY+IB5BwkAOw==}] +R0lGODlhIAAgAIQRAIeHh4iIiImJiYqKio6Ojo+Pj6GhoaKiorW1tba2tre3t7i4uLm5ub+/v8DA +wMHBwcPDw////////////////////////////////////////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWV4CeKQWmeaBqM7CeocAy0pWAkD6TvfA89CcNrJXoRGL6kErIglEgD5HLK +W7w+pQN1uzOcFFxuIjB0hLeO05mrXlPb7iU8npzTe/b7Lq+H8PV/d4F0g3GFbodriWeLYY1sJmZ9 +Ow0nCZM7CGQlBpg6XitkC5hWRAABBKN6CwUBMyRkBgiSYQ4IQk8sMbsqLSObvClXLCEAOw==}] set ckIndArr(alternate) [image create photo -format gif -data { -R0lGODlhIAAgAMIEAElphEpphEpphUpqg////////////////yH5BAEKAAcALAAAAAAgACAAAAM4 -eBfc/hAKtaK9r+LNu/9gKI5kaZ5oqq5sS7xwLBPgbMP1bee63P7AoHBILBqPKcFvoFEBKCvmIQEA -Ow==}] +R0lGODlhIAAgAOMIAEpohUtohEpphEpphUtphEtphUpqhEtqhP////////////////////////// +/////yH5BAEKAA8ALAAAAAAgACAAAART8ElpiLg4a0zA/E+xjSQ2gGVaTmq7HZIrY48xz8B9W3rv +/8CgcEgszhDIpHKJuDGfSSf0KZ0ujdisdsvten857UP8GGANk4ARdBiiQZIcT8YDRQAAOw==}] set ckIndArr(alt_disabled) [image create photo -format gif -data { -R0lGODlhIAAgAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAgACAAAAM3 -SBTc/jAqAqK9b+F9Bf9gKI5kaZ5oqq5s65pDLM/0INa4fOf4ztOvoHBILBqPyKSSpHFNPCxFAgA7}] +R0lGODlhIAAgAMIDAKKioqOjo6SkpP///////////////////yH5BAEKAAQALAAAAAAgACAAAANF +SKoi8TBK6JYlM+soLtigtjhhKSlmChGk6r5wLM90bd94Lg987/8DF3DYExKHxuNPx2w6n9CodCpq +MnQdFC67uHEvtEsCADs=}] set ckIndArr(alt_pressed) [image create photo -format gif -data { -R0lGODlhIAAgAMIGAFeUvFiUvFeVvFiVvFiVvVmVvP///////yH5BAEKAAcALAAAAAAgACAAAAM/ -eAc1/jDKV4Q6YeodF/9b0YBkaZ5oqq5s675wLM+pYd94bpx6f/O+HjCYoxmPyKRyyWweRzSBkXAw -XqAu6iEBADs=}] +R0lGODlhIAAgAOMHAFiUvFmUvFiVu1iVvFiVvVmVvFiWvf////////////////////////////// +/////yH5BAEKAAgALAAAAAAgACAAAARXEEk5qr04l8mRyWBoAV0hniApCWiLCZQrV8hsE4EtE7ps +9sCgcEgsGo+Dg3LJbB5szugSKo1Sq02kdsvteom/bW5LCCMDta0EoJbwjBsOq9iZEN43NCcCADs=}] set ckIndArr(selected) [image create photo -format gif -data { -R0lGODlhIAAgAIQYAElphEpphEpphUpqg0tqhGB7k2J9lICWqYGWqYOZq4WarIaarYicrpKltZOm -tpusu83V3c/X3tDY3+zv8u3w8vb3+ff5+vz9/f///////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAWG4PcFZGmeKCqIY+q+ZwvPdG3feK7vfO+XCArl8DMVKhjMpEgiRJJKZsAB -xTSYR6iEUCRAoBbD7SBUoKhQB26SvDCMyGSEe2O33wEntFLIKS5QblNVajoMgG0PcRhzPAuIVRhh -PoeRGIWUkIx0P49Jk1IJQghSpaanqKkmAqgDMlIALKWuHyEAOw==}] +R0lGODlhIAAgAIQbAEpohUtohEpphEpphUtphEtphUpqhEtqhGB7k2J9lICWqYGWqYOZq4WarIaa +rYicrpKltZOmtpusu83V3c/X3tDY3+zv8u3w8vb3+ff5+vz9/f///////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWj4CeKBiGcaKqiBDC+X7HONDrAdV6Per8eIp8Q9TEMh4Dj0aRsHheXi8JJ +Q2A2Gwv1R8Fmt6qIdwMBo6zeysEsOEy8mcRQEW2sxN7I0YLVPFJoWBRrQ3x9f21dWBgISg0aXn4C +eFh6TQ+QfRJXgoRNDpljG3FgmKIblqWhG4NsAqBYpK4CDFELs7izSbknH7wCIgO5BiMBuDCeW8Qw +IklMQkwwIQA7}] set ckIndArr(sel_disabled) [image create photo -format gif -data { R0lGODlhIAAgAIQUAKKioqOjo6SkpK6urq+vr76+vr+/v8DAwMHBwcLCwsjIyMzMzOXl5ebm5ufn 5/X19fb29vr6+vv7+/7+/v///////////////////////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAV/4PcFZGmeaCp+QOq+5wjPr0DfeK7vfO//OgMEUgCeBhEK5WE0NZTLJkkB -pSikSKhDGmBAJYRcYYhAUaHX3EM5SZiyysZuzXaTnsrIYIeYQNsBZ0ppOwl+bAtJcT99VV9hP4aO -Vk2SUHJSjRRgXAEHQwadoqOkpaakMqIrNlwiIQA7}] +AB8ALAAAAAAgACAAAAWQ4CeKghCcaKqi5uh+ayynwgvMuDyaea+KviDqwxMaj8ikcmaAQArL1SBC +oTyiqkbVikUpthRFNzDdOsYBxlZCEBaciNV3KxY+qpNEqlxtHO94eidaVREDRwgTW3kBc1V1RwmK +eAtUfUuJYGttS5KaYV2eW35jmRRsaAEHTgaprq+pMK8krjVAaLYjY7kvUS8hADs=}] set ckIndArr(sel_pressed) [image create photo -format gif -data { -R0lGODlhIAAgAIQYAFeUvFiUvFeVvFiVvFiVvVmVvGyixG6jxYq10I230Y630o+40pG505u/15vA -16PE2tDh7NLj7dTk7u30+O70+Pb6/Pj6/Pz9/v///////////////////////////////yH5BAEK -AB8ALAAAAAAgACAAAAWP4PcBxWCeaKqehSB+wSrP6Ujfc1HifO//wKBwSOwhKBREMWWoYDCTJSvy -hEpNjiqmcW1WJbtiAVK1HHxHikKVrTp+k+eFgfI+I2FeXE4fFKhPFQZAChdVcwNtT29BDIZyD053 -eT8Lj1oYZkWOmBiMm5cYeFeWT5pXAwlISqitrq+wJpSoArAEH7Avs0O3HyEAOw==}] +R0lGODlhIAAgAIQZAFiUvFmUvFiVu1iVvFiVvVmVvFiWvWyixG6jxYq10I230Y630o+40pG505u/ +15vA16PE2tDh7NLj7dTk7u30+O70+Pb6/Pj6/Pz9/v///////////////////////////yH5BAEK +AB8ALAAAAAAgACAAAAWo4CeKQ2meaFqM7GekcGwCbSHfMC0KeI8KJJ+w9BkaCQGjkKAU2pqlRKWS +gMYOlkyGYlVJtNsu6gHOOMQmLHjyFBci4AtiKK0sUmTww0jRYhonaloSbT59foADBV9aFgdKCxhg +fwN5WntNDZJ+EFmDhUYMm2UZcmKapBmYp6MZhGglolqmsCUKU1VOtSlJuyYEoLUBRb5EHwDFAyNM +tSssPLAty8xHwywhADs=}] } } } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl index f09fbda8..84544ab4 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/svgIndicatorImgs.tcl @@ -3,7 +3,7 @@ # Checkbutton.image_ind and Radiobutton.image_ind of the alt, clam, and default # themes. # -# Copyright (c) 2022-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 2022-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== #------------------------------------------------------------------------------ @@ -260,52 +260,52 @@ proc themepatch::default::createCheckbtnIndImgs_svg fmt { variable ckIndArr set ckIndArr(default) [image create photo -format $fmt -data { - + }] set ckIndArr(disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(pressed) [image create photo -format $fmt -data { - + }] set ckIndArr(alternate) [image create photo -format $fmt -data { - + }] set ckIndArr(alt_disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(alt_pressed) [image create photo -format $fmt -data { - + }] set ckIndArr(selected) [image create photo -format $fmt -data { - + }] set ckIndArr(sel_disabled) [image create photo -format $fmt -data { - + }] set ckIndArr(sel_pressed) [image create photo -format $fmt -data { - + }] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/tclIndex similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/indicatorImgs/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/indicatorImgs/tclIndex diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/mwutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/mwutil.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/mwutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/mwutil.tcl index c245eaca..fbe155e9 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/mwutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/mwutil.tcl @@ -8,7 +8,9 @@ # Copyright (c) 2000-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} # # Namespace initialization @@ -19,7 +21,7 @@ namespace eval mwutil { # # Public variables: # - variable version 2.22 + variable version 2.23 variable library [file dirname [file normalize [info script]]] # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/pkgIndex.tcl similarity index 55% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/pkgIndex.tcl index 461742c4..513df823 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/pkgIndex.tcl @@ -4,8 +4,8 @@ # Copyright (c) 2020-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package ifneeded mwutil 2.22 [list source [file join $dir mwutil.tcl]] -package ifneeded scaleutil 1.12 [list source [file join $dir scaleutil.tcl]] -package ifneeded themepatch 1.6 [list source [file join $dir themepatch.tcl]] -package ifneeded scaleutilmisc 1.6 \ +package ifneeded mwutil 2.23 [list source [file join $dir mwutil.tcl]] +package ifneeded scaleutil 1.14.1 [list source [file join $dir scaleutil.tcl]] +package ifneeded themepatch 1.8 [list source [file join $dir themepatch.tcl]] +package ifneeded scaleutilmisc 1.7.1 \ [list source [file join $dir scaleutilMisc.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/scaleutil.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutil.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/scaleutil.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutil.tcl index b4c46110..7b6aafd9 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/scaleutil.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutil.tcl @@ -9,7 +9,9 @@ # Copyright (c) 2020-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} # # Namespace initialization @@ -20,7 +22,7 @@ namespace eval scaleutil { # # Public variables: # - variable version 1.12 + variable version 1.14.1 variable library [file dirname [file normalize [info script]]] # @@ -140,6 +142,7 @@ proc scaleutil::scalingPercentage winSys { result] == 0 && [set idx \ [string first "'Gdk/WindowScalingFactor'" $result]] >= 0} { + ##nagelfar ignore scan [string range $result $idx end] "%*s <%d>" winScalingFactor } @@ -388,6 +391,7 @@ proc scaleutil::scaleX11Fonts factor { set str [string range $str $idx end] set idx [string first "size" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 9 : $size}] ;# -12 -> 9, else 10 foreach font {TkDefaultFont TkTextFont TkHeadingFont @@ -396,6 +400,7 @@ proc scaleutil::scaleX11Fonts factor { } set idx [string first "ttsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 8 : $size}] ;# -10 -> 8, else 9 foreach font {TkTooltipFont TkSmallCaptionFont} { @@ -403,11 +408,13 @@ proc scaleutil::scaleX11Fonts factor { } set idx [string first "capsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 11 : $size}] ;# -14 -> 11, else 12 font configure TkCaptionFont -size [expr {$factor * $points}] set idx [string first "fixedsize" $str] + ##nagelfar ignore scan [string range $str $idx end] "%*s %d" size set points [expr {$size < 0 ? 9 : $size}] ;# -12 -> 9, else 10 font configure TkFixedFont -size [expr {$factor * $points}] @@ -545,7 +552,11 @@ proc scaleutil::scaleStyles_clam pct { #------------------------------------------------------------------------------ proc scaleutil::scaleStyles_classic pct { ttk::style theme settings classic { - set scrlbarWidth [scale 15 $pct] + if {[ttk::style lookup . -borderwidth] == 1} { + set scrlbarWidth [scale 12 $pct] + } else { + set scrlbarWidth [scale 15 $pct] + } ttk::style configure TScrollbar \ -arrowsize $scrlbarWidth -width $scrlbarWidth diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutilMisc.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutilMisc.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutilMisc.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutilMisc.tcl index 6e9658aa..eedeb07a 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/scripts/utils/scaleutilMisc.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/scaleutilMisc.tcl @@ -9,8 +9,12 @@ # Copyright (c) 2020-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- -package require scaleutil 1.10- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} +if {[catch {package require scaleutil 1.10-}]} { + package require scaleutil 1.10 +} # # Namespace initialization @@ -21,7 +25,7 @@ namespace eval scaleutilmisc { # # Public variables: # - variable version 1.6 + variable version 1.7.1 variable library [file dirname [file normalize [info script]]] # @@ -79,6 +83,7 @@ proc scaleutilmisc::scaleBWidgetComboBox w { # ComboBox::_create_popup $w if {![Widget::theme]} { + ##nagelfar ignore bind $w.shell [format { if {[winfo class %%W] eq "Toplevel"} { %%W.sw.vscroll configure -width %d diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/themepatch.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/themepatch.tcl similarity index 90% rename from src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/themepatch.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/themepatch.tcl index cb74373d..decc508d 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/scrollutil/scripts/utils/themepatch.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/scripts/utils/themepatch.tcl @@ -10,12 +10,18 @@ # Copyright (c) 2022-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {[catch {package require Tk 8.4-}]} { + package require Tk 8.4 +} if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.8- + if {[catch {package require tile 0.8-}]} { + package require tile 0.8 + } } if {![info exists ::tk::scalingPct]} { ;# earlier than Tk 8.7b1 - package require scaleutil 1.10- + if {[catch {package require scaleutil 1.10-}]} { + package require scaleutil 1.10 + } } # @@ -27,7 +33,7 @@ namespace eval themepatch { # # Public variables: # - variable version 1.6 + variable version 1.8 variable library [file dirname [file normalize [info script]]] # @@ -75,6 +81,7 @@ proc themepatch::patch args { } } + set currentTheme [getCurrentTheme] foreach theme $args { if {[lsearch -exact {alt clam default} $theme] < 0} { return -code error \ @@ -110,10 +117,12 @@ proc themepatch::patch args { } } - # - # Send a <> virtual event to all widgets - # - ::ttk::ThemeChanged + if {$theme eq $currentTheme} { + # + # Send a <> virtual event to all widgets + # + ::ttk::ThemeChanged + } } } @@ -133,6 +142,7 @@ proc themepatch::unpatch args { } } + set currentTheme [getCurrentTheme] foreach theme $args { if {[lsearch -exact {alt clam default} $theme] < 0} { return -code error \ @@ -143,10 +153,12 @@ proc themepatch::unpatch args { unpatch_$theme $pct } - # - # Send a <> virtual event to all widgets - # - ::ttk::ThemeChanged + if {$theme eq $currentTheme} { + # + # Send a <> virtual event to all widgets + # + ::ttk::ThemeChanged + } } } @@ -172,6 +184,23 @@ proc themepatch::ispatched theme { # ========================= # +#------------------------------------------------------------------------------ +# themepatch::getCurrentTheme +# +# Returns the current tile theme. +#------------------------------------------------------------------------------ +proc themepatch::getCurrentTheme {} { + if {[catch {ttk::style theme use} result] == 0} { + return $result + } elseif {[info exists ::ttk::currentTheme]} { + return $::ttk::currentTheme + } elseif {[info exists ::tile::currentTheme]} { + return $::tile::currentTheme + } else { ;# this is highly improbable + return "" + } +} + #------------------------------------------------------------------------------ # themepatch::patch_alt # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist.tcl similarity index 85% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist.tcl index fd07b3d2..d6c9cb1f 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist.tcl @@ -4,8 +4,7 @@ # Copyright (c) 2000-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- -package require -exact tablelist::common 7.2 +package require -exact tablelist::common 7.4.1 package provide tablelist $::tablelist::version package provide Tablelist $::tablelist::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelistCommon.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelistCommon.tcl similarity index 90% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelistCommon.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelistCommon.tcl index 8ea312cf..91c4b774 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelistCommon.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelistCommon.tcl @@ -5,10 +5,14 @@ #============================================================================== namespace eval ::tablelist { + proc - {} { return [expr {$::tcl_version >= 8.5 ? "-" : ""}] } + + package require Tk 8.4[-] + # # Public variables: # - variable version 7.2 + variable version 7.4.1 variable library [file dirname [file normalize [info script]]] # @@ -92,17 +96,17 @@ lappend auto_path [file join $::tablelist::library scripts] # proc ::tablelist::loadUtils {} { if {[catch {package present mwutil} version] == 0 && - [package vcompare $version 2.22] < 0} { + [package vcompare $version 2.23] < 0} { package forget mwutil } - package require mwutil 2.22- + package require mwutil 2.23[-] if {[catch {package present scaleutil} version] == 0 && - [package vcompare $version 1.12] < 0} { + [package vcompare $version 1.14.1] < 0} { package forget scaleutil } - package require scaleutil 1.12- + package require scaleutil 1.14.1[-] - package require scaleutilmisc 1.6- + package require scaleutilmisc 1.7.1[-] } ::tablelist::loadUtils diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist_tile.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist_tile.tcl similarity index 87% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist_tile.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist_tile.tcl index 1cff5236..a6496fd1 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tablelist/tablelist_tile.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tablelist/tablelist_tile.tcl @@ -4,11 +4,11 @@ # Copyright (c) 2000-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +package require -exact tablelist::common 7.4.1 + if {$::tk_version < 8.5 || [regexp {^8\.5a[1-5]$} $::tk_patchLevel]} { - package require tile 0.6- + package require tile 0.6[::tablelist::-] } -package require -exact tablelist::common 7.2 package provide tablelist_tile $::tablelist::version package provide Tablelist_tile $::tablelist::version diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/text/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/text/pkgIndex.tcl new file mode 100644 index 00000000..8ef2202d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/text/pkgIndex.tcl @@ -0,0 +1 @@ +package ifneeded dgw::txmixins 0.2.0 [list source [file join $dir txmixins.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/text/txmixins.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/text/txmixins.tcl new file mode 100644 index 00000000..434d17fb --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/text/txmixins.tcl @@ -0,0 +1,1382 @@ +#!/usr/bin/env tclsh +############################################################################## +# +# Created By : Dr. Detlef Groth +# Created : Thu Aug 12 12:00:00 2021 +# Last Modified : <210930.0539> +# +# Description +# +# Notes +# +# History +# +############################################################################## +# +# Copyright (c) 2021 Dr. Detlef Groth. +# +############################################################################## +#' --- +#' documentclass: scrartcl +#' title: dgw::txmixins __PKGVERSION__ +#' author: Detlef Groth, Schwielowsee, Germany +#' --- +#' +#' ## NAME +#' +#' **dgw::txmixins** - implementations of extensions for the *text* +#' widget which can be added dynamically using chaining of commands +#' at widget creation or using the *dgw::txmixin* command after widget +#' creation. +#' +#' ## TABLE OF CONTENTS +#' +#' - [SYNOPSIS](#synopsis) +#' - [DESCRIPTION](#description) +#' - [WIDGET COMMANDS](#commands) +#' - [dgw::txmixin](#txmixin) - method to add one mixin widgetadaptor to text widget after widget creation +#' - [dgw::txlipsum](#txlipsum) - method to generate simple lipsum text +#' - [WIDGET ADAPTORS](#adapters) +#' - [dgw::txautorep](#txautorep) - adapter to generate short abbreviations snippets invoked after closing parenthesis +#' - [dgw::txblocksel](#txblocksel) - adaptor rectangular text selection in the text widget +#' - [dgw::txfileproc](#txfileproc) - adaptor which implements the typical file commands for the text widget, fileOpen, fileSave etc. +#' - [dgw::txfold](#txfold) - adaptor for a folding text editor +#' - [dgw::txhighlight](#txhighlight) - adaptor for text widget supporting syntax highlighting +#' - [dgw::txindent](#txindent) - adaptor to keep indentation of previous line +#' - [dgw::txpopup](#txpopup) - adaptor for typical right click popup implementation +#' - [dgw::txrotext](#txrotext) - adaptor for a read only text widget +#' - [EXAMPLE](#example) +#' - [INSTALLATION](#install) +#' - [DEMO](#demo) +#' - [DOCUMENTATION](#docu) +#' - [SEE ALSO](#see) +#' - [CHANGES](#changes) +#' - [TODO](#todo) +#' - [AUTHORS](#authors) +#' - [COPYRIGHT](#copyright) +#' - [LICENSE](#license) +#' +#' ## SYNOPSIS +#' +#' ``` +#' package require Tk +#' package require snit +#' package require dgw::txmixins +#' ::dgw::txmixin pathName widgetAdaptor ?options? +#' ::dgw::txfold [tk::text pathName ?options?] ?options? +#' set txt [tk::text pathName ?options?] +#' dgw::txmixin $txt dgw::txfold ?options? +#' ``` +#' +#' ## DESCRIPTION +#' +#' The package **dgw::txmixins** implements several *snit::widgetadaptor*s which +#' extend the standard *tk::text* widget with different functionalities. +#' Different adaptors can be chained together to add the required functionalities. +#' Furthermore at any later time point using the *dgw::txmixin* command other adaptors can be installed on the widget. +#' +#' ## WIDGET COMMANDS +#' +package require Tk +package require snit + +namespace eval ::dgw { + variable vlipsum + set vlipsum " Lorem ipsum dolor sit amet, consectetur adipiscing elit, + sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. + Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi + ut aliquip ex ea commodo consequat. + Duis aute irure dolor in reprehenderit in voluptate velit esse cillum + dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat + non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.\n +" + catch { + font create headerfont -family Monaco -size 16 + } + catch { + font create headerfont -family Consolas -size 16 + } +} +package provide dgw::txmixins 0.2.0 + +# dgw::txmixin docu { +#' +#' **dgw::txmixin** *pathName mixinWidget ?-option value ...?* +#' +#' Adds the properties and methods of a snit::widgetadaptor specified with *mixinWidget* +#' to the exising widget created before with the given *pathName* and configures the widget +#' using the given *options*. +#' +#' Example: +#' +#' > ``` +#' # demo: mixin +#' # standard text widget +#' set text [tk::text .txt] +#' pack $text -side top -fill both -expand true +#' dgw::txmixin $text dgw::txfold +#' # fill the widget +#' $text insert end "\n## Hint\n\nPress F2 or F3 and see what happend!" +#' for {set i 1} {$i < 4} {incr i} { +#' $text insert end "## Header $i\n\n" +#' $text insert end [dgw::lispum 3] +#' } +#' > ``` +#' +# } + +proc ::dgw::txmixin {pathName mixinWidget args} { + return [$mixinWidget $pathName {*}$args] +} + + +# dgw::txlipsum docu { +#' +#' **dgw::txlipsum** *dgw::txlipsum n* +#' +#' Returns *n* paragraphs of simple lipsum text. +#' +#' Example: +#' +#' > ``` +#' # demo: txlipsum +#' tk::text .txt +#' .txt insert end "[dgw::txlipsum 5]" +#' .txt configure -borderwidth 10 -relief flat +#' pack .txt -side top -fill both -expand yes -padx 5 -pady 5 +#' > ``` +#' +# } + +proc ::dgw::txlipsum {n} { + variable vlipsum + return [string repeat $vlipsum $n] +} + +#' ## WIDGET ADAPTERS +#' + +# dgw::txautorep docu { +#' +#' **dgw::txautorep** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txautorep* widget using the Tk window id _pathName_ and +#' the given *options*. All options are delegated to the standard text widget. +#' Based on code in the Wiki page https://wiki.tcl-lang.org/page/autoreplace started by Richard Suchenwirth in 2008. +#' +#' The following option is available: +#' +#' > - *-automap* *list* - list of abbreviations and their replacement, the abbreviations must end with a closing +#' parenthesis such as [list DG) {Detlef Groth}]. +#' +#' Example: +#' +#' > ``` +#' # demo: txautorep +#' dgw::txautorep [tk::text .txt] -automap [list (TM) \u2122 (C) \ +#' \u00A9 (R) \u00AE (K) \u2654 D) {D Groth} \ +#' (DG) {Detlef Groth, University of Potsdam}] +#' .txt insert end "type a few abbreviations like (TM), (C), (R) or (K) ..." +#' pack .txt -side top -fill both -expand yes +#' > ``` +#' +#' TODO: Take abbreviations from file +#' +#' +# } + +::snit::widgetadaptor ::dgw::txautorep { + delegate option * to hull + delegate method * to hull + option -automap [list (DG) {Detlef Groth\nUniversity of Potsdam}] + constructor {args} { + installhull $win + $self configurelist $args ;#( + bind $win [mymethod autochange] + } + method autochange {} { + set w $win + foreach {abbrev value} $options(-automap) { + set n [string length $abbrev] + if {[$w get "insert-$n chars" insert] eq $abbrev} { + $w delete "insert-$n chars" insert + $w insert insert $value + break + } + } + } +} + +# dgw::txblocksel docu { +#' +#' **dgw::txblocksel** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txblocksel* widget using the Tk window id _pathName_ and +#' the given *options*. The text widget supports the block selection of text using +#' The Control-key together with left mouse down and movement for selecting the text. +#' +#' So the steps are: +#' +#' * Control-ButtonPress-1 to activate block selection +#' * Control-Button1-Motion to modify (increase/decrease) the selection +#' * Control-x to cut selection, Control-c to copy selection to clipboard +#' +#' The widget adaptor code is just an adaption from the Wiki code written by Martin Eder here: +#' [Simple Block Selection for Text Widget](https://wiki.tcl-lang.org/page/Simple+Block+Selection+for+Text+Widget). +#' +#' The widget adaptor currently has no options and public methods which should be used. +#' The code is however a good example on how to port namespace based widget code into +#' a snit widgetadaptor using snit procedures only. +#' +#' Example: +#' +#' > ``` +#' # demo: txblocksel +#' dgw::txblocksel [tk::text .txt -undo true] +#' .txt insert end "\nHint:\n\n* Press Ctrl-Button-1 and then, by holding move the mouse\n" +#' .txt insert end "to the bottom right.\n* For copy and paste use Control-c and Control-v." +#' .txt tag configure hint -foreground #1166ff +#' .txt tag add hint 1.0 6.end +#' .txt insert end "\n\nBlock selection!\n\n" +#' foreach col [list A B C] { +#' .txt insert end "# Header $col\n\nSome text\n\n" +#' .txt insert end [dgw::txlipsum 2] +#' .txt insert end "\n\n" +#' } +#' .txt configure -borderwidth 10 -relief flat +#' pack .txt -side top -fill both -expand yes -padx 5 -pady 5 +#' > ``` +#' +# https://wiki.tcl-lang.org/page/Simple+Block+Selection+for+Text+Widget +# } + +snit::widgetadaptor dgw::txblocksel { + delegate option * to hull + delegate method * to hull + variable spos + constructor {args} { + installhull $win + $self configurelist $args + bind Text [list [myproc mouse_down] %W %x %y] + bind Text [list [myproc block_sel] %W %x %y] + bind Text [list [myproc copy_blocksel] .txt 1] + bind Text [list [myproc copy_blocksel] .txt 0] + } + proc block_sel {wid x y} { + $wid tag remove sel 0.0 end + set fpos [split [$wid index "@$x,$y"] "."] + for {set sl [lindex $::spos 0]} {$sl <= [lindex $fpos 0]} {incr sl} { + $wid tag add sel "$sl.[lindex $::spos 1]" "$sl.[lindex $fpos 1]" + } + } + proc mouse_down {wid x y} { + $wid mark set insert "@$x,$y" + $wid tag remove sel 0.0 end + set ::spos [split [$wid index insert] "."] + } + proc copy_blocksel {txt {cutit 0}} { + set starttag [$txt index end] + set mseltxt "" + + while {[set curmtag [$txt tag prevrange sel $starttag]] != ""} { + set msta [lindex $curmtag 0] + set msto [lindex $curmtag 1] + set mseltxt "[$txt get $msta $msto]\n$mseltxt" + if {$cutit == 1} {$txt delete $msta $msto} + set starttag [lindex $curmtag 0] + } + if {$mseltxt != ""} { + clipboard clear + clipboard append -- $mseltxt + } + } + +} + +# dgw::txfileproc docu { +#' **dgw::txfileproc** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txfileproc* widget using the Tk window id _pathName_ and +#' the given *options*. The text widget supports the typical file actions, so fileNew, fileOpen, fileSave, fileSaveAs and fileExit with checks +#' for file modifications. It comes with a set of default bindings which can be disabled quite easily, see below for an example. +#' +#' The following options are available: +#' +#' > - *-openkey* *sequence* - the key sequence to open the file open dialog, can be inactivated by supplying an empty string, default: *Control-o* +#' - *-savekey* *sequence* - the key sequence to save the current file or the file save as dialog if there is currently no file opened, can be inactivated by supplying an empty string, default: *Control-s* +#' - *-newkey* *sequence* - the key sequence to create an empty new file with checking for modified text, can be inactivated by supplying an empty string, default: *Control-n* +#' - *-quitkey* *sequence* - the key sequence to close the application with checking for modified text, can be inactivated by supplying an empty string, default: "Control-q" +#' - *-filecallback* *proc* - a callback to be executed if a file action like fileSave etc is performed, the Tcl procedure must take two arguments, first the action, second the filename, see below for an example, default: empty string, so no callback. +#' - *-filetypes* *list* - the filetypes to be used for the file dialogs, defaults to Text (\*.txt), Tcl (\*.tcl, \*.tm), Markdown (\*.md, \*.rmd) and any (\*.\*) files. +#' - *-initdir* *directory* - the initial starting dir for the first file dialog, subsequent file dialogs will use the directory for the last opened files. +#' +#' The following public methods are available: +#' +#' > - *getFile* - get the currently loaded file, if no file is loaded yet returns \*new\* +#' - *fileNew* - creates a new empty file named \*new\* +#' - *fileSave* - saves the currently opened file, if it is a new file, fileSaveAs will be called +#' - *fileSaveAs* - calls the file save dialog to save the current text in a new file +#' - *fileOpen ?filename?* - will open the given filename or if no filename is given opens the file dialog to select a file. +#' - *fileExit* - checks for text modifications and will then quit the application +#' - *fileRecent* - returns the last recent opened files with the last file as first element +#' +#' The following events are implemented by this widget adaptor: +#' +#' > - <\> if a new file is opened or the save-as option is called. +#' - <\> if the current file is saved +#' +#' Example: +#' +#' > ``` +#' # demo: txfileproc +#' dgw::txfileproc [tk::text .txt -undo true] -openkey "" ;# disable Control-o rebind it below +#' .txt insert end "\nHint\n\nPress ctrl-o, control-n, control-s\n and see the" +#' .txt insert end "standard file dialogs!\n\n" +#' foreach col [list A B C] { +#' .txt insert end "# Header $col\n\nSome text\n\n" +#' .txt insert end [dgw::txlipsum 2] +#' .txt insert end "\n\n" +#' } +#' .txt configure -borderwidth 10 -relief flat +#' .txt configure -filecallback callback +#' pack .txt -side top -fill both -expand yes -padx 5 -pady 5 +#' pack [label .label -text ""] -side top -fill x -expand false -padx 5 -pady 5 +#' bind .txt { focus -force .txt } +#' bind .txt [list .txt fileExit] +#' bind .txt [list .txt fileOpen] +#' dgw::txmixin .txt dgw::txpopup ;# right click popup +#' proc callback {type filename} { +#' .label configure -text "Done: $type with [file tail $filename]" +#' puts [.txt fileRecent] +#' } +#' proc eventMessage {w} { +#' puts "currentFile [$w getFile]" +#' } +#' bind .txt <> [list eventMessage %W] +#' +#' > ``` +#' +# } + +snit::widgetadaptor dgw::txfileproc { + delegate option * to hull + delegate method * to hull + option -openkey Control-o + option -newkey Control-n + option -savekey Control-s + option -quitkey Control-q + option -filetypes { + {{Text Files} {.txt} } + {{Tcl Files} {.tcl .tm} } + {{Markdown Files} {.md .Rmd} } + {{All Files} * } + } + option -initdir "" + variable lastfile "*new*" + variable lastdir "." + variable info "" + variable lastfiles [list] + option -filecallback "" + constructor {args} { + installhull $win + $self configurelist $args + #bind $win <$options(-openkey)> break + if {$options(-newkey) ne ""} { + bind $win <$options(-newkey)> "[mymethod fileNew] ; break " + } + if {$options(-savekey) ne ""} { + bind $win <$options(-savekey)> "[mymethod fileSave]; break " + } + if {$options(-openkey) ne ""} { + bind $win <$options(-openkey)> "[mymethod fileOpen]; break" + } + if {$options(-quitkey) ne ""} { + bind $win <$options(-quitkey)> "[mymethod fileExit]; break" + } + if {$options(-initdir) ne ""} { + set lastdir $options(-initdir) + } + } + method getFile {} { + return $lastfile + } + method fileNew {} { + if {[$win edit modified]} { + set answer [tk_messageBox -title "File modified!" -message "Do you want to save changes?" -type yesnocancel -icon question] + switch -- $answer { + yes { + $self fileSave + } + cancel { return } + } + } + $win delete 1.0 end + set lastfile "*new*" + if {$options(-filecallback) ne ""} { + eval $options(-filecallback) new $lastfile + } + event generate $win <> + return "*new*" + } + method fileOpen {{filename ""}} { + if {[$win edit modified]} { + set answer [tk_messageBox -title "File modified!" -message "Do you want to save changes?" -type yesnocancel -icon question] + switch -- $answer { + yes { + $self fileSave + } + cancel { return } + } + } + if {$filename eq ""} { + set filename [tk_getOpenFile -filetypes $options(-filetypes) -initialdir $lastdir] + + } + if {$filename ne ""} { + if [catch {open $filename r} infh] { + tk_messageBox -title "Info!" -icon info -message "Cannot open $filename: $infh" -type ok + } else { + $win delete 1.0 end + while {[gets $infh line] >= 0} { + $win insert end "$line\n" + } + close $infh + set lastfile $filename + set lastdir [file dirname $filename] + $win edit modified false + if {$options(-filecallback) ne ""} { + eval $options(-filecallback) open $lastfile + } + $self PushFile + event generate $win <> + } + } + return $filename + } + method fileSave {} { + if {$lastfile eq "*new*"} { + unset -nocomplain savefile + set file [tk_getSaveFile -filetypes $options(-filetypes) \ + -initialdir $lastdir] + } else { + set file $lastfile + } + if {$file != ""} { + set out [open $file w 0600] + puts $out [$win get 1.0 end] + close $out + set lastfile $file + set lastdir [file dirname $lastfile] + $win edit modified false + if {$options(-filecallback) ne ""} { + eval $options(-filecallback) save $lastfile + } + $self PushFile + event generate $win <> + } + return $file + } + method fileSaveAs {} { + unset -nocomplain savefile + set filename [tk_getSaveFile -filetypes $options(-filetypes) -initialdir $lastdir] + if {$filename != ""} { + set out [open $filename w 0600] + puts $out [$text get 1.0 end] + close $out + set lastfile $filename + set lastdir [file dirname $file] + $win edit modified false + if {$options(-filecallback) ne ""} { + eval $options(-filecallback) saveas $lastfile + } + $self PushFile + event generate $win <> + event generate $win <> + } + return $filename + } + method fileExit {} { + if {[$win edit modified]} { + set answer [tk_messageBox -title "File modified!" -message "Do you want to save changes?" -type yesnocancel -icon question] + switch -- $answer { + yes { + $self fileSave + } + cancel { return } + } + } + exit 0 + } + method fileRecent {} { + set t {} + foreach i $lastfiles {if {[lsearch -exact $t $i]==-1} {lappend t $i}} + set lastfiles $t + return $t + } + method PushFile {} { + set lastfiles [linsert $lastfiles 0 $lastfile] + } + +} +#' +#' **dgw::txfold** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txfold* widget using the Tk window id _pathName_ and +#' the given *options*. The widgets supports text folding based on linestart regular expressions usually which allows fast navigation of larger +#' documents by hiding and showing larger chunks of text within the folding marks. +#' +#' The following options are available: +#' +#' > - *-foldkey* *sequence* - the key sequence fold or unfold regions where the insert cursor is within, default: F2 +#' - *-foldallkey* *sequence* - the key sequence to fold/unfold the complete text, default: F3 +#' - *-foldstart* *regex* - the start folding marker, default is Markdown header folding using the '#' at the beginning, default: "^#" +#' - *-foldend* *regex* - the end fold marker, where the folding ends, if the end marker is the same as the start marker folding is ended in the line before the end line, otherwise on the end line, default: "^#" +#' +#' The following widget tags are created and can be modified at runtime: +#' +#' > - *fold* - the folding line which remains visible, usually the background should be configured only, default is `#ffbbaa` a light salmon like color +#' - *folded* - the hidden (-elide true) part which is invisible, usually not required to change it, as it is hidden +#' +#' Example: +#' +#' > ``` +#' # demo: txfold +#' dgw::txfold [tk::text .txt] +#' foreach col [list A B C] { +#' .txt insert end "# Header $col\n\nSome text\n\n" +#' } +#' .txt insert end "Place the cursor on the header lines and press F2\n" +#' .txt insert end "or press F3 to fold or unfold the complete text.\n" +#' .txt tag configure fold -background #cceeff +#' .txt configure -borderwidth 10 -relief flat +#' pack .txt -side top -fill both -expand yes +#' # next line would fold by double click (although I like F2 more ...) +#' # .txt configure -foldkey Double-1 +#' bind .txt { focus -force .txt } +#' > ``` +#' +#' TODO: add Tcl fold example + +# widget adaptor which does a folding text +snit::widgetadaptor ::dgw::txfold { + delegate option * to hull + delegate method * to hull + option -foldkey F2 + option -foldall F3 + option -foldstart "^#" + option -foldend "^#" + # problem: + # can't avoid delegating insert as if it is + # overwritten parent insert can't be called + # solved by adding trace executation + # might slow down the widget + constructor {args} { + installhull $win + $self configurelist $args + set fold $options(-foldkey) + set foldall $options(-foldall) + bind $win <$fold> [mymethod FoldCurrent] + bind $win <$foldall> [mymethod FoldAll] + $win tag configure fold -background #ffbbaa + $win tag configure folded -elide true + + } + method FoldAll {} { + set text $win + set rng [$text tag ranges fold] + if {[llength $rng] ==0} { + set store [$text index insert] + set current [$text index insert] + set lastrng [list] + set start 1.0 + set start [$text search -regexp -forward $options(-foldstart) 1.0] + set start [$text index "$start + 1 line"] + tk::TextSetCursor $text $start + set x 1 + while {true} { + $self FoldCurrent + set rng [$text tag ranges folded] + if {[llength $lastrng] == [llength $rng]} { + break + } + set current1 [lindex $rng end] + if {$options(-foldstart) eq $options(-foldend)} { + set current2 [$text index "$current1 - 1 line"] + } else { + set current2 [$text index "$current1"] + } + set current2 [$text search -regexp -forward $options(-foldstart) $current2 end] + if {$current2 eq ""} break + tk::TextSetCursor $text $current2 + set lastrng $rng + } + tk::TextSetCursor $text $store + } else { + $text tag remove fold 1.0 end + $text tag remove folded 1.0 end + $text see insert + } + } + onconfigure -foldkey value { + if {$value ne ""} { + set fold $options(-foldkey) + bind $win <$fold> {} + bind $win <$value> [mymethod FoldCurrent] + set options(-foldkey) $value + } + return $options(-foldkey) + } + onconfigure -foldall value { + if {$value ne ""} { + set fold $options(-foldall) + bind $win <$fold> {} + bind $win <$value> [mymethod FoldAll] + set options(-foldall) $value + } + return $options(-foldall) + } + + method FoldCurrent {} { + set text $win + set folds [$self getFolds] + puts $folds + set current [$text index insert] + if {[lsearch [$text tag names $current] fold] > -1} { + $text tag remove fold "$current linestart" "$current lineend + 1 char" + $text tag remove folded "$current lineend + 1 char" "[lindex $folds 1] lineend" + } else { + if {[llength $folds] > 0} { + $text tag add fold "[lindex $folds 0] linestart" "[lindex $folds 0] lineend + 1char" + $text tag add folded "[lindex $folds 0] lineend + 1 char" "[lindex $folds 1]" + if {[$text compare "$current linestart" != "[lindex $folds 0] linestart"]} { + tk::TextSetCursor $text "[lindex $folds 0] linestart" + } + } + } + return + } + method isInFold {} { + set text $win + set current [$text index insert] + set foldOpen [$text search -all -elide -regexp -forward $options(-foldstart) 1.0 end] + set foldEnd [$text search -all -elide -regexp -forward $options(-foldend) 1.0 end] + set ret [list] + for {set i 0} {$i < [llength $foldOpen]} {incr i 1} { + if {[$text compare [lindex $foldOpen $i] <= $current]} { + if {[$text compare $current <= [lindex $foldEnd $i]]} { + set ret [list [lindex $foldOpen $i] [$text index "[lindex $foldEnd $i] + 1 line"]] + break + } + } + } + return $ret + } + method getFolds {} { + set text $win + set current [$text index insert] + set foldendb [$text search -elide -regexp -backward $options(-foldend) $current 1.0] + set foldstart [$text search -elide -regexp -backward $options(-foldstart) "$current + 1 char" 1.0] + + if {$options(-foldstart) eq $options(-foldend)} { + set foldende [$text search -elide -regexp -forward $options(-foldend) "$current + 1 char" end] + } else { + set foldende [$text search -elide -regexp -forward $options(-foldend) "$current" end] + } + #puts "foldendb: $foldendb" + #puts "foldende: $foldende" + #puts "foldstart: $foldstart" + #puts "current: $current" + if {$options(-foldstart) eq $options(-foldend)} { + if {$foldstart ne "" & $foldende eq ""} { + return [list $foldstart end] + } else { + return [list [$text index "$foldstart linestart"] [$text index "$foldende linestart"]] + } + } else { + + return [$self isInFold] + + } + } +} +#' +#' **dgw::txhighlight** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txhighlight* widget using the Tk window id _pathName_ and +#' the given *options*. The widgets supports text highlighting for different file +#' types by providing tag names and regular expressions. +#' +#' The following options are available: +#' +#' > - *-highlightcommand* *proc* - a possible command to be used for hilighting, default: empty string, i.e. none +#' - *-highlights* *list* - a nested list with highlights first element file type, second tag, third regular expression +#' +#' The following widget tags are created and can be used for highlighting and can be as well +#' as well configured by the user to change the appearance +#' +#' > - *header, comment, highlight, keyword, operator, string, package, class, method, proc* +#' +#' Example: +#' + +#' ``` +#' # demo: txhighlight +#' package require dgw::txmixins +#' text .top -borderwidth 5 -relief flat -font "Helvetica 14" +#' dgw::txmixin .top dgw::txhighlight +#' .top configure -highlights {{md header ^#.+} +#' {md comment ^>.+} +#' {md keyword _{1,2}[^_]+_{1,2}} +#' {md string {"[^"]+"}}} +#' pack .top -side top -fill both -expand true ;#" +#' # TODO: txfileproc .top configure -filetypes {{Markdown Files} {.md}} +#' +#' # configure for Markdown highlight +#' .top configure -highlights {{md header ^#.+} +#' {md comment ^>.+} +#' {md keyword _{1,2}[^_]+_{1,2}} +#' {md string {"[^"]+"}}} +#' .top configure -mode md +#' # create sample Markdown text and insert it +#' .top insert end "# Header example\n" +#' .top insert end "_keyword_ example\n" +#' .top insert end "Some not highlighted text\n" +#' .top insert end "> some markdown quote text\n" +#' .top insert end "## Subheader\n" +#' .top insert end "Some more standard text with two \"strings\" which are \"inside!\"" +#' .top insert end "\n\n## Tcl\n\nTcl be with you!\n\n## EOF\n\nThe End\n" +#' .top insert 3.0 "\nSome text\nSome more text" +#' update +#' after 2000 +#' update +#' after 2000 +#' # switch to SQL highlight which is embedded per default +#' .top delete 1.0 end +#' .top configure -mode sql +#' .top insert end "select * from temp limit 10;\n -- a comment in SQL\n drop table temp;\n" +#' ``` +#' + +snit::widgetadaptor dgw::txhighlight { + delegate option * to hull + delegate method * to hull + option -highlightcommand "" + option -highlights [list {tcl highlight "^(itcl|oo|snit)::\[a-zA-Z0-9 \]+"} \ + {tcl highlight "^ *(method|constructor|typeconstructor|destructor|typedestructor|proc) *\[a-zA-Z0-9 \]+"} \ + {tcl package "^ *(package|source).+"} \ + {tcl comment "^ *#.*"} \ + {tcl comment " ;#.+"} \ + {txt package "^!+.+"} \ + {txt comment "^ *.+\$"} \ + {sql string {".+?"}} \ + {sql highlight {\m(asc|all|attach|begin|between|by|commit|create|database|desc|detach|distinct|drop|except|exists|filter|from|full|glob|group|having|if|in|index|inner|insert|intersect|into|is|isnull|join|like|limit|match|natural|not|notnull|on|or|order|order|outer|pragma|primary|range|regexp|right|select|table|temp|transaction|trigger|union|unique|update|using|view|where|with|without)\M}} \ + {sql comment "^ *--.+\$"} \ + ] + option -mode "" + variable lastfile "" + variable lastmode "" + variable modified false + variable tags [list header comment highlight string package class method proc operator] + variable id -1 + variable textw + constructor {args} { + installhull $win + set textw $win + $self configurelist $args + $textw tag configure header -underline 1 -foreground "dark blue" + $textw tag configure highlight -foreground blue + $textw tag configure keyword -foreground blue + $textw tag configure operator -foreground blue + $textw tag configure string -foreground magenta + $textw tag configure package -foreground "#aa6633" + $textw tag configure class -foreground "#33cc99" + $textw tag configure method -foreground "#33aa88" + $textw tag configure proc -foreground "#33aa88" + $textw tag configure comment -underline 0 -foreground "#999999" + bind $win [mymethod Keypress %K] + #trace add execution $textw enter [mymethod textenter] + trace add execution $textw leave [mymethod textleave] + } + method textleave {args} { + if {[lindex $args 0 1] eq "insert"} { + #puts "current: [[lindex $args 0 0] index end]" + if {$id == -1} { + set id 0 + after 1000 [mymethod updateHighlight] + } + } + } + method updateHighlight {} { + if {$options(-mode) ne ""} { + $self doHilights $options(-mode) + update + } + set id -1 + } + #method textleave {args} { + # if {[lindex $args 0 1] eq "insert"} { + # puts "$args" + # } + # + #} + # method insert {args} { + # $textw insert {*}$args + # $self GuiTextChanged + # } + # method delete {args} { + # $textw delete {*}$args + # $self GuiTextChanged + # } + onconfigure -highlights value { + set m [lindex [lindex $value 0] 0] + #puts $m + # remove old highlight for this file type $m + set idx [lsearch -index 0 -all -not $options(-highlights) $m] + set options(-highlights) [lmap a $idx { lindex $options(-highlights) $a } ] + # add new highlights + foreach val $value { + lappend options(-highlights) $val + } + } + method addHilights {value} { + foreach val $value { + lappend options(-highlights) $val + } + } + method ForText {w args} { + + # initialize search command; we may add to it, depending on the + # arguments passed in... + set searchCommand [list $w search -count count] + + # Poor man's switch detection + set i 0 + while {[string match {-*} [set arg [lindex $args $i]]]} { + + if {[string match $arg* -regexp]} { + lappend searchCommand -regexp + incr i + } elseif {[string match $arg* -elide]} { + lappend searchCommand -elide + incr i + } elseif {[string match $arg* -nocase]} { + lappend searchCommand -nocase + incr i + } elseif {[string match $arg* -exact]} { + lappend searchCommand -exact + incr i + } elseif {[string compare $arg --] == 0} { + incr i + break + } else { + return -code error "bad switch \"$arg\": must be\ + --, -elide, -exact, -nocase or -regexp" + } + } + + # parse remaining arguments, and finish building search command + foreach {pattern start end script} [lrange $args $i end] {break} + lappend searchCommand $pattern matchEnd searchLimit + + # make sure these are of the canonical form + set start [$w index $start] + set end [$w index $end] + + # place marks in the text to keep track of where we've been + # and where we're going + $w mark set matchStart $start + $w mark set matchEnd $start + $w mark set searchLimit $end + + # default gravity is right, but we're setting it here just to + # be pedantic. It's critical that matchStart and matchEnd have + # left and right gravity, respectively, so that any text inserted + # by the caller duing the search won't normally (*) cause an infinite + # loop. + # (*) If the script inserts text after the matchEnd mark, and the + # text that was added matches the pattern, madness will ensue. + $w mark gravity searchLimit right + $w mark gravity matchStart left + $w mark gravity matchEnd right + + # finally, the part that does useful work. Keep running the search + # command until we don't find anything else. Each time we find + # something, adjust the marks and execute the script + while {1} { + set cmd $searchCommand + set index [eval $searchCommand] + if {[string length $index] == 0} break + + $w mark set matchStart $index + $w mark set matchEnd [$w index "$index + $count c"] + + uplevel $script + } + } + method Keypress {key} { + if {$key eq "Return" || $key eq "space" || ![regexp {[a-zA-Z0-9]} $key]} { + if {$lastmode ne ""} { + $self doHilights $lastmode + } else { + $self doHilights "" + } + } + } + method doHilights {{mode tcl}} { + if {$options(-highlightcommand) ne ""} { + $options(-highlightcommand) $text + return + } + if {$lastfile ne ""} { + set mode [string tolower [string range [file extension $lastfile] 1 end]] + } + set lastmode $mode + set text $textw + foreach tag [$text tag names] { + if {[lsearch $tags $tag] != -1} { + $text tag remove $tag 1.0 end + } + } + foreach tps $options(-highlights) { + foreach {tp tag regex} $tps { + if {$tp eq $mode} { + $self ForText $text -regexp -nocase $regex 1.0 end { + $text tag add $tag matchStart matchEnd + } + } + } + } + } + method isModified {} { + return [$text edit modified] + } + + +} + +# dgw::txindent docu { +#' +#' **dgw::txindent** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txindent* widget using the Tk window id _pathName_ and +#' the given *options*. All options are delegated to the standard text widget. +#' The widget indents every new line based on the initial indention of the previous line. +#' Based on code in the Wiki page [https://wiki.tcl-lang.org/page/auto-indent](https://wiki.tcl-lang.org/page/auto-indent) started by Richard Suchenwirth. +#' +#' Example: +#' +#' > ``` +#' # demo: txindent +#' dgw::txindent [tk::text .txt] +#' foreach col [list A B C] { +#' .txt insert end "# Header $col\n\nSome text\n\n" +#' } +#' .txt insert end " * item 1\n * item 2 (press return here)" +#' pack .txt -side top -fill both -expand yes +#' > ``` +# } + +::snit::widgetadaptor ::dgw::txindent { + delegate option * to hull + delegate method * to hull + constructor {args} { + installhull $win + $self configurelist $args + bind $win "[mymethod indent]; break" + } + + method indent {{extra " "}} { + set w $win + set lineno [expr {int([$w index insert])}] + set line [$w get $lineno.0 $lineno.end] + regexp {^(\s*)} $line -> prefix + if {[string index $line end] eq "\{"} { + tk::TextInsert $w "\n$prefix$extra" + } elseif {[string index $line end] eq "\}"} { + if {[regexp {^\s+\}} $line]} { + $w delete insert-[expr [string length $extra]+1]c insert-1c + tk::TextInsert $w "\n[string range $prefix 0 end-[string length $extra]]" + } else { + tk::TextInsert $w "\n$prefix" + } + } else { + tk::TextInsert $w "\n$prefix" + } + } +} + +# dgw::txpopup docu { +#' +#' **dgw::txpopup** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txpopup* widget using the Tk window id _pathName_ and +#' the given *options*. The text widget supports the typical right click popup operations +#' for the text widget like undo/redo, copy, paste, delete etc. +#' It comes with a set of default bindings which can be disabled quite easily, +#' see below for an example. +#' +#' The following options are available: +#' +#' > - *-redokey* *sequence* - the key sequence to redo an operation, default: *Control-y* +#' - *-popupkey* *sequence* - the key sequence to open the popup, usually right mouse click, so default: *Button-3* +#' - *-toolcommand* *procname* - the name of a procedure which is called when the tool command is exectued, default emtpy string, none +#' +#' The following public method is available: +#' +#' > - *menu* - show the popup menu, usually the right mouse click, but the user can create additional popup keys. +#' +#' Example: +#' +#' > ``` +#' # demo: txpopup +#' dgw::txpopup [tk::text .txt -undo true] +#' .txt insert end "\nHint\n\nPress right mouse click\n and see the" +#' .txt insert end "popup menu with context dependent active or inactive entries!\n\n" +#' foreach col [list A B C] { +#' .txt insert end "# Header $col\n\nSome text\n\n" +#' .txt insert end [dgw::txlipsum 2] +#' .txt insert end "\n\n" +#' } +#' dgw::txmixin .txt dgw::txblocksel ;# just another mixin +#' .txt configure -borderwidth 10 -relief flat +#' pack .txt -side top -fill both -expand yes -padx 5 -pady 5 +#' bind .txt { focus -force .txt } +#' > ``` +#' +# } +snit::widgetadaptor dgw::txpopup { + delegate option * to hull + delegate method * to hull + option -toolcommand "" + constructor {args} { + installhull $win + $self configurelist $args + bind $win [mymethod Menu] + bind $win [mymethod TextRedo] + + } + method Menu {} { + catch {destroy .editormenu} + menu .editormenu -tearoff 0 + set state disabled + if {[$win cget -undo]} { + if {[$win edit canundo]} { + set state active + } + .editormenu add command -label "Undo" -underline 0 -state $state \ + -command [list $self TextUndo] -accelerator Ctrl+z + set state disabled + if {[$win edit canredo]} { + set state active + } + + .editormenu add command -label "Redo" -underline 0 -state $state \ + -command [list $self TextRedo] -accelerator Ctrl+y + .editormenu add separator + } + set sel [$win tag ranges sel] + set state active + if {$sel eq ""} { + set state disabled + } + .editormenu add command -label "Cut" -underline 2 -state $state \ + -command [list tk_textCut $win] -accelerator Ctrl+x + + .editormenu add command -label "Copy" -underline 0 -state $state \ + -command [list tk_textCopy $win] -accelerator Ctrl+c + .editormenu add command -label "Paste" -underline 0 \ + -command [list tk_textPaste $win] -accelerator Ctrl+v + .editormenu add command -label "Delete" -underline 2 -state $state \ + -command [list $self DeleteText $win] -accelerator Del + .editormenu add separator + .editormenu add command -label "Select All" -underline 7 \ + -command [list $win tag add sel 1.0 end] -accelerator Ctrl+/ + if {$options(-toolcommand) ne ""} { + .editormenu add separator + $self AddTool ;#[list -toolcommand $options(-toolcommand) -accelerator $options(-accelerator) -label $options(-toollabel)] + } + tk_popup .editormenu [winfo pointerx .] [winfo pointery .] + } + method TextRedo { } { + catch { + $win edit redo + } + } + method TextUndo { } { + catch { + $win edit undo + } + } + method DeleteText {w} { + set cuttexts [selection own] + if {$cuttexts != "" } { + catch { + $cuttexts delete sel.first sel.last + selection clear + } + } + } + method AddTool {} { + puts not-yet + } + + + +} + +# dgw::txrotext docu { +#' +#' **dgw::txrotext** *[tk::text pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::txrotext* widget using the Tk window id _pathName_ and +#' the given *options*. All options are delegated to the standard text widget. +#' This creates a readonly text widget. +#' Based on code from the snitfaq by William H. Duquette. +#' +#' Methods: instead of *insert* and *delete* you have to use the methods *ins* and *del* +#' +#' Example: +#' +#' > ``` +#' # demo: txrotext +#' dgw::txrotext [tk::text .txt] +#' foreach col [list A B C] { +#' .txt ins end "# Header $col\n\nSome text\n\n" +#' } +#' pack .txt -side top -fill both -expand yes +#' > ``` +# } + +::snit::widgetadaptor ::dgw::txrotext { + delegate option * to hull + delegate method * to hull + constructor {args} { + installhull $win + $self configure -insertwidth 0 + $self configurelist $args + } + + # Disable the text widget's insert and delete methods, to + # make this readonly. + method insert {args} {} + method delete {args} {} + + # Enable ins and del as synonyms, so the program can insert and + # delete. + delegate method ins to hull as insert + delegate method del to hull as delete +} + + +# More ideas: +# https://wiki.tcl-lang.org/page/File+watch +# https://wiki.tcl-lang.org/page/Simple+Block+Selection+for+Text+Widget +# https://wiki.tcl-lang.org/page/block%2Dselect +# https://wiki.tcl-lang.org/page/Simple+Text+Widget+Sort +# https://wiki.tcl-lang.org/page/A+little+logic+notation+editor +# https://wiki.tcl-lang.org/page/Text+Drag+%2DDrag+and+Drop+for+Text+Widget+Selections +# https://wiki.tcl-lang.org/page/text+line+coloring +# https://wiki.tcl-lang.org/page/Displaying+tables +# https://wiki.tcl-lang.org/page/Time%2Dstamp +# https://wiki.tcl-lang.org/page/Balloon+Help%2C+Generalised +# https://wiki.tcl-lang.org/page/Super+and+Subscripts+in+a+text+widget +namespace eval dgw { + namespace export txmixin txfold txrotext txindent +} + +if {[info exists argv0] && $argv0 eq [info script] && [regexp {txmixins} $argv0]} { + # dgwutils is only required for doucmentation and script execution + package require dgw::dgwutils + set dpath dgw + set pfile [file rootname [file tail [info script]]] + if {[llength $argv] == 1 && [lindex $argv 0] eq "--version"} { + puts [dgw::getVersion [info script]] + destroy . + } elseif {[llength $argv] >= 1 && [lindex $argv 0] eq "--demo"} { + if {[llength $argv] == 1} { + dgw::runExample [info script] true + } else { + puts "running [lindex $argv 1]" + dgw::runExample [info script] true [lindex $argv 1] + } + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--code"} { + puts [dgw::runExample [info script] false] + #destroy . + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--example"} { + puts [dgw::runExample [info script] false] + destroy . + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--test"} { + package require tcltest + set argv [list] + tcltest::test dummy-1.1 { + Calling my proc should always return a list of at least length 3 + } -body { + set result 1 + } -result {1} + tcltest::cleanupTests + destroy . + } elseif {[llength $argv] == 1 && ([lindex $argv 0] eq "--license" || [lindex $argv 0] eq "--man" || [lindex $argv 0] eq "--html" || [lindex $argv 0] eq "--markdown")} { + dgw::manual [lindex $argv 0] [info script] + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--install"} { + dgw::install [info script] + } else { + destroy . + puts "\n -------------------------------------" + puts " The ${dpath}::$pfile package for Tcl" + puts " -------------------------------------\n" + puts "Copyright (c) 2021 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de\n" + puts "License: MIT - License see manual page" + puts "\nThe ${dpath}::$pfile package provides a text editor widget with syntax hilighting facilities and and toolbar" + puts "" + puts "Usage: [info nameofexe] [info script] option\n" + puts " Valid options are:\n" + puts " --help : printing out this help page" + puts " --demo : runs a small demo application." + puts " --code : shows the demo code." + puts " --test : running some test code" + puts " --license : printing the license to the terminal" + puts " --install : install ${dpath}::$pfile as Tcl module" + puts " --man : printing the man page in pandoc markdown to the terminal" + puts " --markdown: printing the man page in simple markdown to the terminal" + puts " --html : printing the man page in html code to the terminal" + puts " if the Markdown package from tcllib is available" + puts "" + } + return +} + +#' ## EXAMPLE +#' +#' In the examples below we create a foldable text widget which can fold Markdown headers. +#' Just press the button F2 and F3 to fold or unfold regions or the complete text. +#' Thereafter a demonstration on how to use the *dgw::txmixin* command which simplifies the addition of +#' new behaviors to our *tk::text* in a stepwise manner. +#' The latter approach is as well nice to extend existing widgets in a more controlled manner +#' avoiding restarts of applications during developing the widget. +#' +#' ``` +#' package require dgw::txmixins +#' # standard text widget +#' set f [ttk::frame .f] +#' set text [tk::text .f.txt -borderwidth 5 -relief flat] +#' pack $text -side left -fill both -expand true +#' dgw::txmixin $text dgw::txfold +#' # fill the widget +#' for {set i 0} {$i < 5} {incr i} { +#' $text insert end "## Header $i\n\n" +#' for {set j 0} {$j < 2} {incr j} { +#' $text insert end "Lorem ipsum dolor sit amet, consetetur sadipscing elitr,\n" +#' $text insert end "sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat,\n" +#' $text insert end "sed diam voluptua. \nAt vero eos et accusam et justo duo dolores et ea rebum.\n" +#' $text insert end "Stet clita kasd gubergren, no sea takimata sanctus est Lorem ipsum dolor sit amet.\n\n" +#' } +#' } +#' set tcltxt [tk::text .f.tcl -borderwidth 5 -relief flat] +#' dgw::txmixin $tcltxt dgw::txfold -foldstart "^\[A-Za-z\].+\{" -foldend "^\}" +#' $tcltxt tag configure fold -background #aaccff +#' $tcltxt insert end "package require Tk\nproc test {} {\n puts Hi\n}\n\nsnit::widget wid {\n\n}\n" +#' pack $tcltxt -side left -fill both -expand true +#' pack $f -side top -fill both -expand yes +#' set f2 [ttk::frame .f2] +#' dgw::txrotext [tk::text $f2.rotxt] +#' foreach col [list A B C] { +#' $f2.rotxt ins end "# Header $col\n\nSome text\n\n" +#' } +#' pack $f2.rotxt -side left -fill both -expand yes +#' dgw::txindent [tk::text $f2.intxt] +#' dgw::txmixin $f2.intxt dgw::txfold +#' $f2.intxt insert end "# Header 1\n\n* item\n * subitem 1\n * subitem2" +#' $f2.intxt insert end "# Header 2\n\n* item\n * subitem 1\n * subitem2" +#' $f2.intxt insert 5.0 "\n" ; $f2.intxt tag add line 5.0 6.0 ; +#' $f2.intxt tag configure line -background black -font "Arial 1" +#' pack $f2.intxt -side left -fill both -expand yes +#' pack $f2 -side top -fill both -expand yes +#' ``` +#' +#' ## INSTALLATION +#' +#' Installation is easy you can install and use the **__PKGNAME__** package if you have a working install of: +#' +#' - the snit package which can be found in [tcllib - https://core.tcl-lang.org/tcllib](https://core.tcl-lang.org/tcllib) +#' +#' For installation you copy the complete *dgw* folder into a path +#' of your *auto_path* list of Tcl or you append the *auto_path* list with the parent dir of the *dgw* directory. +#' Alternatively you can install the package as a Tcl module by creating a file dgw/__BASENAME__-__PKGVERSION__.tm in your Tcl module path. +#' +#' Only if you you like to extract the HTML documentation and run the examples, +#' you need the complete dgw package and for the HTML generation the tcllib Markdown package. +#' +#' ## DEMO +#' +#' Example code for this package in the *EXAMPLE* section can be executed, +#' if you have the complete dgw package installed, by running this file using +#' the following command line: +#' +#' ``` +#' $ wish __BASENAME__.tcl --demo +#' ``` +#' +#' Specific code examples outside of the EXAMPLE section can be executed using +#' the string after the *demo:* prefix string in the code block for the individual code adaptors such as: +#' +#' +#' ``` +#' $ wish __BASENAME__.tcl --demo txfold +#' ``` +#' +#' The example code used for the demo in the EXAMPLE section can be seen in the terminal by using the following command line: +#' +#' ``` +#' $ tclsh __BASENAME__.tcl --code +#' ``` +#' #include "documentation.md" +#' +#' ## SEE ALSO +#' +#' - [dgw package homepage](https://chiselapp.com/user/dgroth/repository/tclcode/index) - various useful widgets +#' - [tk::text widget manual](https://www.tcl.tk/man/tcl8.6/TkCmd/ttk_treeview.htm) standard manual page for the ttk::treeview widget +#' +#' +#' ## CHANGES +#' +#' * 2021-08-12 - version 0.1 initial starting the widget. +#' * 2021-08-19 +#' * completing docu +#' * finalize txfold +#' * adding txrotext, txindent, txautorep +#' * 2021-09-29 - version 0.2.0 +#' * txfileproc - file procedures, fileOpen, fileNew, ... fileExit +#' * txpopup - right click popup +#' * txblocksel - block selection +#' * txlipsum - lispum code generator +#' * txhighlight - syntax highlighter +#' +#' ## TODO +#' +#' * Syntax hilighter (done) +#' * switch folding by switching file +#' * File watch: https://wiki.tcl-lang.org/page/File+watch (done) +#' * Block selection: https://wiki.tcl-lang.org/page/Simple+Block+Selection+for+Text+Widget (done) +#' * Text sorting: https://wiki.tcl-lang.org/page/Simple+Text+Widget+Sort +#' * Logic notation https://wiki.tcl-lang.org/page/A+little+logic+notation+editor +#' * Drag and drop of text: https://wiki.tcl-lang.org/page/Text+Drag+%2DDrag+and+Drop+for+Text+Widget+Selections +#' * text line coloring https://wiki.tcl-lang.org/page/text+line+coloring +#' * table display https://wiki.tcl-lang.org/page/Displaying+tables +#' * time stamp https://wiki.tcl-lang.org/page/Time%2Dstamp +#' * balloon help https://wiki.tcl-lang.org/page/Balloon+Help%2C+Generalised +#' * sub and superscripts https://wiki.tcl-lang.org/page/Super+and+Subscripts+in+a+text+widget +#' +#' ## AUTHORS +#' +#' The **__PKGNAME__** widget adaptors were written by Detlef Groth, Schwielowsee, Germany based on code mentioned at the specific adaptor documentation. +#' +#' ## Copyright +#' +#' +#' Copyright (c) 2021 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de +#' +# LICENSE START +# +#' #include "license.md" +# +# LICENSE END diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/boxlabel.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/boxlabel.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/boxlabel.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/boxlabel.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/canlabel.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/canlabel.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/canlabel.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/canlabel.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/labarray.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/labarray.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/labarray.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/labarray.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/objselec.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/objselec.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/objselec.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/objselec.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/perilabel.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/perilabel.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/perilabel.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/perilabel.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pie.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pie.tcl similarity index 91% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pie.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pie.tcl index 8ef4f9cb..1be09cc2 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pie.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pie.tcl @@ -1,13 +1,9 @@ -# $Id: pie.tcl,v 2.25 2006/01/27 19:05:52 andreas_kupries Exp $ - package require Tk 8.3- package require stooop ::stooop::class pie { - set (colors) [list\ - #7FFFFF #FFFF7F #FF7F7F #7FFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF\ - ] + set (colors) [list #7FFFFF #FFFF7F #FF7F7F #7FFF7F #7F7FFF #FFBF00 #BFBFBF #FF7FFF #FFFFFF] } proc pie::pie {this canvas x y args} switched {$args} { @@ -66,6 +62,7 @@ foreach option {\ } proc pie::set-thickness {this value} { + ##nagelfar ignore if {$switched::($this,complete)} { error {option -thickness cannot be set dynamically} } @@ -78,6 +75,7 @@ proc pie::set-thickness {this value} { proc pie::set-height {this value} { # value is height is slices height not counting thickness set ($this,height) [expr {[winfo fpixels $($this,canvas) $value] - 1}] + ##nagelfar ignore if {$switched::($this,complete)} { update $this } else { ;# keep track of initial value for latter scaling calculations @@ -86,6 +84,7 @@ proc pie::set-height {this value} { } proc pie::set-width {this value} { set ($this,width) [expr {[winfo fpixels $($this,canvas) $value] - 1}] + ##nagelfar ignore if {$switched::($this,complete)} { update $this } else { ;# keep track of initial value for latter scaling calculations @@ -96,38 +95,49 @@ proc pie::set-width {this value} { proc pie::complete {this} { ;# no user slices exist yet set canvas $($this,canvas) + ##nagelfar ignore if {$switched::($this,-labeler) == 0} { # use default labeler if user defined none set ($this,labeler) [::stooop::new pieBoxLabeler $canvas] } else { ;# use user defined labeler + ##nagelfar ignore set ($this,labeler) $switched::($this,-labeler) } $canvas addtag pie($this) withtag pieLabeler($($this,labeler)) + ##nagelfar ignore if {[string length $switched::($this,-background)] == 0} { set bottomColor {} } else { + ##nagelfar ignore set bottomColor [darken $switched::($this,-background) 60] } + ##nagelfar ignore + set bg $switched::($this,-background) set slice [::stooop::new slice\ $canvas [expr {$($this,initialWidth) / 2}]\ [expr {$($this,initialHeight) / 2}]\ -startandextent {90 360} -height $($this,thickness)\ - -topcolor $switched::($this,-background) -bottomcolor $bottomColor\ + -topcolor $bg -bottomcolor $bottomColor\ ] $canvas addtag pie($this) withtag slice($slice) $canvas addtag pieSlices($this) withtag slice($slice) set ($this,backgroundSlice) $slice + ##nagelfar ignore if {[string length $switched::($this,-title)] == 0} { set ($this,titleRoom) 0 } else { - set ($this,title) [$canvas create text 0 0\ - -anchor n -text $switched::($this,-title)\ - -font $switched::($this,-titlefont) -tags pie($this)\ - ] - set ($this,titleRoom) [expr {\ - [font metrics $switched::($this,-titlefont) -ascent] +\ - [winfo fpixels $canvas $switched::($this,-titleoffset)]\ - }] + ##nagelfar ignore + set title $switched::($this,-title) + ##nagelfar ignore + set font $switched::($this,-titlefont) + set ($this,title) [$canvas create text 0 0 \ + -anchor n \ + -text $title \ + -font $font \ + -tags pie($this)] + ##nagelfar ignore + set offset $switched::($this,-titleoffset) + set ($this,titleRoom) [expr { [font metrics $font -ascent] + [winfo fpixels $canvas $offset] }] } update $this } @@ -139,14 +149,16 @@ proc pie::newSlice {this {text {}} {color {}}} { # (slices grow clockwise from 12 o'clock) set start 90 foreach slice $($this,slices) { + ##nagelfar ignore set start [expr {$start - $slice::($slice,extent)}] } if {[string length $color] == 0} { # get a new color + ##nagelfar ignore set color [lindex $switched::($this,-colors) $($this,colorIndex)] - set ($this,colorIndex) [expr {\ - ($($this,colorIndex) + 1) % [llength $switched::($this,-colors)]\ - }] ;# circle through colors + # circle through colors + ##nagelfar ignore + set ($this,colorIndex) [expr { ($($this,colorIndex) + 1) % [llength $switched::($this,-colors)] }] } # darken slice top color by 40% to obtain bottom color, as it is done for # Tk buttons shadow, for example @@ -170,6 +182,7 @@ proc pie::newSlice {this {text {}} {color {}}} { # update tags which canvas does not automatically do $canvas addtag pie($this) withtag pieLabeler($labeler) update $this + ##nagelfar ignore if {$switched::($this,-selectable)} { # toggle select state at every button release if {![info exists ($this,selector)]} { ;# create selector if necessary @@ -213,6 +226,7 @@ proc pie::deleteSlice {this slice} { error "invalid slice $slice for pie $this" } set ($this,slices) [lreplace $($this,slices) $index $index] + ##nagelfar ignore set extent $slice::($slice,extent) ::stooop::delete $slice foreach following [lrange $($this,slices) $index end] { @@ -222,6 +236,7 @@ proc pie::deleteSlice {this slice} { # finally delete label last so that other labels may eventually be # repositionned according to remaining slices placement pieLabeler::delete $($this,labeler) $($this,sliceLabel,$slice) + ##nagelfar ignore if {$switched::($this,-selectable)} { selector::remove $($this,selector) $($this,sliceLabel,$slice) } @@ -236,9 +251,10 @@ proc pie::sizeSlice {this slice unitShare {valueToDisplay {}}} { } # cannot display slices that occupy more than whole pie and less than zero set newExtent [expr {[maximum [minimum $unitShare 1] 0] * 360}] + ##nagelfar ignore set growth [expr {$newExtent - $slice::($slice,extent)}] - switched::configure $slice -startandextent\ - "[expr {$slice::($slice,start) - $growth}] $newExtent" ;# grow clockwise + ##nagelfar ignore + switched::configure $slice -startandextent "[expr {$slice::($slice,start) - $growth}] $newExtent" ;# grow clockwise if {[string length $valueToDisplay] > 0} { # update label after slice for it may need slice latest configuration pieLabeler::set $($this,labeler) $($this,sliceLabel,$slice)\ @@ -250,6 +266,7 @@ proc pie::sizeSlice {this slice unitShare {valueToDisplay {}}} { foreach slice [lrange $($this,slices) [incr index] end] { slice::rotate $slice $value } + ##nagelfar ignore if {$switched::($this,-autoupdate)} { # since label was changed, labeler may need to reorganize labels, # for example @@ -299,12 +316,12 @@ proc pie::setLabelsState {this labels selected} { proc pie::currentSlice {this} { # return current slice (slice or its label under the mouse cursor) if any set tags [$($this,canvas) gettags current] - if {\ - ([scan $tags slice(%u) slice] > 0) &&\ - ($slice != $($this,backgroundSlice))\ + ##nagelfar ignore + if {([scan $tags slice(%u) slice] > 0) && ($slice != $($this,backgroundSlice)) } { ;# ignore background slice return $slice ;# found current slice } + ##nagelfar ignore if {[scan $tags canvasLabel(%u) label] > 0} { foreach slice $($this,slices) { if {$($this,sliceLabel,$slice) == $label} { diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pielabel.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pielabel.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/pielabel.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pielabel.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pkgIndex.tcl new file mode 100644 index 00000000..0e3d087a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/pkgIndex.tcl @@ -0,0 +1,3 @@ +# Package index file created with stooop version 4.4.1 for stooop packages + +package ifneeded tkpiechart 6.6.1 [list source [file join $dir tkpiechart.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/relirect.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/relirect.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/relirect.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/relirect.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/selector.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/selector.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/selector.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/selector.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/slice.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/slice.tcl similarity index 97% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/slice.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/slice.tcl index 920327fd..0d80b749 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/slice.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/slice.tcl @@ -21,8 +21,10 @@ proc slice::slice {this canvas xRadius yRadius args} switched {$args} { } proc slice::~slice {this} { + ##nagelfar ignore if {[string length $switched::($this,-deletecommand)] > 0} { # always invoke command at global level + ##nagelfar ignore uplevel #0 $switched::($this,-deletecommand) } $($this,canvas) delete slice($this) @@ -40,6 +42,7 @@ proc slice::options {this} { } proc slice::set-height {this value} { ;# not a dynamic option: see complete + ##nagelfar ignore if {$switched::($this,complete)} { error {option -height cannot be set dynamically} } @@ -64,6 +67,7 @@ proc slice::set-topcolor {this value} { proc slice::set-deletecommand {this value} {} proc slice::set-scale {this value} { + ##nagelfar ignore if {$switched::($this,complete) && ($value > 0)} { # check for valid value following a non reproducible bug report update $this ;# requires initialization to be complete @@ -82,6 +86,7 @@ proc slice::set-startandextent {this value} { } else { set ($this,extent) $extent } + ##nagelfar ignore if {$switched::($this,complete)} { update $this ;# requires initialization to be complete } @@ -102,10 +107,12 @@ proc slice::complete {this} { set canvas $($this,canvas) set xRadius $($this,xRadius) set yRadius $($this,yRadius) + ##nagelfar ignore set bottomColor $switched::($this,-bottomcolor) # use an empty image as an origin marker with only 2 coordinates set ($this,origin)\ [$canvas create image -$xRadius -$yRadius -tags slice($this)] + ##nagelfar ignore if {$switched::($this,-height) > 0} { ;# 3D set ($this,startBottomArcFill) [$canvas create arc\ 0 0 0 0 -style chord -extent 0 -fill $bottomColor\ @@ -135,9 +142,11 @@ proc slice::complete {this} { set ($this,endRightLine)\ [$canvas create line 0 0 0 0 -tags slice($this)] } + ##nagelfar ignore + set tfill $switched::($this,-topcolor) set ($this,topArc) [$canvas create arc\ -$xRadius -$yRadius $xRadius $yRadius\ - -fill $switched::($this,-topcolor) -tags slice($this)\ + -fill $fill -tags slice($this)\ ] # move slice so upper-left corner is at requested coordinates $canvas move slice($this) $xRadius $yRadius @@ -153,6 +162,7 @@ proc slice::update {this} { $canvas coords $($this,topArc) -$xRadius -$yRadius $xRadius $yRadius $canvas itemconfigure $($this,topArc)\ -start $($this,start) -extent $($this,extent) + ##nagelfar ignore if {$switched::($this,-height) > 0} { ;# 3D updateBottom $this } @@ -160,6 +170,7 @@ proc slice::update {this} { $canvas move slice($this) [expr {[lindex $coordinates 0] + $xRadius}]\ [expr {[lindex $coordinates 1] + $yRadius}] # finally apply scale + ##nagelfar ignore eval $canvas scale slice($this) $coordinates $switched::($this,-scale) } @@ -172,6 +183,7 @@ proc slice::updateBottom {this} { set canvas $($this,canvas) set xRadius $($this,xRadius) set yRadius $($this,yRadius) + ##nagelfar ignore set height $switched::($this,-height) # first make all bottom parts invisible @@ -302,9 +314,11 @@ proc slice::data {this arrayName} { set data(start) $($this,start) set data(extent) $($this,extent) + ##nagelfar ignore foreach {x y} $switched::($this,-scale) {} set data(xRadius) [expr {$x * $($this,xRadius)}] set data(yRadius) [expr {$y * $($this,yRadius)}] + ##nagelfar ignore set data(height) [expr {$y * $switched::($this,-height)}] foreach {x y} [$($this,canvas) coords $($this,origin)] {} set data(xCenter) [expr {$x + $data(xRadius)}] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/tkpiechart.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/tkpiechart.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/tkpiechart.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/tkpiechart.tcl index 9f37150c..62cb6e27 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tkpiechart/tkpiechart.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tkpiechart/tkpiechart.tcl @@ -12,4 +12,4 @@ tclPkgSetup [file dirname [file join [pwd] [info script]]] tkpiechart 6.6 { {relirect.tcl source {::canvasReliefRectangle::_copy ::canvasReliefRectangle::canvasReliefRectangle ::canvasReliefRectangle::options ::canvasReliefRectangle::set-background ::canvasReliefRectangle::set-coordinates ::canvasReliefRectangle::set-relief ::canvasReliefRectangle::update ::canvasReliefRectangle::~canvasReliefRectangle}} } -package provide tkpiechart 6.6 +package provide tkpiechart 6.6.1 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/pkgIndex.tcl similarity index 61% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/pkgIndex.tcl index 93a169b5..5a323c53 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/pkgIndex.tcl @@ -1,4 +1,4 @@ # -*- tcl -*- -package ifneeded tooltip 1.6 [list source [file join $dir tooltip.tcl]] +package ifneeded tooltip 2.0.1 [list source [file join $dir tooltip.tcl]] package ifneeded tipstack 1.0.1 [list source [file join $dir tipstack.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tipstack.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tipstack.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tipstack.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tipstack.tcl index b55df758..5c43ffa6 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tipstack.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tipstack.tcl @@ -2,16 +2,13 @@ # # Based on 'tooltip', provides a dynamic stack of tip texts per # widget. This allows dynamic transient changes to the tips, for -# example to temporarily replace a standard epxlanation with an +# example to temporarily replace a standard explanation with an # error message. # # Copyright (c) 2003 ActiveState Corporation. # # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: tipstack.tcl,v 1.4 2009/01/09 05:46:12 andreas_kupries Exp $ -# # ### ######### ########################### # Requisites diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tooltip.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tooltip.tcl similarity index 74% rename from src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tooltip.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tooltip.tcl index b6e39381..f5332691 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/tooltip/tooltip.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/tooltip/tooltip.tcl @@ -3,17 +3,15 @@ # Balloon help # # Copyright (c) 1996-2007 Jeffrey Hobbs +# Copyright (c) 2024 Emmanuel Frecon, Rene Zaumseil # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tooltip.tcl,v 1.16 2008/12/01 23:37:16 hobbs Exp $ -# # Initiated: 28 October 1996 package require Tk 8.5- -package require msgcat #------------------------------------------------------------------------ # PROCEDURE @@ -44,7 +42,10 @@ package require msgcat # enable OR on # Enables tooltips for defined widgets. # -# ?-index index? ?-item(s) items? ?-tab tabId" ?-tag tag? ?message? +# ?-heading columnId? ?-index index? ?-item(s) items? ?-tab tabId" +# ?-tag tag? ?message? +# * If -heading is specified, then is assumed to be a +# ttk::treeview widget and columnId specifies a column identifier. # * If -index is specified, then is assumed to be a menu and # index represents what index into the menu (either the numerical index # or the label) to associate the tooltip message with. @@ -71,6 +72,11 @@ package require msgcat # #------------------------------------------------------------------------ +# TkTooltipFont is defined in tk library/ttk/fonts.tcl +catch {font create TkTooltipFontItalic} +catch {font configure TkTooltipFontItalic \ + {*}[font configure TkTooltipFont] -slant italic} + namespace eval ::tooltip { namespace export -clear tooltip variable tooltip @@ -93,15 +99,21 @@ namespace eval ::tooltip { } # functional options - option add *Tooltip.Label.highlightThickness 0 - option add *Tooltip.Label.relief solid - option add *Tooltip.Label.borderWidth 1 - option add *Tooltip.Label.padX 5 - option add *Tooltip.Label.padY 5 + option add *Tooltip.Frame.highlightThickness 0 + option add *Tooltip.Frame.relief solid + option add *Tooltip.Frame.borderWidth 1 + option add *Tooltip*Label.highlightThickness 0 + option add *Tooltip*Label.relief flat + option add *Tooltip*Label.borderWidth 0 + option add *Tooltip*Label.padX 3p + option add *Tooltip*Label.padY 3p + # configurable options - option add *Tooltip.Label.background lightyellow - option add *Tooltip.Label.foreground black - option add *Tooltip.Label.font TkTooltipFont + option add *Tooltip.Frame.background lightyellow + option add *Tooltip*Label.background lightyellow + option add *Tooltip*Label.foreground black + option add *Tooltip*label.font TkTooltipFont ;# lowercase! + option add *Tooltip*info.font TkTooltipFontItalic # The extra ::hide call in is necessary to catch moving to # child widgets where the event won't be generated @@ -133,7 +145,8 @@ proc ::tooltip::tooltip {w args} { delay { if {[llength $args]} { set millisecs [lindex $args 0] - if {![string is integer -strict $millisecs] || $millisecs<50} { + ##nagelfar ignore + if {![string is integer -strict $millisecs] || ($millisecs < 50)} { return -code error "tooltip delay must be an integer\ greater than or equal to 50 (delay is in millisecs)" } @@ -172,67 +185,85 @@ proc ::tooltip::tooltip {w args} { proc ::tooltip::register {w args} { variable tooltip set key [lindex $args 0] + set img {} + set inf {} while {[string match -* $key]} { switch -- $key { -- { - set args [lreplace $args 0 0] - set key [lindex $args 0] - break + set args [lassign $args _ key] + break + } + -heading { + if {[winfo class $w] ne "Treeview"} { + return -code error "widget \"$w\" is not a ttk::treeview widget" + } + set args [lassign $args _ columnId] } -index { - if {[catch {$w entrycget 1 -label}]} { + if {[catch { + $w entrycget 1 -label + }]} { return -code error "widget \"$w\" does not seem to be a\ menu, which is required for the -index switch" } - set index [lindex $args 1] - set args [lreplace $args 0 1] + set args [lassign $args _ index] } - -item - -items { + -item - + -items { if {[winfo class $w] in {Listbox Treeview}} { - set items [lindex $args 1] + set args [lassign $args _ items] } else { - set namedItem [lindex $args 1] - if {[catch {$w find withtag $namedItem} items]} { + set args [lassign $args _ namedItem] + if {[catch { + $w find withtag $namedItem + } items]} { return -code error "widget \"$w\" is not a canvas, or\ item \"$namedItem\" does not exist in the canvas" } } - set args [lreplace $args 0 1] } -tab { if {[winfo class $w] ne "TNotebook"} { - return -code error "widget \"$w\" is not a ttk::notebook\ - widget" + return -code error "widget \"$w\" is not a ttk::notebook widget" } - set tabId [lindex $args 1] - if {[catch {$w index $tabId} tabIndex]} { + set args [lassign $args _ tabId] + if {[catch { + $w index $tabId + } tabIndex]} { return -code error $tabIndex } elseif {$tabIndex < 0 || $tabIndex >= [$w index end]} { return -code error "tab index $tabId out of bounds" } set tabWin [lindex [$w tabs] $tabIndex] - set args [lreplace $args 0 1] } -tag { - set tag [lindex $args 1] - set r [catch {lsearch -exact [$w tag names] $tag} ndx] + set args [lassign $args _ tag] + set r [catch { + lsearch -exact [$w tag names] $tag + } ndx] if {$r || $ndx == -1} { return -code error "widget \"$w\" is not a text widget or\ \"$tag\" is not a text tag" } - set args [lreplace $args 0 1] } + -image { + set args [lassign $args _ img] + } + -info { + set args [lassign $args _ inf] + } default { return -code error "unknown option \"$key\":\ - should be -index, -item(s), -tab, -tag or --" + should be -heading, -image, -index, -info,\ + -item(s), -tab, -tag or --" } } set key [lindex $args 0] } if {[llength $args] != 1} { return -code error "wrong # args: should be \"tooltip widget\ - ?-index index? ?-item(s) items? ?-tab tabId? ?-tag tag? ?--?\ - message\"" + ?-heading columnId? ?-image image? ?-index index? ?-info info?\ + ?-item(s) items? ?-tab tabId? ?-tag tag? ?--? message\"" } if {$key eq ""} { clear $w @@ -240,12 +271,17 @@ proc ::tooltip::register {w args} { if {![winfo exists $w]} { return -code error "bad window path name \"$w\"" } - if {[info exists index]} { - set tooltip($w,$index) $key + set details [list $key $img $inf] + if {[info exists columnId]} { + set tooltip($w,$columnId) $details + enableListbox $w $columnId + return $w,$columnId + } elseif {[info exists index]} { + set tooltip($w,$index) $details return $w,$index } elseif {[info exists items]} { foreach item $items { - set tooltip($w,$item) $key + set tooltip($w,$item) $details set class [winfo class $w] if { $class eq "Listbox" || $class eq "Treeview"} { enableListbox $w $item @@ -257,15 +293,15 @@ proc ::tooltip::register {w args} { # how this is called return $w,[lindex $items 0] } elseif {[info exists tabWin]} { - set tooltip($w,$tabWin) $key + set tooltip($w,$tabWin) $details enableNotebook $w $tabWin return $w,$tabWin } elseif {[info exists tag]} { - set tooltip($w,t_$tag) $key + set tooltip($w,t_$tag) $details enableTag $w $tag return $w,$tag } else { - set tooltip($w) $key + set tooltip($w) $details # Note: Add the necessary bindings only once. set tags [bindtags $w] if {[lsearch -exact $tags "Tooltip"] == -1} { @@ -278,7 +314,6 @@ proc ::tooltip::register {w args} { proc ::tooltip::createToplevel {} { variable G - variable labelOpts set b $G(TOPLEVEL) if {[winfo exists $b]} { return } @@ -294,8 +329,14 @@ proc ::tooltip::createToplevel {} { catch {wm attributes $b -alpha 0.99} wm positionfrom $b program wm withdraw $b - label $b.label {*}[expr {[info exists labelOpts] ? $labelOpts : ""}] - pack $b.label -ipadx 1 + + frame $b.f + label $b.f.label -justify left -compound left + label $b.f.info -justify left + + grid $b.f + grid $b.f.label -sticky w + grid $b.f.info -sticky w } proc ::tooltip::configure {args} { @@ -311,7 +352,7 @@ proc ::tooltip::configure {args} { createToplevel } foreach opt {-foreground -background -font} { - set val [$b.label configure $opt] + set val [$b.f.label configure $opt] set opts($opt) [lindex $val 4] set defs($opt) [lindex $val 1] lappend keys $opt @@ -340,8 +381,29 @@ proc ::tooltip::configure {args} { return -level 2 -code error "unknown option \"$key\"" } if {[catch { - $b.label configure $key $val - option add *Tooltip.Label.$defs($key) $val + switch $key { + -background - -bg { + foreach widget [list $b.f $b.f.label $b.f.info] { + $widget configure $key $val + } + option add *Tooltip*Frame.$defs($key) $val + option add *Tooltip*Label.$defs($key) $val + } + -foreground - -fg { + foreach widget [list $b.f.label $b.f.info] { + $widget configure $key $val + } + option add *Tooltip*Label.$defs($key) $val + } + -font { + $b.f.label configure $key $val + option add *Tooltip*label.$defs($key) $val + + catch {font configure TkTooltipFontItalic \ + {*}[font actual $val] -slant italic} + $b.f.info configure $key TkTooltipFontItalic + } + } } err]} { return -level 2 -code error $err } @@ -358,7 +420,8 @@ proc ::tooltip::clear {{pattern .*}} { unset tooltip($w) if {[winfo exists $w]} { set tags [bindtags $w] - if {[set i [lsearch -exact $tags "Tooltip"]] != -1} { + set i [lsearch -exact $tags "Tooltip"] + if {$i != -1} { bindtags $w [lreplace $tags $i $i] } ## We don't remove TooltipMenu because there @@ -387,10 +450,20 @@ proc ::tooltip::show {w msg {i {}}} { if {![winfo exists $b]} { createToplevel } - # Use late-binding msgcat (lazy translation) to support programs - # that allow on-the-fly l10n changes - $b.label configure -text [::msgcat::mc $msg] -justify left + + lassign $msg text image infotext + $b.f.label configure -text $text -image $image + if {$infotext eq {}} { + grid remove $b.f.info + } else { + $b.f.info configure -text $infotext + grid $b.f.info + } update idletasks + + # Bail out if the widget went way during the idletasks + if {![winfo exists $w]} return + set screenw [winfo screenwidth $w] set screenh [winfo screenheight $w] set reqw [winfo reqwidth $b] @@ -436,6 +509,8 @@ proc ::tooltip::show {w msg {i {}}} { } # avoid the blink issue with 1 to <1 alpha on Windows, watch half-fading catch {wm attributes $b -alpha 0.99} + # put toplevel placed outside the screen back into it, just a little below the top border. + if {$y < 0} { set y 10 } wm geometry $b +$x+$y wm deiconify $b raise $b @@ -463,7 +538,9 @@ proc ::tooltip::menuMotion {w} { after cancel $G(AFTERID) catch {wm withdraw $G(TOPLEVEL)} if {[info exists tooltip($m,$cur)] || \ - (![catch {$w entrycget $cur -label} cur] && \ + (![catch { + $w entrycget $cur -label + } cur] && \ [info exists tooltip($m,$cur)])} { set G(AFTERID) [after $G(DELAY) \ [namespace code [list show $w $tooltip($m,$cur) cursor]]] @@ -484,7 +561,9 @@ proc ::tooltip::hide {{fadeOk 0}} { } proc ::tooltip::fade {w step} { - if {[catch {wm attributes $w -alpha} alpha] || $alpha <= 0.0} { + if {[catch { + wm attributes $w -alpha + } alpha] || $alpha <= 0.0} { catch { wm withdraw $w } catch { wm attributes $w -alpha 0.99 } } else { @@ -515,7 +594,15 @@ proc ::tooltip::listitemTip {w x y} { if {[winfo class $w] eq "Listbox"} { set item [$w index @$x,$y] } else { - set item [$w identify item $x $y] + switch [$w identify region $x $y] { + tree - cell { + set item [$w identify item $x $y] + } + heading - separator { + set item [$w column [$w identify column $x $y] -id] + } + default { set item "" } + } } if {$G(enabled) && [info exists tooltip($w,$item)]} { set G(AFTERID) [after $G(DELAY) \ @@ -523,8 +610,7 @@ proc ::tooltip::listitemTip {w x y} { } } -# Handle the lack of / between listbox/treeview items using -# +# Handle the lack of / between listbox/treeview items using proc ::tooltip::listitemMotion {w x y} { variable tooltip variable G @@ -532,10 +618,12 @@ proc ::tooltip::listitemMotion {w x y} { if {[winfo class $w] eq "Listbox"} { set item [$w index @$x,$y] } else { - set item {} - set region [$w identify region $x $y] - if {$region eq "tree" || $region eq "cell"} { - set item [$w identify item $x $y] + switch [$w identify region $x $y] { + tree - cell { set item [$w identify item $x $y] } + heading - separator { + set item [$w column [$w identify column $x $y] -id] + } + default { set item "" } } } if {$item ne $G(LAST)} { @@ -630,15 +718,38 @@ proc ::tooltip::tagTip {w tag} { if {[info exists G(AFTERID)]} { after cancel $G(AFTERID) } set G(AFTERID) [after $G(DELAY) \ [namespace code [list show $w $tooltip($w,t_$tag) cursor]]] + # clear the 'Enter' binding. it is restored by `conditionally-hide` below. + $w tag bind $tag "" } } proc ::tooltip::enableTag {w tag} { + variable G if {[string match *tagTip* [$w tag bind $tag]]} { return } $w tag bind $tag +[namespace code [list tagTip $w $tag]] - $w tag bind $tag +[namespace code [list hide 1]] ; # fade ok + $w tag bind $tag +[namespace code [list conditionally-hide $w $tag]] ; # fade ok $w tag bind $tag +[namespace code hide] $w tag bind $tag +[namespace code hide] + + # save the 'Enter' binding. + # this is cleared by `tagTip`, see above, and restored by `conditionally-hide` below. + set G(enterBinding,$w,$tag) [$w tag bind $tag ] +} + +proc ::tooltip::conditionally-hide {w tag} { + variable G + # re-enable the 'Enter' binding. it is saved by `enableTag`, and cleared by `tagTip`. + $w tag bind $tag $G(enterBinding,$w,$tag) + + # have we really left ? if the cursor is _in_ the tooltip we haven't. + createToplevel + lassign [split [wm geometry $G(TOPLEVEL)] "x+"] w h xT yT + lassign [winfo pointerxy "."] x y + + if {($x >= $xT) && ($x <= ($xT + $w)) && + ($y >= $yT) && ($y <= ($yT + $h))} return + + hide 1 } -package provide tooltip 1.6 +package provide tooltip 2.0.1 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/pkgIndex.tcl new file mode 100644 index 00000000..6cebe01b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/pkgIndex.tcl @@ -0,0 +1 @@ +package ifneeded dgw::tvmixins 0.3 [list source [file join $dir tvmixins.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/tvmixins.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/tvmixins.tcl new file mode 100644 index 00000000..6d9f0479 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/treeview/tvmixins.tcl @@ -0,0 +1,1411 @@ +#!/usr/bin/env tclsh +############################################################################## +# +# Created By : Dr. Detlef Groth +# Created : Sun Apr 5 17:37:39 2020 +# Last Modified : <201221.0758> +# +# Description +# +# Notes +# +# History +# +############################################################################## +# +# Copyright (c) 2020 Dr. Detlef Groth. +# +############################################################################## +#' --- +#' documentclass: scrartcl +#' title: dgw::tvmixins __PKGVERSION__ +#' author: Detlef Groth, Schwielowsee, Germany +#' --- +#' +#' ## NAME +#' +#' **dgw::tvmixins** - implementations of extensions for the *ttk::treeview* +#' widget which can be added dynamically using chaining of commands +#' at widget creation or using the *dgw::mixin* command after widget +#' creation. +#' +#' ## TABLE OF CONTENTS +#' +#' - [SYNOPSIS](#synopsis) +#' - [DESCRIPTION](#description) +#' - [WIDGET COMMANDS](#commands) +#' - [dgw::mixin](#mixin) +#' - [dgw::tvband](#tvband) +#' - [dgw::tvedit](#tvedit) +#' - [dgw::tvfilebrowser](#tvfilebrowser) +#' - [dgw::tvksearch](#tvksearch) +#' - [dgw::tvsortable](#tvsortable) +#' - [dgw::tvtooltip](#tvtooltip) +#' - [dgw::tvtree](#tvtree) +#' - [EXAMPLE](#example) +#' - [INSTALLATION](#install) +#' - [DEMO](#demo) +#' - [DOCUMENTATION](#docu) +#' - [SEE ALSO](#see) +#' - [CHANGES](#changes) +#' - [TODO](#todo) +#' - [AUTHORS](#authors) +#' - [COPYRIGHT](#copyright) +#' - [LICENSE](#license) +#' +#' ## SYNOPSIS +#' +#' ``` +#' package require Tk +#' package require snit +#' package require dgw::tvmixins +#' ::dgw::mixin pathName widgetAdaptor ?options? +#' ::dgw::tvband [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvedit [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvfilebrowser [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvksearch [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvsortable [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvtooltip [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvtree [ttk::treeview pathName ?options?] ?options? +#' ::dgw::tvfilebrowser [dgw::tvband [dgw::tvsortable [dgw::tvsearch \ +#' [ttk::treeview pathName ?options?] ?options?] ?options?] ?options?] +#' set tv [ttk::treeview pathName ?options?] +#' dgw::mixin $tv dgw::tvband ?options? +#' ``` +#' +#' ## DESCRIPTION +#' +#' The package **dgw::tvmixins** implements several *snit::widgetadaptor*s which +#' extend the standard *ttk::treeview* widget with different functionalities. +#' Different adaptors can be chained together to add the required functionalities. +#' Furthermore at any later time point using the *dgw::mixin* command other adaptors can be installed on the widget. +#' +#' ## WIDGET COMMANDS +#' +package require Tk +package require snit + +namespace eval ::dgw {} +package provide dgw::tvmixins 0.3 + +#' +#' **dgw::mixin** *pathName mixinWidget ?-option value ...?* +#' +#' Adds the properties and methods of a snit::widgetadaptor specified with *mixinWidget* +#' to the exising widget created before with the given *pathName* and configures the widget +#' using the given *options*. +#' +#' Example: +#' +#' > ``` +#' # demo: mixin +#' # standard treeview widget +#' set tv [ttk::treeview .tv -columns "A B C" -show headings] +#' $tv heading A -text A +#' $tv heading B -text B +#' $tv heading C -text C +#' pack $tv -side top -fill both -expand true +#' # add sorting after object creation using the mixin command +#' dgw::mixin $tv dgw::tvsortable +#' # fill the widget +#' for {set i 0} {$i < 20} {incr i} { +#' $tv insert {} end -values [list [expr {rand()*4}] \ +#' [expr {rand()*10}] [expr {rand()*20}]] +#' } +#' # add another widget adaptor +#' dgw::mixin $tv dgw::tvband +#' # configure the new options of this adaptor at a later point +#' $tv configure -bandcolors [list white ivory] +#' > ``` + +proc ::dgw::mixin {pathName mixinWidget args} { + return [$mixinWidget $pathName {*}$args] +} + +#' +#' **dgw::tvband** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvband* widget using the Tk window id _pathName_ and the given *options*. +#' Please note that this adaptor might have performace issues and that the +#' *ttk::treeview* widget of Tk 8.7 +#' probably will have a configure option *-striped* and *-stripedbackgroundcolor* which can replace this adaptor. +#' +#' The following option is available: +#' +#' > - *-bandcolors* *list* - list of the two colors to be displayed alternatively. +#' +#' Example: +#' +#' > ``` +#' # demo: tvband +#' dgw::tvband [ttk::treeview .fb -columns [list A B C] -show headings] +#' foreach col [list A B C] { .fb heading $col -text $col } +#' for {set i 0} {$i < 20} {incr i 1} { +#' .fb insert {} end -values [list [expr {int(rand()*100)}] \ +#' [expr {int(rand()*1000)}] [expr {int(rand()*1000)}]] +#' } +#' pack .fb -side top -fill both -expand yes +#' > ``` + +# widget adaptor which does a banding of the ttk::treeview +# widget automatically after each insert command +snit::widgetadaptor ::dgw::tvband { + delegate option * to hull + delegate method * to hull + option -bandcolors [list #FFFFFF #DDEEFF] + # problem: + # can't avoid delegating insert as if it is + # overwritten parent insert can't be called + # solved by adding trace executation + # might slow down the widget + constructor {args} { + installhull $win + $self configurelist $args + $win tag configure band0 -background [lindex $options(-bandcolors) 0] + $win tag configure band1 -background [lindex $options(-bandcolors) 1] + trace add execution $win leave [mymethod wintrace] + # new line + bind $win <> [mymethod band] + $self band + #bind $win <> { puts Dummy } + } + # new method + method band {} { + set i 0 + foreach item [$win children {}] { + set t [expr { [incr i] % 2 }] + $win tag remove band0 $item + $win tag remove band1 $item + $win tag add band$t $item + } + } + onconfigure -bandcolors value { + set options(-bandcolors) $value + $win tag configure band0 -background [lindex $options(-bandcolors) 0] + $win tag configure band1 -background [lindex $options(-bandcolors) 1] + + } + method wintrace {args} { + set path [lindex [lindex $args 0] 0] + set meth [lindex [lindex $args 0] 1] + if {$meth eq "insert"} { + set parent [lindex [lindex $args 0] 2] + set index [lindex [lindex $args 0] 3] + set item [lindex [$path children $parent] $index] + if {$index eq "end"} { + set i [llength [$path children $parent]] + } else { + set i $index + } + set t [expr { $i % 2 }] + $path tag remove band0 $item + $path tag remove band1 $item + $path tag add band$t $item + } + } +} + +#' +#' **dgw::tvedit** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvedit* widget using the Tk window id _pathName_ and the given *options*. +#' This widget adaptor allows to do in place edits of the text within the ttk::treeview widget. The code is largly based on the wiki code in [Inplace edit in ttk::treeview](https://wiki.tcl-lang.org/page/Inplace+edit+in+ttk%3A%3Atreeview). Note: Currently only tabular, non hierarchical *ttk::treeview* widget's can be edited. +#' +#' The following options are available: +#' +#' > - *-edittypes* *list* - list of key values pairs where the key is the colummn name and +#' the values are pssible data types or lists of available values. The following data types are available +#' 1. *bool* provides a boolean value selection of true and false using a check box +#' 1. *int* a integer range of values must be given as: *int [list start end]* +#' 1. *list* list of possible values must be given with the values such as: *list [list A B C D E]* +#' 1. the default if no type is provided for a column name is a text entry with free text edition available +#' +#' > - *-editdefault* *type* the default edit is a entry text field, if you set this to an empty string only columns listed in the *-edittypes* options can be edited. +#' +#' > - *-editendcmd* *commandName* the command to be executed after the value was changed. +#' The widget path, the data type, the row id, the old and the new value are added as command arguments. This method can be used to validate the input as well and to perform some actions after the entry was edited. +#' +#' The widget provides the follwing events: +#' +#' > - <<*TreeviewEditEnd*\>> which is fired if a entry in the *ttk::treeview* widget +#' is changed. The following event symbols are available: *%d* a list of the row index and the column name which was changed, *%W* (widget). +#' +#' Bindings: +#' +#' > - ** - edit current row entries +#' - ** - cancel edits +#' - ** - save edit and end current edits +#' - ** - switch to the next edit field +#' - ** - switch to the previous edit field +#' +#' Example: +#' +#' > ``` +#' # demo: tvedit +#' proc editDone {args} { +#' puts "done: $args" +#' } +#' pack [dgw::tvedit [ttk::treeview .tv -columns {bool int list} -show {headings} \ +#' -selectmode extended -yscrollcommand {.sb set}] \ +#' -edittypes [list bool bool int [list int 0 100]] \ +#' -editdefault "" -editendcmd editDone] -fill both -expand true -side left +#' pack [ttk::scrollbar .sb -orient v -command ".tv yview"] -fill y -side left +#' .tv insert {} end -values {true 15 {Letter B}} +#' .tv insert {} end -values {true 35 {Letter D}} +#' for {set i 0} {$i<20} {incr i} { +#' .tv insert {} end -values [list true $i {Letter B}] +#' } +#' dgw::mixin .tv dgw::tvband +#' > ``` + +snit::widgetadaptor ::dgw::tvedit { + delegate option * to hull + delegate method * to hull + option -edittypes [list] + option -editdefault entry + option -editendcmd "" + variable edittypes + variable curfocus + constructor {args} { + installhull $win + $self configurelist $args + # intercept all the events changing focus + #bind $win <> +[mymethod checkFocus %W] + bind $win +[mymethod checkFocus %W %x %y] + #bind $win +[mymethod checkFocus %W] + bind $win +[list after idle [mymethod updateWnds %W]] + bind $win +[list after idle [mymethod updateWnds %W]] + bind $win +[list after idle [mymethod updateWnds %W]] + bind $win +[list if {$ttk::treeview::State(pressMode)=="resize"} { [mymethod updateWnds %W] }] + bind $win +[list after idle [mymethod updateWnds %W]] + bind all +[mymethod _clear $win %d] + #bind all +[mymethod _clear $win %d] + bind $win <> [mymethod InplaceEdit %d %v] + array set edittypes $options(-edittypes) + } + method InplaceEdit {d v} { + if {[$win children [lindex $d 1]]==""} { + set col [lindex $d 0] + if {$col eq "#0"} { + $win _inplaceEntry $win {*}$d + } elseif {[info exists edittypes($col)]} { + if {$edittypes($col) eq "bool"} { + $win _inplaceCheckbutton $win {*}$d true false + } elseif {[lindex $edittypes($col) 0] eq "int"} { + $win _inplaceSpinbox $win {*}$d [lindex $edittypes($col) 1] [lindex $edittypes($col) 2] 1 + } elseif {[lindex $edittypes($col) 0] eq "list"} { + $win _inplaceList $win {*}$d [lrange $edittypes($col) 1 end] + } else { + $win _inplaceEntry $win {*}$d + } + } else { + if {$options(-editdefault) eq "entry"} { + $win _inplaceEntry $win {*}$d + } + } + } elseif {[lindex $d 0]=="list"} { + # did not work yet + $win _inplaceEntryButton $win {*}$d [list set %$v "tree: $win, column,item=$d"] + } + } + # check, if focus has changed + method checkFocus {w {X {}} {Y {}} } { + if {![info exists curfocus($w)]} { + set changed 1 + } elseif {$curfocus($w)!=[$w focus]} { + $self _clear $w $curfocus($w) + set changed 1 + } else { + set changed 0 + } + set newfocus [$w focus] + if {$changed} { + if {$newfocus!=""} { + $self _focus $w $newfocus + if {$X!=""} { + set col [$w identify column $X $Y] + if {$col!=""} { + if {$col!="#0"} { + set col [$w column $col -id] + } + } + catch {focus $w.$col} + } + } + set curfocus($w) $newfocus + $self updateWnds $w + } + } + # update inplace edit widgets positions + method updateWnds {w} { + if {![info exists curfocus($w)]} { return } + set item $curfocus($w) + if {$item==""} { return } + foreach col [concat [$w cget -columns] #0] { + set wnd $w.$col + if {[winfo exists $wnd]} { + set bbox [$w bbox $item $col] + if {$bbox==""} { + place forget $wnd + } else { + place $wnd -x [lindex $bbox 0] -y [lindex $bbox 1] -width [lindex $bbox 2] -height [lindex $bbox 3] + } + } + } + } + # remove all inplace edit widgets + method _clear {w {item ""}} { + foreach col [concat [$w cget -columns] #0] { + set wnd $w.$col + if {[winfo exists $wnd]} { + destroy $wnd + } + } + } + # called when focus item has changed + method _focus {w item} { + set cols [$w cget -displaycolumns] + if {$cols=="#all"} { + set cols [concat #0 [$w cget -columns]] + } + foreach col $cols { + event generate $w <> -data [list $col $item] + if {[winfo exists $w.$col]} { + bind $w.$col {focus [tk_focusNext %W]} + bind $w.$col {focus [tk_focusPrev %W]} + } + } + } + # helper functions for inplace edit + method _get_value {w column item} { + if {$column=="#0"} { + return [$w item $item -text] + } else { + return [$w set $item $column] + } + } + method _set_value {w column item value} { + if {$column=="#0"} { + $w item $item -text $value + } else { + $w set $item $column $value + } + } + method _cancel_value {w column item} { + set value [$self _get_value $w $column $item] + set curfocus($w,$column) $value + $self _clear $w + focus -force $w + } + + method _update_value {w column item} { + set value [$self _get_value $w $column $item] + set newvalue $curfocus($w,$column) + if {$value!=$newvalue} { + $self _set_value $w $column $item $newvalue + } + if {$options(-editendcmd) ne ""} { + $options(-editendcmd) $w $column $item $value $newvalue + } + focus -force $w + event generate $w <> -data [list $item $column] + } + # these functions create widgets for in-place edit, use them in your in-place edit handler + method _inplaceEntry {w column item} { + set wnd $w.$column + ttk::entry $wnd -textvariable [myvar ::curfocus($w,$column)] -width 3 + set curfocus($w,$column) [$self _get_value $w $column $item] + bind $wnd [mymethod _update_value $w $column $item] + bind $wnd [mymethod _cancel_value $w $column $item] + } + method _inplaceEntryButton {w column item script} { + set wnd $w.$column + ttk::frame $wnd + pack [ttk::entry $wnd.e -width 3 -textvariable [myvar curfocus($w,$column)]] -side left -fill x -expand true + pack [ttk::button $wnd.b -style Toolbutton -text "..." -command [string map [list %v [myvar curfocus($w,$column)]] $script]] -side left -fill x + set curfocus($w,$column) [$self _get_value $w $column $item] + bind $wnd [mymethod _update_value $w $column $item] + bind $wnd [mymethod _cancel_value $w $column $item] + } + method _inplaceCheckbutton {w column item {onvalue 1} {offvalue 0} } { + set wnd $w.$column + ttk::checkbutton $wnd -variable [myvar ::curfocus($w,$column)] -onvalue $onvalue -offvalue $offvalue + set curfocus($w,$column) [$self _get_value $w $column $item] + bind $wnd [mymethod _update_value $w $column $item] + bind $wnd [mymethod _cancel_value $w $column $item] + } + method _inplaceList {w column item values} { + set wnd $w.$column + ttk::combobox $wnd -textvariable [myvar curfocus($w,$column)] -values $values -state readonly + set curfocus($w,$column) [$self _get_value $w $column $item] + bind $wnd [mymethod _update_value $w $column $item] + bind $wnd [mymethod _cancel_value $w $column $item] + } + method _inplaceSpinbox {w column item min max step} { + set wnd $w.$column + spinbox $wnd -textvariable [myvar curfocus($w,$column)] -from $min -to $max -increment $step + set curfocus($w,$column) [$self _get_value $w $column $item] + bind $wnd [mymethod _update_value $w $column $item] + bind $wnd [mymethod _cancel_value $w $column $item] + } +} + +#' +#' **dgw::tvfilebrowser** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvfilebrowser* widget using the Tk window id _pathName_ and the given *options*. +#' +#' The following option is available: +#' +#' > - *-directory dirName* - starting directory for the filebrowser, default current directory. +#' - *-browsecmd cmdName* - command to be executed if the users double clicks on a row item or presses the Return key. The widgets *pathName* and the actual row index are appended to the *cmdName* as arguments, default to empty string. +#' - *-fileimage imgName* - image to be displayed as filename image left of the filename, default is standard file icon. +#' - *-filepattern pattern* - the filter for the files to be displayed in the widget, default to ".+" i.e. all files +#' +#' The following method(s) is(are) available: +#' +#' > - *browseDir dirName* - the directory to be loaded into the *dgw::tvfilebrowser* widget. +#' +#' Example: +#' +#' > ``` +#' # demo: tvfilebrowser +#' dgw::tvfilebrowser [dgw::tvsortable [dgw::tvksearch [dgw::tvband \ +#' [ttk::treeview .fb]]] \ +#' -sorttypes [list Name directory Size real Modified dictionary]] +#' pack .fb -side top -fill both -expand yes +#' > ``` + +# a file browser widget as widget adaptor +# could be may be better be a snit::widget +# as it is already quite specialized +# however writing it as a adaptor allows nesting +# so banding widget adaptor can go intern +# this is required as in the constructor already +# browseDir is called +snit::widgetadaptor ::dgw::tvfilebrowser { + option -filepattern ".+" + option -directory "." + option -browsecmd "" + option -fileimage fileImg + delegate option * to hull + delegate method * to hull except browseDir + variable LastKeyTime + variable LastKey "" + constructor {args} { + ttk::style configure Treeview.Item -padding {1 1 1 1} + installhull $win ;# using ttk::treeview + $win configure -columns [list Name Size Modified] -show [list tree headings] + $win heading Name -text Name -anchor w + $win heading Size -text Size -anchor center + $win heading Modified -text Modified -anchor w + $win column Name -width 60 + $win column Size -width 40 + $win column Size -width 40 + $win column #0 -width 35 -anchor w -stretch false + bind $win [mymethod fbOnClick %W %x %y] + bind $win [mymethod fbReturn %W] + bind $win [mymethod browseDir ..] + $win tag configure hilight -foreground blue + $self configurelist $args + set LastKeyTime [clock seconds] + $self browseDir $options(-directory) + } + typeconstructor { + image create photo movie -data { + R0lGODlhEAAQAIIAAPwCBARCRAQCBASChATCxATCBASCBAAAACH5BAEAAAAA + LAAAAAAQABAAAANHCLrc/izISauYI5NduvlXMIjEQBSnUYCYxnmsSJrouhqh + 6J4wLo0mWuqWy5heN58seBrGdEdeMgQsNW0ggXbL7Qog4HDDnwAAIf5oQ3Jl + YXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3Ig + MTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5k + ZXZlbGNvci5jb20AOw== + } + image create photo fileImg -data { + R0lGODlhEAAOAPcAAAAAADVJYzZKZJOit5WkuZalupqpvpyrwJ6uw6OyyKSzyae2zKm5z6u70a6+ + 1K+/1bLC2LrF1L3K4cTP5MnT5svV59HZ6tPb69Xd7Njf7drh7tzj79/l8OHn8ePp8ubr9Ont9evv + 9u7x9/Dz+PL1+fX3+vf4+/n6/Pv8/fz9/v7+/v///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAP8ALAAAAAAQAA4A + AAh7AP/9g0CwoAMGCgQqFAhhhcOHKw4IWCjwAcSHBCJMXNjgosMBAkIuXOBxBYoBIBcm8KiiBIgB + ARYi8HhCRAeYCw1cTEHigwacCgtcNBGCwwWgAgdARDHCQ4YKSP8pddgSxAYLE6JOXVGzAwYKErSi + HEs2aoCzaNOeFRgQADs=} + image create photo clsdFolderImg -data { + R0lGODlhEAAOAPcAAAAAAJycAM7OY//OnP//nP//zvf39wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAP8ALAAAAAAQAA4A + AAhjAP8JHEiw4MAACBECMHjQQIECBAgEWGgwgICLGAUkTCgwwMOPIB8SELDQY8STKAkMIPnPZEqV + MFm6fDlApUyIKGvqHFkSZ06YK3ue3KkzaMsCRIEOMGoxo1OMFAFInUqV6r+AADs=} + image create bitmap arrowBlank -data { + #define arrowBlank_width 7 + #define arrowBlank_height 4 + static char arrowBlank_bits[] = { + 0x00, 0x00, 0x00, 0x00 + }; + } + + } + method fbReturn {w} { + set row [$win selection] + $win tag remove hilight + $win tag add hilight $row + set fname [lindex [$win item $row -values] 0] + if {[file isdirectory $fname]} { + $self browseDir $fname + } else { + if {$options(-browsecmd) ne ""} { + $options(-browsecmd) $fname + } + } + } + method fbOnClick {w x y} { + set row [$win identify item $x $y] + $win tag remove hilight + $win tag add hilight $row + set fname [lindex [$win item $row -values] 0] + if {[file isdirectory $fname]} { + $self browseDir $fname + } else { + if {$options(-browsecmd) ne ""} { + $options(-browsecmd) $fname + } + } + } + onconfigure -directory value { + $self browseDir $value + set options(-directory) $value + } + method browseDir {{dir "."}} { + if {[llength [$win children {}]] > 0} { + $win delete [$win children {}] + } + if {$dir ne "."} { + cd $dir + set options(-directory) [pwd] + } + $win insert {} end -values [list ".." " " [clock format [file mtime ..] -format "%Y-%m-%d %H:%M"]] -image clsdFolderImg + foreach dir [lsort -dictionary [glob -types d -nocomplain [file join $options(-directory) *]]] { + $win insert {} end -values [list [file tail $dir] " " \ + [clock format [file mtime [file tail $dir]] -format "%Y-%m-%d %H:%M"]] -image clsdFolderImg + } + + foreach file [lsort -dictionary [glob -types f -nocomplain [file join $options(-directory) *]]] { + if {[regexp $options(-filepattern) $file]} { + $win insert {} end -values [list [file tail $file] \ + [format "%3.2fMb" [expr {([file size $file] /1024.0)/1024.0}]] \ + [clock format [file mtime [file tail $file]] -format "%Y-%m-%d %H:%M"]] \ + -image $options(-fileimage) + } + } + $win focus [lindex [$win children {}] 0] + $win selection set [lindex [$win children {}] 0] + focus -force $win + foreach header [$win cget -columns] { + $win heading $header -image arrowBlank + } + } + +} + +#' +#' **dgw::tvksearch** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvksearch* widget using the Tk window id _pathName_ and the given *options*. +#' With this widget you can use the Home and End keys for navigation and further letter +#' typing starts searching in the first column shifting focus and display to the current matching entry. +#' +#' There are currently no options or methods available for this widget. +#' +#' Example: +#' +#' > ``` +#' # demo: tvksearch +#' dgw::tvfilebrowser [dgw::tvksearch [ttk::treeview .fb]] +#' pack .fb -side top -fill both -expand yes +#' > ``` + +# widget adaptor which allows forward searching in a ttk::treeview +# using the starting letters matchinf entries in column 1 +# with typing beginning letters +# further has bindings of Home and End key +snit::widgetadaptor ::dgw::tvksearch { + delegate option * to hull + delegate method * to hull + variable LastKeyTime "" + variable LastKey "" + constructor {args} { + installhull $win + bind $win [mymethod setSelection 0] + bind $win [mymethod setSelection end] + bind $win [mymethod ListMatch %A] + set LastKeyTime [clock seconds] + $self configurelist $args + + } + method setSelection {index} { + $self focus [lindex [$self children {}] $index] + $self selection set [lindex [$self children {}] $index] + focus -force $win + $self see [lindex [$self selection] 0] + } + method ListMatch {key} { + if [regexp {[-A-Za-z0-9]} $key] { + set ActualTime [clock seconds] + if {[expr {$ActualTime-$LastKeyTime}] < 3} { + set ActualKey "$LastKey$key" + } else { + set ActualKey $key + } + + set n 0 + foreach i [$win children {}] { + set name [lindex [$win item $i -value] 0] + if [string match $ActualKey* $name] { + $win selection remove [$win selection] + $win focus $i + $win selection set $i + focus -force $win + $win see $i + set LastKeyTime [clock seconds] + set LastKey $ActualKey + break + } else { + incr n + } + } + } + + } +} + + + +#' +#' **dgw::tvsortable** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvsortable* widget using the Tk window id _pathName_ and the given *options*. +#' +#' The following option is available: +#' +#' > - *-sorttypes* the options for the *lsort* command for each of the columns, +#' such as dictionary, ascii, real etc. Default: autocheck for dictionary or real. +#' The values are given as a list of key-value pairs where the key is +#' the column name. In addition to the standard *lsort* options as well +#' the option *directory* can be given if the widget contains results of a +#' directory listening with filenames and directory names. +#' In this case the directories are always sorted above the filenames. +#' +#' The following methods are available: +#' +#' > - *sortBy* *colId decreasing* - sort widget by column with the given *colId* and in decreasing order if true or *increasing* if false. +#' - *reSort* redo the last sorting again, useful if the data in the widget where changed either interactively for instance using the *tvedit* adaptor or programmatically. +#' +#' The widget further provides the following event: +#' +#' - <<*SortEnd*\>> - with the following symbols *%W* (widget path) and *%d* (column id) +#' +#' Example: +#' +#' > ``` +#' # demo: tvsortable +#' dgw::tvsortable [dgw::tvband [ttk::treeview .fb -columns [list A B C] \ +#' -show headings]] -sorttypes [list A real B real C integer] +#' foreach col [list A B C] { .fb heading $col -text $col } +#' for {set i 0} {$i < 20} {incr i 1} { +#' .fb insert {} end -values [list [expr {int(rand()*100)}] \ +#' [expr {int(rand()*1000)}] [expr {int(rand()*1000)}]] +#' } +#' pack .fb -side top -fill both -expand yes +#' > ``` +# +snit::widgetadaptor ::dgw::tvsortable { + delegate option * to hull except -sorttypes + delegate method * to hull + # -filename column-id to always sort directories before columns + option -sorttypes [list] + variable sortOpt + variable lastCol "" + variable lastDir "" + + constructor {args} { + installhull $win + $self configurelist $args + array set sortOpt $options(-sorttypes) + set headers [$win cget -columns] + set x 0 + foreach col $headers { + $win heading $col -image arrowBlank \ + -command [mymethod sortBy $col 0] + } + + } + typeconstructor { + image create photo arrow(1) -data { + R0lGODlhEAAQAIIAAAT+BPwCBAQCBAQC/FxaXAAAAAAAAAAAACH5BAEAAAAA + LAAAAAAQABAAAAM5CBDM+uKp8KiMsmaAs82dtnGeCHnNp4TjNQ4jq8CbDNOr + oIe3ROyEx2A4vOgkOBzgFxQ6Xa0owJ8AACH+aENyZWF0ZWQgYnkgQk1QVG9H + SUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxs + IHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= + } + image create photo arrow(0) -data { + R0lGODlhEAAQAIIAAAT+BAQC/AQCBPwCBFxaXAAAAAAAAAAAACH5BAEAAAAA + LAAAAAAQABAAAAM4CAqxLm61CGBs81FMrQxgpnhKJlaXFJHUGg0w7DrDUmvt + PQo8qyuEHoHW6hEVv+DQFvuhWtCFPwEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ + RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg + cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== + } + + image create bitmap arrow(2) -data { + #define arrowUp_width 7 + #define arrowUp_height 4 + static char arrowUp_bits[] = { + 0x08, 0x1c, 0x3e, 0x7f + }; + } + image create bitmap arrow(3) -data { + #define arrowDown_width 7 + #define arrowDown_height 4 + static char arrowDown_bits[] = { + 0x7f, 0x3e, 0x1c, 0x08 + }; + } + image create bitmap arrowBlank -data { + #define arrowBlank_width 7 + #define arrowBlank_height 4 + static char arrowBlank_bits[] = { + 0x00, 0x00, 0x00, 0x00 + }; + } + } + # not working yet + method sortBy {col direction} { + set lastCol $col + set lastDir $direction + #set mtimer [Timer %AUTO%] + set ncol [lsearch -exact [$win cget -columns] $col] + if {![info exists sortOpt($col)]} { + set fchild [lindex [$win children ""] 0] + set fvalues [$win item $fchild -values] + set i 0 + foreach heading [$win cget -columns] { + if {[$win heading $heading -text] eq "$col"} { + set val [lindex $fvalues $i] + break + } + incr i + } + if {[string is double $val]} { + set stype real + } else { + set stype dictionary + } + } else { + set stype $sortOpt($col) + } + set dir [expr {$direction ? "-decreasing" : "-increasing"}] + if {[lsearch [array get sortOpt] directory] > -1} { + set hasDir true + foreach key [array names sortOpt] { + if {$sortOpt($key) eq "directory"} { + set cname $key + set i 0 + foreach heading [$win cget -columns] { + if {[$win heading $heading -text] eq "$cname"} { + set didx $i + break + } + incr i + } + break + } + } + } else { + set hasDir false + } + + set l [list] + foreach child [$win children {}] { + set val [lindex [$win item $child -values] $ncol] + if {$stype eq "directory"} { + # ensure that .. is always on top + # and thereafter sorted directories + # and only then sorted files + if {$val eq ".." && $direction} { + set val "Z$val" + } elseif {$val eq ".."} { + set val "A$val" + } elseif {[file isdirectory $val] && $direction} { + set val "O$val" + } elseif {[file isdirectory $val]} { + set val "D$val" + } else { + set val "F$val" + } + lappend l [list $val $child] + } elseif {$hasDir} { + set val [lindex [$win item $child -values] $ncol] + set fname [lindex [$win item $child -values] $didx] + if {$fname eq ".."} { + set letter A + } elseif {[file isdirectory $fname]} { + set letter D + } else { + set letter F + } + lappend l [list $val $child $letter] + } else { + lappend l [list $val $child] + } + } + if {$hasDir && ($stype eq "real" || $stype eq "integer")} { + set l [lmap x $l { list [regsub -all {[^0-9\.]} [lindex $x 0] "0"] [lindex $x 1] [lindex $x 2] }] + } elseif {$stype eq "real" && $stype eq "integer"} { + set l [lmap x $l { list [regsub -all {[^0-9]} [lindex $x 0] ""] [lindex $x 1] }] + } + #set idx [lsort -$stype -indices -index 0 $dir $l] + if {$stype eq "directory"} { + set l [lsort -dictionary -index 0 $dir $l] + } elseif {$hasDir} { + #puts $l + set l [lsort -dictionary -index 2 -increasing [lsort -$stype -index 0 $dir $l]] + #puts $l + } else { + set l [lsort -$stype -index 0 $dir $l] + } + for {set i 0} {$i < [llength $l]} {incr i 1} { + set item [lindex [lindex $l $i] 1] + $win move $item {} $i + } + set idx -1 + foreach ccol [$win cget -columns] { + incr idx + set img arrowBlank + if {$ccol == $col} { + set img arrow($direction) + } + $win heading $idx -image $img + } + set cmd [mymethod sortBy $col [expr {!$direction}]] + $win heading $col -command $cmd + # new event + event generate $win <> -data $col + } + method reSort {} { + if {$lastCol ne ""} { + $self sortBy $lastCol $lastDir + } + } + + +} + +#' +#' **dgw::tvtooltip** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvtooltip* widget using the Tk window id _pathName_ and the given *options*. +#' +#' There are currently no options available. +#' +#' The widget provides the following events: +#' +#' - <> with the following symbols: %d the row index, and the standards %W (widget), %x (widgetX), %y (widgetY), %X (rootx), %Y (rootY) +#' - <> with the following symbols: %d the row index, and the standards %W (widget), %x (widgetX), %y (widgetY), %X (rootx), %Y (rootY) +#' +#' Example: +#' +#' > ``` +#' # demo: tvtooltip +#' set fb [dgw::tvtooltip [dgw::tvfilebrowser [ttk::treeview .fp2] \ +#' -directory . -fileimage movie \ +#' -filepattern {\.(3gp|mp4|avi|mkv|mp3|ogg)$}]] +#' pack $fb -side top -fill both -expand yes +#' pack [::ttk::label .msg -font "Times 12 bold" -textvariable ::msg -width 20 \ +#' -background salmon -borderwidth 2 -relief ridge] \ +#' -side top -fill x -expand false -ipadx 5 -ipady 4 +#' bind $fb <> { set ::msg " Entering row %d"} +#' bind $fb <> { set ::msg " Leaving row %d"} +#' > ``` +#' + +# https://wiki.tcl-lang.org/page/TreeView+Tooltips +snit::widgetadaptor ::dgw::tvtooltip { + delegate option * to hull + delegate method * to hull + variable LAST + variable AFTERS + constructor {args} { + installhull $win + $self configurelist $args + array set LAST [list $win ""] + array set AFTERS [list $win ""] + bind $win [mymethod OnMotion %W %x %y %X %Y] + } + method OnMotion {W x y rootX rootY} { + set id [$W identify row $x $y] + set lastId $LAST($W) + set LAST($W) $id + if {$id ne $lastId} { + after cancel $AFTERS($W) + if {$lastId ne ""} { + event generate $W <> \ + -data $lastId -x $x -y $y -rootx $rootX -rooty $rootY + } + if {$id ne ""} { + set AFTERS($W) \ + [after 300 event generate $W <> \ + -data $id -x $x -y $y -rootx $rootX -rooty $rootY] + } + } + } +} + +#' +#' **dgw::tvtree** *[ttk::treeview pathName] ?-option value ...?* +#' +#' Creates and configures the *dgw::tvtree* widget using the Tk window id _pathName_ and the given *options*. +#' +#' There is(are) currently the following option(s) available: +#' +#' - *-icon* - the icon type, which can be currently either book or folder. To provide your own icons you must create two image icons \open16 and \close16. Support for icons of size 22 will be added later. +#' +#' The widget provides the following event: +#' +#' - <> which is fired if a item is inserted into the *tvtree* widget, there are the following event symbols available: _%d_ the row index, and the standard _%W_ (widget pathname). +#' +#' Example: +#' +#' > ``` +#' # demo: tvtree +#' set tree [dgw::tvtree [ttk::treeview .tree \ +#' -height 15 -show tree -selectmode browse] \ +#' -icon folder] +#' foreach txt {first second third} { +#' set id [$tree insert {} end -text " $txt item" -open 1] +#' for {set i [expr {1+int(rand()*5)}]} {$i > 0} {incr i -1} { +#' set child [$tree insert $id 0 -text " child $i"] +#' for {set j [expr {int(rand()*3)}]} {$j > 0} {incr j -1} { +#' $tree insert $child 0 -text " grandchild $i" +#' } +#' } +#' } +#' pack $tree -side top -fill both -expand true +#' > ``` +#' + +snit::widgetadaptor ::dgw::tvtree { + delegate option * to hull + delegate method * to hull + option -icon book + constructor {args} { + installhull $win + $self configurelist $args + trace add execution $win leave [mymethod wintrace] + bind $win <> [mymethod TreeviewUpdateImages true] + bind $win <> [mymethod TreeviewUpdateImages false] + bind $win <> [mymethod InsertItem %d] + } + typeconstructor { + image create photo bookclose16 -data { + R0lGODlhEAAQAIQAAPwCBAQCBDyKhDSChGSinFSWlEySjCx+fHSqrGSipESO + jCR6dKTGxISytIy6vFSalBxydAQeHHyurAxubARmZCR+fBx2dDyKjPz+/MzK + zLTS1IyOjAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAVkICCOZGmK + QXCWqTCoa0oUxnDAZIrsSaEMCxwgwGggHI3E47eA4AKRogQxcy0mFFhgEW3M + CoOKBZsdUrhFxSUMyT7P3bAlhcnk4BoHvb4RBuABGHwpJn+BGX1CLAGJKzmK + jpF+IQAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0K + qSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpo + dHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 + } + image create photo bookopen16 -data { + R0lGODlhEAAQAIUAAPwCBAQCBExCNGSenHRmVCwqJPTq1GxeTHRqXPz+/Dwy + JPTq3Ny+lOzexPzy5HRuVFSWlNzClPTexIR2ZOzevPz29AxqbPz6/IR+ZDyK + jPTy5IyCZPz27ESOjJySfDSGhPTm1PTizJSKdDSChNzWxMS2nIR6ZKyijNzO + rOzWtIx+bLSifNTGrMy6lIx+ZCRWRAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAae + QEAAQCwWBYJiYEAoGAFIw0E5QCScAIVikUgQqNargtFwdB9KSDhxiEjMiUlg + HlB3E48IpdKdLCxzEAQJFxUTblwJGH9zGQgVGhUbbhxdG4wBHQQaCwaTb10e + mB8EBiAhInp8CSKYIw8kDRSfDiUmJ4xCIxMoKSoRJRMrJyy5uhMtLisTLCQk + C8bHGBMj1daARgEjLyN03kPZc09FfkEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJ + RiBQcm8gdmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwg + cmlnaHRzIHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== + } + image create photo folderclose16 -data { + R0lGODlhEAAQAIMAAPwCBNSeBJxmBPz+nMzOZPz+zPzSBPz2nPzqnAAAAAAA + AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARFEMhJ6wwYC3uH + 98FmBURpElkmBUXrvsVgbOxw3F8+A+zt/7ddDwgUFohFWgGB9BmZzcMTASUK + DdisNisSeL9gMGdMJvsjACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZl + cnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyBy + ZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= + } + image create photo folderopen16 -data { + R0lGODlhEAAQAIMAAPwCBJxmBPz+nNSeBPz6nPz2nPzqnPzunPzynPzmnPzi + nAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAROEMhJKw0Y2yt6 + DxswEJ43nOc0FGTpgiLbup+I3nc9GMdRsK6BALTjIWQlISzAOxwLwWUi0XvO + BjBAINE8zoaTgIJr/LWy2oxaHWq7Lf4IACH+aENyZWF0ZWQgYnkgQk1QVG9H + SUYgUHJvIHZlcnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxs + IHJpZ2h0cyByZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs= + } + + image create photo file16 -data { + R0lGODlhEAAQAIUAAPwCBFxaXNze3Ly2rJyanPz+/Ozq7GxqbPz6/GxubNTK + xDQyNIyKhHRydERCROTi3PT29Pz29Pzy7PTq3My2pPzu5PTi1NS+rPTq5PTe + zMyynPTm1Pz69OzWvMyqjPTu5PTm3OzOtOzGrMSehNTCtNS+tAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAAZ/ + QAAgQCwWhUhhQMBkDgKEQFIpKFgLhgMiOl1eC4iEYrtIer+MxsFRRgYe3wLk + MWC0qXE5/T6sfiMSExR8Z1YRFRMWF4RwYIcYFhkahH6AGBuRk2YCCBwSFZgd + HR6UgB8gkR0hpJsSGCAZoiEiI4QKtyQlFBQeHrVmC8HCw21+QQAh/mhDcmVh + dGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIuNQ0KqSBEZXZlbENvciAx + OTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQuDQpodHRwOi8vd3d3LmRl + dmVsY29yLmNvbQA7 + } + image create photo bookclose22 -data { + R0lGODlhFgAWAIUAAPwCBAQCBDyGhCyCfFSWlESOjDyKjDSGhCx+fGSinGSe + nFyanEySjHSqpHSqrGympEySlBx2dISytHyyrCR6dKTGxHyurHSurHyytGSi + pCR6fARmZFSalEyWlBRubAxubBRydDyKhDSChLSytPz+/MzKzIyOjAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAWABYAAAbF + QIBwSCwaj8ikMhBQIpmCQdM5ZBIKhgNiugwkFAsCI7pNMhuOxkNBgBgEiAi3 + GkBLJpJHYgEpaClyREwVFhcSEhgOGQoMfgMaERtcARQBFRMYExZ6HB0FUYAe + kkIBHxqWFmlrC1haESAfG6MBGx+VFRgKYH0hInGRklO0ppYXCwwMWQiQHkwj + grWnFRdYZHIBJCTP0LaWGAcDW9jZ2nMAw9IWTOQkJSZMRsOV49nu8E+19Pbm + R7TY+1TovONH5V7Ag0QMBAEAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8g + dmVyc2lvbiAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRz + IHJlc2VydmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== + } + image create photo bookopen22 -data { + R0lGODlhFgAWAIYAAAQCBAQ2NPwCBHSurIS2tBx2dBweHPz+/Ozm1GxiTGyq + pPz6/Pz69GSqpOzaxPzy5HxuVLSmlOTazPz27PT29NzClPTexHxuXLSmjAxq + bFSinPTy9KyehNy+lPTy5Pz29HxyXNzWxKSahOzexPzy7IR2ZOTWtESenPTy + 7KSWfIyCbKyijAQGBDyalPTu3KSSdDSOjJyOdCSGhPzu3OzizJSGdPTq1PTq + 3JySdMy6lAyKhOzWtOzi1OTOrJyKbMS2nJySfMS+rAwCBNzOrNTCpNzKpJSG + ZKyafLSifLyylIx+ZHx6ZDSChAQuLAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAIA + LAAAAAAWABYAAAf/gAABAoSFhoeHAAMAiI2IAAQFjI6EAAaJkQeTjwAICYkK + BQcLm5WdBwyfhgChB66bp64HCQC1lQ2irqQCAA4PowsLEBESE4wAuLIHFAAV + Fr+uDBcYxRm1GrmuGxwdFh4Mrh8gGCET1gDYyhsiFSMkDAsMDCUYJhvnJ9kH + KCnODwwfPlBQsULCPRYAWogK9sHFiwoOPEyQh0JFPXO1YBSYwBEFghjdHkwQ + OYGgwQwIZRR44GHGDBogabhAsYEEihrUMAIoUMCEDRs3HODIYQHFA6MPcJA7 + KICFjgw7eIzo4cOfiwc/gKwIUm2SkKdDdlDt4AABDaU/iIRwwbTSUyJFOow4 + S3Hkx9oNDDZgXPU0h1wcSIgEGUw4ibVET5WoWMKksePHpdxmyKADAEIWly9H + JtQkQJMmlAgZCAQAIf5oQ3JlYXRlZCBieSBCTVBUb0dJRiBQcm8gdmVyc2lv + biAyLjUNCqkgRGV2ZWxDb3IgMTk5NywxOTk4LiBBbGwgcmlnaHRzIHJlc2Vy + dmVkLg0KaHR0cDovL3d3dy5kZXZlbGNvci5jb20AOw== + } + image create photo filenew22 -data { + R0lGODlhFgAWAIUAAPwCBExOTERCRDw6PCwuLBwaHAwODAQCBOze1NTW1OTi + 5Nze3MTGxLS2tJyanPz+/Ozu7OTi3BQSFCwqLDw+PDQyNFRSVPTu7MzKxLyy + rIR+fCQmJPz6/NTOxPz69Pzy7PTu5Pz29Pzu5PTq5PTm1My6pBQWFPTq3PTm + 3NS+rAwKDPTi1PTezOzWxMy2pPz27PTazOzSvMyynOzaxOzOtPTaxOzKrMyq + jOzGpMymhPTizOTCpNzSzNTGvMymjMSihCH5BAEAAAAALAAAAAAWABYAAAbo + QIBwSCwaiYGAYEAgFAqGg/Q4DCASCsTiymgcHAcqQLB4mM+QiIQBppLPcMjk + wQ4bB2X4maKgt4sVCHpnFhQTElNFE3mDDxcYGRp2RBuMgxwIHX9EBZZwHh8g + CBmTQ52NISEiIyQlpUImng8hHyInKAgprwAqgnC0IKwrLLpGB4wctLYkwy0u + uwd9Z8AnJywsLcVFx2YcL7UnJCwwLTEy0GXJoSgrCCwzNDTnxgjeH9UrKzXw + NDY36LRGhEOwLx4NHDmgJbh3QoeOgv127EhojEeHDj16pEhRQoZHHzl+QJNC + sqTJSXaCAAAh/mhDcmVhdGVkIGJ5IEJNUFRvR0lGIFBybyB2ZXJzaW9uIDIu + NQ0KqSBEZXZlbENvciAxOTk3LDE5OTguIEFsbCByaWdodHMgcmVzZXJ2ZWQu + DQpodHRwOi8vd3d3LmRldmVsY29yLmNvbQA7 + } + } + + method wintrace {args} { + set path [lindex [lindex $args 0] 0] + set meth [lindex [lindex $args 0] 1] + if {$meth eq "insert"} { + set parent [lindex [lindex $args 0] 2] + set index [lindex [lindex $args 0] 3] + set item [lindex [$path children $parent] $index] + event generate $win <> -data $item + } + } + method InsertItem {item} { + set parent [$win parent $item] + $win item $item -image file16 + if {$parent eq {}} { + $win item $item -image file16 + } else { + if {[$win item $parent -open]} { + $win item $parent -image $options(-icon)open16 + } else { + $win item $parent -image $options(-icon)close16 + } + } + } + + method TreeviewUpdateImages {open} { + # event fires before + # the children are indeed displayed or hided + set item [$win focus] + if {$open} { + if {[llength [$win children $item]] > 0} { + $win item $item -image $options(-icon)open16 + } + } else { + if {[llength [$win children $item]] > 0} { + $win item $item -image $options(-icon)close16 + } + } + } +} + +namespace eval dgw { + namespace export mixin tvband tvedit tvfilebrowser tvksearch \ + tvsortable tvtooltip tvtree +} + +if {[info exists argv0] && $argv0 eq [info script] && [regexp {tvmixins} $argv0]} { + # dgwutils is only required for doucmentation and script execution + package require dgw::dgwutils + set dpath dgw + set pfile [file rootname [file tail [info script]]] + if {[llength $argv] == 1 && [lindex $argv 0] eq "--version"} { + puts [dgw::getVersion [info script]] + destroy . + } elseif {[llength $argv] >= 1 && [lindex $argv 0] eq "--demo"} { + if {[llength $argv] == 1} { + dgw::runExample [info script] true + } else { + dgw::runExample [info script] true [lindex $argv 1] + } + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--code"} { + puts [dgw::runExample [info script] false] + #destroy . + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--example"} { + puts [dgw::runExample [info script] false] + destroy . + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--test"} { + package require tcltest + set argv [list] + tcltest::test dummy-1.1 { + Calling my proc should always return a list of at least length 3 + } -body { + set result 1 + } -result {1} + tcltest::cleanupTests + destroy . + } elseif {[llength $argv] == 1 && ([lindex $argv 0] eq "--license" || [lindex $argv 0] eq "--man" || [lindex $argv 0] eq "--html" || [lindex $argv 0] eq "--markdown")} { + dgw::manual [lindex $argv 0] [info script] + } elseif {[llength $argv] == 1 && [lindex $argv 0] eq "--install"} { + dgw::install [info script] + } else { + destroy . + puts "\n -------------------------------------" + puts " The ${dpath}::$pfile package for Tcl" + puts " -------------------------------------\n" + puts "Copyright (c) 2020 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de\n" + puts "License: MIT - License see manual page" + puts "\nThe ${dpath}::$pfile package provides a text editor widget with syntax hilighting facilities and and toolbar" + puts "" + puts "Usage: [info nameofexe] [info script] option\n" + puts " Valid options are:\n" + puts " --help : printing out this help page" + puts " --demo : runs a small demo application." + puts " --code : shows the demo code." + puts " --test : running some test code" + puts " --license : printing the license to the terminal" + puts " --install : install ${dpath}::$pfile as Tcl module" + puts " --man : printing the man page in pandoc markdown to the terminal" + puts " --markdown: printing the man page in simple markdown to the terminal" + puts " --html : printing the man page in html code to the terminal" + puts " if the Markdown package from tcllib is available" + puts "" + } + return + proc fbrowse {path args} { + set fb [dgw::tvtooltip [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview $path]] {*}$args]]] + return $fb + } + # Example code + + set fb [dgw::tvsortable [dgw::tvksearch [dgw::tvfilebrowser [dgw::tvband [ttk::treeview .fp]] -directory . -fileimage fileImg]] -sorttypes [list Name directory Size dictionary Modified dictionary]] + pack $fb -side top -fill both -expand yes + #set fb2 [dgw::tvfilebrowser [ttk::treeview .fp2] -directory . -fileimage movie -filepattern {\.(3gp|mp4|avi|mkv|mp3|ogg)$}] + set fb2 [fbrowse .fp2] + #pack $fb2 -side top -fill both -expand yes + #pack [::ttk::label .msg -font "Times 12 bold" -textvariable ::msg -width 20 \ + # -background salmon -borderwidth 2 -relief ridge] -side top -fill x -expand false -ipadx 5 -ipady 4 + bind $fb2 <> { set ::msg " Entering row %d"} + bind $fb2 <> { set ::msg " Leaving row %d"} + set headers {Year Games AB Runs Code} + set data { + {1939 149 565 131 A1} + {1940 144 561 134 B2} + {1941 143 456 135 Z2} + {1942 150 522 141 K3} + {1946 150 514 142 D4} + {1947 156 528 125 AA} + {1948 137 509 124 BB} + {1949 155 566 150 CB} + {1950 89 334 82 D3} + {1951 148 531 109 K4} + {1952 6 10 2 XY} + {1953 37 91 17 P1} + {1954 117 386 93 L3} + {1955 98 320 77 ZZ} + {1956 136 400 71 XX} + {1957 132 420 96 K5} + {1958 129 411 81 C6} + {1959 103 272 32 A7} + {1960 113 310 56 HJ} + } + pack [dgw::tvsortable \ + [dgw::tvband \ + [ttk::treeview .tv3 -columns $headers -show headings]] \ + -sorttypes [list Code dictionary]] -side top -fill both -expand yes + foreach col $headers { + .tv3 heading $col -text $col + .tv3 column $col -width 100 + + } + foreach row $data { + .tv3 insert {} end -values $row + } +} + +#' ## EXAMPLE +#' +#' In the examples below we create first a filebrowser widget using all the widget +#' adaptors for demonstration purposes. Therafter comes a tooltip demonstration, a tree demonstration and +#' finally a demonstration on how to use the *dgw::mixin* command which simplifies the addition of +#' new behaviors to our *ttk::treewidget* in a stepwise manner. The latter approach is as well nice to extend existing widgets in a more controlled manner avoiding restarts of applications during developing the widget. +#' +#' ``` +#' # wrapper function +#' proc fbrowse {path args} { +#' set fb [dgw::tvtooltip [dgw::tvsortable [dgw::tvksearch \ +#' [dgw::tvfilebrowser [dgw::tvband \ +#' [ttk::treeview $path]] {*}$args]] \ +#' -sorttypes [list Name directory Size real Modified dictionary]]] +#' return $fb +#' } +#' set pw [ttk::panedwindow .pw -orient horizontal] +#' set f0 [ttk::frame $pw.f] +#' set f1 [ttk::frame $f0.f] +#' set fb [fbrowse $f1.fb] +#' pack $fb -side left -fill both -expand yes +#' pack [ttk::scrollbar $f1.yscroll -command [list $fb yview]] \ +#' -side left -fill y -expand false +#' $fb configure -yscrollcommand [list $f1.yscroll set] +#' pack $f1 -side top -fill both -expand true +#' # demo tvtooltip +#' pack [::ttk::label $f0.msg -font "Times 12 bold" -textvariable ::msg -width 20 \ +#' -background salmon -borderwidth 2 -relief ridge] \ +#' -side top -fill x -expand false -ipadx 5 -ipady 4 +#' bind $fb <> { set ::msg " Entering row %d"} +#' bind $fb <> { set ::msg " Leaving row %d"} +#' +#' $pw add $f0 + +#' set tree [dgw::tvtree [ttk::treeview $pw.tree -height 15 -show tree -selectmode browse] -icon folder] +#' foreach txt {first second third} { +#' set id [$tree insert {} end -text " $txt item" -open 1] +#' for {set i [expr {1+int(rand()*5)}]} {$i > 0} {incr i -1} { +#' set child [$tree insert $id 0 -text " child $i"] +#' for {set j [expr {int(rand()*3)}]} {$j > 0} {incr j -1} { +#' $tree insert $child 0 -text " grandchild $i" +#' } +#' } +#' } +#' $pw add $tree +#' # another example using mixin syntax +#' set tv [ttk::treeview $pw.tv -columns "A B C" -show headings] +#' dgw::mixin $tv dgw::tvsortable +#' +#' $tv heading A -text A +#' $tv heading B -text B +#' $tv heading C -text C +#' $pw add $tv +#' for {set i 0} {$i < 20} {incr i} { +#' $tv insert {} end -values [list [expr {rand()*4}] \ +#' [expr {rand()*10}] [expr {rand()*20}]] +#' } +#' dgw::mixin $tv dgw::tvband +#' $tv configure -bandcolors [list white ivory] +#' pack $pw -side top -fill both -expand true +#' ``` +#' +#' ## INSTALLATION +#' +#' Installation is easy you can install and use the **__PKGNAME__** package if you have a working install of: +#' +#' - the snit package which can be found in [tcllib - https://core.tcl-lang.org/tcllib](https://core.tcl-lang.org/tcllib) +#' +#' For installation you copy the complete *dgw* folder into a path +#' of your *auto_path* list of Tcl or you append the *auto_path* list with the parent dir of the *dgw* directory. +#' Alternatively you can install the package as a Tcl module by creating a file dgw/__BASENAME__-__PKGVERSION__.tm in your Tcl module path. +#' +#' Only if you you like to extract the HTML documentation and run the examples, +#' you need the complete dgw package and for the HTML generation the tcllib Markdown package. +#' +#' ## DEMO +#' +#' Example code for this package in the *EXAMPLE* section can be executed by running this file using the following command line: +#' +#' ``` +#' $ wish __BASENAME__.tcl --demo +#' ``` +#' +#' Specific code examples outside of the EXAMPLE section can be executed using the string after the *demo:* prefix string in the code block for the individual code adaptors such as: +#' +#' +#' ``` +#' $ wish __BASENAME__.tcl --demo tvband +#' ``` +#' +#' The example code used for the demo in the EXAMPLE section can be seen in the terminal by using the following command line: +#' +#' ``` +#' $ tclsh __BASENAME__.tcl --code +#' ``` +#' #include "documentation.md" +#' +#' ## SEE ALSO +#' +#' - [dgw package homepage](https://chiselapp.com/user/dgroth/repository/tclcode/index) - various useful widgets +#' - [ttk::treeview widget manual](https://www.tcl.tk/man/tcl8.6/TkCmd/ttk_treeview.htm) standard manual page for the ttk::treeview widget +#' +#' +#' ## CHANGES +#' +#' * 2020-04-10 - version 0.2 released with adaptors: *tvband*, *tvfilebrowser*, *tvksearch*, *tvsortable*, *tvtooltip* +#' * 2020-04-14 - version 0.3 released with adaptor *tvtree*, *tvedit' and command *dgw::mixin* +#' +#' ## TODO +#' +#' * tests +#' * github url +#' +#' ## AUTHORS +#' +#' The **__PKGNAME__** widget was written by Detlef Groth, Schwielowsee, Germany. +#' +#' ## Copyright +#' +#' Copyright (c) 2020 Dr. Detlef Groth, E-mail: detlef(at)dgroth(dot)de +#' +# LICENSE START +# +#' #include "license.md" +# +# LICENSE END diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/pkgIndex.tcl similarity index 55% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/pkgIndex.tcl index 55e82d2e..f5bc9e0d 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/pkgIndex.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/pkgIndex.tcl @@ -1,15 +1,15 @@ #============================================================================== # Wcb package index file. # -# Copyright (c) 1999-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 1999-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # # Regular package: # -package ifneeded wcb 4.0 [list source [file join $dir wcb.tcl]] +package ifneeded wcb 4.1.1 [list source [file join $dir wcb.tcl]] # # Alias: # -package ifneeded Wcb 4.0 { package require -exact wcb 4.0 } +package ifneeded Wcb 4.1.1 { package require -exact wcb 4.1.1 } diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/tclIndex b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/tclIndex similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/tclIndex rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/tclIndex diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbCommon.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbCommon.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbCommon.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbCommon.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbEntry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbEntry.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbEntry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbEntry.tcl index 2099d2ce..7e8653db 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbEntry.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbEntry.tcl @@ -214,6 +214,7 @@ proc wcb::checkEntryForUInt {max w idx str} { if {![regexp {^[0-9]*$} $newText]} { cancel } elseif {$max ne "*"} { + ##nagelfar ignore scan $newText "%d" val if {$val > $max} { cancel diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbListbox.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbListbox.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbListbox.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbListbox.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbTablelist.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbTablelist.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbTablelist.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbTablelist.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbText.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbText.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbText.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbText.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbTreeview.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbTreeview.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/scripts/wcbTreeview.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/scripts/wcbTreeview.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/wcb.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/wcb.tcl similarity index 90% rename from src/vfs/punk9win.vfs/lib/tklib0.8/wcb/wcb.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/wcb/wcb.tcl index 967cdd50..d85c7f7f 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/wcb/wcb.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/wcb/wcb.tcl @@ -1,16 +1,20 @@ #============================================================================== # Main Wcb package module. # -# Copyright (c) 1999-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) +# Copyright (c) 1999-2024 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== -package require Tk 8.4- +if {$tcl_version >= 8.5} { + package require Tk 8.4- +} else { + package require Tk 8.4 +} namespace eval wcb { # # Public variables: # - variable version 4.0 + variable version 4.1.1 variable library [file dirname [file normalize [info script]]] # diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/arrowb.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/arrowb.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/arrowb.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/arrowb.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/calendar.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/calendar.tcl similarity index 98% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/calendar.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/calendar.tcl index 6d4c1f84..ed5c97be 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/calendar.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/calendar.tcl @@ -7,8 +7,6 @@ # # Copyright (c) 2008 Rüdiger Härtel # -# RCS: @(#) $Id: calendar.tcl,v 1.14 2011/12/05 20:34:24 andreas_kupries Exp $ -# # # Creation and Options - widget::calendar $path ... @@ -83,7 +81,7 @@ snit::widgetadaptor widget::calendar { foreach {data(day) data(month) data(year)} \ [clock format $now -format "%e %m %Y"] { break } - scan $data(month) %d data(month) ; # avoid leading 0 issues + scan $data(month) %lld data(month) ; # avoid leading 0 issues set data(selday) $data(day) set data(selmonth) $data(month) @@ -222,7 +220,7 @@ snit::widgetadaptor widget::calendar { foreach {data(day) data(month) data(year)} \ [clock format $date -format "%e %m %Y"] { break } - scan $data(month) %d data(month) ; # avoid leading 0 issues + scan $data(month) %lld data(month) ; # avoid leading 0 issues set data(selday) $data(day) set data(selmonth) $data(month) @@ -698,5 +696,5 @@ snit::widgetadaptor widget::calendar { } } -package provide widget::calendar 1.0.1 - +package provide widget::calendar 1.0.2 +return diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/dateentry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/dateentry.tcl similarity index 77% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/dateentry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/dateentry.tcl index 72c22585..7a8f869b 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/dateentry.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/dateentry.tcl @@ -16,8 +16,6 @@ # # See the example at the bottom. # -# RCS: @(#) $Id: dateentry.tcl,v 1.7 2011/12/13 21:28:00 haertel Exp $ -# # Creation and Options - widget::dateentry $path ... # -command -default {} @@ -117,11 +115,11 @@ snit::widgetadaptor widget::dateentry { delegate option * to hull delegate method * to hull - option -command -default {} - option -dateformat -default "%m/%d/%Y" -configuremethod C-passtocalendar - option -font -default {Helvetica 9} -configuremethod C-passtocalendar - option -textvariable -default {} - option -language -default en -configuremethod C-passtocalendar + option -command -default {} + option -dateformat -default "%m/%d/%Y" -configuremethod C-passtocalendar + option -font -default {Helvetica 9} -configuremethod C-passtocalendar + option -textvariable -default {} -configuremethod C-textvariable + option -language -default en -configuremethod C-passtocalendar delegate option -highlightcolor to calendar delegate option -shadecolor to calendar @@ -131,10 +129,9 @@ snit::widgetadaptor widget::dateentry { component dropbox component calendar - variable waitVar - variable formattedDate - variable rawDate - variable startOnMonday 1 + variable formattedDate ;# Chosen date, formatted, linked to calendar, shown in entry + variable rawDate ;# Same, as seconds. + variable startOnMonday 1 ;# !! Unused constructor args { ::widget::createdateentryLayout @@ -144,25 +141,35 @@ snit::widgetadaptor widget::dateentry { bindtags $win [linsert [bindtags $win] 1 TDateEntry] $self MakeCalendar - $self configurelist $args - set now [clock seconds] - set x [clock format $now -format "%d/%m%/%Y"] - set rawDate [clock scan "$x 00:00:00" -format "%d/%m%/%Y %H:%M:%S"] + # Initialize entry to current date, midnight + set rawDate [expr {([clock seconds] / 86400) * 86400}] set formattedDate [clock format $rawDate -format $options(-dateformat)] - $hull configure -state normal - $hull delete 0 end - $hull insert end $formattedDate - $hull configure -state readonly + $self UpdateEntry } + destructor { + # Drop link to outer textvariable + $self configure -textvariable {} + } + method C-passtocalendar {option value} { set options($option) $value $calendar configure $option $value } + method C-textvariable {option value} { + if {$options(-textvariable) ne {}} { + trace remove variable $options(-textvariable) write [mymethod DateSet] + } + set options($option) $value + if {$options(-textvariable) ne {}} { + trace add variable $options(-textvariable) write [mymethod DateSet] + } + } + method MakeCalendar {args} { set dropbox $win.__drop destroy $dropbox @@ -190,24 +197,37 @@ snit::widgetadaptor widget::dateentry { set calendar $dropbox.calendar widget::calendar $calendar \ - -textvariable [myvar formattedDate] \ - -dateformat $options(-dateformat) \ - -font $options(-font) \ - -language $options(-language)\ - -borderwidth 1 -relief solid \ - -enablecmdonkey 0 -command [mymethod DateChosen] + -textvariable [myvar formattedDate] \ + -dateformat $options(-dateformat) \ + -font $options(-font) \ + -language $options(-language)\ + -borderwidth 1 \ + -relief solid \ + -enablecmdonkey 0 \ + -command [mymethod DateChosen] bind $calendar [list focus -force $calendar] - pack $calendar -expand 1 -fill both return $dropbox } + method set {date} { + # Run the incoming value through scan to ensure that it has the proper format. + set rawDate [clock scan $date -format $options(-dateformat)] + set formattedDate [clock format $rawDate -format $options(-dateformat)] + $self UpdateEntry + return + } + method post { args } { + # TODO TCL 8.5+: `"disabled" in [$self state]` + if {[lsearch -exact [$self state] "disabled"] >= 0} { + return + } + # XXX should we reset date on each display? if {![winfo exists $dropbox]} { $self MakeCalendar } - set waitVar 0 foreach {x y} [$self PostPosition] { break } wm geometry $dropbox "+$x+$y" @@ -217,19 +237,16 @@ snit::widgetadaptor widget::dateentry { if {[tk windowingsystem] ne "aqua"} { tkwait visibility $dropbox } + focus -force $calendar return - - tkwait variable [myvar waitVar] - - $self unpost } method unpost {args} { - if {[winfo exists $dropbox]} { - wm withdraw $dropbox - grab release $dropbox ; # just in case - } + if {![winfo exists $dropbox]} return + wm withdraw $dropbox + grab release $dropbox ; # just in case + return } method PostPosition {} { @@ -272,21 +289,44 @@ snit::widgetadaptor widget::dateentry { # ## method DateChosen { args } { - upvar 0 $options(-textvariable) date + $self UpdateEntry - set waitVar 1 - set date $formattedDate + # synch raw date - Ensures that chosen format is held to set rawDate [clock scan $formattedDate -format $options(-dateformat)] - if { $options(-command) ne "" } { - uplevel \#0 $options(-command) $formattedDate $rawDate - } + + # Export to linked variable + upvar 0 $options(-textvariable) date + set date $formattedDate + + # Export via callback + $self CallCommand + $self unpost + return + } + # Handle changes to the contents of the linked -textvariable + method DateSet {n1 n2 op} { + upvar #0 $options(-textvariable) date + # ignore non-changes + if {$date eq $formattedDate} return + # pass into the system + $self set $date + return + } + + method CallCommand {} { + if {![llength $options(-command)]} return + uplevel \#0 $options(-command) [list $formattedDate] $rawDate + } + + method UpdateEntry {} { $hull configure -state normal $hull delete 0 end $hull insert end $formattedDate $hull configure -state readonly - } + return + } } # Bindings for menu portion. @@ -308,7 +348,7 @@ bind TDateEntry { %W state !pressed } bind TDateEntryPopdown { ttk::globalGrab %W } bind TDateEntryPopdown { ttk::releaseGrab %W } -package provide widget::dateentry 0.96 +package provide widget::dateentry 0.98 ############## # TEST CODE ## diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/dialog.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/dialog.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/dialog.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/dialog.tcl index 9277e564..b98b4208 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/dialog.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/dialog.tcl @@ -4,8 +4,6 @@ # # Generic dialog widget (themed) # -# RCS: @(#) $Id: dialog.tcl,v 1.23 2010/06/01 18:06:52 hobbs Exp $ -# # Creation and Options - widget::dialog $path ... # -command -default {} ; # gets appended: $win $reason diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/mentry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/mentry.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/mentry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/mentry.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/panelframe.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/panelframe.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/panelframe.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/panelframe.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widget/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/pkgIndex.tcl new file mode 100644 index 00000000..d387ac2c --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/pkgIndex.tcl @@ -0,0 +1,15 @@ +if {![package vsatisfies [package provide Tcl] 8.4-]} {return} +package ifneeded widget 3.2 [list source [file join $dir widget.tcl]] +package ifneeded widget::arrowbutton 1.0 [list source [file join $dir arrowb.tcl]] +package ifneeded widget::calendar 1.0.2 [list source [file join $dir calendar.tcl]] +package ifneeded widget::dateentry 0.98 [list source [file join $dir dateentry.tcl]] +package ifneeded widget::dialog 1.3.1 [list source [file join $dir dialog.tcl]] +package ifneeded widget::menuentry 1.0.1 [list source [file join $dir mentry.tcl]] +package ifneeded widget::panelframe 1.1 [list source [file join $dir panelframe.tcl]] +package ifneeded widget::ruler 1.2 [list source [file join $dir ruler.tcl]] +package ifneeded widget::screenruler 1.3 [list source [file join $dir ruler.tcl]] +package ifneeded widget::scrolledtext 1.0 [list source [file join $dir stext.tcl]] +package ifneeded widget::scrolledwindow 1.2.1 [list source [file join $dir scrollw.tcl]] +package ifneeded widget::statusbar 1.2.1 [list source [file join $dir statusbar.tcl]] +package ifneeded widget::superframe 1.0.1 [list source [file join $dir superframe.tcl]] +package ifneeded widget::toolbar 1.2.1 [list source [file join $dir toolbar.tcl]] diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/ruler.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/ruler.tcl similarity index 99% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/ruler.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/ruler.tcl index 9ac88eb2..01433cf1 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/ruler.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/ruler.tcl @@ -6,8 +6,6 @@ # # Copyright (c) 2005 Jeffrey Hobbs. All Rights Reserved. # -# RCS: @(#) $Id: ruler.tcl,v 1.13 2008/02/21 20:11:16 hobbs Exp $ -# ### # Creation and Options - widget::ruler $path ... @@ -497,6 +495,7 @@ snit::widget widget::screenruler { } method C-zoom {option value} { + ##nagelfar ignore if {![string is integer -strict $value] || $value < 1} { return -code error "invalid $option value \"$value\":\ must be a valid integer >= 1" @@ -632,8 +631,8 @@ snit::widget widget::screenruler { ######################################## ## Ready for use -package provide widget::ruler 1.1 -package provide widget::screenruler 1.2 +package provide widget::ruler 1.2 +package provide widget::screenruler 1.3 if {[info exist ::argv0] && $::argv0 eq [info script]} { # We are the main script being run - show ourselves diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/scrollw.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/scrollw.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/scrollw.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/scrollw.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/statusbar.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/statusbar.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/statusbar.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/statusbar.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/stext.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/stext.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/stext.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/stext.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/superframe.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/superframe.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/superframe.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/superframe.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/toolbar.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/toolbar.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/toolbar.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/toolbar.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/widget.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/widget.tcl similarity index 96% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widget/widget.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widget/widget.tcl index 1965de52..0f019107 100644 --- a/src/vfs/punk9win.vfs/lib/tklib0.8/widget/widget.tcl +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widget/widget.tcl @@ -6,8 +6,6 @@ # # Copyright (c) 2005 Jeffrey Hobbs # -# RCS: @(#) $Id: widget.tcl,v 1.6 2010/06/01 18:06:52 hobbs Exp $ -# package require Tk 8.4- package require snit @@ -127,6 +125,7 @@ proc ::widget::isa {as args} { } } elseif {$as eq "integer" || $as eq "int"} { foreach {min max} $range { break } + ##nagelfar ignore if {![string is integer -strict $value] || ($value < $min) || ($value > $max)} { return -code error "$option requires an integer in the\ @@ -136,8 +135,9 @@ proc ::widget::isa {as args} { if {$range eq ""} { set range [expr {1<<16}] } set i 0 foreach val $value { + ##nagelfar ignore if {![string is integer -strict $val] || ([incr i] > $range)} { - return -code error "$option requires an list of integers" + return -code error "$option requires a list of integers" } } } elseif {$as eq "double"} { @@ -159,4 +159,4 @@ proc ::widget::isa {as args} { return } -package provide widget 3.1 +package provide widget 3.2 diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetPlus/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetPlus/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetPlus/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetPlus/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetPlus/widgetPlus.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetPlus/widgetPlus.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetPlus/widgetPlus.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetPlus/widgetPlus.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/add.png b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/add.png new file mode 100644 index 00000000..6332fefe Binary files /dev/null and b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/add.png differ diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_down.png b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_down.png new file mode 100644 index 00000000..2c4e2793 Binary files /dev/null and b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_down.png differ diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_up.png b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_up.png new file mode 100644 index 00000000..1ebb1932 Binary files /dev/null and b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/arrow_up.png differ diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/delete.png b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/delete.png new file mode 100644 index 00000000..08f24936 Binary files /dev/null and b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/delete.png differ diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/folder_explore.png b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/folder_explore.png new file mode 100644 index 00000000..0ba93918 Binary files /dev/null and b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/icons/folder_explore.png differ diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/listentry.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/listentry.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/listentry.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/listentry.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/listsimple.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/listsimple.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/listsimple.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/listsimple.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/de.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/de.msg new file mode 100644 index 00000000..a9d27904 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/de.msg @@ -0,0 +1,20 @@ +# -*- tcl -*- +namespace eval ::widget::listentry { + msgcat::mcset de wle.add Hinzufuegen + msgcat::mcset de wle.remove Entfernen + msgcat::mcset de wle.up Rauf + msgcat::mcset de wle.down Runter + msgcat::mcset de wle.browse Suche... + msgcat::mcset de wle.tip.add {Fuege neues Element in die Liste ein} + msgcat::mcset de wle.tip.remove {Entferne die ausgewaehlten Elemente aus der Liste} + msgcat::mcset de wle.tip.up {Schiebe die ausgewaehlten Elemente hoch} + msgcat::mcset de wle.tip.down {Schiebe die ausgewaehlten Elemente runter} + msgcat::mcset de wle.tip.browse {Suche nach neuen Elementen} + msgcat::mcset de wle.tip.main {Liste} + msgcat::mcset de wle.tip.entry {Eingabefeld fuer neues Element} + msgcat::mcset de wle.tip.list {Liste} + msgcat::mcset de wle.tip.empty Leer + msgcat::mcset de wle.tip.dup {Die Liste enthaelt dieses Element bereits} + msgcat::mcset de wle.tip.add-none {Nichts vorhanden zum Hinzufuegen} + msgcat::mcset de wle.tip.remove-none {Keine Elemente zum Entfernen ausgewaehlt} +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/en.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/en.msg new file mode 100644 index 00000000..ca33b848 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/en.msg @@ -0,0 +1,20 @@ +# -*- tcl -*- +namespace eval ::widget::listentry { + msgcat::mcset en wle.add Add + msgcat::mcset en wle.remove Remove + msgcat::mcset en wle.up Up + msgcat::mcset en wle.down Down + msgcat::mcset en wle.browse Browse... + msgcat::mcset en wle.tip.add {Add a new value to the list} + msgcat::mcset en wle.tip.remove {Remove the selected values from the list} + msgcat::mcset en wle.tip.up {Move selected element up a position} + msgcat::mcset en wle.tip.down {Move selected element down a position} + msgcat::mcset en wle.tip.browse {Search for elements} + msgcat::mcset en wle.tip.main {List of values} + msgcat::mcset en wle.tip.entry {Enter a new value} + msgcat::mcset en wle.tip.list {List of values} + msgcat::mcset en wle.tip.empty Empty + msgcat::mcset en wle.tip.dup {The list already contains this item} + msgcat::mcset en wle.tip.add-none {Nothing to enter} + msgcat::mcset en wle.tip.remove-none {Nothing selected for removal} +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/root.msg b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/root.msg new file mode 100644 index 00000000..5ac9d00b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/msgs/root.msg @@ -0,0 +1,20 @@ +# -*- tcl -*- +namespace eval ::widget::listentry { + msgcat::mcset {} wle.add Add + msgcat::mcset {} wle.remove Remove + msgcat::mcset {} wle.up Up + msgcat::mcset {} wle.down Down + msgcat::mcset {} wle.browse Browse... + msgcat::mcset {} wle.tip.add {Add a new value to the list} + msgcat::mcset {} wle.tip.remove {Remove the selected values from the list} + msgcat::mcset {} wle.tip.up {Move the selected elements up a position} + msgcat::mcset {} wle.tip.down {Move the selected elements down a position} + msgcat::mcset {} wle.tip.browse {Search for elements} + msgcat::mcset {} wle.tip.main {List of values} + msgcat::mcset {} wle.tip.entry {Enter a new value} + msgcat::mcset {} wle.tip.list {List of values} + msgcat::mcset {} wle.tip.empty Empty + msgcat::mcset {} wle.tip.dup {The list already contains this item} + msgcat::mcset {} wle.tip.add-none {Nothing to enter} + msgcat::mcset {} wle.tip.remove-none {Nothing selected for removal} +} diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetl/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetl/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetv/pkgIndex.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetv/pkgIndex.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetv/pkgIndex.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetv/pkgIndex.tcl diff --git a/src/vfs/punk9win.vfs/lib/tklib0.8/widgetv/validator.tcl b/src/vfs/punk9win.vfs/lib/tklib0.9/widgetv/validator.tcl similarity index 100% rename from src/vfs/punk9win.vfs/lib/tklib0.8/widgetv/validator.tcl rename to src/vfs/punk9win.vfs/lib/tklib0.9/widgetv/validator.tcl diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ArrowButton.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ArrowButton.html new file mode 100644 index 00000000..3969d3db --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ArrowButton.html @@ -0,0 +1,276 @@ + +ArrowButton + +
NAME
+
ArrowButton + - Button widget with an arrow shape. +
+
+
CREATION
+
ArrowButton pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -activebackground
  -activeforeground
  -background or -bg  -borderwidth or -bd
  -disabledforeground
  -foreground or -fg
  -highlightbackground
  -highlightcolor
  -highlightthickness
  -relief
  -repeatdelay
  -repeatinterval
  -takefocus
  -troughcolor
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -armcommand
  -arrowbd
  -arrowrelief
  -clean
  -command
  -dir
  -disarmcommand
  -height
  -helptext
  -helptype
  -helpvar
  -ipadx
  -ipady
  -state
  -type
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName invoke +
+
+

+DESCRIPTION
+

+ +ArrowButton can be of two types following type option: +for button type, it is standard button with an arrow drawn on it; +for arrow type, it is an arrow like scrollbar's arrow. +

+

+WIDGET-SPECIFIC OPTIONS
+
-armcommand
+
+ +Specifies a Tcl command to associate with the ArrowButton when mouse button 1 is pressed +over the ArrowButton. When repeatdelay or repeatinterval option is positive +integer, this command is repeatedly called if mouse pointer is over the button and until +mouse button 1 is released. +
+
+
-arrowbd
+
+ +When ArrowButton type is arrow, specifies the border width of the +arrow. Must be 1 or 2. + +
+
+
-arrowrelief
+
+ +When ArrowButton type is arrow, specifies the relief of the arrow. +Must be raised or sunken. + +
+
+
-clean
+
+ +Specifies a level of quality, between 0 and 2, for the arrow. +If 0, the arrow is drawn with its maximum width and height. +If 1, the base of arrow is arranged to be odd to have same edges. +If 2, the base of arrow is arranged to be odd and the orthogonal to be (base+1)/2 to +have 'straight' diagonal for edges. +
+
+
-command
+
+ +Specifies a Tcl command to associate with the ArrowButton. This command +is typically invoked when mouse button 1 is released over the ArrowButton +window. +
+
+
-dir
+
+ +Specifies the direction of the arrow: top, bottom, left +or right. +
+
+
-disarmcommand
+
+ +Specifies a Tcl command to associate with the ArrowButton when mouse button 1 is released. +This command is called even if pointer is not over the ArrowButton, and always before +the command specified by command option. +It is typically used in conjuntion with armcommand, repeatdelay and +repeatinterval. +
+
+
-height
+
+ +Specifies a desired height for the ArrowButton. The value is in screen units. +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this widget. +See also DynamicHelp. +
+
+
-helptype
+
+Type of dynamic help. Use balloon or variable. +See also DynamicHelp. +
+
+
-helpvar
+
+Variable to use when helptype option is variable. +See also DynamicHelp. +
+
+
-ipadx
+
+ +Specifies a minimun pad between the ArrowButton border and the right and left side +of the arrow. The value is in screen units. +
+
+
-ipady
+
+ +Specifies a minimun pad between the ArrowButton border and the top and bottom side +of the arrow. The value is in screen units. +
+
+
-state
+
+ +Specifies one of three states for the ArrowButton: normal, active, +or disabled. +
If ArrowButton type is button:
+
In normal state the ArrowButton is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the ArrowButton. In active state +the ArrowButton is displayed using the activeforeground and +activebackground options. In disabled state the disabledforeground and +background options determine how the ArrowButton is displayed. +
+
If ArrowButton type is arrow:
+
Only colors of arrow change. The background of ArrowButton is always +displayed using troughcolor option. +In normal state the ArrowButton is displayed using the background option. The active +state is typically used when the pointer is over the ArrowButton. In active state +the ArrowButton is displayed using the activebackground option. In disabled state +the ArrowButton is displayed with a dark stipple. +
+
+Disabled state means that the ArrowButton +should be insensitive: the default bindings will refuse to activate +the widget and will ignore mouse button presses. +
+
+
-type
+
+ +Determines the type of the ArrowButton: button for standard button look, or +arrow scrollbar's arrow look. +
+
+
-width
+
+ +Specifies a desired width for the ArrowButton. The value is in screen units. +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName invoke +
+ +If ArrowButton state is not disabled, this invoke the commands of the button. +ArrowButton is redisplayed with active color and sunken relief, and +armcommand is called. Then ArrowButton is redisplayed with +normal color and its defined relief, and disarmcommand then command +are called. +

invoke is called when ArrowButton has input focus and user press the space bar. +

+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/BWidget.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/BWidget.html new file mode 100644 index 00000000..35afba47 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/BWidget.html @@ -0,0 +1,228 @@ + +BWidget + + Under construction ...
+
NAME
+
BWidget + - Description text +
+
+
COMMAND
+
BWidget::XLFDfont + cmd + ?arg...? +
+
BWidget::assert + exp + ?msg? +
+
BWidget::badOptionString + type + value + list +
+
BWidget::bindMouseWheel + widget +
+
BWidget::classes + class +
+
BWidget::clonename + menu +
+
BWidget::focus + option + path +
+
BWidget::get3dcolor + path + bgcolor +
+
BWidget::getname + name +
+
BWidget::grab + option + path +
+
BWidget::inuse + class +
+
BWidget::library + class ?class ...? +
+
BWidget::lreorder + list + neworder +
+
BWidget::parsetext + text +
+
BWidget::place + path + w + h + ?arg...? +
+
BWidget::write + filename ?mode? +
+
BWidget::wrongNumArgsString + string +
+
+

+DESCRIPTION
+

+Description text +

+

+COMMAND
+
BWidget::XLFDfont + cmd + ?arg...? +
+Description text +
+
BWidget::assert + exp + ?msg? +
+Description text +
+
BWidget::badOptionString + type + value + list +
+Return a proper error string for a value of type that doesn't +match list. +
+ +
BWidget::bindMouseWheel + widget +
+ Bind the given widget with the standard mouse wheel bindings. +
+ +
BWidget::classes + class +
+ Returns a list of classes needed by the given class. +
+ +
BWidget::clonename + menu +
+Description text +
+
BWidget::focus + option + path +
+Description text +
+
BWidget::get3dcolor + path + bgcolor +
+Description text +
+
BWidget::getname + name +
+Description text +
+
BWidget::grab + option + path +
+Description text +
+ +
BWidget::inuse + class +
+ Returns true or false if the given class is being used by the + current running program. +
+ +
BWidget::library + class + ?class ...? +
+ Returns a string of code that contains all the libraries needed to + use the widgets given by class. Each class's code and the + code of its dependent classes is appended to the string and returned. + This is mostly useful for saving BWidgets to another project. +
+ +
BWidget::lreorder + list + neworder +
+Description text +
+
BWidget::parsetext + text +
+Description text +
+
BWidget::place + path + w + h + ?arg...? +
+Used to position and resize the widget specified by +path. w and h are used to specify the requested +width and height of the path widget for use by wm +geometry (set to 0 to use current values). The placement of the widget relative to other widgets or +the screen is controlled by additional arguments: +
+
at x y
+
Place the widget specified by the path argument at screen + position x,y. See wm geometry for information about window + placement values.
+ +
center ?widget?
+
Place the path widget centered against widget or against the + root widget if widget is not given.
+ +
left ?widget?
+
right ?widget?
+
Place the path widget either left or right of the + reference widget (or the root widget if widget is not + specified). If the reference widget's position is such that the newly + placed window might be obscured then the opposite side will be tried.
+ +
above ?widget?
+
below ?widget?
+
As for left/right above, this option causes the widget to be + placed either above or below the reference widget with the opposite + placement being attempted if the newly placed widget will not be visible. +
+
+ +
BWidget::write + filename + ?mode? +
+ Writes the currently used set of BWidget class code to the given + filename. All the code necessary to run the BWidgets + currently in use is written to the file. This is mostly useful + for saving BWidget code to another project as a single file instead + of the entire BWidget package. +
+ +
+
BWidget::wrongNumArgsString + string +
+
+ Returns a standard error string for the wrong number of arguments. + string is appended to the standard string. +
+
+ + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Button.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Button.html new file mode 100644 index 00000000..f1b5aae2 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Button.html @@ -0,0 +1,307 @@ + +Button + +
NAME
+
Button + - Button widget with enhanced options +
+
+
CREATION
+
Button pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
Not themed
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -activebackground  -activeforeground
  -anchor  -background or -bg
  -bitmap  -borderwidth or -bd
  -cursor  -disabledforeground
  -font  -foreground or -fg
  -highlightbackground  -highlightcolor
  -highlightthickness  -image
  -justify  -padx
  -pady  -repeatdelay
  -repeatinterval  -takefocus
  -text  -textvariable
  -wraplength
+
Themed
+
+ + + + + + + + + + + + + + + + + + +
  -compound  -cursor
  -image  -style
  -repeatdelay  -repeatinterval
  -takefocus  -text
  -textvariable
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
  -armcommand  -command
  -default  -disarmcommand
  -height  -helptext
  -helptype  -helpvar
  -name  -relief
  -state  -underline
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName invoke +
+
+

+DESCRIPTION
+

+ +Button widget extends the Tk button with new options. +DynamicHelp options, +a new relief style, callback for arm/disarm, and +repeatdelay/repeatinterval options has been added. +

+

+WIDGET-SPECIFIC OPTIONS
+
-armcommand
+
+ +Specifies a Tcl command to associate with the Button when mouse button 1 is pressed over the +Button. When repeatdelay or repeatinterval option is positive integer, +this command is repeatedly called if mouse pointer is over the Button and until mouse +button 1 is released. +
+
+
-command
+
+ +Specifies a Tcl command to associate with the Button. This command +is typically invoked when mouse button 1 is released over the Button +window. +
+
+
-default
+
+ +Specifies one of three states for the default ring: normal, active, +or disabled. In active state, the button is drawn with the platform specific +appearance for a default button. In normal state, the button is drawn with the platform +specific appearance for a non-default button, leaving enough space to draw the default +button appearance. The normal and active states will result in buttons of the same size. +In disabled state, the button is drawn with the non-default button appearance without +leaving space for the default appearance. The disabled state may result +in a smaller button than the active state. +
+
+
-disarmcommand
+
+ +Specifies a Tcl command to associate with the Button when mouse button 1 is released. +This command is called even if pointer is not over the Button, and always before +the command specified by command option. +It is typically used in conjuntion with armcommand, repeatdelay and +repeatinterval. +
+
+
-height
+
+ +Specifies a desired height for the Button. +If an image or bitmap is being displayed in the Button then the value is in +screen units; +for text it is in lines of text. +If this option isn't specified, the Button's desired height is computed +from the size of the image or bitmap or text being displayed in it.
+Option not available when widget is themed. +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this widget. +See also DynamicHelp. +
+
+
-helptype
+
+Type of dynamic help. Use balloon or variable. +See also DynamicHelp. +
+
+
-helpvar
+
+Variable to use when helptype option is variable. +See also DynamicHelp. +
+
+
-name
+
+ +Specifies a standard name for the button. If the option *nameName is +found in the resources database, then text and underline options +are extracted from its value. + +
+
+
-relief
+
+ +Specifies the 3-D effect desired for the widget. Acceptable values are standard values for +button relief (raised, sunken, flat, ridge, solid, and groove) and link, which specifies that button relief is flat when pointer +is outside the button and raised when pointer is inside.
+This option has only the following effect if the widget is themed: +The value link used a style Toolbutton while any other value uses the standard effect. +
+
+
-state
+
+ +Specifies one of three states for the Button: normal, active, +or disabled. In normal state the Button is displayed using the +foreground and background options. The active state is +typically used when the pointer is over the Button. In active state +the Button is displayed using the activeforeground and +activebackground options. Disabled state means that the Button +should be insensitive: the default bindings will refuse to activate +the widget and will ignore mouse button presses. +In this state the disabledforeground and +background options determine how the Button is displayed. +
+
+
-underline
+
+ +Specifies the integer index of a character to underline in the label of the button. +0 corresponds to the first character of the text displayed, 1 to the next character, +and so on. +
The binding <Alt-char> is automatically set on the toplevel +of the Button to call Button::setfocus. + +
+
+
-width
+
+ +If an image or bitmap is being displayed in the Button then the value is in +screen units; +for text it is in characters. +If this option isn't specified, the Button's desired width is computed +from the size of the image or bitmap or text being displayed in it. +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName invoke +
+ +If Button state is not disabled, this invoke the commands of the Button. +Button is redisplayed with active color and sunken relief, and +armcommand is called. Then Button is redisplayed with +normal color and its defined relief, and disarmcommand then command +are called. +

invoke is called when Button has input focus and user press the space bar. + +

+

+BINDINGS
+
<<Invoke>> +
+ +Invoke the invoke widget command. +
+

+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ButtonBox.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ButtonBox.html new file mode 100644 index 00000000..f65f20fe --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ButtonBox.html @@ -0,0 +1,266 @@ + +ButtonBox + +
NAME
+
ButtonBox + - Set of buttons with horizontal or vertical layout +
+
+
CREATION
+
ButtonBox pathName ?option value...?
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + +
  -background or -bg  -default
  -homogeneous  -orient
  -padx  -pady
  -spacing  -state
+
+
+
WIDGET COMMAND
+
pathName add + ?option value...? +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName delete + index +
+
pathName index + index +
+
pathName insert + index ?option value...? +
+
pathName invoke + index +
+
pathName itemcget + index + option +
+
pathName itemconfigure + index + ?option? ?value option value ...? +
+
pathName setfocus + index +
+
+

+DESCRIPTION
+

+ +ButtonBox layouts Button horizontally or vertically. +Some commands take an index as argument indicating on which +Button it work. This index may be specified in any of the following forms: +

+

+
+number +
+Specifies the Button numerically, where 0 corresponds +to the first added Button, 1 to the next, and so on. +
+end or last +
+Indicates the last item added. +
default +
+Indicates the default Button. + +
+name +
+Indicates the button whose -name option is name. + +
+text +
+Indicates the button whose -text option is text. +
+ +

+

+WIDGET-SPECIFIC OPTIONS
+
-background
+
+ +Specifies a default background color for all added buttons and for the frame.
+For themed wigets, the button color is not set. + +
+
+
-default
+
+ +Specifies the default button of the button box. The value is an integer +referencing the n-th added button, starting from 0. +If this value is -1 (the default), all button wil be drawn with their -default +option set to disabled, and this value can not be changed.
If this value is +not -1, the associated button is drawn with -default option set to active and +the others are drawn with -default option set to normal. The value can be changed +by configure. + +
+
+
-homogeneous (read-only)
+
+ +Specifies wether or not buttons must have the same width for horizontal layout. + +
+
+
-orient (read-only)
+
+ +Specifies the orientation of the button box. If this option is horizontal +(the default), buttons are added from top to bottom. +If this option is vertical, buttons are added from left to right. + +
+
+
-padx
+
+ +Specifies a default value for the -padx option of all added buttons.
+Option has no effect for themed wigets. +
+
+
-pady
+
+ +Specifies a default value for the -pady option of all added buttons.
+Option has no effect for themed wigets. + +
+
+
-spacing
+
+ +Specifies the default spacing between buttons. This value can be changed before each +call to add. + +
+
+ +
-state
+
+ +Specifies a state for all the buttons in the button box. Can be any state supported by buttons. + +
+
+ +

+WIDGET COMMAND
+
pathName add + ?option value...? +
+ +Add a button to the button box. +

+See Button for description of options. +

+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+ +
pathName delete + index +
+ +Delete the button at index from the button box. + +
+ +
pathName index + index +
+ +Return the numerical index corresponding to the item. + +
+ +
pathName insert + index ?option value...? +
+ +Insert a new button into the button box before the given index. + +
+ +
pathName invoke + index +
+ +Invoke the Button given by index. + +
+
pathName itemcget + index + option +
+ +Returns the current value of a configuration option for the item. +Option may have any of the values accepted by the item creation command. + +
+
pathName itemconfigure + index + ?option? ?value option value ...? +
+ +This command is similar to the configure command, except that it applies to the +options for an individual item, whereas configure applies to the options for +the widget as a whole. Options may have any of the values accepted by the +item creation widget command. If options are specified, options are modified as indicated +in the command and the command returns an empty string. If no options are specified, +returns a list describing the current options for the item. +Read-only options are not be modified. + +
+
pathName setfocus + index +
+ +Set the focus to the Button given by index. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ComboBox.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ComboBox.html new file mode 100644 index 00000000..92b4dd18 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ComboBox.html @@ -0,0 +1,410 @@ + +ComboBox + +
NAME
+
ComboBox + - ComboBox widget +
+
+
CREATION
+
ComboBox pathName ?option value...?
+
+
+
OPTIONS from ArrowButton
+
+ + + + + + + + +
  -background or -bg  -disabledforeground
  -foreground or -fg  -state
+
+
+
OPTIONS from Entry
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -command  -disabledforeground
  -dragenabled  -dragendcmd
  -dragevent  -draginitcmd
  -dragtype  -dropcmd
  -dropenabled  -dropovercmd
  -droptypes  -editable
  -entrybg (see -background)  -entryfg (see -foreground)
  -exportselection  -font
  -helptext  -helptype
  -helpvar  -highlightbackground
  -highlightcolor  -highlightthickness
  -insertbackground  -insertborderwidth
  -insertofftime  -insertontime
  -insertwidth  -justify
  -selectbackground  -selectborderwidth
  -selectforeground  -show
  -state  -takefocus
  -text  -textvariable
  -width  -xscrollcommand
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + +
  -autocomplete  -autopost
  -bwlistbox  -expand
  -height  -hottrack
  -images  -listboxwidth
  -modifycmd  -postcommand
  -values
+
+
+
WIDGET COMMAND
+
pathName bind + ?arg...? +
+
pathName cget + option +
+
pathName clearvalue +
+
pathName configure + ?option? ?value option value ...? +
+
pathName get
+
pathName getentry
+
pathName getlistbox
+
pathName getvalue
+
pathName icursor +index +
+
pathName post
+
pathName setvalue + index +
+
pathName unpost
+
+

+DESCRIPTION
+

+ +ComboBox widget enables the user to select a value among a list given by +the values option. The list of possible values can be popped by +pressing the ArrowButton or by clicking in the entry when editable +value of the ComboBox is false.
If editable value of the +ComboBox is true and the entry has the focus, the user can press the +top and bottom arrow keys to modify its value. If the current value exactly +match a value in the list, then the previous (for top arrow key) or then +next (for bottom arrow key) value in the list is displayed. If the current +value match the beginning of a value in the list, then this value is +displayed. If the current value doesnt match anything, then the first +value is displayed. + +

+

+WIDGET-SPECIFIC OPTIONS
+
+
-autocomplete
+
+ Specifies whether or not the combobox should attempt to auto-complete + the value in the entry field as the user types. If true, the combobox + will fill in a value that it finds in its value list as the user types + into the entry. +
+
+ +
+
-autopost
+
+ Specifies whether or not the combobox should post the drop down as + the user types. If true, the combobox will post and scroll to the + entry that most closely matches the user entry. +
+
+ +
+
-bwlistbox
+
+ Specifies that the combobox should use a BWidget listbox in its drop + down instead of the standard Tk option. This option is enabled by + default if the -images option is not empty. +
+
+ +
-expand
+
+ +Specifies the value expansion behavior for the window. It must be +none (default) or tab. If tab is specified, then +a Tab binding is added to attempt to expand the current value based on +the other values in -values. +
+
+ +
-height
+
+ +Specifies the desired height for the window, in lines. If zero or less, +then the desired height for the window is made just large enough to hold +all the elements in the listbox. +
+ +
+
-hottrack
+
+ The selection in the drop down listbox will follow the mouse cursor + as it moves. +
+
+ +
+
-images
+
+ A list of images that correspond to the -values option. Each + image will be drawn next to its value in the drop down. This option + enables the -bwlistbox by default as it is needed to display + images. +
+
+ +
+
-listboxwidth
+
+ Specifies the width of the listbox in the drop down. Defaults to the + same size as the combobox. +
+
+ +
+
-modifycmd
+
+ +Specifies a Tcl command called when the user modify the value of the ComboBox by selecting it in the listbox or pressing arrow key. +
+
+
-postcommand
+
+ +Specifies a Tcl command called before the listbox of the ComboBox is mapped. +
+
+
-values
+
+ +Specifies the values to display in the listbox of the ComboBox. +
+
+

+WIDGET COMMAND
+
pathName bind + ?arg...? +
+ +Set bindings on the entry widget. + +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. + +
+ +
pathName clearvalue +
+ +Clears the current text of the ComboBox. + +
+ +
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no +option is specified, returns a list describing all of the available +options for pathName. If option is specified with no +value, then the command returns a list describing the one named +option (this list will be identical to the corresponding sublist of +the value returned if no option is specified). If one or more +option-value pairs are specified, then the command modifies the +given widget option(s) to have the given value(s); in this case the command +returns an empty string. Option may have any of the values accepted +by the creation command. Read-only options are not be modified. + +
+ +
pathName get +
+ +Returns the current contents of the entry. + +
+ +
pathName getentry +
+ +Returns the path to the contained entry widget. + +
+ +
pathName getlistbox +
+ +Returns the path to the listbox in the drop down. + +
+ +
pathName getvalue +
+ +Returns the index of the current text of the ComboBox in the list of values, +or -1 if it doesn't match any value. + +
+ +
pathName icursor + index +
+ +Arrange for the insertion cursor to be displayed just before the +character given by index. Returns an empty string. + +
+ +
pathName post +
+ +Post the drop down. + +
+ +
pathName setvalue + index +
+ +Set the text of the ComboBox to the value indicated by index in the list of values. +index may be specified in any of the following forms: +

+

+
+last +
+Specifies the last element of the list of values. +
first +
+Specifies the first element of the list of values. +
+next +
+Specifies the element following the current (ie returned by getvalue) in the list +of values. +
previous +
+Specifies the element preceding the current (ie returned by getvalue) in the list +of values. +
+@number +
+Specifies the integer index in the list of values. +
+ +
+ +
pathName unpost +
+ +Unpost the drop down. + +
+ +

BINDINGS

+ +When Entry of the ComboBox has the input focus, it has the following bindings, in addition +to the default Entry bindings: +
    +
  • Page up set the value of the ComboBox to the first value. +
  • Page down set the value of the ComboBox to the last value. +
  • Arrow up set the value of the ComboBox to the previous value. +
  • Arrow down set the value of the ComboBox to the next value. +
  • If -autopost is enabled, Escape unposts the listbox. +
+If the listbox is not mapped and ComboBox is not editable or disabled, +mouse button 1 on the Entry cause the listbox to popup, as if the user press the ArrowButton. + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Dialog.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Dialog.html new file mode 100644 index 00000000..73abb711 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Dialog.html @@ -0,0 +1,328 @@ + +Dialog + +
NAME
+
Dialog + - Dialog abstraction with custom buttons +
+
+
CREATION
+
Dialog pathName ?option value...?
+
+
+
OPTIONS from ButtonBox
+
+ + + + + + + + + + +
  -background or -bg  -homogeneous
  -padx  -pady
  -spacing
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -anchor
  -bitmap
  -cancel
  -default
  -geometry
  -image
  -modal
  -parent
  -place
  -separator
  -side
  -title
  -transient
+
+
+
WIDGET COMMAND
+
pathName add + ?arg...? +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName draw + ?focus? +
+
pathName enddialog + result +
+
pathName getframe +
+
pathName invoke + index +
+
pathName itemcget + index + option +
+
pathName itemconfigure + index + ?option? ?value option value ...? +
+
pathName setfocus + index +
+
pathName withdraw +
+
+

+DESCRIPTION
+

+ +Dialog widget enables the user to create a dialog box. +Some commands take an index as argument indicating on which +Button it work. This index is the same specified for equivalent ButtonBox command: +

+

+
+number +
+Specifies the Button numerically, where 0 corresponds +to the first added Button, 1 to the next, and so on. +
+end or last +
+Indicates the last item added. +
default +
+Indicates the default Button. +
+ +

+

+WIDGET-SPECIFIC OPTIONS
+
-anchor (read-only)
+
+ +Specifies the anchor point of the ButtonBox. +Must be one of w, e, n, s or c. +If side option is set to top or bottom, +anchor values n, s and c have the same effect. +If side option is set to left or right, +anchor values w, e and c have the same effect. + +
+
+
-bitmap (read-only)
+
+ +Specifies a bitmap to display at the left of the user frame. +image option override bitmap. +
+
+
-cancel
+
+ +Specifies the number of the cancel button of the Dialog. When user presses Esc or the windows close button, +this button is invoked.
+If set to -1, Esc does not invoke anything. +The window close button destroys the dialog in this case and returns -1. +
+
+
-default
+
+ +Specifies the number of the default button of the Dialog. +When user press Return in the Dialog, this button is invoked. +
+
+ +
-geometry
+
+ +Set the geometry used when method draw is called. +See wm geometry for a parameter description. +
+
+
-image (read-only)
+
+ +Specifies an image to display at the left of the user frame. +image option override bitmap. +
+
+
-modal
+
+ +This option must be none, local or global. The value of this option +specifies the grab mode of the dialog and how works Dialog::draw. + +
+
+
-parent
+
+ +Parent of the Dialog. Dialog is placed relative to its parent. If empty, it is +placed relative to the root window. Also see place option. + +
+
+
-place
+
+Specifies where to draw the Dialog toplevel relative to the dialog's +parent. Must be one of none, center, left, right, +above, below. Default value of place is center. + +
+
+
-separator (read-only)
+
+ +Specifies wether or not to draw a separator between the user frame and the ButtonBox. + +
+
+
-side (read-only)
+
+ +Specifies where to draw the ButtonBox relative to the user frame. Must be one of +top, left, bottom or right. +
+
+
-title
+
+ +Title of the Dialog toplevel. + +
+
+
-transient (read-only)
+
+ +Specifies if the Dialog Toplevel should be a transient window or not. Default +value of transient is true. + +
+
+

+WIDGET COMMAND
+
pathName add + ?arg...? +
+ +Add a button to the button box of the dialog box. Default -command option is +Dialog::enddialog $path index where index is number of button added. +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName draw + ?focus? +
+ +This command draw the Dialog, and set grab to it following modal option. +If modal option is set to none, the command returns immediatly +an empty string. In all other case, the command returns when Dialog::enddialog +is called or when Dialog is destroyed. +The return value is the result argument of Dialog::enddialog or -1 if it is destroyed. +

+By default, the focus is set to the default button referenced by default option, +or to the toplevel of Dialog if no default button has been set. +If focus is present, it must be a pathname, or an index to a button. +Initial focus is set on this pathname or corresponding button. + +

+
pathName enddialog + result +
+ +This command is typically called within a command of a button to make Dialog::draw +return. + +
+
pathName getframe +
+ +Returns the pathname of the user window. +
+
pathName invoke + index +
+ +Invoke the Button given by index. + +
+
pathName itemcget + index + option +
+ +Returns the current value of a configuration option for the item. +Option may have any of the values accepted by the item creation command. + +
+
pathName itemconfigure + index + ?option? ?value option value ...? +
+ +This command is similar to the configure command, except that it applies to the +options for an individual item, whereas configure applies to the options for +the widget as a whole. Options may have any of the values accepted by the +item creation widget command. If options are specified, options are modified as indicated +in the command and the command returns an empty string. If no options are specified, +returns a list describing the current options for the item. +Read-only options are not be modified. + +
+
pathName setfocus + index +
+ +Set the focus to the Button given by index. + +
+
pathName withdraw +
+ +Call this command to hide the dialog box. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DragSite.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DragSite.html new file mode 100644 index 00000000..e60cf10d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DragSite.html @@ -0,0 +1,141 @@ + +DragSite + +
NAME
+
DragSite + - Commands set for Drag facilities +
+
+
COMMAND
+
DragSite::include + class + type + event +
+
DragSite::register + path + ?option value...? +
+
DragSite::setdrag + path + subpath + initcmd + endcmd + ?force? +
+
+

+DESCRIPTION
+

+ +Commands of this namespace enable user to define a BWidget or a Tk widget as a drag site. + + + +

+

+COMMAND
+
DragSite::include + class + type + event +
+ +This command provides a simple way to include options relatives to a drag site into +BWidget resources definition. +It includes the options needed for register: -dragevent, initialized to +event, -draginitcmd and -dragendcmd, initialized to empty string, +and two new options: + +
-dragenabledSpecifies wether or not drag is active (initialized to 0) +
-dragtypeDefault or alternate dragged data type (initialized to type) +
+ +
+
DragSite::register + path + ?option value...? +
+ +This command is used to declare path as a drag site. Options are: + +

+

-dragendcmd
+
+ +Command called when drag terminates (ie when user release drag icon). +This command is called with the following arguments: +
    +
  • the pathname of the drag source (the widget itself), +
  • the pathname of the drop target, +
  • the operation, +
  • the type of the dragged data, +
  • the dragged data, +
  • result of the drop (result of the call to -dropcmd of the target), +
+If the drop does not occurs, the target and the operation are empty string and the result +is 0. + +
+
+
-dragevent
+
+ +Specifies the number of the mouse button associated to the drag. +Must be 1, 2 or 3. + +
+
+
-draginitcmd
+
+ +Command called when drag initiates. When the event of option dragevent occurs on +path, this command is called with the following arguments: +
    +
  • pathname of the drag source (path), +
  • root x-coordinate of pointer, +
  • root y-coordinate of pointer, +
  • a toplevel created to represent dragged data. When returning, if it +has no children, a bitmap is automatically displayed. +
+If the command returns an empty string, then the drag will be +suppressed. Otherwise the command must return a list containing three +elements: +
    +
  • the type of the data, +
  • the list of acceptable basic operations (copy, move and link) +
  • and the data. +
+Note that even if copy does not appear in the list of basic +operation, it is considered as an acceptable operation, since +copy semantic does not modify the drag source. + +
+
+
+
DragSite::setdrag + path + subpath + initcmd + endcmd + ?force? +
+ +This command provides a simple way to call register during a BWidget creation or +configuration. +
    +
  • path is the pathname of the BWidget, +
  • subpath is the pathname of the tk widget where drag event occurs, +
  • initcmd BWidget command for drag-init event, +
  • endcmd BWidget command for drag-end event, +
  • force specifies wether or not to call register whenever no option value has +changed (0 by default - for BWidget configuration, use 1 for BWidget creation). +
+setdrag verifies the modification flag of options dragenabled and +dragevent and calls register if needed according to the options values and +initcmd and endcmd arguments. draginitcmd and dragendcmd are not +taken from options of widget because they are considered as user command, called by +BWidget implementation of drag-init and drag-end events. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DropSite.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DropSite.html new file mode 100644 index 00000000..5073ce6e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DropSite.html @@ -0,0 +1,266 @@ + +DropSite + +
NAME
+
DropSite + - Commands set for Drop facilities +
+
+
COMMAND
+
DropSite::include + class + types +
+
DropSite::register + path + ?option value...? +
+
DropSite::setcursor + cursor +
+
DropSite::setdrop + path + subpath + dropover + drop + ?force? +
+
DropSite::setoperation + op +
+
+

+DESCRIPTION
+

+ +Commands of this namespace enable user to define a BWidget or a Tk widget as a drop site. +A drop site is composed of the type of object that can be dropped and associated operation, +a command called when drop occurs, and a command when an object is dragged over the widget. +A drop site must have at least one type of acceptable object and a drop command. + +

+

+COMMAND
+
DropSite::include + class + types +
+ +This command provides a simple way to include options relatives to a drop site into +BWidget resources definition. +It includes the options needed for register, -dropovercmd and -dropcmd, +initialized to empty string, and -droptypes, initialized to types, +and one new option: + +
-dropenabledSpecifies wether or not drop is active (initialized to 0) +
+ +
+
DropSite::register + path + ?option value...? +
+ +This command is used to declare path as a drop site. Options are: + +

+

-dropcmd
+
+ +This command is called when user release the drag icon over a valid +drop target widget. Arguments passed to the command are: + +
    +
  • pathname of the drop target (the widget itself), +
  • pathname of the drag source, +
  • root x-coordinate of the pointer, +
  • root y-coordinate of the pointer, +
  • operation, +
  • type of the dragged data, +
  • dragged data. +
+ +Its return values is passed as a result to the -dragendcmd +command of the drag source widget. + +
+
+
-dropovercmd
+
+ +This command can be used to provide a dynamic drag while drag-over events. +While a drag occurs, events <Enter>, <Motion> and <Leave> are catched. +Arguments passed to the command are: +
    +
  • pathname of the drop target (the widget itself), +
  • pathname of the drag source, +
  • event over the drop target: enter, motion or leave, +
  • root x-coordinate of the pointer, +
  • root y-coordinate of the pointer, +
  • operation, +
  • type of the dragged data, +
  • dragged data. +
+Command must the new status of the drag: +
    +
  • 0 if widget refuse this drag. Command will not be recalled on motion/leave event. +
  • 1 if widget accept this drag. Command will not be recalled on motion/leave event. +
  • 2 if widget refuse this drag. Command will be recalled on each motion event to reevaluate. +
  • 3 if widget accept this drag. Command will be recalled on each motion event to reevaluate. + +
+Here is a list of events and associated actions on a DropSite widget. This example +assumes that dragged data type is valid for the drop target. +status is the status of the drag on a DropSite. Its value is: +

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
EventOld statusActionNew status
+<Enter> +- +if DropSite has dropovercmd, call it with enter +result of dropovercmd
+else +1
+<Motion> +0 or 1  +unchanged
+2 or 3 +call dropovercmd with motion +result of dropovercmd
+<Leave>  +0 or 1  +-
+2 or 3 +call dropovercmd with leave +-
+<Drop> +0 +call dragendcmd of drag source +-
+1 +call dropcmd and call dragendcmd of drag source
+2 +call dropovercmd with leave and call dragendcmd of drag source
+3 +call dropcmd and call dragendcmd of drag source
+
+ +
+
+
-droptypes
+
+ +Specifies a list {type oplist ?type oplist? ...} of acceptable +types and associated operations for the drop target. +For each type, oplist is a list +{descops mod ?descops mod? ...} describing operations and +modifier keys for these operations. +descops describe an operation. It can be a predefined operations (copy, +move or link) or a new user defined operation, of the form {subop +baseop ?bitmap?}. +subop is the name given to the sub operation, baseop is the name of the +base operation (copy, move or link) and bitmap is a bitmap +to display for the operation. +
If bitmap is empty, the default bitmap of the base operation is used for the +sub operation. +
subop can be a base operation, in order to change the bitmap of a base operation. +In this case, baseop must be empty or equal to subop. +
mod is the modifer key for the operation. It can be: +
    +
  • none to specify that no modifier key is pressed. This modifier can only be used +with a sub operation named default (and vice versa), which has the behaviour of not +display any bitmap operation. For all type, if the modifier none is not given, it is +automatically associated to the default sub operation of a copy base operation. +
  • program to specifies a sub operation accessible only by DropSite::setoperation. +
  • A list combining shift, control and alt, which means their +corresponding key. +
+ +
+
+
+
DropSite::setcursor + cursor +
+ +This command can be used within the script dragovercmd. It is usefull to provide +visual effect about the state of the drag. +
+
DropSite::setdrop + path + subpath + dropover + drop + ?force? +
+ +This command provides a simple way to call register during a BWidget creation or +configuration. +
    +
  • path is the pathname of the BWidget, +
  • subpath is the pathname of the tk widget where drag event occurs, +
  • dropover is a command for drag-over event, +
  • drop is a command for drop event, +
  • force specifies wether or not to call register whenever no option value +has changed (0 by default - for BWidget configuration, use 1 for BWidget creation). +
+setdrop verifies the modification flag of options dropenabled and +droptypes and calls register if needed according to the options values and +dropover and drop arguments. dropovercmd and dropcmd are not +taken from options of widget because they are considered as user command, called by +BWidget implementation of drag-over and drop events. + +
+
DropSite::setoperation + op +
+Description text +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DynamicHelp.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DynamicHelp.html new file mode 100644 index 00000000..6a9dcd51 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/DynamicHelp.html @@ -0,0 +1,251 @@ + +DynamicHelp + +
NAME
+
DynamicHelp + - Provide help to Tk widget or BWidget +
+
+
COMMAND
+
DynamicHelp::add +widget ?option value ...? +
+
DynamicHelp::configure + ?option? ?value option value ...? +
+
DynamicHelp::delete +widget +
+
DynamicHelp::include + class + type +
+
DynamicHelp::register + path + type + ?arg...? +
+
DynamicHelp::sethelp + path + subpath + ?force? +
+
+

+DESCRIPTION
+

+Description text +

+

+COMMAND
+ +
DynamicHelp::add + ?option value ...? +
+

+This command adds dynamic help to the given widget. +

+
-command
+
+ If specified, refers to a command to execute to get the help + text to display. The command must return a string to display. + If the command returns an empty string, no help is displayed. +
+
+ +
-index
+
+ If specified, refers to a menu index to bind the help to instead of + a widget. If -type is not menu, this option is ignored. +
+
+ +
-item
+
+ If specified, refers to an item or tag on a canvas widget or to a tag + in a text widget to bind the help to instead of to a widget. +
+
+ +
-type
+
+ Specifies the type of help. Can be: + balloon, variable or menu. + Default is balloon. +
+
+ +
-text
+
+ The text to be displayed as help. +
+
+ +
-variable
+
+ Specifies a variable name to which the help string will be + written. Some other widget (e.g., a status bar) is + responsible for displaying this variable. +
+
+ +

+ Creating dynamic help for a menu is a two-step process. The menu + itself must first be added and then each menu entry must be added + separately. Here is a brief example. +

+ + + 
+    # create menu
+    menu .m -type menubar
+    # associate menubar to toplevel BEFORE DynamicHelp::register
+    # to make it works with menu clone name
+    . configure -menu .m
+    .m add cascade -label "File" -menu .m.file
+    menu .m.file
+    .m.file add command -label "Open..."
+    .m.file add command -label "Quit"
+    # create label for help, using variable varinfo
+    label .l -textvariable varinfo
+    # associate all entries of menu .m.file to variable varinfo
+    DynamicHelp::add .m.file -type menu -variable varinfo
+    # then declare entries of .m.file
+    DynamicHelp::add .m.file -type menu -index 0 -text "Detach menu"
+    DynamicHelp::add .m.file -type menu -index 1 -text "Open a file"
+    DynamicHelp::add .m.file -type menu -index 2 -text "Exit demo"
+
+ +
+ +
DynamicHelp::configure + ?option? ?value option value ...? +
+This command configure the ballon help. +

+

-borderwidth
+
+Width of the black border around the balloon. +
+
+
-delay
+
+Define the delay in millisecond of mouse inactivity before displaying +the balloon. +
+
+
+
-state
+
+ Specifies one of two states for help balloons: normal and + disabled. +
+
+ If state is disabled, help balloons will not be displayed + for any registered widget. +
+
+
-topbackground
+
+The background color of the toplevel window created for a balloon. +
+
+
Other standard options are: +
+ + + + + + + + + + + + +
  -background or -bg  -font
  -foreground or -fg  -justify
  -padx  -pady
+
+ +
DynamicHelp::delete + widget +
+ Delete all dynamic help for the given widget. +
+ +
DynamicHelp::include + class + type +
+Description text +
+
DynamicHelp::register + path + type + ?arg...? +
+

+Its use is deprecated. Use DynamicHelp::add instead. +

+ +Register a help text to the widget path. +type determines the type of the help or the type of the widget. +Depending on type, other options must be provided. +
+ + + + + + +
type options
balloon ?tagOrItem? text
variable ?tagOrItem? varName text
menu varName
menuentry index text
+
If one of the option is missing or is empty, help is removed for this widget. +

+ +If tagOrItem is specified, then path is a canvas or a text. In +case of a canvas, tagOrItem is the name of a tag or item on the canvas +to which the help will be bound. In case of a text, tagOrItem is the +name of a tag on the text to which the help will be bound. + +

+For type other than balloon, varName is typically a variable +linked to a label. +
For menu, balloon type help is not available. To declare a help for menu, +you first declare the menu, and then entries of this menu. +
For example: +

+
+ +
+     # create menu
+menu .m -type menubar
+# associate menubar to toplevel BEFORE DynamicHelp::register
+# to make it works with menu clone name
+. configure -menu .m
+.m add cascade -label "File" -menu .m.file
+menu .m.file
+.m.file add command -label "Open..."
+.m.file add command -label "Quit"
+# create label for help, using variable varinfo
+label .l -textvariable varinfo
+# associate all entries of menu .m.file to variable varinfo
+DynamicHelp::register .m.file menu varinfo
+# then declare entries of .m.file
+DynamicHelp::register .m.file menuentry 0 "Detach menu"
+DynamicHelp::register .m.file menuentry 1 "Open a file"
+DynamicHelp::register .m.file menuentry 2 "Exit demo"
+
+
+
Notice that if popup menu is owned by a menubar, you must associate first the menubar +to its toplevel. In this case, when you create a menu popup, its clone window is also +created, and DynamicHelp::register detects the exitence of the clone window and maps +events to it. +
+
DynamicHelp::sethelp + path + subpath + ?force? +
+Description text +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Entry.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Entry.html new file mode 100644 index 00000000..97c95ffa --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Entry.html @@ -0,0 +1,366 @@ + +Entry + +
NAME
+
Entry + - Entry widget with state option, dynamic help and drag and drop facilities +
+
+
CREATION
+
Entry pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
Not themed
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -disabledbackground  -disabledforeground
  -exportselection  -font
  -foreground or -fg  -highlightbackground
  -highlightcolor  -highlightthickness
  -insertbackground  -insertborderwidth
  -insertofftime  -insertontime
  -insertwidth  -justify
  -relief  -selectbackground
  -selectborderwidth  -selectforeground
  -takefocus  -text
  -textvariable  -xscrollcommand
+
+
+
Themed
+
+ + + + + + + + + + + + + + + + + + + +
  -exportselection  -font
  -insertofftime  -insertontime
  -insertwidth  -justify
  -takefocus  -text
  -textvariable  -xscrollcommand
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -command  -dragenabled
  -dragendcmd  -dragevent
  -draginitcmd  -dragtype
  -dropcmd  -dropenabled
  -dropovercmd  -droptypes
  -editable  -helptext
  -helptype  -helpvar
  -show  -state
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName invoke +
+
+

+DESCRIPTION
+

+ +The Entry widget extends the default Tk entry. Options have been added to provide +visual effect depending on the state of the Entry, +DynamicHelp options, +and Drag and +Drop. +Entry behaves much like a Label, with text option to set its contents. +
Tk entry command can also be used on Entry widget. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-command
+
+ +Specifies a command when user press <Return> in the Entry. +
+
+
-dragenabled
+
+A boolean specifying if drag is enabled. +
+
+
-dragendcmd
+
+ +Specifies a command to be called when drag ended. +dragendcmd must be a command conforming to the description of the +option dragendcmd of DragSite::register. + +
If dragendcmd is empty, the internal dragend command updates the entry +following the operation (move or copy) and the dragged data +(whole or selected part of the entry). + +
+
+
-dragevent
+
+ +Specifies the number of the mouse button associated to the drag. +Must be 1, 2 or 3. + +
+
+
-draginitcmd
+
+ +Specifies a command to be called when dragevent occurs on widget. +draginitcmd must be a command conforming to the description of the +option draginitcmd of DragSite::register. + +
if draginitcmd is empty, the command refuse the drag if entry is empty or if +portion of text is selected and event doesn't occur above the selection. In all other cases, +the command returns: +
    +
  • as the data type, the value of option dragtype or TEXT if empty, +
  • as the operations, {copy move} if state is normal and editable +is true, or {copy} only in other cases, +
  • as the data, the whole content or the selected portion of the entry. +
+ +
+
+
-dragtype
+
+ +Specifies an alternate type of dragged object. + +
+
+
-dropcmd
+
+ +Entry has a command wrapper for drop events. This command stops auto scrolling +and extract current position. +
If dropcmd is not empty, it is called with the following arguments: +
    +
  • the pathname of the Entry, +
  • the pathname of the drag source, +
  • the numeric index in the entry designated by the cursor, +
  • the current operation, +
  • the data type, +
  • the data. +
+and must return a value conforming to dropcmd option described in +DropSite::register. +If dropcmd is empty, the wrapper updates the entry following the type of data: +
+ + + + + + +
COLOR or FGCOLORreconfigure the foreground of the Entry
BGCOLORreconfigure the background of the Entry
TEXT,
or any other tag		reconfigure the Entry to display the associated string.
+and returns 1. + +
+
+
-dropenabled
+
+A boolean specifying if drop is enabled. +
+
+
-dropovercmd
+
+ +Entry has a command wrapper for drag-over events. This command enables auto scrolling +and position extraction during the drag-over. +
If dropovercmd is empty, the wrapper accepts the drop if editable option is +true and state option is normal. +
If dropovercmd is not empty, it is called with the following arguments: +
    +
  • the pathname of the Entry, +
  • the pathname of the drag source, +
  • the event, +
  • the numeric index in the entry designated by the cursor, +
  • the current operation, +
  • the data type, +
  • the data. +
+and must return a value conforming to dropovercmd option described in +DropSite::register. + +
+
+
-droptypes
+
+ +Specifies a list of accepted dropped object/operation. +See option droptypes of +DropSite::register. +for more infromation. + +Default accepts FGCOLOR, COLOR, BGCOLOR and TEXT, +all with copy and move operations. + +
+
+
-editable
+
+ +Specifies whether the Entry is editable by the user. Equivalent to the state option +of the Tk entry widget. +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this widget. +See also DynamicHelp. +
+
+
-helptype
+
+Type of dynamic help. Use balloon or variable. +See also DynamicHelp. +
+
+
-helpvar
+
+Variable to use when helptype option is variable. +See also DynamicHelp. +
+
+
-show
+
+ +If this option is specified, then the true contents of the entry are not displayed in the +window. Instead, each character in the entry's value will be displayed as the first character +in the value of this option, such as ``*''. This is useful, for example, if the entry is to +be used to enter a password. If characters in the entry are selected and copied elsewhere, the +information copied will be what is displayed, not the true contents of the entry. +
+
+
-state
+
+ +Specifies one of two states for the Entry: normal or disabled. +In normal state the text of the Entry is displayed using the foreground option. +In disabled state the text of the Entry is displayed using the disabledforeground +option. If the entry is disabled then the value may not be changed by user input +and no insertion cursor will be displayed, even if the input focus is in the widget. +Disabled state is the same as not editable with visual effect. +
+
+
-width
+
+ +Specifies an integer value indicating the desired width of the entry window, in average-size +characters of the widget's font. If the value is less than or equal to zero, the widget picks +a size just large enough to hold its current text. +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName invoke +
+ +Calls the command specified by the option -command. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Label.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Label.html new file mode 100644 index 00000000..384b3232 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Label.html @@ -0,0 +1,362 @@ + +Label + +
NAME
+
Label + - Label widget with state option, dynamic help and drag and drop facilities +
+
+
CREATION
+
Label pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
Not themed
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -anchor
  -background or -bg
  -bitmap
  -borderwidth or -bd
  -cursor
  -disabledforeground
  -font
  -foreground or -fg
  -highlightbackground
  -highlightcolor
  -highlightthickness
  -image
  -justify
  -padx
  -pady
  -relief
  -takefocus
  -text
  -textvariable
  -wraplength
+
Themed
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + +
  -anchor
  -background or -bg
  -cursor
  -font
  -foreground or -fg
  -image
  -justify
  -relief
  -takefocus
  -text
  -textvariable
  -wraplength
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -dragenabled
  -dragendcmd
  -dragevent
  -draginitcmd
  -dragtype
  -dropcmd
  -dropenabled
  -dropovercmd
  -droptypes
  -focus
  -height
  -helptext
  -helptype
  -helpvar
  -name
  -state
  -underline
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName setfocus +
+
+

+DESCRIPTION
+

+ +The Label widget extends the default Tk label. Options have been added to provide +visual effect depending on the state of the Label, DynamicHelp options, and Drag + and Drop. +

+

+WIDGET-SPECIFIC OPTIONS
+
-dragenabled
+
+A boolean specifying if drag is enabled. +
+
+
-dragendcmd
+
+ +Specifies a command to be called when drag ended. +dragendcmd must be a command conforming to the description of the +option dragendcmd of DragSite::register. + +
+
+
-dragevent
+
+ +Specifies the number of the mouse button associated to the drag. +Must be 1, 2 or 3. + +
+
+
-draginitcmd
+
+ +Specifies a command to be called when dragevent occurs on widget. +draginitcmd must be a command conforming to the description of the +option draginitcmd of DragSite::register. + +
If draginitcmd is empty, the internal draginitcmd command is used instead +and returns: +
+
IMAGE {copy} <image name> +if an image is displayed. +
BITMAP {copy} <bitmap name> +if a bitmap is displayed. +
TEXT {copy} <text> +if a text is displayed. +
+Note that if dragtype option is not empty, its value is used instead of those above. + +
+
+
-dragtype
+
+ +Specifies an alternate type of dragged object. + +
+
+
-dropcmd
+
+ +Specifies a command to be called when drop occurs on the widget. +dropcmd must be a command conforming to the description of the +option dropcmd of DropSite::register. + +
If dropcmd is empty, the command updates the label following the type of the data: +
+ + + + + + + + + + +
COLOR or FGCOLORreconfigure the foreground of the Label.
BGCOLORreconfigure the background of the Label.
IMAGEreconfigure the Label to display the associated image.
BITMAPreconfigure the Label to display the associated bitmap. +image option is set to empty.
TEXT,
or any other tag		reconfigure the Label to display the associated string. +image and bitmap options are set to empty.
+and returns 1. + +
+
+
-dropenabled
+
+A boolean specifying if drop is enabled. +
+
+
-dropovercmd
+
+ +Specifies a command to be called when drag icon is over the widget. +dropovercmd must be a command conforming to the description of the +option dropovercmd of DropSite::register. + +
If dropovercmd is empty, Label always accepts the drop if data type is +FGCOLOR, COLOR, BGCOLOR, and accepts all other data type only if +state is normal. + +
+
+
-droptypes
+
+ +Specifies a list of accepted dropped object/operation. +See option droptypes of +DropSite::register. +for more infromation. + +Default accepts FGCOLOR, COLOR, BGCOLOR, TEXT, BITMAP +and IMAGE, all with copy and move operations. + +
+
+
-focus
+
+ +Specifies a pathname to set the focus on for Label::setfocus command. + +
+
+
-height
+
+ +Specifies a desired height for the label. +If an image or bitmap is being displayed in the label then the value is in +screen units, for text it is in lines of text. +If this option isn't specified, the label's desired height is computed +from the size of the image or bitmap or text being displayed in it.
+Option not available for themed widgets. +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this widget. +See also DynamicHelp. +
+
+
-helptype
+
+Type of dynamic help. Use balloon or variable. +See also DynamicHelp. +
+
+
-helpvar
+
+Variable to use when helptype option is variable. +See also DynamicHelp. +
+
+
-name
+
+ +Specifies a standard name for the label. If the option *nameName is +found in the resource database, then text and underline options +are extracted from its value. + +
+
+
-state
+
+ +Specifies one of two states for the Label: normal or disabled. +In normal state the text of the Label is displayed using the foreground option. +In disabled state the text of the Label is displayed using the disabledforeground option. +
+
+
-underline
+
+ +Specifies the integer index of a character to underline in the label. +0 corresponds to the first character of the text displayed, 1 to the next character, +and so on. +
The binding <Alt-char> is automatically set on the toplevel +of the Label to call Label::setfocus. + +
+
+
-width
+
+ +Specifies a desired width for the label. +If an image or bitmap is being displayed in the label then the value is in +screen units, for text it is in characters. +If this option isn't specified, the label's desired width is computed +from the size of the image or bitmap or text being displayed in it. + +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName setfocus +
+ +Set the focus on the pathname given by -focus option if -state is normal. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelEntry.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelEntry.html new file mode 100644 index 00000000..c0858c71 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelEntry.html @@ -0,0 +1,194 @@ + +LabelEntry + +
NAME
+
LabelEntry + - +LabelFrame containing an Entry widget. + +
+
+
CREATION
+
LabelEntry pathName ?option value...?
+
+
+
OPTIONS from Entry
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -borderwidth or -bd  -command
  -disabledforeground  -dragenabled
  -dragendcmd  -dragevent
  -draginitcmd  -dragtype
  -dropcmd  -dropenabled
  -dropovercmd  -droptypes
  -editable  -entrybg (see -background)
  -entryfg (see -foreground)  -exportselection
  -font  -helptext
  -helptype  -helpvar
  -highlightbackground  -highlightcolor
  -highlightthickness  -insertbackground
  -insertborderwidth  -insertofftime
  -insertontime  -insertwidth
  -justify  -relief
  -selectbackground  -selectborderwidth
  -selectforeground  -show
  -state  -takefocus
  -text  -textvariable
  -width  -xscrollcommand
+
+
+
OPTIONS from LabelFrame
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -background or -bg  -disabledforeground
  -foreground or -fg  -helptext
  -helptype  -helpvar
  -label (see -text)  -labelanchor (see -anchor)
  -labelfont (see -font)  -labelheight (see -height)
  -labeljustify (see -justify)  -labelwidth (see -width)
  -name  -padx
  -pady  -side
  -state  -underline
  -wraplength
+
+
+
WIDGET COMMAND
+
pathName bind + ?arg...? +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+

+ +LabelEntry is a widget composed of LabelFrame widget +containing an Entry widget. +Tk entry command can also be used on LabelEntry widget. + +

+

+WIDGET COMMAND
+
pathName bind + ?arg...? +
+ +Set bindings on the entry widget. + +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelFrame.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelFrame.html new file mode 100644 index 00000000..f0fb4243 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/LabelFrame.html @@ -0,0 +1,144 @@ + +LabelFrame + +
NAME
+
LabelFrame + - Frame with a Label +
+
+
CREATION
+
LabelFrame pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + +
  -borderwidth or -bd  -relief
+
+
+
OPTIONS from Label
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -anchor  -background or -bg
  -bitmap  -disabledforeground
  -focus  -font
  -foreground or -fg  -height
  -helptext  -helptype
  -helpvar  -image
  -justify  -name
  -padx  -pady
  -state  -text
  -textvariable  -underline
  -width  -wraplength
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + +
  -side
+
+
+
WIDGET COMMAND
+
LabelFrame::align + ?arg...? +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName getframe +
+
+

+DESCRIPTION
+

+ +LabelFrame enables user to create a frame with a +Label positionned at any side. +LabelFrame is used by ComboBox +and SpinBox. +

+

+WIDGET-SPECIFIC OPTIONS
+
-side (read-only)
+
+ +Specifies where to position the Label relative to the user frame: top, bottom, left or right. +
+
+

+WIDGET COMMAND
+
LabelFrame::align + ?arg...? +
+ +This command align label of all widget given by args of class LabelFrame +(or "derived") by setting their width to the max one +1 + +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName getframe +
+ +Return the frame where the user can create any other widget. +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ListBox.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ListBox.html new file mode 100644 index 00000000..8765d6a4 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ListBox.html @@ -0,0 +1,675 @@ + +ListBox + +
NAME
+
ListBox + - ListBox widget +
+
+
CREATION
+
ListBox pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -cursor  -highlightbackground
  -highlightcolor  -highlightthickness
  -relief  -selectbackground
  -selectforeground  -takefocus
  -xscrollcommand  -yscrollcommand
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -autofocus  -deltax  -deltay
  -dragenabled  -dragendcmd
  -dragevent  -draginitcmd
  -dragtype  -dropcmd
  -dropenabled  -dropovercmd
  -dropovermode  -droptypes
  -height  -multicolumn
  -padx  -redraw
  -selectfill  -selectmode  -width
+
+
+
WIDGET COMMAND
+
pathName bindImage + event + script +
+
pathName bindText + event + script +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName delete + ?arg...? +
+
pathName edit + item + text + ?verifycmd? + ?clickres? + ?select? +
+
pathName exists + item +
+
pathName index + item +
+
pathName insert + index + item + ?option value...? +
+
pathName item + first + ?last? +
+
pathName itemcget + item + option +
+
pathName itemconfigure + item + ?option? ?value option value ...? +
+
pathName items + ?first? + ?last? +
+
pathName move + item + index +
+
pathName reorder + neworder +
+
pathName see + item +
+
pathName selection + cmd + ?arg...? +
+
pathName xview + ?arg...? +
+
pathName yview + ?arg...? +
+
+

+DESCRIPTION
+

+ +ListBox widget uses canvas to display a list of items. +Each item is composed of a label with its own font and foreground attributes, and an optional +image or window. Each item is drawn in a single line, whose height is defined by the +deltay option, so they must have at most this height. +A item is uniquely identified by a string given at creation (by the +insert command). The ListBox can have one or more columns, depending on +multicolumn option. The user do not handle columns; the number of columns +is determined following the height of the ListBox in order to see each item vertically. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-autofocus (read-only)
+
+ If this option is true, the listbox will take focus any time the user + clicks in it. Without focus, the listbox's mouse wheel bindings will + not work properly. The default is true. +
+
+ +
-deltax
+
+ +Specifies horizontal pad between each columns. + +
+
+
-deltay
+
+ +Specifies vertical size of the items. + +
+
+
-dragenabled
+
+A boolean specifying if drag is enabled. +
+
+
-dragendcmd
+
+ +Specifies a command to be called when drag ended. +dragendcmd must be a command conforming to the description of the +option dragendcmd of DragSite::register. + +
+
+
-dragevent
+
+ +Specifies the number of the mouse button associated to the drag. +Must be 1, 2 or 3. + +
+
+
-draginitcmd
+
+ +ListBox has a command wrapper for drag-init events. This command refused the drag +if no item is designated. In other cases: +
If draginitcmd is empty, it returns: +
    +
  • the value of option dragtype or LISTBOX_ITEM if empty as the data type, +
  • {move copy link} as the operations, +
  • the item identifier as the data. +
+If draginitcmd is not empty, it is called with the following arguments: +
    +
  • the pathname of the listbox, +
  • the identifier of the dragged item, +
  • the toplevel created to represent dragged data. +
+and must return a value conforming to draginitcmd option described in +DragSite::register. + +
+
+
-dragtype
+
+ +Specifies an alternate type of dragged object. + +
+
+
-dropcmd
+
+ +ListBox has a command wrapper for drop events. This command stops auto scrolling +and extract item and position. +
If dropcmd is not empty, it is called with the following arguments: +
    +
  • the pathname of the listbox, +
  • the pathname of the drag source, +
  • a list describing where the drop occurs. It can be: +
      +
    • {widget}, +
    • {item item} or +
    • {position index}. +
    +
  • the current operation, +
  • the data type, +
  • the data. +
+ +

+The default drop command allows for drag-and-drop within the listbox but +not to or from other widgets. +

+ +
+
+
-dropenabled
+
+A boolean specifying if drop is enabled. +
+
+
-dropovercmd
+
+ +LsitBox has a command wrapper for drag-over events. This command enables auto scrolling +and position extraction during the drag-over. +If dropovercmd is not empty, the command is called with the following aguments: +
    +
  • the pathname of the listbox, +
  • the pathname of the drag source, +
  • a list describing where the drop can occur, whose elements are: +
      +
    • the string widget if dropovertype option contains w, else empty string. +
    • the targeted item if drag icon points an item and dropovertype option contains +i, else empty string. +
    • an index within two items where drag icon points to if dropovertype option +contains p, else empty string. +
    • optionally, the preferred method if drop can occur both inside an item and between two +items. The value is position or item. +
    +
  • the current operation, +
  • the data type, +
  • the data. +
+The command must return a list with two elements: +
    +
  • the drop status, conforming to those described in dropovercmd option of +DropSite::register, +
  • the choosen method: widget, item or position. +
+ +
+
+
-dropovermode
+
+ +Specifies the type of drop-over interaction. Must be a combination of +w, which specifies that drop can occurs everywhere on widget, +p, which specifies that drop can occurs between two items, +and i, which specifies that drop occurs inside items. + +
+
+
-droptypes
+
+ +Specifies a list of accepted dropped object/operation. +See option droptypes of +DropSite::register. +for more infromation. + +
Default is LISTBOX_ITEM with operations copy and move. + +
+
+
-height
+
+ +Specifies the desired height for the listbox in units of deltay pixels. + +
+
+
-multicolumn
+
+ +Specifies wether or not ListBox layouts items in order to see each one vertically. + +
+
+
-padx
+
+ +Specifies distance between image or window and text of the items. + +
+
+
-redraw
+
+ +Specifies wether or not the listbox should be redrawn when entering idle. +Set it to false if you call update while modifying the listbox. + +
+
+ +
-selectfill (read-only)
+
+ If true, the listbox will draw a selection rectangle that fills the + listbox from left-to-right instead of just drawing a box around the + selected item. This more closely mimics the standard Tk listbox. +
+
+ +
-selectmode
+
+ +Specifies the desired selection-mode for the listbox. Must be one of +none, single or multiple. selectmode single +allows to select 1 item by its text or image. selectmode multiple +allows to select multiple items by their text or image. For more info on +selectmodes single or multiple, see the Tk listbox +command. Default value for selectmode is none. + +
+
+
-width
+
+ +Specifies the desired width for the listbox in units of 8 pixels. + +
+
+

+WIDGET COMMAND
+
pathName bindImage + event + script +
+ +This command associates a command to execute whenever the event +sequence given by event occurs on the image of a item. +The item idenfier on which the event occurs is appended to the command. + +

+Any occurrence of %W in script is substituted with the +path of the listbox. +

+ +
+
pathName bindText + event + script +
+ +This command associates a command to execute whenever the event +sequence given by event occurs on the label of a item. +The item idenfier on which the event occurs is appended to the command. + +

+Any occurrence of %W in script is substituted with the +path of the listbox. +

+ +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName delete + ?arg...? +
+ +Deletes all items in arg. arg can be a list +of items or a list of list of items. +To delete all items, do $pathName delete [$pathName items]. + +
+
pathName edit + item + text + ?verifycmd? + ?clickres? + ?select? +
+ +Provides a way for the user to edit in place the label of an item. +
The command takes the initial text as argument and does not modify the label of the +edited node, but returns an empty string if edition is canceled, or the typed text +if edition is accepted. +
When editing, the user can cancel by pressing Escape, or accept by pressing Return. +
clickres specifies what to do if the user click outside the editable area. +If clickres is 0 (the default), the edition is canceled. +If clickres is 1, the edition is accepted. +In all other case, the edition continues. +
If edition is accepted and modifycmd is not empty, then it is called with +the new text as argument and must return 1 to accept the new text, 0 to refuse it +and continue edition. +
select specifies wether or not the initial text should be selected. Default is 1. + +
+
pathName exists + item +
+ +Returns 1 if item exists in the listbox, else 0. + +
+
pathName index + item +
+ +Returns the position of item in the list. + +
+
pathName insert + index + item + ?option value...? +
+ +

+Inserts a new item identified by item in the list at position index. +

+ +

+Any instance of #auto within the item name will be replaced by the +number of the item in the order of insertion. +

+ +

+

-data
+
+ +User data associated to the item. + +
+
+
-fill
+
+ +Specifies the foreground color of the label of the item. + +
+
+
-font
+
+ +Specifies a font for the label of the item. + +
+
+
-image
+
+ +Specifies an image to display at the left of the label of the item. +window option override image. +
+
+
-indent
+
+ +Specifies the amount of extra space in pixels at the left of the item. + +
+
+
-text
+
+ +Specifies the label of the item. + +
+
+
-window
+
+ +Specifies a pathname to display at the left of the label of the item. +window option override image. +
+
+
+
pathName item + first + ?last? +
+ +Its use is deprecated. Use items instead.
+If last is omitted, returns the item at index first in the list, +or an empty string if first refers to a non-existent element. +If last is specified, the command returns a list whose elements are all +of the items between first and last, inclusive. +Both first and last may have any of the standard forms for indices. + +
+
pathName itemcget + item + option +
+ +Returns the current value of a configuration option for the item. +Option may have any of the values accepted by the item creation command. + +
+
pathName itemconfigure + item + ?option? ?value option value ...? +
+ +This command is similar to the configure command, except that it applies to the +options for an individual item, whereas configure applies to the options for +the widget as a whole. Options may have any of the values accepted by the +item creation widget command. If options are specified, options are modified as indicated +in the command and the command returns an empty string. If no options are specified, +returns a list describing the current options for the item. +Read-only options are not be modified. + +
+
pathName items + ?first? + ?last? +
+ +If first and last are omitted, returns the list of all items. +If first is specified and last omitted, returns the item at index +first, or an empty string if first refers to a non-existent element. +If first and last are specified, the command returns a list whose elements +are all of the items between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
+
pathName move + item + index +
+ +Moves item at position index in the list. + +
+
pathName reorder + neworder +
+ +Modifies the order of items in the listbox given by neworder. Items that do not +appear in neworder are no moved. + +
+
pathName see + item +
+ +Arrange the scrolling area to make item visible. + +
+
pathName selection + cmd + ?arg...? +
+ +Modifies the list of selected items following cmd: +
+
clear +
remove all items of the selection. +
set +
set the selection to all items in arg +
add +
add all items of arg in the selection +
remove +
remove all items of arg of the selection +
get +
return the current selected items +
+ +
+
pathName xview + ?arg...? +
+ +Standard command to enable horizontal scrolling of pathName. + +
+
pathName yview + ?arg...? +
+ +Standard command to enable vertical scrolling of pathName. + +
+ + +BINDINGS + +

+A <<ListboxSelect>> virtual event is generated any time the +selection in the listbox changes. +

+ +

+The listbox has all the standard mouse wheel bindings when it has focus. +

+

+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MainFrame.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MainFrame.html new file mode 100644 index 00000000..96813a5d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MainFrame.html @@ -0,0 +1,323 @@ + +MainFrame + +
NAME
+
MainFrame + - Manage toplevel with menu, toolbar and statusbar +
+
+
CREATION
+
MainFrame pathName ?option value...?
+
+
+
OPTIONS from ProgressBar
+
+ + + + + + + + + + + +
  -background or -bg  -progressfg (see -foreground)
  -progressmax (see -maximum)  -progresstype (see -type)
  -progressvar (see -variable)
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + + + + +
  -height
  -menu
  -menubarfont
  -menuentryfont
  -separator
  -statusbarfont
  -textvariable
  -width
  -sizegrip
+
+
+
WIDGET COMMAND
+
pathName addindicator + ?arg...? +
+
pathName addtoolbar +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName getframe +
+
pathName getindicator + index +
+
pathName getmenu + menuid +
+
pathName gettoolbar + index +
+
pathName setmenustate + tag + state +
+
pathName showstatusbar + name +
+
pathName showtoolbar + index + bool +
+
+

+DESCRIPTION
+

+ +MainFrame manage toplevel to have:
+

    +
  • simple menu creation, with automatic accelerator bindings and +DynamicHelp association,
    • +
  • one or more toolbars that user can hide,
    • +
  • a status bar, displaying a user message or a menu description, and optionally a +ProgressBar.
    • +
+

+

+WIDGET-SPECIFIC OPTIONS
+
-height
+
+ +Specifies the desired height for the user frame in any of the forms acceptable to +Tk_GetPixels. If this option is less than or equal to zero (the default) then the window +will not request any size at all. +
+
+
-menu (read-only)
+
+ +This option describes the menu. This is a list whose each five elements describe +one cascade menu. It has the following form: +{menuname tags menuId tearoff menuentries...} +where menuentries is a list where each element describe one menu entry, which can be: +
    +
  • for a separator:
    + {separator}
    • +
  • for a command:
    + {command menuname ?tags? ?description? ?accelerator? ?option value? ...}
    • +
  • for a check button:
    + {checkbutton menuname ?tags? ?description? ?accelerator? ?option value? ...}
    • +
  • for a radio button:
    + {radiobutton menuname ?tags? ?description? ?accelerator ?option value? ...}
    • +
  • for a cascade menu:
    + {cascade menuname tags menuId tearoff menuentries}
    • +
+where: +
    +
  • menuname is the name of the menu. If it contains a &, the following character +is automatically converted to the corresponding -underline option of menu add +command.
    • +
  • tags is the tags list for the entry, used for enabling or disabling menu +entries with MainFrame::setmenustate.
    • +
  • menuId is an id for the menu, from which you can get menu pathname with + MainFrame::getmenu.
    • +
  • tearoff specifies if menu has tearoff entry.
    • +
  • description specifies a string for DynamicHelp.
    • +
  • accelerator specifies a key sequence. It is a list of two elements, where the first +is one of Shift, Ctrl, Alt, CtrlAlt, Cmd, or ShiftCmd, and the second as letter +(see -casesensitive option for interpretation), digit or +a special key name. +An accelerator string is build and corresponding binding set on the toplevel to invoke the +menu entry.
    • +
  • option value specifies additionnal options for the entry (see menu add +command).
    • +
+Each value enclosed by ? are optional and defaulted to empty string, but must be +provided if one or more following options is not empty. +
Example: +
+set descmenu {
+    "&File" {} {} 0 {
+        {command "&New"     {} "Create a new document"     {Ctrl n} -command Menu::new}
+        {command "&Open..." {} "Open an existing document" {Ctrl o} -command Menu::open}
+        {command "&Save"    open "Save the document" {Ctrl s} -command Menu::save}
+        {cascade  "&Export"  {} export 0 {
+            {command "Format &1" open "Export document to format 1" {} -command {Menu::export 1}}
+            {command "Format &2" open "Export document to format 2" {} -command {Menu::export 2}}
+        }}
+        {separator}
+        {cascade "&Recent files" {} recent 0 {}}
+        {separator}
+        {command "E&xit" {} "Exit the application" {} -command Menu::exit}
+    }
+    "&Options" {} {} 0 {
+        {checkbutton "Toolbar" {} "Show/hide toolbar" {}
+            -variable Menu::_drawtoolbar
+            -command  {$Menu::_mainframe showtoolbar toolbar $Menu::_drawtoolbar}
+        }
+    }
+}
+
+ +
+
+
-menubarfont
+
+Font for the top menu bar. +
+
-menuentryfont
+
+Font for the submenus. +
+
-separator (read-only)
+
+ +Specifies if separator should be drawn at the top and/or at the bottom of the user window. +Must be one of the values none, top, bottom or both. +It depends on the relief of subwidgets of user window. +
+
+
-textvariable
+
+ +Specifies the textvariable option for the label of the status bar. +DynamicHelp description +of menu entries are mapped to this variable at the creation of the MainFrame. +If this variable is changed by MainFrame::configure, menu description will +not be available. +
You change the text of the label by modifying the value of the variable. +
+
+
-statusbarfont
+
+Font for the status bar. +
+
-width
+
+ +Specifies the desired width for the user frame in any of the forms acceptable to +Tk_GetPixels. If this option is less than or equal to zero (the default) then the window +will not request any size at all. +
+
+
-sizegrip (themed, read-only)
+
+ +If bool argument is true and themed mode, show a ttk sizegrip widget in the lower-right corner. +
+

+WIDGET COMMAND
+
pathName addindicator + ?arg...? +
+ +Add an indicator box at the right of the status bar. Each indicator are added from left +to right. An indicator is a Tk label widget configured with option-value pair +given by ?arg...?. -relief and -borderwidth options are respetively +defaulted to sunken and 1. Returns the pathname of the created label. +
+
pathName addtoolbar +
+ +Add a toolbar to the MainFrame. Returns the pathname of the new window where to place +toolbar items. +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName getframe +
+ +Returns the pathname of the user window. +
+
pathName getindicator + index +
+ +Returns the pathname of the indexth added indicator. +
+
pathName getmenu + menuid +
+ +Returns the pathname of the menu whose id is menuid. +
+
pathName getmenustate + tag + state +
+ +Returns the state of the given menu tag. +
+
pathName gettoolbar + index +
+ +Returns the pathname of the indexth added toolbar. +
+
pathName setmenustate + tag + state +
+ +Set the -state option value of all the menu entries that have the tag tag +to state. +A menu entry is disabled, if one of its associated tags have state disabled. + +
+
pathName showstatusbar + name +
+ +name is one of none, status or progression. +Use none to hide the status bar, status to display the label only, or +progression to display the label and the +ProgressBar. +
+
pathName showtoolbar + index + bool +
+ +Hide if bool is 0, or show if bool is 1 the indexth added toolbar. +To prevent your toplevel from resizing while hiding/showing toolbar, +do [wm geometry $top [wm geometry $top]] when it is managed. +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MessageDlg.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MessageDlg.html new file mode 100644 index 00000000..f64ee38a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/MessageDlg.html @@ -0,0 +1,221 @@ + +MessageDlg + +
NAME
+
MessageDlg + - Message dialog box +
+
+
CREATION
+
MessageDlg pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + + + +
  -anchor  -font
  -foreground or -fg  -padx
  -pady
+
+
+
OPTIONS from Dialog
+
+ + + + + + + + +
  -background or -bg  -cancel
  -default  -parent
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + + + + +
  -aspect  -buttons
  -buttonwidth  -icon
  -justify  -message
  -title  -type
  -width
+
+

+DESCRIPTION
+

+ +MessageDlg provides a simple way to display a message dialog. +MessageDlg::create creates the message dialog, displays +it and return the index of the pressed button, or -1 if it is destroyed. +When returning, the dialog no longer exists. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-aspect
+
+ +Specifies a non-negative integer value indicating desired +aspect ratio for the text. The aspect ratio is specified as +100*width/height. 100 means the text should +be as wide as it is tall, 200 means the text should +be twice as wide as it is tall, 50 means the text should +be twice as tall as it is wide, and so on. +Used to choose line length for text if width option +isn't specified. +Defaults to 150. + +The options -width and -aspect are directly heritated from the Tk message widget. +
+
+
-buttons
+
+ +Specifies a list of buttons to display when type option is user. +If a button has a symbolic name, its associated text will be displayed. + +
+
+ +
-buttonwidth
+
+ Specifies the standard width of the buttons in the dialog. +
+
+ +
-icon
+
+ +Specifies an icon to display. Must be one of the following: error, info, +question or warning. + +
+
+
-justify
+
+ +Specifies how to justify lines of text. +Must be one of left, center, or right. Defaults +to left. +This option works together with the anchor, aspect, +padx, pady, and width options to provide a variety +of arrangements of the text within the window. +The aspect and width options determine the amount of +screen space needed to display the text. +The anchor, padx, and pady options determine where this +rectangular area is displayed within the widget's window, and the +justify option determines how each line is displayed within that +rectangular region. +For example, suppose anchor is e and justify is +left, and that the message window is much larger than needed +for the text. +The the text will displayed so that the left edges of all the lines +line up and the right edge of the longest line is padx from +the right side of the window; the entire text block will be centered +in the vertical span of the window. + +
+
+
-message
+
+ +Specifies the message to display in this message box. + +
+
+
-title
+
+ +Specifies a string to display as the title of the message box. +If the value is empty (the default), a default title will be set corresponding +to the icon option. +The default associated title is in english, and can be modified to set it in +another language by specifying the resource: +
    *MessageDlg.nameTitle:   value
+or the equivalent tcl command: +
    option add *MessageDlg.nameTitle value
+where name is the name of an icon as defined in the icon option. +
For example, for french language, you can specify for a warning dialog: +
    option add *MessageDlg.warningTitle  "Attention"
+ +
+
+
-type
+
+ +Specifies a set of buttons to be displayed. The following values are possible: +
+

+

+
+abortretryignore +
+Displays three buttons whose symbolic names are abort, +retry and ignore.

+

+ok +
+Displays one button whose symbolic name is ok.

+

+okcancel +
+Displays two buttons whose symbolic names are ok and cancel.

+

+retrycancel +
+Displays two buttons whose symbolic names are retry and cancel.

+

+yesno +
+Displays two buttons whose symbolic names are yes and no.

+

+yesnocancel +
+Displays three buttons whose symbolic names are yes, no +and cancel. +

+

+user +
+Displays buttons of -buttons option.

+

+ +

+For any -type but user, the native Tk widget tk_messageBox is used. +In this case, only the following options are considered: -default, -icon, -message, -title and -type. +

+
+
-width
+
+ +Specifies the length of lines in the window. +If this option has a value greater than zero then the aspect +option is ignored and the width option determines the line +length. +If this option has a value less than or equal to zero, then +the aspect option determines the line length. + +
+
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/NoteBook.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/NoteBook.html new file mode 100644 index 00000000..146d95af --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/NoteBook.html @@ -0,0 +1,483 @@ + +NoteBook + +
NAME
+
NoteBook + - Notebook manager widget +
+
+
CREATION
+
NoteBook pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + +
  -font
+
+
+
OPTIONS from ArrowButton
+
+ + + + + + + + + + + + + + + + +
  -activebackground  -activeforeground
  -background or -bg  -borderwidth or -bd
  -disabledforeground  -foreground or -fg
  -repeatdelay  -repeatinterval
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + +
  -arcradius  -height
  -homogeneous  -internalborderwidth or -ibd
  -side  -tabbevelsize
  -tabpady  -width
+
+
+
WIDGET COMMAND
+
pathName bindtabs + event + script +
+
pathName cget + option +
+
pathName compute_size +
+
pathName configure + ?option? ?value option value ...? +
+
pathName delete + page + ?destroyframe? +
+
pathName getframe + page +
+
pathName index + page +
+
pathName insert + index + page + ?option value...? +
+
pathName itemcget + page + option +
+
pathName itemconfigure + page + ?option? ?value option value ...? +
+
pathName move + page + index +
+
pathName page + first + ?last? +
+
pathName pages + ?first? + ?last? +
+
pathName raise + ?page? +
+
pathName see + page +
+
+

+DESCRIPTION
+

+ +The NoteBook widget manages a set of pages and displays one of them. A page +is a frame or ttk::frame that is included in the NoteBook by its +insert command. Each page is associated with a tab; +the tabs are displayed in a band either above or below the pages, depending on +the value of the option -side. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-arcradius
+
+ +Specifies the amount of rounding effect at the corners of a tab. This value +can be adjusted from 0 to 8 pixels with the default being 2 pixels. Usually, +small values are preferable. +
+
+
-height
+
+ +Specifies the desired height for the pages. If this option is equal to zero (the default) +then the window will not request any size at all. +In this case, user may want to call NoteBook::compute_size to make NoteBook larger +enough to contains the largest page. +
+
+
-homogeneous
+
+ +Specifies whether or not the label of the pages must have the same width. + +
+
+ +
-internalborderwidth or -ibd
+
+ +Value that is applied to each page in the NoteBook as its -borderwidth or -bd. + +
+
+ + +
-side
+
+ +Specifies the side where to place the label of the pages. Must be one +of top or bottom. + +
+
+
-tabbevelsize
+
+ +Specifies the amount of bevel the tabs should have. This value can be adjusted from +0 to 8 pixels with the default being 0 pixels. A zero pixel bevel is essentially rectangular +while non-zero bevel size will look trapezoidal. +
+
+ +
-tabpady
+
+ Specifies the padding between the text in the tab and the top and bottom + of the tab. Padding may be a list of two values to specify padding for + top and bottom separately. Padding defaults to {0 6}. +
+
+ +
-width
+
+ +Specifies the desired width for the pages. If this option is equal to zero (the default) +then the window will not request any size at all. +In this case, user may want to call NoteBook::compute_size to make NoteBook larger +enough to contains the largest page. +
+
+

+WIDGET COMMAND
+
pathName bindtabs + event + script +
+ +This command associates a command to execute whenever the event +sequence given by event occurs on a tab. The page identifier on which +the event occurs is appended to the command. + +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName compute_size +
+ +This command can be called to make the NoteBook large enough to contain the largest page. +Note that if all pages use -createcmd, they will have no requested size. + +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName delete + page + ?destroyframe? +
+ +Deletes the page page. If destroyframe is 1 (the default), the frame +associated to page is destroyed. If destroyframe is 0, the frame is not +destroyed and is reused by further call to insert with the same page. + +
+
pathName getframe + page +
+ +Returns the pathname of the page page. + +
+
pathName index + page +
+ +Return the numerical index corresponding to the item. + +
+
pathName insert + index + page + ?option value...? +
+ +Insert a new page identified by page at position index in the pages list. +index must be numeric or end. The pathname of the new page is returned. +Dynamic help, if it is specified by the options, is +displayed when the pointer hovers over the tab that belongs to the page. + +

+

-activebackground
+
+ +Background color for the tab when it is active. + +
+
+
-activeforeground
+
+ +Color used for the tab's text when the tab is active. + +
+
+
-background
+
+ +Background color for the tab when it is not active. + +
+
+
-createcmd
+
+ +Specifies a command to be called the first time the page is raised. + +
+
+
-disabledforeground
+
+ +Color used for the tab's text when the tab is disabled. + +
+
+ +
-foreground
+
+ +Color used for the tab's text when the tab is neither active nor disabled. + +
+
+
-helpcmd
+
+ +Has no effect. +See also DynamicHelp. + +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this page. +See also DynamicHelp. + +
+
+
-helptype
+
+ +Type of dynamic help. Use balloon (the default for a NoteBook +page) or variable. +See also DynamicHelp. + +
+
+
-helpvar
+
+ +Variable to use when -helptype option is variable. +See also DynamicHelp. + +
+
+
-image
+
+ +Specifies an image to display for the page at the left of the label + +
+
+
-leavecmd
+
+ +Specifies a command to be called when a page is about to be leaved. +The command must return 0 if the page can not be leaved, or 1 if it can. + +
+
+
-ractiveimage
+
+ +Image to show on the right of the tab when the tab is active. + +
+
+
-raisecmd
+
+ +Specifies a command to be called each time the page is raised. + +
+
+
-rimage
+
+ +Image to show on the right of the tab when the tab is not active. + +
+
+
-rimagecmd
+
+ +Specifies a command to be evaluated, with two arguments appended, when the +image shown on the right of the tab is clicked. The first appended argument +is the Tk window path of the NoteBook, the second is the name of the page. + +
+
+
-state
+
+ +Specifies the state of the page. Must be normal or disabled. + +
+
+
-text
+
+ +Specifies a label to display for the page. + +
+
+
+
pathName itemcget + page + option +
+ +Returns the current value of a configuration option for the item. +Option may have any of the values accepted by the item creation command. + +
+
pathName itemconfigure + page + ?option? ?value option value ...? +
+ +This command is similar to the configure command, except that it applies to the +options for an individual item, whereas configure applies to the options for +the widget as a whole. Options may have any of the values accepted by the +item creation widget command. If options are specified, options are modified as indicated +in the command and the command returns an empty string. If no options are specified, +returns a list describing the current options for the item. +Read-only options are not be modified. + +
+
pathName move + page + index +
+ +Moves page tab to index index. + +
+
pathName page + first + ?last? +
+ +Its use is deprecated. Use pages instead.
+If last is omitted, returns the page at index first, or an empty string if +first refers to a non-existent element. If last is specified, the command +returns a list whose elements are all of the pages between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
+
pathName pages + ?first? + ?last? +
+ +If first and last are omitted, returns the list of all pages. +If first is specified and last omitted, returns the page at index +first, or an empty string if first refers to a non-existent element. +If first and last are specified, the command returns a list whose elements +are all of the pages between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
+
pathName raise + ?page? +
+ +Raise the page page, or return the raised page if page is omitted. + +
+
pathName see + page +
+ +Scrolls labels to make the label of the page page visible. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PagesManager.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PagesManager.html new file mode 100644 index 00000000..e5edf615 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PagesManager.html @@ -0,0 +1,180 @@ + +PagesManager + +
NAME
+
PagesManager + - Pages manager widget +
+
+
CREATION
+
PagesManager pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + +
  -background
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + +
  -height
  -width
+
+
+
WIDGET COMMAND
+
pathName add + page +
+
pathName cget + option +
+
pathName compute_size +
+
pathName configure + ?option? ?value option value ...? +
+
pathName delete + page +
+
pathName getframe + page +
+
pathName page + first + ?last? +
+
pathName pages + ?first? + ?last? +
+
pathName raise + ?page? +
+
+

+DESCRIPTION
+

+ +PagesManager widget manages a set of pages and displays one of them. +PagesManager does not provide any user access method, as NoteBook +does, so it can be done through a listbox, a menu, radiobutton, or +whatever. The widget shows no pages during creation; there must be an +explicit call to raise to display one. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-height
+
+ +Specifies the desired height for the pages. If this option is equal to zero (the default) +then the window will not request any size at all. +In this case, user may want to call PagesManager::compute_size to make PagesManager +larger enough to contains the largest page. +
+
+
-width
+
+ +Specifies the desired width for the pages. If this option is equal to zero (the default) +then the window will not request any size at all. +In this case, user may want to call PagesManager::compute_size to make PagesManager +larger enough to contains the largest page. +
+
+

+WIDGET COMMAND
+
pathName add + page +
+ +Add a new page identified by page, which is an arbitrary +identifier. The pathname of the new page is returned and widgets for +the page should be created with this as the parent or ancestor. +However, PagesManager manages its own geometry. pack, +grid or an equivalent should not be used with the pathname +returned by add. + +
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName compute_size +
+ +This command can be called to make the PagesManager large enough to contain the largest page. + +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName delete + page +
+ +Deletes the page page. + +
+
pathName getframe + page +
+ +Returns the pathname of the page page. + +
+
pathName page + first + ?last? +
+ +Its use is deprecated. Use pages instead.
+If last is omitted, returns the page at index first, or an empty string if +first refers to a non-existent element. If last is specified, the command +returns a list whose elements are all of the pages between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
+
pathName pages + ?first? + ?last? +
+ +If first and last are omitted, returns the list of all pages. +If first is specified and last omitted, returns the page at index +first, or an empty string if first refers to a non-existent element. +If first and last are specified, the command returns a list whose elements +are all of the pages between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
+
pathName raise + ?page? +
+ +Raise the page page, or return the raised page if page is omitted. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanedWindow.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanedWindow.html new file mode 100644 index 00000000..c74c818f --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanedWindow.html @@ -0,0 +1,158 @@ + +PanedWindow + +
NAME
+
PanedWindow + - Tiled layout manager widget +
+
+
CREATION
+
PanedWindow pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + +
  -background or -bg
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + +
  -activator  -pad
  -side  -weights
  -width
+
+
+
WIDGET COMMAND
+
pathName add + ?option value...? +
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName getframe + index +
+
+

+DESCRIPTION
+

+ +PanedWindow is a widget that lays out children in +a vertically or horizontally tiled format. +The user can adjust the size of the panes, with a pane control sash created +between children. +

+

+WIDGET-SPECIFIC OPTIONS
+
-activator (read-only)
+
+ +By default, the control sash is either a button or a line depending +upon the underlying operating system. This sash may be explicitly set +using this option. If set to line then the sash consists of +just a dividing line. Otherwise if set to button then it +constists of a knob that can be dragged. + +
+
+
-pad (read-only)
+
+ +Specifies additional space between the button of the sash and children. + +
+
+
-side (read-only)
+
+ +Specifies the side of the sash, which implies the layout: top or bottom +(horizontal layout), left or right (vertical layout). +
+
+
-weights (read-only)
+
+ +Specifies how the weights specified when adding panes should be used. Must be +extra or available. When using extra, only extra space is +devided among the diffferent panes relative to their weight. When using +available, all space is devided among the diffferent panes relative to +their weight. Default value for weights is extra. + +
+
+
-width (read-only)
+
+ +Specifies the width of the button of the sash. This option is ignored +if the activator is set to line. + +
+
+

+WIDGET COMMAND
+
pathName add + ?option value...? +
+ +This command add a new pane. The new pane is placed below the previous pane for +vertical layout or at right for horizontal layout. This command returns a frame +where user can place its widget. Valid options are: +

+

-minsize
+
+ +Specifies the minimum size requested for the pane. +See the grid command for more information. +
+
+
-weight
+
+ +Specifies the relative weight for apportioning any extra spaces among panes. +See the grid command for more information. +
+
+
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName getframe + index +
+ +Returns the pathname of the indexth added pane. +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanelFrame.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanelFrame.html new file mode 100644 index 00000000..2d5ccdfc --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PanelFrame.html @@ -0,0 +1,153 @@ + +PanelFrame + +
NAME
+
PanelFrame + - Frame with a boxed title area +
+
+
CREATION
+
PanelFrame pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -text
  -textvariable
  -font  -relief
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + +
  -height
  -width
  -panelbackground  -panelforeground
  -ipad
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+ +

+PanelFrame creates a frame area with a boxed title area. The boxed title +area contains a label ands allows for other items to be placed in it. This +can serve like a mini-toolbar. +

+ +

+WIDGET-SPECIFIC OPTIONS
+
-height
+
+Specifies the desired height for the widget. +
+
-ipad
+
+The spacing to place around individual panel area items. +
+
-panelbackground
+
+The color for the panel area background. +Defaults to the selection highlight background color. +
+
-panelforeground
+
+The color for the title text. +Defaults to the selection highlight foreground color. +
+
-width
+
+Specifies the desired width for the widget. +
+
+ +

+WIDGET COMMAND
+
pathName add widget + ?option value option value ...? +
+Add a widget to the panel. Widgets are packed in. +Possible options are: +
+
-side
+
Side to place item on (defaults to right).
+
-fill
+
Whether to fill space (defaults to none).
+
-expand
+
Whether to expand space (defaults to 0).
+
-pad
+
Override of the widget's -ipad option for this item.
+
+
+
+
pathName cget + option +
+Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no +option is specified, returns a list describing all of the available +options for pathName. If option is specified with no +value, then the command returns a list describing the one named +option (this list will be identical to the corresponding sublist of +the value returned if no option is specified). If one or more +option-value pairs are specified, then the command modifies the +given widget option(s) to have the given value(s); in this case the command +returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. +
+
+
pathName delete +widget ?widget ...? +
+Delete a widget and associated state from the panel.
+
+
pathName getframe +
+Get the frame widget for the status bar in which status bar items should be +created.
+
+
+
pathName items +
List of items in the status bar.
+
+
pathName remove +widget ?widget ...? +
+Remove a widget item and associated state from the panel without destroying +the item.
+
+ + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PasswdDlg.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PasswdDlg.html new file mode 100644 index 00000000..3511c8e6 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/PasswdDlg.html @@ -0,0 +1,214 @@ + +PasswdDlg + +
NAME
+
PasswdDlg + - Login/Password dialog box +
+
+
CREATION
+
PasswdDlg pathName ?option value...?
+
+
+
OPTIONS from Dialog
+
+ + + + + + + + + + + + + + + + + + +
  -anchor  -background or -bg
  -homogeneous  -modal
  -padx  -pady
  -parent  -spacing
  -title
+
+
+
OPTIONS from LabelEntry
+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -disabledforeground  -entrybg
  -entryfg  -exportselection
  -font  -foreground or -fg
  -helptype  -highlightbackground
  -highlightcolor  -highlightthickness
  -insertbackground  -insertborderwidth
  -insertofftime  -insertontime
  -insertwidth  -labelanchor
  -labelfont  -labelheight
  -labeljustify  -labelwidth
  -loginhelptext (see -helptext)  -loginhelpvar (see -helpvar)
  -loginlabel (see -label)  -logintext (see -text)
  -logintextvariable (see -textvariable)  -loginunderline (see -underline)
  -passwdeditable (see -editable)  -passwdhelptext (see -helptext)
  -passwdhelpvar (see -helpvar)  -passwdlabel (see -label)
  -passwdstate (see -state)  -passwdtext (see -text)
  -passwdtextvariable (see -textvariable)  -passwdunderline (see -underline)
  -relief  -selectbackground
  -selectborderwidth  -selectforeground
  -wraplength
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + +
  -command
  -type
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+

+ +PasswdDlg provides a simple way to display a login/password dialog. +PasswdDlg::create creates the dialog, displays it, and return the value of login +and password in a list, or an empty list if it is destroyed or user press cancel. +When returning, the dialog no longer exists. +
Additionnal resources can be set to modify other text: +

+    *loginName     Label for login LabelEntry
+    *passwordName  Label for password LabelEntry
+
+ +

+

+WIDGET-SPECIFIC OPTIONS
+
-command
+
+ +Specifies a command to call when user press ok button. + +
+
+
-type
+
+ +Specifies a set of buttons to be displayed. The following values are possible: +
+

+

+
+ok +
+Displays one button whose symbolic name is ok.

+

+okcancel +
+Displays two buttons whose symbolic names are ok and cancel.

+

+ +
+
+ + +
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
+ +Stephane Lavirotte (Stephane.Lavirotte@sophia.inria.fr) + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressBar.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressBar.html new file mode 100644 index 00000000..649ebac9 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressBar.html @@ -0,0 +1,152 @@ + +ProgressBar + +
NAME
+
ProgressBar + - Progress indicator widget +
+
+
CREATION
+
ProgressBar pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -foreground or -fg  -orient
  -relief
  -troughcolor
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + +
  -height
  -maximum
  -type
  -variable
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+

+ +ProgressBar widget indicates the user the progress of a lengthly operation. +It is used by MainFrame +and ProgressDlg. +

+

+WIDGET-SPECIFIC OPTIONS
+
-height
+
+ +Specifies the desired height for the progress indicator. +
+
+
-maximum
+
+ +Specifies the maximum value of the variable. This value must be +greater than zero. + +
+
+
-type
+
+ +Specifies the type of the ProgressBar. Must be one of normal, +incremental, infinite or nonincremental_infinite. + +

If type is normal, the progress indicator is drawn +proportional to the variable value and maximum option each time the +variable is set. + +

If type is incremental, the value of the progress +indicator is maintained internally, and incremented each time the variable is +set by its value. The progress indicator is drawn proportional to the internal +value and +maximum option. + +

If type is infinite, the value of the progress indicator +is maintained internally, and incremented each time the variable is set by its +value. The progress indicator moves from left to right if internal value +(modulo maximum) is less than maximum/2, and from right to left +if internal value is greater than maximum/2. + +

If type is nonincremental_infinite, the value of the +progress indicator taken from the variable value, The progress indicator moves +from left to right if variable value (modulo maximum) is less than +maximum/2, and from right to left if internal value is greater than +maximum/2. + +

See -variable option for special case of its value, + +

Default value for type is normal. + +
+
+
-variable
+
+ +Specifies the variable attached to the progress indicator. Progress indicator +is updated when the value of the variable changes. If the value of the +variable is negative, the progress indicator is not displayed (it is drawn flat +with background color - usefull for ProgressDlg to make it +invisible). If its value 0, progress indicator is reinitialized. + +
+
+
-width
+
+ +Specifies the desired width for the progress indicator. +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressDlg.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressDlg.html new file mode 100644 index 00000000..77cca981 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ProgressDlg.html @@ -0,0 +1,145 @@ + +ProgressDlg + +
NAME
+
ProgressDlg + - Progress indicator dialog box +
+
+
CREATION
+
ProgressDlg pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + +
  -font
  -textvariable
+
+
+
OPTIONS from Dialog
+
+ + + + + + + + +
  -background or -bg  -parent
  -separator  -title
+
+
+
OPTIONS from ProgressBar
+
+ + + + + + + + + + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -foreground or -fg  -maximum
  -relief  -troughcolor
  -type  -variable
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + +
  -command
  -height
  -stop
  -width
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+

+ +ProgressDlg provides a simple way to display a progress indicator dialog. +ProgressDlg::create creates the dialog, displays it, set a local +grab to it and immediatly return. The dialog is updated by modifying the +value of the variable of options -textvariable and -variable. +You have to destroy the dialog after use. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-command
+
+ +Specifies a command to call when user press stop button. Note that it +is the program's responsibility to periodically call update so +that button press events can be generated. + +
+
+
-height
+
+ +Specifies a desired height for the label in lines of text. + +
+
+
-stop
+
+ +Specifies the text of the button typically used to stop process. If empty, no button will +be drawn. This can be a symbolic name. + +
+
+
-width
+
+ +Specifies a desired width for the label in characters. + +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollView.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollView.html new file mode 100644 index 00000000..c94fc1e8 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollView.html @@ -0,0 +1,130 @@ + +ScrollView + +
NAME
+
ScrollView + - Display the visible area of a scrolled window +
+
+
CREATION
+
ScrollView pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + + + +
  -background or -bg  -borderwidth or -bd
  -cursor
  -relief
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + +
  -fill
  -foreground or -fg
  -height
  -width
  -window
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
+

+DESCRIPTION
+

+ +ScrollView displays the visible area of a scrolled window within +its scroll region. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-fill
+
+ +Specifies the fill color of the rectangle. + +
+
+
-foreground
+
+ +Specifies the color of the border of the rectangle. + +
+
+
-height
+
+ +Specifies the desired height for the ScrollView. +
+
+
-width
+
+ +Specifies the desired width for the ScrollView. +
+
+
-window
+
+ +Specifies the window to view. This widget must have -xscrollcommand and +-yscrollcommand options, and respond to xview and yview command. +In order to make ScrollView working with other scrollbar, -xscrollcommand and +-yscrollcommand options of the widget must be set before the widget is passed to +the -window option of the ScrollView (for example, if the widget is handled by +a ScrolledWindow, call setwidget before setting -window option). + +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+

BINDINGS

+ +
If mouse button 1 is pressed and dragged over the ScrollView, the top left corner of +the visible area of the scrolled window is moved proportionally to the mouse displacement. +
+
If mouse button 3 is pressed over the ScrollView, the top left corner of the visible +area is proportionally set to this point. +
+ + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollableFrame.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollableFrame.html new file mode 100644 index 00000000..f497183a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrollableFrame.html @@ -0,0 +1,194 @@ + +ScrollableFrame + +
NAME
+
ScrollableFrame + - Scrollable frame containing widget +
+
+
CREATION
+
ScrollableFrame pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
+ + + + + + +
  -background or -bg  -xscrollcommand
  -yscrollcommand
+
+Themed widget (Widget::theme true): Options -background and -bg are not available. +Modify style TFrame property -background instead. +
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + + + + + + + + + +
  -areaheight
  -areawidth
  -constrainedheight
  -constrainedwidth
  -height
  -width
  -xscrollincrement
  -yscrollincrement
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName getframe +
+
pathName see + widget + ?vert? + ?horz? +
+
pathName xview + ?arg...? +
+
pathName yview + ?arg...? +
+
+

+DESCRIPTION
+

+ +ScrollableFrame widget containing widget. + +

+

+WIDGET-SPECIFIC OPTIONS
+
-areaheight
+
+ +Specifies the height for the scrollable area. If zero, then the height +of the scrollable area is made just large enough to hold all its children. +
+
+
-areawidth
+
+ +Specifies the width for the scrollable area. If zero, then the width +of the scrollable area window is made just large enough to hold all its children. +
+
+
-constrainedheight
+
+ +Specifies whether or not the scrollable area should have the same height of the +scrolled window. If true, vertical scrollbar is not needed. + +
+
+
-constrainedwidth
+
+ +Specifies whether or not the scrollable area should have the same width of the +scrolled window. If true, horizontal scrollbar is not needed. + +
+
+
-height
+
+ +Specifies the desired height for the window in pixels. + +
+
+
-width
+
+ +Specifies the desired width for the window in pixels. + +
+
+
-xscrollincrement
+
+ +See xscrollincrement option of canvas widget. + +
+
+
-yscrollincrement
+
+ +See yscrollincrement option of canvas widget. + +
+
+

+WIDGET COMMAND
+
pathName cget + option +
+ +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
+
pathName configure + ?option? ?value option value ...? +
+ +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
+
pathName getframe +
+ +Return the pathname of the scrolled frame where widget should be created. + +
+
pathName see + widget + ?vert? + ?horz? +
+ +Arrange scrollable area to make widget visible in the window. +vert and horz specify which part of widget must be preferably +visible, in case where widget is too tall or too large to be entirely visible. +vert must be top (the default) or bottom, +and horz must be left (the default) or right. +If vert or horz is not a valid value, area is not scrolled in this direction. + +
+
pathName xview + ?arg...? +
+ +Standard command to enable horizontal scrolling of pathName. + +
+
pathName yview + ?arg...? +
+ +Standard command to enable vertical scrolling of pathName. + +
+ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrolledWindow.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrolledWindow.html new file mode 100644 index 00000000..af815813 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/ScrolledWindow.html @@ -0,0 +1,160 @@ + +ScrolledWindow + +
NAME
+
ScrolledWindow + - Generic scrolled widget +
+
+
CREATION
+
ScrolledWindow pathName ?option value...?
+
+
+
STANDARD OPTIONS
+
Not themed
+
+ + + + + + +
  -background or -bg  -borderwidth or -bd
  -relief
+
Themed
+
+ + + + + + + +
  -borderwidth or -bd  -relief
  (-bg has no effect)
+
+
+
WIDGET-SPECIFIC OPTIONS
+
+ + + + + + + + +
  -auto
  -ipad
  -managed
  -scrollbar
  -sides
  -size
+
+
+
WIDGET COMMAND
+
pathName cget + option +
+
pathName configure + ?option? ?value option value ...? +
+
pathName getframe +
+
pathName setwidget + widget +
+
+

+DESCRIPTION
+

+ +ScrolledWindow enables user to create easily a widget with its scrollbar. +Scrollbars are created by ScrolledWindow and scroll commands are automatically associated to +a scrollable widget with ScrolledWindow::setwidget. +

+

+WIDGET-SPECIFIC OPTIONS
+
-auto
+
+ +Specifies the desired auto managed scrollbar: +
  • none means scrollbar are always drawn +
  • horizontal means horizontal scrollbar is drawn as needed +
  • vertical means vertical scrollbar is drawn as needed +
  • both means horizontal and vertical scrollbars are drawn as needed (default value) +
    • +
    +
    -ipad (read-only)
    +
    + +Padding in pixels between client widget and scrollbars. +Default value: 1. +
    +
    +
    -managed (read-only)
    +
    + +If true, scrollbar are managed during creation, so their size are included in the requested size of the +ScrolledWindow. If false, they are not. +Default value: true. +
    +
    +
    -scrollbar
    +
    + +Specifies the desired scrollbar: none, horizontal, vertical +or both (default value). +
    +
    +
    -sides (read-only)
    +
    + +Side of the scrollbars. +Possible values are: ne, en, nw, wn, se (default value), es, sw, ws. +
    +
    +
    -size (read-only)
    +
    + +Size of the scrollbars in pixels. +Use 0 for standard size (default value).
    +This option has no effect if widget is themed. +
    +
    +

    +WIDGET COMMAND
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    pathName getframe +
    + +Return the pathname of the frame where the scrolled widget should be created. This command +is no longer needed. You can directly create the scrolled widget as the child +of pathName. +
    +
    pathName setwidget + widget +
    + +Associate widget to the the scrollbars. widget becomes +managed by the ScrolledWindow. The user should not attempt to manage +widget until it is no longer managed by the ScrolledWindow. +widget must be a scrollable widget, i.e. have the options +xscrollcommand/yscrollcommand and the command xview/yview, +such as canvas or text. +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectColor.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectColor.html new file mode 100644 index 00000000..87bf7529 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectColor.html @@ -0,0 +1,212 @@ + +SelectColor + +
    NAME
    +
    SelectColor + - Color selection widget +
    +
    +
    CREATION
    +
    SelectColor pathName ?option value...?
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + + + + + + + + + + + +
      -background  -color
      -command  -help
      -parent  -placement
      -title  -type
    +
    +
    +
    WIDGET COMMAND
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    SelectColor::dialog + pathName + ?option value ...? +
    +
    SelectColor::menu + pathName + placement + ?option value ...? +
    +
    SelectColor::setbasecolor + index + color +
    +
    SelectColor::setcolor + index + color +
    +
    +

    +DESCRIPTION
    +

    + +SelectColor provides a simple way to select color. It can be displayed +as a dialog box or as a menubutton. + +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -background
    +
    + +Specifies the background color of the widget. + +
    +
    +
    -color
    +
    + +Specifies the initial color used in the widget's color selectors. When modifying a +color that is used in the GUI, the value supplied is typically the existing value of +that color. + +
    +
    +
    -command
    +
    + +Specifies a command to be evaluated, with a color value appended, whenever +the color selected in the dialog changes. This facility can be used to modify +a color in the calling GUI and preview the change before deciding whether or not +to accept it. If the user selects "Cancel" in the dialog, the command is called +a final time to restore the initial color (supplied by option -color) that was +used before the dialog was opened. + +
    +
    +
    -help
    +
    + +This option takes a Boolean value. If the value is Boolean true, the SelectColor +dialog will include a balloon help for text entry and mouse operation. + +
    +
    +
    -parent
    +
    + +Parent of the Dialog. Dialog is centered in its parent. If empty, it is centered in +root window. +
    +
    +
    -placement
    +
    + +Where to place the popup color dialog when displaying it. +Must be any of: at, center, left, +right, above, or below. If -parent is specified, +placement will be in relation to the parent widget. +
    +
    +
    -title
    +
    + +Title of the Dialog toplevel. + +
    +
    +
    -type (only on widget creation)
    +
    + +Specifies the type of the SelectColor widget. Must be dialog or +popup.
    If type option is dialog, +SelectColor::create directly creates the dialog, displays it and +return an empty string if cancel button is pressed or if dialog is destroyed, +and the selected color if ok button is pressed. In all cases, dialog is +destroyed.
    If type option is popup, +SelectColor::create creates a small, popup dialog with a small set of +predefined colors and a button to activate a full color dialog.
    +The widget commands dialog and menu below are synonymes for those operation modes. + +
    +
    +

    +WIDGET COMMAND
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    SelectColor::dialog + pathName + ?option value ...? +
    + +Creates a dialog for the user to select a custom color. + +
    + +
    SelectColor::menu + pathName + placement + ?option value ...? +
    + +Creates a small, popup dialog for the user to select from a predefined list +of colors with an additional button to display a full color dialog. + +

    +placement can be any of at, center, left, +right, above, or below. If -parent is specified, +placement will be in relation to the parent widget. +

    + +
    + +
    +
    SelectColor::setbasecolor + index + color +
    + +Set the value of user predefined base color at index index to color. +index must be between 0 and 10. + +
    +
    SelectColor::setcolor + index + color +
    + +Set the value of user predefined color at index index to color. +index must be between 0 and 10. + +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectFont.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectFont.html new file mode 100644 index 00000000..49df1968 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SelectFont.html @@ -0,0 +1,152 @@ + +SelectFont + +
    NAME
    +
    SelectFont + - Font selection widget +
    +
    +
    CREATION
    +
    SelectFont pathName ?option value...?
    +
    +
    +
    STANDARD OPTIONS
    +
    + + + + +
      -background or -bg  -font
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + + + + + + + + + +
      -command
      -initialcolor
      -nosizes
      -parent
      -sampletext
      -title
      -type
    +
    +
    +
    WIDGET COMMAND
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    SelectFont::loadfont +
    +
    +

    +DESCRIPTION
    +

    + +SelectFont provides a simple way to choose font. It can be displayed +as a dialog box or as a toolbar. +
    Textual items in Dialog box uses -name options so they +can be translated to any language. Symbolic name used are +ok, cancel, font, size, style, +bold, italic, underline and overstrike. + +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -command
    +
    + +Specifies a command to call when user select a new font when SelectFont type +option is toolbar. + +
    +
    +
    -initialcolor
    +
    + +If specified, add an additional button that lets the user pick a +color. This option is ignored if type is toolbar. +
    +
    +
    -nosizes
    +
    + +If true, don't show the listbox containing valid font sizes. This +option is ignored if type is toolbar. +
    +
    +
    -parent
    +
    + +Parent of the Dialog. Dialog is centered in its parent. If empty, it is centered in +root window. +
    +
    +
    -sampletext
    +
    + +Specifies the text displayed in the preview area. + +
    +
    +
    -title
    +
    + +Title of the Dialog toplevel. + +
    +
    +
    -type
    +
    + +Specifies the type of the SelectFont widget. Must be dialog or toolbar. +
    If type option is dialog, SelectFont::create directly creates the +dialog, displays it and return an empty string if cancel button is +pressed or if dialog is destroyed, and the selected font (and color +if initialcolor) if ok button is pressed. In all cases, dialog +is destroyed. +
    If type option is toolbar, SelectFont::create returns the pathname +of the widget created. + +
    +
    +

    +WIDGET COMMAND
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    SelectFont::loadfont +
    + +Load the font available in the system. + +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Separator.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Separator.html new file mode 100644 index 00000000..c015e0a0 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Separator.html @@ -0,0 +1,77 @@ + +Separator + +
    NAME
    +
    Separator + - 3D separator widget +
    +
    +
    CREATION
    +
    Separator pathName ?option value...?
    +
    +
    +
    STANDARD OPTIONS
    +
    + + + + +
      -background or -bg  -orient
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + +
      -relief
    +
    +
    +
    WIDGET COMMAND
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    +

    +DESCRIPTION
    +

    + +Separator is a widget that display an horizontal or vertical 3-D line. + +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -relief
    +
    + +Specifies the relief of the Separator. Must be groove (the default) or ridge. + +
    +
    +

    +WIDGET COMMAND
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SpinBox.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SpinBox.html new file mode 100644 index 00000000..10c3d7cd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/SpinBox.html @@ -0,0 +1,250 @@ + +SpinBox + +
    NAME
    +
    SpinBox + - SpinBox widget +
    +
    +
    CREATION
    +
    SpinBox pathName ?option value...?
    +
    +
    +
    OPTIONS from ArrowButton
    +
    + + + + + + + + + + + + +
      -background or -bg  -disabledforeground (not themed)
      -foreground or -fg  -repeatdelay
      -repeatinterval  -state
    +
    +
    +
    OPTIONS from Entry
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      -command  -disabledforeground (not themed)
      -dragenabled  -dragendcmd
      -dragevent  -draginitcmd
      -dragtype  -dropcmd
      -dropenabled  -dropovercmd
      -droptypes  -editable
      -entrybg (see -background)  -entryfg (see -foreground)
      -exportselection  -font
      -helptext  -helptype
      -helpvar  -highlightbackground
      -highlightcolor  -highlightthickness
      -insertbackground  -insertborderwidth
      -insertofftime  -insertontime
      -insertwidth  -justify
      -selectbackground  -selectborderwidth
      -selectforeground  -show
      -state  -takefocus
      -text  -textvariable
      -width  -xscrollcommand
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + +
      -modifycmd
      -range
      -values
    +
    +
    +
    WIDGET COMMAND
    +
    pathName bind + ?arg...? +
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    pathName getvalue +
    +
    pathName setvalue + index +
    +
    +

    +DESCRIPTION
    +

    + +SpinBox widget enables the user to select a value among a list given by the values +option or a set of values defined by a mininum, a maximum and an increment. +Notice that range option defines a list of values, so getvalue and +setvalue work with both values and range. + +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -modifycmd
    +
    + +Specifies a Tcl command called when the user modify the value of the SpinBox. +
    +
    +
    -range
    +
    + +Specifies a list of three intergers (or real) describing the minimum, maximum and increment +of the SpinBox. +
    +
    +
    -values
    +
    + +Specifies the values accepted by the SpinBox. This option takes precedence over +range option. +
    +
    +

    +WIDGET COMMAND
    +
    pathName bind + ?arg...? +
    + +Set bindings on the entry widget. + +
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    pathName getvalue +
    + +Returns the index of the current text of the SpinBox in the list of values, +or -1 if it doesn't match any value. + +
    +
    pathName setvalue + index +
    + +Set the text of the SpinBox to the value indicated by index in the list of values. +index may be specified in any of the following forms: +

    +

    +
    +last +
    +Specifies the last element of the list of values. +
    first +
    +Specifies the first element of the list of values. +
    +next +
    +Specifies the element following the current (ie returned by getvalue) in the list +of values. +
    previous +
    +Specifies the element preceding the current (ie returned by getvalue) in the list +of values. +
    +@number +
    +Specifies the integer index in the list of values. +
    + +
    +

    BINDINGS

    + +When Entry of the SpinBox has the input focus, it has the following bindings, in addition +to the default Entry bindings: +
      +
    • Page up set the value of the SpinBox to the last value. +
    • Page down set the value of the SpinBox to the first value. +
    • Arrow up set the value of the SpinBox to the next value. +
    • Arrow down set the value of the SpinBox to the previous value. +
    + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/StatusBar.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/StatusBar.html new file mode 100644 index 00000000..d5f0877a --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/StatusBar.html @@ -0,0 +1,147 @@ + +StatusBar + +
    NAME
    +
    StatusBar + - status bar widget +
    +
    +
    CREATION
    +
    StatusBar pathName ?option value...?
    +
    +
    +
    STANDARD OPTIONS
    +
    + + + + + + + + + + + + +
      -background or -bg  -borderwidth or -bd
      -foreground or -fg  -orient
      -relief
      -troughcolor
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + + + + + +
      -height
      -showresize
      -ipad
      -pad
      -width +
    +
    +
    +
    WIDGET COMMAND
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    +

    +DESCRIPTION
    + +

    +StatusBar widget is a simple container widget with a corner resize control, +meant to be placed at the bottom of a toplevel dialog. +

    + +

    +WIDGET-SPECIFIC OPTIONS
    +
    -height
    +
    +Specifies the desired height for the widget. +
    +
    +
    -showresize
    +
    +Specifies whether to show the corner resize control. +
    +
    +
    -pad
    +
    +The spacing to place around the status bar. +
    +
    +
    -ipad
    +
    +The spacing to place around individual status bar items. +
    +
    +
    -width
    +
    +Specifies the desired width for the widget. +
    +
    + +

    +WIDGET COMMAND
    +
    pathName add widget + ?option value option value ...? +
    +Add a widget to the status bar. Possible options are: +
    +
    -weight
    +
    Weighting of this item for resizing (passed to grid).
    +
    -separator
    +
    Whether to use a separator for this item.
    +
    -sticky
    +
    Passed on to grid.
    +
    -pad
    +
    Override of the widget's -ipad option for this item.
    +
    +
    +
    +
    pathName cget + option +
    +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no +option is specified, returns a list describing all of the available +options for pathName. If option is specified with no +value, then the command returns a list describing the one named +option (this list will be identical to the corresponding sublist of +the value returned if no option is specified). If one or more +option-value pairs are specified, then the command modifies the +given widget option(s) to have the given value(s); in this case the command +returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. +
    +
    +
    pathName delete +widget ?widget ...? +
    +Delete a widget and associated state from the status bar.
    +
    +
    pathName getframe +
    +Get the frame widget for the status bar in which status bar items should be +created.
    + +
    +
    pathName items +
    List of items in the status bar.
    +
    + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/TitleFrame.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/TitleFrame.html new file mode 100644 index 00000000..c1b8261f --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/TitleFrame.html @@ -0,0 +1,107 @@ + +TitleFrame + +
    NAME
    +
    TitleFrame + - Frame with a title +
    +
    +
    CREATION
    +
    TitleFrame pathName ?option value...?
    +
    +
    +
    STANDARD OPTIONS
    +
    + + + + + + + + + + + + +
      -background or -bg  -borderwidth or -bd
      -font
      -foreground or -fg
      -relief
      -text
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + +
      -baseline
      -ipad
      -side
    +
    +
    +
    WIDGET COMMAND
    +
    pathName cget + option +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    pathName getframe +
    +
    +

    +DESCRIPTION
    +

    + +TitleFrame enables user to create a frame with a title like XmFrame Motif widget. +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -baseline
    +
    + +Specifies the vertical alignment of the title: top, center or bottom. +
    +
    +
    -ipad
    +
    + +Specifies a pad between the border of the frame and the user frame. +The value is in screen units. +
    +
    +
    -side
    +
    + +Specifies the horizontal alignment of the title: left, center or right. +
    +
    +

    +WIDGET COMMAND
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is specified, +returns a list describing all of the available options for pathName. +If option is specified with no value, then the command returns a list +describing the one named option (this list will be identical to the corresponding +sublist of the value returned if no option is specified). If one or +more option-value pairs are specified, then the command modifies the given widget +option(s) to have the given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    pathName getframe +
    + +Return the frame where the user can create any other widget. +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Tree.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Tree.html new file mode 100644 index 00000000..4da88748 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Tree.html @@ -0,0 +1,942 @@ + +Tree + +
    NAME
    +
    Tree + - Tree widget +
    +
    +
    CREATION
    +
    Tree pathName ?option value...?
    +
    +
    +
    STANDARD OPTIONS
    +
    + + + + + + + + + + + + + + + + + + + + + + + + +
      -background or -bg  -borderwidth or -bd
      -cursor  -highlightbackground
      -highlightcolor  -highlightthickness
      -relief  -selectbackground
      -selectforeground  -takefocus
      -xscrollcommand  -yscrollcommand
    +
    +
    +
    WIDGET-SPECIFIC OPTIONS
    +
    + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
      -closecmd  -crossfill
      -crossclosebitmap  -crosscloseimage
      -crossopenbitmap  -crossopenimage
      -deltax  -deltay
      -dragenabled  -dragendcmd
      -dragevent  -draginitcmd
      -dragtype  -dropcmd
      -dropenabled  -dropovercmd
      -dropovermode  -droptypes
      -height  -linesfill
      -linestipple  -opencmd
      -padx  -redraw
      -selectcommand  -selectfill
      -showlines  -width
    +
    + +
    +
    WIDGET COMMAND
    +
    pathName bindArea + event + script +
    +
    pathName bindImage + event + script +
    +
    pathName bindText + event + script +
    +
    pathName cget + option +
    +
    pathName closetree + node +
    +
    pathName configure + ?option? ?value option value ...? +
    +
    pathName delete + ?arg...? +
    +
    pathName edit + node + text + ?verifycmd? + ?clickres? + ?select? +
    +
    pathName exists + node +
    +
    pathName find + findinfo + ?confine? +
    +
    pathName index + node +
    +
    pathName insert + index + parent + node + ?option value...? +
    +
    pathName itemcget + node + option +
    +
    pathName itemconfigure + node + ?option? ?value option value ...? +
    +
    pathName line + node +
    +
    pathName move + parent + node + index +
    +
    pathName nodes + node + ?first? + ?last? +
    +
    pathName opentree + node +
    +
    pathName parent + node +
    +
    pathName reorder + node + neworder +
    +
    pathName see + node +
    +
    pathName selection + cmd + ?arg...? +
    +
    pathName toggle + node +
    +
    pathName visible + node +
    +
    pathName xview + ?arg...? +
    +
    pathName yview + ?arg...? +
    +
    +

    +DESCRIPTION
    +

    + +Tree widget uses canvas to display a hierarchical list of items (called nodes). +Each node is composed of a label with its own font and foreground attributes, and an optional +image or window. Each node can have a list of subnodes, which can be collapsed or expanded. +Each node is drawn in a single line, whose height is defined by the +deltay option, so they must have at most this height. +A node is uniquely identified by a string given at creation (by the +insert command). The node named root is the root of +the tree and is not drawn. +The tree structure is directly maintained by the widget. + +

    +

    +WIDGET-SPECIFIC OPTIONS
    +
    -closecmd
    +
    + +Specifies a command to be called when user close a node. The +closed node is appended to the command. + +
    +
    + +
    +
    -crossfill
    +
    + Specifies a foreground color for the cross bitmap. +
    +
    + +
    -crossclosebitmap
    +
    + Specifies a bitmap to be displayed in place of the standard cross + when a node is closed. +
    +
    + +
    -crosscloseimage
    +
    + Specifies an image to be displayed in place of the standard cross + when a node is closed. Overrides the -crossclosebitmap option. +
    +
    + +
    -crossopenbitmap
    +
    + Specifies a bitmap to be displayed in place of the standard cross + when a node is open. +
    +
    + +
    -crossopenimage
    +
    + Specifies an image to be displayed in place of the standard cross + when a node is open. Overrides the -crossopenbitmap option. +
    +
    + +
    -deltax
    +
    + +Specifies horizontal indentation between a node and its children. + +
    +
    +
    -deltay
    +
    + +Specifies vertical size of the nodes. + +
    +
    +
    -dragenabled
    +
    +A boolean specifying if drag is enabled. +
    +
    +
    -dragendcmd
    +
    + +Specifies a command to be called when drag ended. +dragendcmd must be a command conforming to the description of the +option dragendcmd of DragSite::register. + +
    +
    +
    -dragevent
    +
    + +Specifies the number of the mouse button associated to the drag. +Must be 1, 2 or 3. + +
    +
    +
    -draginitcmd
    +
    + +Tree has a command wrapper for drag-init events. This command refused the drag +if no node is designated. In other cases: +
    If draginitcmd is empty, it returns: +
      +
    • the value of option dragtype or TREE_NODE if empty as the data type, +
    • {copy move link} as the operations, +
    • the node identifier as the data. +
    +If draginitcmd is not empty, it is called with the following arguments: +
      +
    • the pathname of the tree, +
    • the identifier of the dragged node, +
    • the toplevel created to represent dragged data. +
    +and must return a value conforming to draginitcmd option described in +DragSite::register. + +
    +
    +
    -dragtype
    +
    + +Specifies an alternate type of dragged object. + +
    +
    +
    -dropcmd
    +
    + +Tree has a command wrapper for drop events. This command stops auto scrolling +and extract node and position. +
    If dropcmd is not empty, it is called with the following arguments: +
      +
    • the pathname of the tree, +
    • the pathname of the drag source, +
    • a list describing where the drop occurs. It can be: +
        +
      • {widget}, +
      • {node node} or +
      • {position node index}. +
      +
    • the current operation, +
    • the data type, +
    • the data. +
    + + +
    +
    +
    -dropenabled
    +
    +A boolean specifying if drop is enabled. +
    +
    +
    -dropovercmd
    +
    + +Tree has a command wrapper for drag-over events. This command enables auto scrolling +and position extraction during the drag-over. +If dropovercmd is not empty, the command is called with the following aguments: +
      +
    • the pathname of the tree, +
    • the pathname of the drag source, +
    • a list describing where the drop can occur, whose elements are: +
        +
      • the string widget if dropovertype option contains w, else empty string. +
      • the targeted node if drag icon points a node and dropovertype option contains n, else empty string. +
      • a list containing a node and the position within the children of the node where drag +icon points to if dropovertype option contains p, else empty string. +
      • optionally, the preferred method if drop can occur both inside a node and between two +nodes. The value is position or node. +
      +
    • the current operation, +
    • the data type, +
    • the data. +
    +The command must return a list with two elements: +
      +
    • the drop status, conforming to those described in dropovercmd option of +DropSite::register, +
    • the choosen method: widget, node or position. +
    + +
    +
    +
    -dropovermode
    +
    + +Specifies the type of drop-over interaction. Must be a combination of +w, which specifies that drop can occurs everywhere on widget, +p, which specifies that drop can occurs between two nodes, +and n, which specifies that drop occurs inside nodes. + +
    +
    +
    -droptypes
    +
    + +Specifies a list of accepted dropped object/operation. +See option droptypes of +DropSite::register. +for more infromation. + +
    Default is TREE_NODE with operations copy and move. + +
    +
    +
    -height
    +
    + +Specifies the desired height for the tree in units of deltay pixels. + +
    +
    +
    -linesfill
    +
    + +Specifies a foreground color for the lines between nodes. + +
    +
    +
    -linestipple
    +
    + +Specifies a stipple bitmap for the lines between nodes. + +
    +
    +
    -opencmd
    +
    + +Specifies a command to be called when the user opens a node. The name +of the opened node is appended to the command. + +
    +
    +
    -padx
    +
    + +Specifies distance between image or window and text of the nodes. + +
    +
    +
    -redraw
    +
    + +Specifies wether or not the tree should be redrawn when entering idle. +Set it to false if you call update while modifying the tree. + +
    +
    +
    -selectcommand
    +
    + +Specifies a command to be called when the selection is changed. The +path of the tree widget and the selected nodes are appended to the +command. + +
    +
    + +
    -selectfill
    +
    + If true, the selection box will be drawn across the entire tree from + left-to-right instead of just around the item text. +
    +
    + +
    -showlines
    +
    + +Specifies whether or not lines should be drawn between nodes. + +
    +
    +
    -width
    +
    + +Specifies the desired width for the tree in units of 8 pixels. + +
    +
    +

    + +NODE NAMES
    +

    +Certain special characters in node names are automatically substituted +by the tree during operation. These characters are & | ^ ! :. +They are internally substituted by non printable characters \1 to \5. +This is only to avoid errors because the characters are special to the tree widget. +In consequence, the characters \1 to \5 are not unique in node names and should be avoided. +

    +

    Note: until BWidget 1.9.16, a double colon ("::") was substituded by \5 and the +single colon (":") lead to an error. This change is incompatible in the sense, that +the generated node name changed between the versions. +

    + +WIDGET COMMAND
    +
    pathName bindArea + event + script +
    + +This command associates a command to execute whenever the event +sequence given by event occurs anywhere within the Tree area. +
    +
    pathName bindImage + event + script +
    + +This command associates a command to execute whenever the event +sequence given by event occurs on the image of a node. +The node idenfier on which the event occurs is appended to the command and may be used to manipulate the tree (e.g. don't use %W). + +

    +If -selectfill is given, an eventual binding of the background box by bindText is overwritten. +

    +
    +
    pathName bindText + event + script +
    + +This command associates a command to execute whenever the event +sequence given by event occurs on the label of a node. +The node idenfier on which the event occurs is appended to the command and may be used to manipulate the tree (e.g. don't use %W). + +

    +If -selectfill is given, an eventual binding of the background box by bindImage is overwritten. +

    +
    +
    pathName cget + option +
    + +Returns the current value of the configuration option given by option. +Option may have any of the values accepted by the creation command. +
    +
    pathName closetree node +?recurse? +
    + +This command close all the subtree given by node. Recurse +through the tree starting at node and set open option to 0 +depending on recurse. Default value of recurse is true. + +
    +
    pathName configure + ?option? ?value option value ...? +
    + +Query or modify the configuration options of the widget. If no option is +specified, returns a list describing all of the available options for +pathName. If option is specified with no value, then the +command returns a list describing the one named option (this list will +be identical to the corresponding sublist of the value returned if no +option is specified). If one or more option-value pairs are +specified, then the command modifies the given widget option(s) to have the +given value(s); in this case the command returns an empty string. +Option may have any of the values accepted by the creation command. +Read-only options are not be modified. + +
    +
    pathName delete + ?arg...? +
    + +Deletes all nodes (and children of them) in arg. arg can be a list +of nodes or a list of list of nodes. +To delete all the tree, do $pathName delete [$pathName nodes root]. + +
    +
    pathName edit + node + text + ?verifycmd? + ?clickres? + ?select? +
    + +Provides a way for the user to edit in place the label of a node. This is +possible only if node is visible (all its parents are open). +
    The command takes the initial text as argument and does not modify the label of the +edited node, but returns an empty string if edition is canceled, or the typed text +if edition is accepted. +
    When editing, the user can cancel by pressing Escape, or accept by pressing Return. +
    clickres specifies what to do if the user click outside the editable area. +If clickres is 0 (the default), the edition is canceled. +If clickres is 1, the edition is accepted. +In all other case, the edition continues. +
    If edition is accepted and modifycmd is not empty, then it is called with +the new text as argument and must return 1 to accept the new text, 0 to refuse it +and continue edition. +
    select specifies wether or not the initial text should be selected. Default is 1. + +
    +
    pathName exists + node +
    + +Returns whether or not node exists in the tree. + +
    +
    pathName find + findinfo + ?confine? +
    + +

    +Returns the node given by the position findinfo. +findinfo can take the form of a pixel position @x,y or +of the line number of a currently visible Tree node. The first line +of the Tree has the value of zero. +

    + +

    +If confine is non-empty, then confine findinfo to only +match pixel positions for the area consumed by Tree labels, not just +anywhere on their lines. (confine has no effect if +findinfo is a line number.) +

    + +
    +
    pathName index + node +
    + +Returns the position of node in its parent. + +
    +
    pathName insert + index + parent + node + ?option value...? +
    + +

    +Inserts a new node identified by node in the children list of +parent at position index. +

    + +

    +Any instance of #auto within the node name will be replaced by the +number of the item in the order of insertion. The non-printable characters +\1 to \5 are reserved for internal use and should not be present in node +names. +

    + + +

    +

    -anchor
    +
    + Specifies the anchor of the image or window of the node. Defaults to w. +
    +
    + +
    -data
    +
    + +User data associated to the node. + +
    +
    +
    -deltax
    +
    + +Specifies the horizontal indentation of the node. If the value is -1, the +node will be drawn with the deltax for the entire tree. + +
    +
    +
    -drawcross
    +
    + +Specifies how the cross used to expand or collapse the children of a node +should be drawn. +Must be one of auto, always or never. +
    If auto, the cross is drawn only if the node has children. +If always, the cross is always drawn. +If never, the cross is never drawn. +To maintain compatibility with older versions of this widget, +allways is a deprecated synonym to always. + +
    +
    +
    -fill
    +
    + +Specifies the foreground color of the label of the node. + +
    +
    +
    -font
    +
    + +Specifies a font for the label of the node. + +
    +
    +
    -helpcmd
    +
    + +If specified, refers to a command to execute to get the help text to display. +The command must return a string to display. +If the command returns an empty string, no help is displayed. +See also DynamicHelp. +
    +
    +
    -helptext
    +
    + +Text for dynamic help. +See also DynamicHelp. +
    +
    +
    -helptype
    +
    +Type of dynamic help. Use balloon or variable. +See also DynamicHelp. +
    +
    +
    -helpvar
    +
    +Variable to use when helptype option is variable. +See also DynamicHelp. +
    +
    +
    -image
    +
    + +Specifies an image to display at the left of the label of the node. +window option override image. +
    +
    +
    -open
    +
    + +Specifies wether or not the children of the node should be drawn. + +
    +
    +
    -padx
    +
    + +Specifies the distance between image or window and the text of the node. If +the value is -1, the node will be drawn with the padx for the entire tree. + +
    +
    +
    -selectable
    +
    + +Specifies if the node can be selected or not. + +
    +
    +
    -text
    +
    + +Specifies the label of the node. + +
    +
    +
    -window
    +
    + +Specifies a pathname to display at the left of the label of the node. +window option override image. +
    +
    +
    +
    pathName itemcget + node + option +
    + +Returns the current value of a configuration option for the item. +Option may have any of the values accepted by the item creation command. + +
    +
    pathName itemconfigure + node + ?option? ?value option value ...? +
    + +This command is similar to the configure command, except that it applies to the +options for an individual item, whereas configure applies to the options for +the widget as a whole. Options may have any of the values accepted by the +item creation widget command. If options are specified, options are modified as indicated +in the command and the command returns an empty string. If no options are specified, +returns a list describing the current options for the item. +Read-only options are not be modified. + +
    +
    pathName line + node +
    + +

    +Returns the line number where node was drawn. If the node is +not visible then return -1. The first line of the tree has the value +of 0. +

    + +
    +
    pathName move + parent + node + index +
    + +Moves node to the children list of parent at position index. +parent can not be a descendant of node. + +
    +
    pathName nodes + node + ?first? + ?last? +
    + +Returns parts of the children of node, following first and last.
    +If first and last are omitted, returns the list of all children. +If first is specified and last omitted, returns the child at index +first, or an empty string if first refers to a non-existent element. +If first and last are specified, the command returns a list whose elements +are all of the children between first and last, +inclusive. Both first and last may have any of the standard +forms for indices. + +
    +
    pathName opentree node ?recurse? + +
    + +This command open all the subtree given by node. Recurse through the +tree starting at node and set open option to 1 depending on value +of recurse. Default value of recurse is true. + +
    +
    pathName parent + node +
    + +Returns the parent of node. + +
    +
    pathName reorder + node + neworder +
    + +Modifies the order of children of node given by neworder. Children of +node that do not appear in neworder are no moved. + +
    +
    pathName see + node +
    + +Arrange the scrolling area to make node visible. + +
    +
    pathName selection + cmd + ?arg...? +
    + +Modifies the list of selected nodes following cmd: +
    +
    add +
    Adds all nodes in arg to the selection. +
    clear +
    Removes all nodes from the selection. +
    get +
    Returns a list containing the indices of current selected nodes. +
    includes +
    Tests if the specified node is selected. Returns true if the answer is yes, and false else. +
    range +
    Sets the selection to all nodes between the two specified ones. +
    remove +
    Removes all nodes in arg from the selection. +
    set +
    Sets the selection to all nodes in arg. +
    toggle +
    Toggles the selection status of all nodes in arg. +
    + +The subcommands add, range, and set silently +ignore nodes which are declared unselectable. See the node option +-selectable to influence this. + +
    + +
    + +
    pathName toggle + node +
    + Toggle the open/close status of the given node. +
    + +
    pathName visible + node +
    + +Returns whether or not node is visible (all its parents are open). + +
    +
    pathName xview + ?arg...? +
    + +Standard command to enable horizontal scrolling of pathName. + +
    +
    pathName yview + ?arg...? +
    + +Standard command to enable vertical scrolling of pathName. + +
    + +BINDINGS
    + +

    +A <<TreeSelect>> virtual event is generated any time the +selection in the tree changes. This is the default behavior of an +item in the tree, but it can be overridden with the bindText or +bindImage command. If the button 1 binding is overridden, this event may +not be generated. +

    + +

    +The tree has all the standard mouse wheel bindings when it has focus. +

    + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Widget.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Widget.html new file mode 100644 index 00000000..27b274cb --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/Widget.html @@ -0,0 +1,505 @@ + +Widget + + Under construction ...
    +
    NAME
    +
    Widget + - The Widget base class +
    +
    +
    COMMAND
    +
    Widget::addmap + class + subclass + subpath + options +
    +
    Widget::bwinclude + class + subclass + subpath + ?arg...? +
    +
    Widget::cget + path + option +
    +
    Widget::configure + path + options +
    +
    Widget::create + class + path + ?rename? +
    +
    Widget::declare + class + optlist +
    +
    Widget::define + class + filename + ?class ...? +
    +
    Widget::destroy + path +
    +
    Widget::focusNext + w +
    +
    Widget::focusOK + w +
    +
    Widget::focusPrev + w +
    +
    Widget::generate-doc + dir + widgetlist +
    +
    Widget::generate-widget-doc + class + iscmd + file +
    +
    Widget::getoption + path + option +
    +
    Widget::getVariable + path + varName + ?myVarName? +
    +
    Widget::hasChanged + path + option + pvalue +
    +
    Widget::init + class + path + options +
    +
    Widget::setoption + path + option + value +
    +
    Widget::subcget + path + subwidget +
    +
    Widget::syncoptions + class + subclass + subpath + options +
    +
    Widget::tkinclude + class + tkwidget + subpath + ?arg...? +
    +
    +

    +DESCRIPTION
    +

    + +The Widget namespace handle data associated to all BWidget and provide commands +to easily define BWidget. +
    For commands can be used to define a BWidget: +tkinclude, bwinclude, declare, addmap and syncoptions. +Here is the definition of ComboBox widget: +

    +

    + + +
    +namespace eval ComboBox {
+    # We're using ArrowButton, Entry and LabelFrame
+    ArrowButton::use
+    Entry::use
+    LabelFrame::use
+
+    # Include resources of LabelFrame
+    Widget::bwinclude ComboBox LabelFrame .labf \ 
+        rename     {-text -label} \ 
+        remove     {-focus} \ 
+        prefix     {label -justify -width -anchor -height -font} \ 
+        initialize {-relief sunken -borderwidth 2}
+
+    # Include resources of Entry
+    Widget::bwinclude ComboBox Entry .e \ 
+        remove {-relief -bd -borderwidth -bg -fg} \ 
+        rename {-foreground -entryfg -background -entrybg}
+
+    # Declare new resources
+    Widget::declare ComboBox {
+        {-height      TkResource 0  0 listbox}
+        {-values      String     "" 0}
+        {-modifycmd   String     "" 0}
+        {-postcommand String     "" 0}
+    }
+
+    # Map resources to subwidget
+    Widget::addmap ComboBox "" :cmd {-background {}}
+    Widget::addmap ComboBox ArrowButton .a \ 
+        {-foreground {} -background {} -disabledforeground {} -state {}}
+
+    # Synchronize subwidget options
+    Widget::syncoptions ComboBox Entry .e {-text {}}
+    Widget::syncoptions ComboBox LabelFrame .labf {-label -text -underline {}}
+
+    proc use {} {}
+}
    +
    + +

    +

    +COMMAND
    +
    Widget::addmap + class + subclass + subpath + options +
    + +This command map some resources to subwidget. +Mapped resources automatically configure subwidget when widget is configured. +
      +
    • class is the class of the new BWidget +
    • subclass is the class the subwidget (BWidget class, e.g Entry, or empty for Tk widget) +
    • subpath is the path of the subwidget +
    • options is the list {option realres ...} of options to map to subwidget +
    +
    +
    Widget::bwinclude + class + subclass + subpath + ?arg...? +
    + +This command includes into a new BWidget the resources of another BWidget. +Arguments are: +
      +
    • class class of the new widget +
    • subclass class name of the BWidget to be included +
    • subpath path of the widget to configure when BWidget is configured +
    • options is: +
        +
      • include {option option ...} +
        list of options to include (all if not defined) +
      • remove {option option ...} +
        list of options to remove +
      • rename {option name option name ...} +
        list of options to rename +
      • prefix {prefix option option ...} +
        pefix all option by prefix +
      • initialize {option value option value ...} +
        default value of options +
      • readonly {option value option value ...} +
        new readonly flag +
    +
    +
    Widget::cget + path + option +
    + +Returns the value of option of BWidget path. cget tests the option +existence and takes care of synchronization with subwidget. +Typically called by the BWidget cget command. + +
    +
    Widget::configure + path + options +
    +Description text +
    + +
    Widget::create + class + path + ?rename? +
    + The standard method for creating a BWidget. The real widget path + is renamed to $path:cmd, and a new proc is created to replace the + path which points to the BWidget's commands. + +

    + If rename is false, the path will not be renamed, but the + proc will still be created. This is useful when inheriting another + BWidget who will already have renamed the widget. +

    + +

    + The command returns the widget path. This command is usually the + last command executed in the ::create command for the widget. +

    +
    + +
    Widget::declare + class + optlist +
    + +This command declare new resources for a BWidget. +
      +
    • class is class of the new widget +
    • options is the list describing new options. Each new option is a list +{option type value ro ?args?} where: +
        +
      • option is the name of the option +
      • type is the type of the option +
      • value is the default value of the option +
      • ro is the readonly flag of the option +
      • args depends on type +
    +
    +type can be: +
    +
    +
    TkResource
    +
    +value of option denotes a resource of a Tk widget. args must be class or +{class realoption}. class is the creation command of the Tk widget, e.g. +entry. +The second form must be used if option has not the same name in Tk widget, +but realoption. +
    If value is empty, it is initialized to the default value of the Tk widget. +
    + +
    BwResource
    +
    +value of option denotes a resource of a BWidget. args must be class or +{class realoption}. class is the name of the namespace of the BWidget, e.g. +LabelFrame. +The second form must be used if option has not the same name in BWidget, +but realoption. +
    If value is empty, it is initialized to the default value of the BWidget. +
    + +
    Int
    +
    value of option is an integer. +args can be {?min? ?max?} to force it to be in a range. The test is +[expr $option > $min] && [expr $option < $max] so +if args is {0 10}, value must be beetween 0 and 10 exclude, +if args is {=0 =10} , value must be beetween 0 and 10 include. +
    + +
    Boolean
    +
    value of option is a boolean. True values can be 1, true or yes. +False values can be 0, false or no. Widget::cget always return +0 or 1. +
    + +
    Enum
    +
    +value of option is a element of a enumeration. args must be the list +of enumeration, e.g. {top left bottom right}. +
    + +
    Flag
    +
    +value of option is a combination of a set of chars. args must be a +string defining the set. +
    + +
    String
    +
    +
    value of option is any uncontrolled string. +
    + +
    Synonym
    +
    +
    option is a synonym of option args. value has no effect here. +
    +
    +
    + +
    Widget::define + class + filename + ?class ...? +
    + +

    + This command is used to define a new BWidget class. It is + usually the first command executed in a new widget definition. +

    + +
      +
    • class is the name of the new widget class.
      • +
    • filename is the name of the file (without extension) in the + BWidget distribution that defines this class.
      • +
    • ?-classonly? If present, the class is not setup.
      • +
    • ?-namespace ns? The namespace where the widget's procedures live + in; defaults to the class name.
      • +
    + +

    + Each class defined after the filename is a class that this widget + depends on. The ::use command will be called for each of these + classes after the new widget has been defined. +

    + +

    + If -classonly option is not given this command does several things to + setup the new class. First, it creates an alias in the global namespace for + the name of the class that points to the class's ::create subcommand. + Second, it defines a ::use subcommand for the class which other classes can + use to load this class on the fly. Lastly, it creates a default binding to + the <Destroy> event for the class that calls Widget::destroy on the + path. This is the default setup for almost all widgets in the BWidget + package. +

    + +
    + +
    Widget::destroy + path +
    +Description text +
    +
    Widget::focusNext + w +
    +Description text +
    +
    Widget::focusOK + w +
    +Description text +
    +
    Widget::focusPrev + w +
    +Description text +
    +
    Widget::generate-doc + dir + widgetlist +
    +Description text +
    +
    Widget::generate-widget-doc + class + iscmd + file +
    +Description text +
    +
    Widget::getoption + path + option +
    + +Returns the value of option of BWidget path. This command does not test +option existence, does not handle synonym and does not take care of synchronization with +subwidget. + +
    +
    Widget::getVariable + path + varName + ?myVarName? +
    + +

    +Make the variable varName relational to path accessible in +the current procedure. The variable will be created in the widget namespace +for path and can be used for storing widget-specific information. +When path is destroyed, any variable accessed in this manner will be +destroyed with it. +

    + +

    +If myVarName is specified, the variable will be accessible in the +current procedure as that name. +

    + +
    +
    Widget::hasChanged + path + option + pvalue +
    +Description text +
    +
    Widget::init + class + path + options +
    +Description text +
    +
    Widget::setoption + path + option + value +
    + +Set the value of option of BWidget path without option test, subwidget mapping, +synonym handling and does not set the modification flag. + +
    +
    Widget::subcget + path + subwidget +
    + +Returns the list of all option/value of BWidget path that are mapped to subwidget. + +
    +
    Widget::syncoptions + class + subclass + subpath + options +
    + +This command synchronize options value of a subwidget. +Used when an option of a subwidget is modified out of the BWidget configure command. +
      +
    • class is the class of the new BWidget +
    • subclass is the class the subwidget (BWidget class, e.g Entry, or empty for Tk widget) +
    • subpath is the path of the subwidget +
    • options is the list {option realres ...} of options to synchronize +with subwidget +
    +
    +
    Widget::tkinclude + class + tkwidget + subpath + ?arg...? +
    + +This command includes into a new BWidget the resources of a Tk widget. +Arguments are: +
      +
    • class class of the new widget +
    • tkwidger command name of the Tk widget to be included +
    • subpath path of the widget to configure when BWidget is configured +
    • options is: +
        +
      • include {option option ...} +
        list of options to include (all if not defined) +
      • remove {option option ...} +
        list of options to remove +
      • rename {option name option name ...} +
        list of options to rename +
      • prefix {prefix option option ...} +
        pefix all option by prefix +
      • initialize {option value option value ...} +
        default value of options +
      • readonly {option value option value ...} +
        new readonly flag +
    +
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/contents.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/contents.html new file mode 100644 index 00000000..0b9a49af --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/contents.html @@ -0,0 +1,95 @@ + +

    Simple Widgets +
    + + + + + + + + + + + + + + +
    LabelLabel widget with state option, dynamic help and drag and drop facilities
    EntryEntry widget with state option, dynamic help and drag and drop facilities
    ButtonButton widget with enhanced options
    ArrowButtonButton widget with an arrow shape.
    ProgressBarProgress indicator widget
    ScrollViewDisplay the visible area of a scrolled window
    Separator3D separator widget
    +

    Manager Widgets +
    + + + + + + + + + + + + + + + + + + + + + + + + +
    MainFrameManage toplevel with menu, toolbar and statusbar
    LabelFrameFrame with a Label
    TitleFrameFrame with a title (consider Tk 8.4+ labelframe instead)
    PanelFrameFrame with a boxed title area
    ScrolledWindowGeneric scrolled widget
    ScrollableFrameScrollable frame containing widget
    PanedWindowTiled layout manager widget (consider Tk 8.4+ panedwindow instead)
    ButtonBoxSet of buttons with horizontal or vertical layout
    PagesManagerPages manager widget
    NoteBookNotebook manager widget
    DialogDialog abstraction with custom buttons
    StatusBarStatus bar widget with resize control
    +

    Composite Widgets +
    + + + + + + + + + + + + + + + + + + + + +
    LabelEntry +LabelFrame containing an Entry widget. +
    ComboBoxComboBox widget
    SpinBoxSpinBox widget (consider Tk 8.4+ spinbox instead)
    TreeTree widget
    ListBoxListBox widget
    MessageDlgMessage dialog box
    ProgressDlgProgress indicator dialog box
    PasswdDlgLogin/Password dialog box
    SelectFontFont selection widget
    SelectColorColor selection widget
    +

    Commands Classes +
    + + + + + + + + + + +
    WidgetThe Widget base class
    DynamicHelpProvide help to Tk widget or BWidget
    DragSiteCommands set for Drag facilities
    DropSiteCommands set for Drop facilities
    BWidgetDescription text
    +
    + +

    Load BWidget

    + +Possible load sequence: +
    +# If package msgcat is available, its locale is used for BWidget
+package require msgcat
+# load BWidget
+package require BWidget
+
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/index.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/index.html new file mode 100644 index 00000000..e928fe2f --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/index.html @@ -0,0 +1,7 @@ + +BWidget Manual Pages + + + + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/navtree.html b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/navtree.html new file mode 100644 index 00000000..73853943 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/navtree.html @@ -0,0 +1,41 @@ + +Brief description
    +Simple Widgets
    +  Label
    +  Entry
    +  Button
    +  ArrowButton
    +  ProgressBar
    +  ScrollView
    +  Separator
    +Manager Widgets
    +  MainFrame
    +  LabelFrame
    +  TitleFrame
    +  PanelFrame
    +  ScrolledWindow
    +  ScrollableFrame
    +  PanedWindow
    +  ButtonBox
    +  PagesManager
    +  NoteBook
    +  Dialog
    +  StatusBar
    +Composite Widgets
    +  LabelEntry
    +  ComboBox
    +  SpinBox
    +  Tree
    +  ListBox
    +  MessageDlg
    +  ProgressDlg
    +  PasswdDlg
    +  SelectFont
    +  SelectColor
    +Commands Classes
    +  Widget
    +  DynamicHelp
    +  DragSite
    +  DropSite
    +  BWidget
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/options.htm b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/options.htm new file mode 100644 index 00000000..cc2605b2 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/BWman/options.htm @@ -0,0 +1,458 @@ +Tk Built-In Commands - options manual page + +
    +
    NAME +
    options - Standard options supported by widgets
    +
    DESCRIPTION +
    +
    -activebackground, activeBackground, Foreground +
    -activeborderwidth, activeBorderWidth, BorderWidth +
    -activeforeground, activeForeground, Background +
    -anchor, anchor, Anchor +
    -background or -bg, background, Background +
    -bitmap, bitmap, Bitmap +
    -borderwidth or -bd, borderWidth, BorderWidth +
    -cursor, cursor, Cursor +
    -disabledbackground, disabledBackground, DisabledBackground +
    -disabledforeground, disabledForeground, DisabledForeground +
    -exportselection, exportSelection, ExportSelection +
    -font, font, Font +
    -foreground or -fg, foreground, Foreground +
    -highlightbackground, highlightBackground, HighlightBackground +
    -highlightcolor, highlightColor, HighlightColor +
    -highlightthickness, highlightThickness, HighlightThickness +
    -image, image, Image +
    -insertbackground, insertBackground, Foreground +
    -insertborderwidth, insertBorderWidth, BorderWidth +
    -insertofftime, insertOffTime, OffTime +
    -insertontime, insertOnTime, OnTime +
    -insertwidth, insertWidth, InsertWidth +
    -jump, jump, Jump +
    -justify, justify, Justify +
    -orient, orient, Orient +
    -padx, padX, Pad +
    -pady, padY, Pad +
    -relief, relief, Relief +
    -repeatdelay, repeatDelay, RepeatDelay +
    -repeatinterval, repeatInterval, RepeatInterval +
    -selectbackground, selectBackground, Foreground +
    -selectborderwidth, selectBorderWidth, BorderWidth +
    -selectforeground, selectForeground, Background +
    -setgrid, setGrid, SetGrid +
    -takefocus, takeFocus, TakeFocus +
    -text, text, Text +
    -textvariable, textVariable, Variable +
    -troughcolor, troughColor, Background +
    -underline, underline, Underline +
    -wraplength, wrapLength, WrapLength +
    -xscrollcommand, xScrollCommand, ScrollCommand +
    -yscrollcommand, yScrollCommand, ScrollCommand +
    +
    KEYWORDS +
    +

    NAME

    +options - Standard options supported by widgets +

    DESCRIPTION

    +This manual entry describes the common configuration options supported +by widgets in the Tk toolkit. Every widget does not necessarily support +every option (see the manual entries for individual widgets for a list +of the standard options supported by that widget), but if a widget does +support an option with one of the names listed below, then the option +has exactly the effect described below. +

    +In the descriptions below, ``Command-Line Name'' refers to the +switch used in class commands and configure widget commands to +set this value. For example, if an option's command-line switch is +-foreground and there exists a widget .a.b.c, then the +command +

    .a.b.c  configure  -foreground black
    +may be used to specify the value black for the option in the +the widget .a.b.c. Command-line switches may be abbreviated, +as long as the abbreviation is unambiguous. +``Database Name'' refers to the option's name in the option database (e.g. +in .Xdefaults files). ``Database Class'' refers to the option's class value +in the option database. +
    +
    Command-Line Name: -activebackground +
    Database Name: activeBackground +
    Database Class: Foreground +
    Specifies background color to use when drawing active elements. +An element (a widget or portion of a widget) is active if the +mouse cursor is positioned over the element and pressing a mouse button +will cause some action to occur. +If strict Motif compliance has been requested by setting the +tk_strictMotif variable, this option will normally be +ignored; the normal background color will be used instead. +For some elements on Windows and Macintosh systems, the active color +will only be used while mouse button 1 is pressed over the element. +

    Command-Line Name: -activeborderwidth +
    Database Name: activeBorderWidth +
    Database Class: BorderWidth +
    Specifies a non-negative value indicating +the width of the 3-D border drawn around active elements. See above for +definition of active elements. +The value may have any of the forms acceptable to Tk_GetPixels. +This option is typically only available in widgets displaying more +than one element at a time (e.g. menus but not buttons). +

    Command-Line Name: -activeforeground +
    Database Name: activeForeground +
    Database Class: Background +
    Specifies foreground color to use when drawing active elements. +See above for definition of active elements. +

    Command-Line Name: -anchor +
    Database Name: anchor +
    Database Class: Anchor +
    Specifies how the information in a widget (e.g. text or a bitmap) +is to be displayed in the widget. +Must be one of the values n, ne, e, se, +s, sw, w, nw, or center. +For example, nw means display the information such that its +top-left corner is at the top-left corner of the widget. +

    Command-Line Name: -background or -bg +
    Database Name: background +
    Database Class: Background +
    Specifies the normal background color to use when displaying the +widget. +

    Command-Line Name: -bitmap +
    Database Name: bitmap +
    Database Class: Bitmap +
    Specifies a bitmap to display in the widget, in any of the forms +acceptable to Tk_GetBitmap. +The exact way in which the bitmap is displayed may be affected by +other options such as anchor or justify. +Typically, if this option is specified then it overrides other +options that specify a textual value to display in the widget; +the bitmap option may be reset to an empty string to re-enable +a text display. +In widgets that support both bitmap and image options, +image will usually override bitmap. +

    Command-Line Name: -borderwidth or -bd +
    Database Name: borderWidth +
    Database Class: BorderWidth +
    Specifies a non-negative value indicating the width +of the 3-D border to draw around the outside of the widget (if such a +border is being drawn; the relief option typically determines +this). The value may also be used when drawing 3-D effects in the +interior of the widget. +The value may have any of the forms acceptable to Tk_GetPixels. +

    Command-Line Name: -cursor +
    Database Name: cursor +
    Database Class: Cursor +
    Specifies the mouse cursor to be used for the widget. +The value may have any of the forms acceptable to Tk_GetCursor. +

    Command-Line Name: -disabledforeground +

    Command-Line Name: -disabledbackground +
    Database Name: disabledBackground +
    Database Class: DisabledBackground +
    Specifies background color to use when drawing a disabled element. +If the option is specified as an empty string (which is typically the +case on monochrome displays), disabled elements are drawn with the +normal background color but they are dimmed by drawing them +with a stippled fill pattern. +
    Database Name: disabledForeground +
    Database Class: DisabledForeground +
    Specifies foreground color to use when drawing a disabled element. +If the option is specified as an empty string (which is typically the +case on monochrome displays), disabled elements are drawn with the +normal foreground color but they are dimmed by drawing them +with a stippled fill pattern. +

    Command-Line Name: -exportselection +
    Database Name: exportSelection +
    Database Class: ExportSelection +
    Specifies whether or not a selection in the widget should also be +the X selection. +The value may have any of the forms accepted by Tcl_GetBoolean, +such as true, false, 0, 1, yes, or no. +If the selection is exported, then selecting in the widget deselects +the current X selection, selecting outside the widget deselects any +widget selection, and the widget will respond to selection retrieval +requests when it has a selection. The default is usually for widgets +to export selections. +

    Command-Line Name: -font +
    Database Name: font +
    Database Class: Font +
    Specifies the font to use when drawing text inside the widget. +

    Command-Line Name: -foreground or -fg +
    Database Name: foreground +
    Database Class: Foreground +
    Specifies the normal foreground color to use when displaying the widget. +

    Command-Line Name: -highlightbackground +
    Database Name: highlightBackground +
    Database Class: HighlightBackground +
    Specifies the color to display in the traversal highlight region when +the widget does not have the input focus. +

    Command-Line Name: -highlightcolor +
    Database Name: highlightColor +
    Database Class: HighlightColor +
    Specifies the color to use for the traversal highlight rectangle that is +drawn around the widget when it has the input focus. +

    Command-Line Name: -highlightthickness +
    Database Name: highlightThickness +
    Database Class: HighlightThickness +
    Specifies a non-negative value indicating the width of the highlight +rectangle to draw around the outside of the widget when it has the +input focus. +The value may have any of the forms acceptable to Tk_GetPixels. +If the value is zero, no focus highlight is drawn around the widget. +

    Command-Line Name: -image +
    Database Name: image +
    Database Class: Image +
    Specifies an image to display in the widget, which must have been +created with the image create command. +Typically, if the image option is specified then it overrides other +options that specify a bitmap or textual value to display in the widget; +the image option may be reset to an empty string to re-enable +a bitmap or text display. +

    Command-Line Name: -insertbackground +
    Database Name: insertBackground +
    Database Class: Foreground +
    Specifies the color to use as background in the area covered by the +insertion cursor. This color will normally override either the normal +background for the widget (or the selection background if the insertion +cursor happens to fall in the selection). +

    Command-Line Name: -insertborderwidth +
    Database Name: insertBorderWidth +
    Database Class: BorderWidth +
    Specifies a non-negative value indicating the width +of the 3-D border to draw around the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +

    Command-Line Name: -insertofftime +
    Database Name: insertOffTime +
    Database Class: OffTime +
    Specifies a non-negative integer value indicating the number of +milliseconds the insertion cursor should remain ``off'' in each blink cycle. +If this option is zero then the cursor doesn't blink: it is on +all the time. +

    Command-Line Name: -insertontime +
    Database Name: insertOnTime +
    Database Class: OnTime +
    Specifies a non-negative integer value indicating the number of +milliseconds the insertion cursor should remain ``on'' in each blink cycle. +

    Command-Line Name: -insertwidth +
    Database Name: insertWidth +
    Database Class: InsertWidth +
    Specifies a value indicating the total width of the insertion cursor. +The value may have any of the forms acceptable to Tk_GetPixels. +If a border has been specified for the insertion +cursor (using the insertBorderWidth option), the border +will be drawn inside the width specified by the insertWidth +option. +

    Command-Line Name: -jump +
    Database Name: jump +
    Database Class: Jump +
    For widgets with a slider that can be dragged to adjust a value, +such as scrollbars, this option determines when +notifications are made about changes in the value. +The option's value must be a boolean of the form accepted by +Tcl_GetBoolean. +If the value is false, updates are made continuously as the +slider is dragged. +If the value is true, updates are delayed until the mouse button +is released to end the drag; at that point a single notification +is made (the value ``jumps'' rather than changing smoothly). +

    Command-Line Name: -justify +
    Database Name: justify +
    Database Class: Justify +
    When there are multiple lines of text displayed in a widget, this +option determines how the lines line up with each other. +Must be one of left, center, or right. +Left means that the lines' left edges all line up, center +means that the lines' centers are aligned, and right means +that the lines' right edges line up. +

    Command-Line Name: -orient +
    Database Name: orient +
    Database Class: Orient +
    For widgets that can lay themselves out with either a horizontal +or vertical orientation, such as scrollbars, this option specifies +which orientation should be used. Must be either horizontal +or vertical or an abbreviation of one of these. +

    Command-Line Name: -padx +
    Database Name: padX +
    Database Class: Pad +
    Specifies a non-negative value indicating how much extra space +to request for the widget in the X-direction. +The value may have any of the forms acceptable to Tk_GetPixels. +When computing how large a window it needs, the widget will +add this amount to the width it would normally need (as determined +by the width of the things displayed in the widget); if the geometry +manager can satisfy this request, the widget will end up with extra +internal space to the left and/or right of what it displays inside. +Most widgets only use this option for padding text: if they are +displaying a bitmap or image, then they usually ignore padding +options. +

    Command-Line Name: -pady +
    Database Name: padY +
    Database Class: Pad +
    Specifies a non-negative value indicating how much extra space +to request for the widget in the Y-direction. +The value may have any of the forms acceptable to Tk_GetPixels. +When computing how large a window it needs, the widget will add +this amount to the height it would normally need (as determined by +the height of the things displayed in the widget); if the geometry +manager can satisfy this request, the widget will end up with extra +internal space above and/or below what it displays inside. +Most widgets only use this option for padding text: if they are +displaying a bitmap or image, then they usually ignore padding +options. +

    Command-Line Name: -relief +
    Database Name: relief +
    Database Class: Relief +
    Specifies the 3-D effect desired for the widget. Acceptable +values are raised, sunken, flat, ridge, +solid, and groove. +The value +indicates how the interior of the widget should appear relative +to its exterior; for example, raised means the interior of +the widget should appear to protrude from the screen, relative to +the exterior of the widget. +

    Command-Line Name: -repeatdelay +
    Database Name: repeatDelay +
    Database Class: RepeatDelay +
    Specifies the number of milliseconds a button or key must be held +down before it begins to auto-repeat. Used, for example, on the +up- and down-arrows in scrollbars. +

    Command-Line Name: -repeatinterval +
    Database Name: repeatInterval +
    Database Class: RepeatInterval +
    Used in conjunction with repeatDelay: once auto-repeat +begins, this option determines the number of milliseconds between +auto-repeats. +

    Command-Line Name: -selectbackground +
    Database Name: selectBackground +
    Database Class: Foreground +
    Specifies the background color to use when displaying selected +items. +

    Command-Line Name: -selectborderwidth +
    Database Name: selectBorderWidth +
    Database Class: BorderWidth +
    Specifies a non-negative value indicating the width +of the 3-D border to draw around selected items. +The value may have any of the forms acceptable to Tk_GetPixels. +

    Command-Line Name: -selectforeground +
    Database Name: selectForeground +
    Database Class: Background +
    Specifies the foreground color to use when displaying selected +items. +

    Command-Line Name: -setgrid +
    Database Name: setGrid +
    Database Class: SetGrid +
    Specifies a boolean value that determines whether this widget controls the +resizing grid for its top-level window. +This option is typically used in text widgets, where the information +in the widget has a natural size (the size of a character) and it makes +sense for the window's dimensions to be integral numbers of these units. +These natural window sizes form a grid. +If the setGrid option is set to true then the widget will +communicate with the window manager so that when the user interactively +resizes the top-level window that contains the widget, the dimensions of +the window will be displayed to the user in grid units and the window +size will be constrained to integral numbers of grid units. +See the section GRIDDED GEOMETRY MANAGEMENT in the wm manual +entry for more details. +

    Command-Line Name: -takefocus +
    Database Name: takeFocus +
    Database Class: TakeFocus +
    Determines whether the window accepts the focus during keyboard +traversal (e.g., Tab and Shift-Tab). +Before setting the focus to a window, the traversal scripts +consult the value of the takeFocus option. +A value of 0 means that the window should be skipped entirely +during keyboard traversal. +1 means that the window should receive the input +focus as long as it is viewable (it and all of its ancestors are mapped). +An empty value for the option means that the traversal scripts make +the decision about whether or not to focus on the window: the current +algorithm is to skip the window if it is +disabled, if it has no key bindings, or if it is not viewable. +If the value has any other form, then the traversal scripts take +the value, append the name of the window to it (with a separator space), +and evaluate the resulting string as a Tcl script. +The script must return 0, 1, or an empty string: a +0 or 1 value specifies whether the window will receive +the input focus, and an empty string results in the default decision +described above. +Note: this interpretation of the option is defined entirely by +the Tcl scripts that implement traversal: the widget implementations +ignore the option entirely, so you can change its meaning if you +redefine the keyboard traversal scripts. +

    Command-Line Name: -text +
    Database Name: text +
    Database Class: Text +
    Specifies a string to be displayed inside the widget. The way in which +the string is displayed depends on the particular widget and may be +determined by other options, such as anchor or justify. +

    Command-Line Name: -textvariable +
    Database Name: textVariable +
    Database Class: Variable +
    Specifies the name of a variable. The value of the variable is a text +string to be displayed inside the widget; if the variable value changes +then the widget will automatically update itself to reflect the new value. +The way in which the string is displayed in the widget depends on the +particular widget and may be determined by other options, such as +anchor or justify. +

    Command-Line Name: -troughcolor +
    Database Name: troughColor +
    Database Class: Background +
    Specifies the color to use for the rectangular trough areas +in widgets such as scrollbars and scales. +

    Command-Line Name: -underline +
    Database Name: underline +
    Database Class: Underline +
    Specifies the integer index of a character to underline in the widget. +This option is used by the default bindings to implement keyboard +traversal for menu buttons and menu entries. +0 corresponds to the first character of the text displayed in the +widget, 1 to the next character, and so on. +

    Command-Line Name: -wraplength +
    Database Name: wrapLength +
    Database Class: WrapLength +
    For widgets that can perform word-wrapping, this option specifies +the maximum line length. +Lines that would exceed this length are wrapped onto the next line, +so that no line is longer than the specified length. +The value may be specified in any of the standard forms for +screen distances. +If this value is less than or equal to 0 then no wrapping is done: lines +will break only at newline characters in the text. +

    Command-Line Name: -xscrollcommand +
    Database Name: xScrollCommand +
    Database Class: ScrollCommand +
    Specifies the prefix for a command used to communicate with horizontal +scrollbars. +When the view in the widget's window changes (or +whenever anything else occurs that could change the display in a +scrollbar, such as a change in the total size of the widget's +contents), the widget will +generate a Tcl command by concatenating the scroll command and +two numbers. +Each of the numbers is a fraction between 0 and 1, which indicates +a position in the document. 0 indicates the beginning of the document, +1 indicates the end, .333 indicates a position one third the way through +the document, and so on. +The first fraction indicates the first information in the document +that is visible in the window, and the second fraction indicates +the information just after the last portion that is visible. +The command is +then passed to the Tcl interpreter for execution. Typically the +xScrollCommand option consists of the path name of a scrollbar +widget followed by ``set'', e.g. ``.x.scrollbar set'': this will cause +the scrollbar to be updated whenever the view in the window changes. +If this option is not specified, then no command will be executed. +

    Command-Line Name: -yscrollcommand +
    Database Name: yScrollCommand +
    Database Class: ScrollCommand +
    Specifies the prefix for a command used to communicate with vertical +scrollbars. This option is treated in the same way as the +xScrollCommand option, except that it is used for vertical +scrollbars and is provided by widgets that support vertical scrolling. +See the description of xScrollCommand for details +on how this option is used. + +
    +

    KEYWORDS

    +class, name, standard option, switch +
    +Copyright © 1990-1994 The Regents of the University of California.
+Copyright © 1994-1996 Sun Microsystems, Inc.
+Copyright © 1995-1997 Roger E. Critchlow Jr.
    + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/CHANGES.txt b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/CHANGES.txt new file mode 100644 index 00000000..171d6757 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/CHANGES.txt @@ -0,0 +1,266 @@ +____________________________________________________________ +BWidget 1.2.1 (07/09/1999) + +CHANGES FROM 1.2 TO 1.2.1 + + This version is the first patch of 1.2. It does not introduce + incompatibilites. + This patch include some new requested features, that I think + can't wait for 1.3: + - special menu handling (see MainFrame) + - tabs bindings in NoteBook + - label alignment of LabelFrame + - -repeatdelay and -repeatinterval options on SpinBox + + +* Entry + - event added to tag BwDisabledEntry + - fixed bug when -textvariable use a variable containing space + +* MainFrame + - fixed bug when -textvariable use a variable containing space + - menubar entry creation modified to use the menuid as the + subpathname to permit special menu (help, system, apple) + +* LabelFrame + - LabelFrame::align command added + +* ScrollableFrame + - fixed typo bug + +* PagesManager + - fixed bug of window size + - 'pages' modified to optionally include first and last indices. + ('page' is still available but deprecated) + +* NoteBook + - new command 'bindtabs' + - fixed bug in handling result of -leavecmd command + - 'pages' modified to optionally include first and last indices. + ('page' is still available but deprecated) + +* ComboBox + - little border added around the popdown list, which appeared + to have no border under windows when popped above a widget + with the same background color. + +* SpinBox + - options -repeatdelay and -repeatinterval added. + +* Tree + - fixed strange behaviour when editing: 'selection range' + replaced by 'selection from'/'selection to' + - widget is redrawn if needed in 'edit' and 'see' + - fixed bug in see + - nodes modified to optionally include first and last indices. + - _subdelete modified to iterative method + +* ListBox + - fixed strange behaviour when editing: 'selection range' + replaced by 'selection from'/'selection to' + - ListBox is redrawn if needed in 'edit' and 'see' + - fixed bug in see + - 'items' modified to optionally include first and last indices. + ('item' is still available but deprecated) + +* SelectColor + - fixed bug in call to GlobalVar::trace renamed GlobalVar::tracevar + +* DragSite and DropSite + - fixed bug introduced by new button event. + +* DynamicHelp + - restored version of 1.1, due to the bug under windows + +* BWidget::place + - fixed bug when x or y is 0. + +* es.rc resource file included + + +____________________________________________________________ +BWidget 1.2 (05/21/1999) + +CHANGES FROM 1.1 TO 1.2 + + +* 4 new widget: + - ScrollableFrame + - ScrollView + - PagesManager + - PasswdDlg (contributed by Stephane Lavirotte) + +* Widget: + - Flag option type added + - option resource database read while widget creation, + not while widget class creation. + - better handling of BWidget definition using another BWidget as a top pathname. + +* MainFrame + - more options included for ProgressBar + (INCOMPATIBILITY: option -variable renamed -progressvar) + - -menu option modified to have tags on entries and menu id on cascad menu + (INCOMPATIBILITY of option -menu) + - new command: getmenu + - new command: setmenustate + +* DropSite + - operations completly reworked + - option -droptypes modified (INCOMPATIBILITY) + - return code of -dropovercmd modified + bit 'ok' and bit 'recall' reverted + (INCOMPATIBILITY in -dropovercmd command) + - new command: setoperation + +* DragSite: + - Drag now initiates while followed by of + 4 pixels, so it is possible to have a event and + drag event on the same button. + - -dragevent option modified: must be the number of the button: 1, 2 or 3 + Option is now defaulted to 1, but Entry widget keep it to 3. + (INCOMPATIBILITY) + - return result of -draginitcmd modified (INCOMPATIBILITY) + +* ListBox: + - edit command improved. + new arguments: initial text, and command to verify the text before accept it. + (INCOMPATIBILITY in call to edit) + - Drag and Drop modified + (INCOMPATIBILITY in -dropovercmd command) + - new command: reorder + +* Tree: + - edit command improved. + new arguments: initial text, and command to verify the text before accept it. + (INCOMPATIBILITY in call to edit) + - Drag and Drop modified + (INCOMPATIBILITY in -dropovercmd command) + - new command: reorder + - new command: visible + - less full-redraw + +* NoteBook: + - relief reworked + - added option -leavecmd on pages + - option -image implemented + - new command: move + - delete command now accept an optionnal argument specifying + whether the frame of the page should be destroyed or not. + If not, this frame is reused by insert command for the same page. + +* Entry and LabelEntry: + - direct access to entry command + - bind command added on the entry subwidget + +* ComboBox: + - option -postcommand added + - bind command added on the entry subwidget + +* SpinBox: + - bind command added on the entry subwidget + - floating point fixed - work needed + +* ProgressBar: + - now can be incremental or not limited ('unknow-time' processing) + +* Bitmap: + - xpm image type added with use of xpm-to-image by Roger E. Critchlow Jr. + +* Lots of focus problem solved + +* ...and bugs corrected. + + +INCOMPATIBILITIES + + Incompatibilities are very localized, so we hope that it will + not be painfull to upgrade to 1.2. + +* MainFrame related imcompatibilities + - Upgrade MainFrame -menu option and change -variable option + by -progressvar. + +* Drag and drop related imcompatibilities + - Upgrade -dragevent option, and command associated to -draginitcmd + and -dropovercmd. + - Upgrade -dragendcmd/-dragovercmd command of Tree and ListBox widget + +* Edition in Tree and ListBox + - Verify arguments passed in call to edit command of + Tree and ListBox + + +____________________________________________________________ +BWidget 1.1 (03/12/1999) + +CHANGES FROM 1.0 TO 1.1 + +WHAT'S NEW + +The most important change in BWidget 1.1 is the support +of tk path command, but the old syntax is always available. +configure command now returns a valid configuration information list. + +(I hope that) All submitted bugs have been corrected. + +Following widget have been reworked: + +* ListBox: + - ListBox items have now a -indent option. + - insert command modified to look more as a tk + listbox insert command (see INCOMPATIBILITIES) + - item command added to retreive one or more items + +* Tree: + - insert command modified to look more as a + listbox insert command (see INCOMPATIBILITIES) + +* LabelEntry: + - -value and -variable options renamed to -text and -textvariable + (see INCOMPATIBILITIES) + +* SpinBox and ComboBox: + - -value and -variable options renamed to -text and -textvariable + (see INCOMPATIBILITIES) + - New command getvalue and setvalue added to manipulate + current value by index. + +* NoteBook: + - Pages have now an identifier. + - insert command modififed (see INCOMPATIBILITIES) + - page command added to retreive one or more pages + - getframe command added + + +INCOMPATIBILITIES (sorry for this) + +* LabelEntry, SpinBox and ComboBox: + - -value and -variable options renamed to -text and -textvariable + +* Entry and LabelEntry: + - setfocus doesn't exist anymore. Directly use tk command focus. + +* NoteBook: + - Pages have now an identifier, which modifies insert command: + NoteBook::insert $nb index ?option value ...? + is now + $nb insert index page ?option value ...? + +* Tree: + - insert command modified: + Tree::insert $nb $parent $node $index ?option value ...? + becomes + $tree insert $index $parent $node ?option value ...? + +* ListBox: + - insert command modified: + ListBox::insert $list $item $index ?option value ...? + becomes + $list insert $index $item ?option value ...? + + +____________________________________________________________ +BWidget 1.0 (02/19/1999) + + First release. + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/ChangeLog b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/ChangeLog new file mode 100644 index 00000000..392194a6 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/ChangeLog @@ -0,0 +1,2522 @@ +2024-10-27 Harald Oehlmann + + **** BWidget 1.10.1 tagged **** + +2024-10-15 Harald Oehlmann + * Fix Tk9 compatibilty of statusbar.tcl. + Thanks to Paul Obermeier. + Ticket [7eb06c3a3a] + +2024-10-15 Harald Oehlmann + + **** BWidget 1.10.0 tagged **** + +2024-10-14 Harald Oehlmann + * TCL/Tk 9 patch provided by Emiliano. Ticket [b78ac94ee6] + +2023-05-22 Harald Oehlmann + * color.tcl: Bugfix in color chooser. + Displayed color box got gray (instead yellow) after the + following action: manually enter #ff0, click on far right + pannel for intensity. + In addition, add limited support for manual entry of named + colors. + Thanks to Steve from https://sourceforge.net/projects/scidvspc/ + for bug report and contribution. Ticket [4f9a4205f0] + +2023-05-22 Harald Oehlmann + TCL9.0/Tk8.7 compatibility issues found by Paul Obermeier. + https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9 + * dropsite.tcl: Replaced "$tcl_platform" with "$::tcl_platform" + in namespaces. + * widget.tcl: Replaced "package require Tcl 8.1.1" with + "package require Tcl 8.1.1-". + Ticket [1bee17b353] + +2023-05-22 Harald Oehlmann + tree.tcl: Bug: node names with leading colons gave error. + The node name solution was changed, that ":" is now + substituded by "\5", and not "::". Ticket [d075175ade]. + Thanks to Rolf Ade for the ticket. + +2022-12-25 Harald Oehlmann + + **** BWidget 1.9.16 tagged **** + +2022-10-12 Wolfgang Kechel + dropsite.tcl: Prevent multiple drops, when movement + while drop is processed. Ticket [1ef1f56cd1] + + +2021-12-03 Harald Oehlmann + + **** BWidget 1.9.15 tagged **** + +2021-12-03 Harald Oehlmann + mainframe.tcl: Recalculate status bar height if the + text size is changed by a change of a used named font. + Ticket [acbd67752a] + +2021-08-05 Harald Oehlmann + notebook.tcl: Repaint tabs if the text size is changed + by a change of a used named font. Ticket [acbd67752a] + +2019-12-03 Harald Oehlmann + + **** BWidget 1.9.14 tagged **** + +2019-11-12 Harald Oehlmann + spinbox.tcl: fix error about unsupported option + -disabledforeground when using themed widgets. + Thanks to Gerhard Reithofer and Christian Werner. + Ticket [071fc80f14] + +2019-05-06 Harald Oehlmann + mainframe.tcl: Add optional parameter "Top" to internal + function "MainFrame::_create_menubar" to allow to use + a menu button for the main menu (Hack). + The mainframe may be initialized with "- menu {}". + Then, the menubutton may be created and the menu may + by added by: + MainFrame::_create_menubar .mf $mitems $menubutton. + Allow to skip a main menu level by empty menu label. + Purpose: support commands/checkboxes at first level. + +2018-12-11 Harald Oehlmann + scrollframe.tcl: use Tk8.7 TIP 518 virtual event + <> to resize client frame to 1x1 when + last child is unmapped. + +2018-12-06 Harald Oehlmann + + **** BWidget 1.9.13 tagged **** + +2018-11-26 Harald Oehlmann + dialog.c: For Unix, also Bind KP_Enter for default dialog + button invokation. Ticket [3e31f04367]. + Thanks to Jos for the proposal. + +2018-01-09 Harald Oehlmann + Spanish translation enhanced by Neko. + Ticket [a947e33526] + +2018-01-10 Harald Oehlmann + + **** BWidget 1.9.12 tagged **** + +2018-01-10 Harald Oehlmann + color.tcl: replace the help widget by balloons bound to the + widgets. Ticket [2cc70ce1cb] + +2018-01-09 Harald Oehlmann + color.tcl: New option -command allows to get a callback + when the user does an unvalidated choice. + New option -background and command SelectColor for + window background. + TitleFrames, Dynamic help and Aqua native buttons used. + Show current choice by highlighting, not focus, to avoid + conflict with keyboard traversal. + Shows entry widget for numerical color input/output. + New option -help to show a help area. + Patch by Keith J. Nash + Ticket [75101bf5ce] + Translators: Jima (es), Vogel (fr), Marcus (nl), Ian (da) + Ticket [a947e33526] + +2017-11-03 Harald Oehlmann + notebook.tcl (+man,demo): Add possibility to NoteBook + to add an image at the right of each tab. + Ticket [15e19fe9ec]. Patch by Keith J. Nash. + +2017-08-25 Harald Oehlmann + + **** BWidget 1.9.11 tagged **** + +2017-05-08 Harald Oehlmann + MessageDlg.html: Documented the use of the native widget for + "MessageDlg -type !user" and the limited set of recognized + options. Ticket [8edade3cea] by Gerhard Reithofer + +2016-10-31 Harald Oehlmann + scrollframe.tcl: Eric advised to check for unmapped window, + as the event may be executed in the unmapped state. + +2016-10-31 Harald Oehlmann + scrollframe.tcl: width changed when unmapped and mapped. + Checkge the Configure vound proc to not be active when + currently unmapped. Ticket [72a5727d1b]. Thanks to + Alexandru for the ticket and patch. + +2016-10-31 Harald Oehlmann + button.tcl: Reverted last change, Eric underlined to + not use ttk widgets as a base due to the option + data base. Did traditional fix to exclude all options + known by button and not known by ttk::button. + Ticket [845613e5590ae7cf] + +2016-08-23 Harald Oehlmann + button.tcl: configure option of a ::Button gave error in + themed mode. Ticket [845613e5590ae7cf]. Report by Adrian. + +2016-07-21 Harald Oehlmann + util.tcl: BWidget::place moved away from visible screens + if the current window is on a virtual screen outside of + the main screen (Windows multi-screen configuration). + Ticket [5919a0ec2d] + +2016-07-15 Adrian Madrano Calvo + pckIndex.tcl: auto-load commands also from global namespace + and not only from BWidget namespace. Ticket [c86207db01] + +2016-03-22 Harald Oehlmann + Only support themed packages Tile 0.8 or Ttk. + Repair the button spacing in themed font toolbar. + Ticket [d7ea07c40a] + +2016-03-15 Harald Oehlmann + mainframe.tcl: "Mainframe configure" caused error in themed + mode. Ticket [52273c0a4e] + +2016-03-08 Harald Oehlmann + + **** BWidget 1.9.10 tagged **** + +2016-01-07 Adrian Medrano Calvo + listbox.tcl: Listbox did not scroll to current item on + startup. Ticket [ae238d5a7] + +2016-01-07 Harald Oehlmann + lang/da.rc, lang/es.rc, lang/fr.rc, lang/no.rc: + Translations non portable on utf-8 systems. + File encoding changed to utf-8. Ticket [6c91e43d76] + +2016-01-07 Harald Oehlmann + tree.tcl: Tree lines are black by default even if background + is black. Ticket [ed4c1dab46] + +2015-12-08 Harald Oehlmann + listbox.tcl: 8.4 compatibility was broken due to the use of + min/max math functions. Ticket [0aef856302] + +2015-11-04 Harald Oehlmann + dynhelp.tcl: Drop the assumption that all windows + screen are the same size (of fix dated 2009-06-26) + and use the virtual screen information to place the bubble + help. Ticket [b64e03e548]. + +2015-10-18 Harald Oehlmann + + **** BWidget 1.9.9 tagged **** + +2015-03-18 Harald Oehlmann + + widget.tcl: Widget::define got new parameter -namespace, + allowing megawidget namespace be different to + class name. This allows lower case namespace names. + Patch by Adrian Medrano Calvo. Ticket [023a631b20] + +2014-09-10 Harald Oehlmann + + **** BWidget 1.9.8 tagged **** + +2014-09-05 Harald Oehlmann + + widget.tcl: Widget::which errors when option not present. + Ticket [397db23424] + +2014-05-21 Harald Oehlmann + + widget.tcl: Don't invoke unqualified upvar in callers + scope. Patch by Adrian Medrano Calvo. Ticket [046fa04231] + + widget.tcl: Don't double creation of temporary widget for + default values retrieval. Use result of _get_tkwidget_options + instead. By Adrian Medrano Calvo. Ticket [393b67ab19] + + widget.tcl: New procedure Widget::which (as in [namespace which]), + that returns the fully qualified name for a widget option or + widget variable. By Adrian Medrano Calvo. Ticket [a8705e5fd9] + + widget.tcl: Remove unneeded upvar. By Adrian Medrano Calvo. + Ticket [43f93e0a97] + + widget.tcl et al: remove apparently unused procedure + Widget::syncoptions and all calls. By Adrian Medrano Calvo. + Ticket [3c2b8eafc6] + + +2013-12-13 Harald Oehlmann + + scrollframe.tcl: Make -constrainedwidth 1 and + -constrainedheight 1 work together. + Patch by Simon Bachmann. Ticket [2fa44401d5] + + 2013-10-17 Harald Oehlmann + widget.tcl: Remove temporary widget. + By Wolfgang S. Kechel. Ticket [6cd041bcc1] + +2013-10-15 Harald Oehlmann + combobox.tcl: Themed ComboBox color specifications + are honored. By Wolfgang S. Kechel. Ticket [6c6704e40f] + +2013-10-14 Harald Oehlmann + combobox.tcl: Fails in themed mode with "unknown + option -bg". Patch solves this but listbox items + are white on white when "-foreground" is specified. + By Wolfgang S. Kechel. Ticket [6632134ce9] + + listbox.tcl: Update on option -deltay added. + Set x0 to 2 to make highlight work and look nice for + listbox with image. + Take image into account to show selection. + By Wolfgang S. Kechel. Ticket [ff1787af9c] + + scrollw.tcl: Raise scrolled window if it is below in + the window hierarchy. By Wolfgang S. Kechel. + Ticket [ff1787af9c] + +2013-10-07 Harald Oehlmann + dynhelp.tcl: Sometimes the tooltip does not occur under + gnome/metacity on ubuntu. By Wolfgang S. Kechel. + Ticket [a588d2f800] + +2013-09-15 Harald Oehlmann + + **** BWidget 1.9.7 tagged **** + +2013-09-11 Harald Oehlmann + + xpm2image.tcl: many issues fixed in xpm import + by Mattias Hembruch. Ticket [9a8b2ee42e] + +2013-08-14 Harald Oehlmann + + * notebook.tcl: cured error in _resize, that + data($p,width) is not (jet) present. Ticket [a4cbba655d]. + +2013-06-28 Harald Oehlmann + + * mainframe.tcl: Included Patch [9f67a66609] + curing issues of Shift-Accellerators with Shift-Lock + on Mac. By Keith Nash, Ticket [83ce3e84e7]. + +2013-06-26 Harald Oehlmann + + * mainframe.tcl: Reverted Patch [1977644] + (-casesensitive for accellerators). It has + issues with shift-lock. + +2013-06-21 Harald Oehlmann + + * labelentry.tcl: Bug fixed: + Methods from Tk entry widget restored [Bug 1002844]. + + * mainframe.tcl: Allow case sensitive accelerators + by new option -casesensitive. + Patch by cmard [Patch 1977644] + + * mainframe.tcl: Allow new modifiers Shift, Cmd and ShiftCmd + for accelerators. Patch by K.J.Nash [Patch-83ce3e84e7] + + * mainframe.tcl: When changing MainFrame -background, do + not change menu colors on Aqua. + Fix by Keith J.Nash [Bug-a81b7afc1e] + + * init.tcl: Make loadable in save interpreter. + Fix by Keith J.Nash [Bug-4365a23bd3] + + * combobox.tcl: Add method getentry to return entry + widget path for bind purposes. + Patch by Michael [Patch-2340355] + +2013-01-09 Harald Oehlmann + + * widget.tcl: Bug fixed: + Error 'invalid command name ".#BWidget.#ttk::entry"' + arises in themed mode when an Entry widget should get + focus by the tab key. + The temporary widget creation fails due to the "::" in + the command name of ttk widgets. + Any "::" is replaced by "__" [Bug 3599955]. + +2011-07-27 Harald Oehlmann + + **** BWidget 1.9.6 tagged **** + +2012-04-12 Harald Oehlmann + + * listbox.tcl ListBox::selection Only redraw if + selection changed. Patch by Wolfgang S. Kechel [Bug 3517145] + +2012-04-02 Harald Oehlmann + + * entry.tcl, BWMan/entry.tcl checkbox.tcl Themed mode: + Invoking "configure" without arguments results in errors + that non-ttk options are not present. + Removed Entry options: -background -foreground -relief + -borderwidth -fg -bg -bd. Reported by Wolfgang S. Kechel + [Bug 3513263] + * entry.tcl mapped entry option -state to ttk::entry + state in themed mode to make state change visible. + +2012-03-06 Harald Oehlmann + + * BWMan/ListBox.html documented options -selectfill and + -autofocus as read-only. Reported by Wolfgang S. Kechel + [Bug 3497592] + +2011-11-14 Harald Oehlmann + + * widget.tcl (Widget::focusOK) fixed list with update. + Arises, if a ttk widget with a widget path with spaces + is the next widget. Reported by jaspertheperson + [Bug 3437761] + +2011-06-24 Harald Oehlmann + + **** BWidget 1.9.5 tagged **** + +2011-06-23 Harald Oehlmann + + * listbox.tcl (listbox::generate_data) fixed last patch + by ryotakatsuki [Bug 3324610] + +2011-06-23 Harald Oehlmann + + * listbox.tcl Fix of Bug 3000293 broke listbox tags. + The bindImage subcommand did not report right tag. + Patch by ryotakatsuki [Bug 3324610] + +2011-06-23 Harald Oehlmann + + * listbox.tcl, tree.tcl (_update_scrollregion) the linewise + scrolling did not always scroll up to the end on windows 7. + Report and patch by Wojciech Kocjan, review and modification + by Koen Danckaert [Bug 3317772] + +2011-05-25 Harald Oehlmann + + *mainframe.tcl: Add a boolean readonly option -sizegrip + to show a sizegrip widget in themed mode. + +2011-05-24 Harald Oehlmann + + *lang/pl.rc updated by Wojciech Kocjan. + +2011-04-26 Harald Oehlmann + + *notebook.tcl The user frame of the notebook is now a themed + frame in themed mode. The set background color does not apply + to the user frame in this case. + +2011-04-26 Harald Oehlmann + + label.tcl configuring foreground color caused error when + themed [Bug 3292977] + +2011-04-20 Harald Oehlmann + + lang/hu.rc by Rezso updated + +2011-04-20 Harald Oehlmann + + * font.tcl, lang/*.rc: Add translation possibility + for color picker button of font dialog. + Used google translater to translate "Color" to all languages. + Please check if this is correct. [Bug 3289573] reported by Rezso + +2011-04-19 Harald Oehlmann + + * lang/*.rc [Bug 3289573] : Add translation (templates) for the + Color picker widget text "Base colors" and "User colors". + Only german and english locals are provided so far. + +2011-02-14 Harald Oehlmann + + * combobox.tcl: [Bug 3182287] : ComboBox failes in themed mode + due to the use of the themed entry widget. The following options + are not supported (and thus called) any more: -relief + -highlightbackground -highlightforeground + +2011-02-14 Harald Oehlmann + + * entry.tcl, labelentry.tcl, labelframe.tcl, mainframe.tcl, + pagesmgr.tcl, scrollw.tcl: [Bug 3168761]: + entry failes when themed support activated with: + unknown option "-highlightthickness" (reported by George + on clt 27 Jan., 16:55). + The patch by Wojciech Kocjan fixes this and enhances + labelentry, labelframe and pagesmgr to also use themed frames. + Within scrollw.tcl, a bug for empty background handling is fixed. + The scrollbar background is not set any more for not-themed widget. + +2011-01-17 Harald Oehlmann + + * pkgIndex.tcl: corrected package version in package provide + +2010-12-14 Harald Oehlmann + + **** BWidget 1.9.4 tagged **** + +2010-12-14 Andreas Kupries + + * tree.tcl [Bug 3106208]: Followup. Moved the fixed code of the + last entry I did (2010-11-09) into a new command Tree::MergeFlag + and call this from both Tree::itemconfigure and Tree::insert. + Missing the place in Tree::insert caused another problem, found by + Dustin Littau. + +2010-11-05 Harald Oehlmann + + **** BWidget 1.9.3 tagged **** + +2010-11-23 Harald Oehlmann + + * scrollw.tcl Add theming support for ScrolledWindow widget. + * ScrolledWindow.html Themed mode documented. + +2010-11-21 Harald Oehlmann + + * label.tcl Add theming support for Label widget. + * label.html Themed mode documented. + +2010-11-16 Harald Oehlmann + + * button.tcl Add theming support for Button widget. + Option "-relief link" is mapped to "Toolbutton style. + Option -height is not available when themed. + Thanks to Kevin Walzer for the test on MacOS. + * buttonbox.tcl When themed, only set themed button options. + The widget itself is not jet themed. + * Dialog.html Removed documentation of unavailable option -buttonwidth. + +2010-11-09 Andreas Kupries + + * tree.tcl (Tree::itemconfigure): Fix intermingling of node names + and flag values which can cause an lsearch to fail, by mistaking a + flag value as the node searched for, and then treating a node name + as flags. As the upd,nodes value is a dictionary it should not be + search as a list. Now using a temporary array for quicker check + and append/replace [Bug 3106208]. + +2010-11-09 Harald Oehlmann + + * mainframe.tcl Menu text shows white on white on Mac aqua + [Bug 3105665] reported by Scott Smedley fixed by Kevin Walzer. + +2010-10-15 Harald Oehlmann + + * label.tcl The frame surround the label gets under + unknown conditions a -padx 5. A pad of 0 is now + hard coded (Bug 3087955) + +2010-08-04 Harald Oehlmann + + * dialog.tcl Changed behaviour of window close button. + If -cancel is given, this button is invoked. + The cancel option may now be changed using the configure + method. + + * init.tcl If msgcat is available use its locale to load + a lang/*.rc file instead always using en.rc. + +2010-06-09 Harald Oehlmann + + * Included lang/pl.rc from HEAD. + +2010-06-07 Harald Oehlmann + + **** BWidget 1.9.2 tagged **** + Version 1.9.1 was skipped. + This was released in ActiveTCL and thus may exist on many + installations. + +2010-05-31 Harald Oehlmann + + * listbox.html Reflected patch 2010-05-12 in documentation. + The selection may not be disabled any more by binding button 1. + +2010-05-12 Harald Oehlmann + + * listbox.tcl(ListBox::bindText and ListBox::bindImage) + Method bindText and bindImage overwrote internal selection + bindings [Bug 3000293] reported by Robert Karen. + +2010-05-11 Harald Oehlmann + + * listbox.tcl(ListBox::see) Method see shifts image out of + view. Showed up, by a selection click on a long item with icon + [Bug 2999764] reported by Robert Karen. + +2010-05-05 Harald Oehlmann + + * listbox.tcl(ListBox::_configureSelectmode) Drag modifies + multiple selection [Bug 2995969] reported by Robert Karen. + Bound events on ButtonRelease-1 instead Button-1 for multiple + selections to avoid bug. + * listbox.tcl(ListBox::_drag_and_drop) The default drag and drop + routine only handled single drag and drop. + It was extended to handle also drag and drop of multiple entries. + +2009-09-03 Harald Oehlmann + + * util.tcl(BWidget::place), BWidget.html Widget placed incorrectly, + when bigger than current screen [Bug 2850031] by Thomas Grausgruber + Possible incompatibility: BWidget::place w h -> w,h are reduced to + screen width. + +2009-08-12 Harald Oehlmann + + * dynhelp.tcl Use balloon help font TkTooltipFont if tk <= 8.5. + Otherwise use helvetica 11 on Aqua [Patch 2835180] for Kevin Walzer + * dynhelp.tcl(DynamicHelp::_show_help)Replaced aqua conditional code + check by $Widget::_aqua + +2009-08-10 Harald Oehlmann + + * notebook.tcl (NoteBook::delete) Method delete destroyframe=1 and + reinsertion -> raise failed - state variables were deleted. + [Bug 2831785] by kjnash + * tree.tcl (Tree::_keynav) Fire virtual event <> also on + keyboard navigation [Patch 2828086] by Kevin Walzer + * combobox.tcl Replaced aqua conditional code check by $Widget::_aqua + +2009-08-10 Harald Oehlmann + + **** Branched to bwidget **** + + This is the bwidget branch of module bwidget of tcllib + Use "-r bwidget" for all cvs operations + Scope: Package BWidget compatible to tcl/tk 8.1 and tk + (e.g. no tile/ttk). + +2009-07-24 Harald Oehlmann + + **** BWidget 1.9.0 tagged **** + + * pkgIndex.tcl, README.txt: updated to BWidget 1.9 + +2009-07-23 Harald Oehlmann + + * tree.tcl (Tree::_set_help), Tree.html DynamicHelp -helpcmd added to + tree node help + * tree.tcl (Tree::_draw_subnodes) a vertical line to a virtual root node + above the widget is only drawn when there are multiple child nodes. + This reverts the modification dated 2004-04-21 for this case. + [Patch 2825354] by Koen Danckaert + +2009-07-17 Harald Oehlmann + + * scrollframe.tcl (ScrollableFrame::create et al) ScrollableFrame.html + Background color of canvas takes the color of the scrolled frame. + If themed, canvas takes the themed color of the scrolled themed frame. + If themed, parameters -background and -bg are not available(doc + code). + [Patch 2822970] by Koen Danckaert + +2009-07-15 Harald Oehlmann + + * dynhelp.tcl (DynamicHelp) Typo from yesterday corrected + [Patch 2820851] by Koen Danckaert + +2009-07-14 Harald Oehlmann + + * dynhelp.tcl (DynamicHelp::_leave_info et al) issues: + - menu help sometimes not cleared when clicking off-window (unix) + - "-helpcmd" available also when dynamichelp is included in another + widget. + - given "-helpcmd" always called at global scope. + - Protect against multiple calls of event. + [Patch 2820851] by Koen Danckaert + +2009-07-07 Harald Oehlmann + + * combobox.tcl (ComboBox::_select) Do not export selection if + -exportselection 0 [Patch 981545] by Jeffrey Hobbs + +2009-07-02 Harald Oehlmann + + * widget.tcl (Widget::configure) Bug: ProgressDlg option -geometry + not setable. The former patch was improved. + Koen Danckaert and myself argued, that we modify symptoms without + basic understandings. Anyway, better now than before. + +2009-07-01 Harald Oehlmann + + * mainframe.tcl, MainFrame.html (MainFrame::getmenustate) + Added method getmenustate to return menu tag state + [Bug 948063] reported by Rolf Ade + + * combobox.tcl (ComboBox::configure) Bug fixed: Widget did not take + focus, when -editable false and "configure -state normal" called. + [Bug 756334] reported by Rolf Ade + + * widget.tcl (Widget::configure) Bug: ProgressDlg option -bg not + setable. The special handling of subwidgets with special class or + path ":cmd" was improved. [Bug 611477] + + * notebook.tcl (NoteBook::_itemconfigure) Not honored option: + itemconfigure ... -helptext [Patch 2814050] by Koen Danckaert + +2009-06-30 Harald Oehlmann + + * buttonbox.tcl (ButtonBox::_redraw) Bug corrected: + -uniform gridding option is used if tcl version >= 8.4 (not 8.3). + [Patch 2807147] by Koen Danckaert + + * tree.tcl (Tree::_drop_cmd) If there is no node, drop didn't work. + [Bug 1042613] reported by Rolf Ade + + * Tree.html Bind commands: removed promise that %W would work in future. + The underlying widgets should only be manipulated using the node id. + [Bug 1224203] by Jasper Taylor, remarks by J. Tang + + * Tree.html Bind commands: with -selectfill, the given command is + overwritten for the background box. [Bug 1003962] by Torsten Berg + + * dropsite.tcl (DropSite::register) Bug fixed: fails on multiple drop + targets [Bug 1213123] by T.Neil + + * combobox.tcl (ComboBox::_create_popup) Bug fixed: Return key in drop + down list when -bwlistbox true [Bug 1205536] patch by Steve Landers + + * combobox.tcl (ComboBox::_create_popup, ComboBox::_unmapliste) + Mac aqua and x11 fixes, multi screen issue still open. + [Bug 1451784] report by Jasper Taylor, fix by Kevin Walzer + + * listbox.tcl (ListBox::_multiple_select) Selected item not deselected + on control-click [Bug 1029144] reported by Konrad Rosenbaum + + +2009-06-29 Harald Oehlmann + + * ScrolledWindow.html ScrolledWindow documentation changed: + Documented options: -ipad, -sides, -size, -managed + [Patch 2807160] Text by Koen Danckaert + Removed (read only) remark of option -scrollbar. + + * scrollframe.tcl (ScrollableFrame::create) changed bindings + [Patch 2807227] by Koen Danckaert (comment) + + * scrollw.tcl (ScrolledWindow::_set_hscroll, ScrolledWindow::_set_vscroll) + Bug corrected: enless loop when both scrollbars where automatically + mapped and the window size was changed by this action (on linux). + Scrollbar unmapping and mapping secured by a locked update [Bug 2783019] + + * widget.tcl (Widget::tkinclude) : option data base entry name keeps the + original name and not the renamed name. + The only resulting modification is to rename the option key for + "MessageDlg -text" from "*MessageDlg.frame.msg.message" to + "*MessageDlg.frame.msg.text". [Bug 1266792] + + * widget.tcl (Widget::init) : fixed a memory leak on wrong option value. + [Bug 1230737] + +2009-06-26 Harald Oehlmann + + * listbox.tcl (ListBox::create et al) new feature: listbox option + -listbox now read/write [Bug 1501874] reported by Stephen Huntley + + * dynhelp.tcl (DynamicHelp::_show_help) fixed issue (as far as possible): + Dynamic help baloon was on the main screen, if it touched the border on + a windows multi screen configuration. + The fix assumes, that all screens have same dimensions and no gaps in- + between. This is necessary, because multi-screen configuration paramters + may not be interrogated by tk (despite of coordinates out of the screen) + [Bug 1499135] reported by Gregor + + * notebook.tcl (NoteBook::delete) Deleted also state variables + [Bug 1445219] reported by Eric Kemp-Benedict + +2009-06-25 Harald Oehlmann + + * combobox.tcl (ComboBox::getvalue et al) fixed bug: getvalue returned + first apearence of current data instead of clicked index, which may not + be the same if values is not unique. Additional variable _index(path) + added to hold click index [Bug 1610965] reported by Martin Lemburg + +2009-06-24 Harald Oehlmann + + * scrollframe.tcl (ScrollableFrame::create, ScrollableFrame::_resize, + ScrollableFrame::_frameConfigure) fixed two issues: + - Scrollbar activated even if not necessary + Fix: update scrolling reagion on configure event of the frame + - Disfunction if the frame got to small to be on the current view + Fix: update scrolling reagion on map or unmap events + [Patch 2807227] by Koen Danckaert + + * buttonbox.tcl (ButtonBox::_redraw) Bug: homogeneous button width + not honored if button size changes after creation. + -uniform gridding option is used if tcl version >= 8.3. + [Patch 2807147] by Koen Danckaert + +2009-06-16 Harald Oehlmann + + * combobox.tcl (ComboBox::_create_popup) In dropdown list, + a vertical scrollbar was always shown if horizantal is used. + ScrolledWindow is now called with "-managed 1". + [Patch 2807160] by Koen Danckaert + +2009-06-11 Harald Oehlmann + + * combobox.tcl removed \ before empty line (potential + trap) [Bug 2804961] Andreas Kupries + + * dialog.html Documented -geometry option. + [Bug 1634416] Erik Leunissen + +2009-06-10 Harald Oehlmann + + * no.rc added norwegian translation file + [Feature Request 2797153] provided by Lars Martin Hambro + + * passwddlg.tcl (PasswdDlg::_verifonpasswd) check for + disabled password field and confirm directly. + [Bug 1642050] (Calvin Bascom) Enter key did not confirm + dialog when -passwdstate disabled. + + * combobox.tcl (ComboBox::_select) included [Patch 981545], + but commented out - it works for me without it. + +2009-06-10 Harald Oehlmann + + * dialog.html Added documentation for option -buttonwidth + of Dialog + [Bug 1668587] (Eric Leunissen) + +2009-06-10 Harald Oehlmann + + * arrow.tcl initialised set _grab(oldstate) to "normal" to avoid + error when there is a ArrowButton::_leave without corresponding + ArrowButton::_enter [Bug 2762361] + + * entry.tcl (Entry::_path_command) Add "invoke" to the list of + internally handled commands + [Bug 2340320] (patch by relaxmike@users.sourceforge.net) + + * uitils.tcl (BWidget::place) BWidget::place used screen width + instead window width. + [Bug 1842346] (patch by Niels Gollesch ngoelles@users.sourceforge.net) + + * listbox.tcl (ListBox::_redraw_selection) Added check if redrawn + item is on the to-delete list and thus does not exist any more as + BWidget. [Bug 1752755] (legolas_a20@users.sourceforge.net] + +2008-10-30 Jeff Hobbs + + * tree.tcl (Tree::_node_name_rev): Return node names as they are + input, and properly handle :: in node names. This changes + internal node name reps, but should be transparent to the user, + except for the result of [insert]. + +2008-05-26 Jeff Hobbs + + * tree.tcl (Tree::_redraw_selection): do not allow empty + * listbox.tcl (ListBox::_redraw_selection): fill color as that + creates a transparent item that doesn't return a bbox. This + showed up on OS X/Aqua, where the listbox selectforeground + defaults to empty. [AS Bug 77186 74923] + +2007-10-31 Jeff Hobbs + + * lang/nl.rc (new): Dutch translation [Bug 1804469] + + * lang/hu.rc (new): Hungarian translation [Bug 1821842] + + * tree.tcl (Tree::insert): do node_name on parent arg [Bug 1046955] + + * listbox.tcl: speed up ListBox insertion significantly. [Bug 1472443] + +2007-05-11 Jeff Hobbs + + * widget.tcl (Widget::theme): make sure Tk 8.5a6 is recognized as + having the themed widgets + +2006-12-20 J. Tang + + * util.tcl: fixed BWidget::write for widgets that require + DynamicHelp. [bug 1518803] + +2006-12-05 Andreas Kupries + + * demo/demo.tcl (Demo::main): Removed the 'inscope' qualifier from + the 'package require Bwidget'. The package system already forces + loading and sourcing of package code in the global namespace, so + this is bogus. + +2006-11-13 J. Tang + + * panedw.tcl: if activator is set to line then its width is set to + 3. --activator was an undocumented option; updated man page to + make it documented. Thanks to Jos Decoster for pointing this out. + +2006-11-10 J. Tang + + * widget.tcl: remove relative namespace resolution of variables, + in anticipation of TIP 278. Widget should have been doing this + anyways. [bug 1579744] + + * DragSite.html: noted that -draginitcmd can return an empty + string to prevent a drag [bug 740499] + + * DropSite.html: fixed documentation with DropSite::register + command [bug 740474] + + * combobox.tcl: allow autocomplete and autopost be + enabled/disabled after the widget was created [bug 1588808]; fixed + keysym in autopost binding [bug 1589111] + + * tree.tcl: fixed error with drag & drop's autoscroll [bug + 1408494] + + * listbox.tcl: fixed error with drag & drop's autoscroll; fixed + error when dropping at the end of the list + + * Added dynamic help to text tags (man page updated); fixed resize + bug with scrollframes. Thanks to Jos Decoster for these patches. + +2006-10-20 Jeff Hobbs + + * utils.tcl (BWidget::bindMouseWheel): do not make special + mousewheel bindings if global ones exist (like from style::as) + +2006-09-28 J. Tang + + **** BWIDGET 1.8.0 TAGGED **** + + * removed Makefile.in + + * font.tcl: correctly handle code path when user cancels dialog + + * passwd.tcl: fixed Dialog::enddialog error; fixed ordering error + + * pkgIndex.tcl, README.txt: updated to BWidget 1.8 + + * removed configure.in and aclocal.m4 + + * messagedlg.tcl: explicitly marked the 'Abort' button upon -type + abortretryignore to be the default button [bug 970199] + + * Tree.html: documented [find] and [line] commands [bug 626819]; + noted bug with %W binding [bug 1224203] + + * tree.tcl: added [bindArea] procedure; updated man page [patch + 839066] + + * combobox.tcl: added [clearvalue] proc to explicitly clear a + ComboBox value, updated man page [patch 780704] + +2006-09-26 J. Tang + + * passwd.tcl: don't ignore -labelwidth when calculating label + widths; return key moves through subwidgets like most login + managers [patch 922877, with slight change] + + * font.tcl: add options to select font color and to disable font + sizes; updated man pages [patch 1531199] + + * font.tcl: using arrow keys to browse font family / font size + will cause an update to the shown sample font [patch 947109] + + * demo/basic.tcl: fixed Entry's enter command callback [bug + 1400838] + +2006-08-21 J. Tang + + * combobox.tcl: unpost after autoposting when another Tk window + gets the focus; unpost upon hitting the enter key + + * scrollw.tcl: allow toggling of scrollbars [bug 1488712] + + * Tree.html: corrected documentation for Tree::opencmd (callback + does not append the path to the tree to the command) [bug 1507713] + + * tree.tcl: disable keyboard navigation for empty trees [bug 1514855] + + * tree.tcl: changed '-drawcross allways' to be '-drawcross + always'; updated documentation + +2006-06-29 Jeff Hobbs + + * statusbar.tcl (StatusBar::remove): remove neighboring separator + when removing the first item. [Bug 1512671] + +2006-03-24 J. Tang + + * pkgIndex.tcl: removed bogus "ControlFrame" entry [bug 1429405] + + * MainFrame man page: fixed some typos on man page + + * mainframe.tcl: fixed status bar placement when it is re-shown + after a [showstatusbar none] command [bug 1027568] + +2006-03-23 J. Tang + + * dynhelp.tcl: if a widget's help balloon is being displayed when + that widget is destroyed, also destroy the associated balloon [bug + 1448424] + + * listbox.tcl: when deleting an item from the ListBox that has + dynamic help text, also remove its entry from the help array [bug + 1443461] + +2006-02-10 J. Tang + + * ProgressDlg man page: note that caller must invoke [update], the + progressbar will not do it automatically [bug 1105778] + + * progressbar.tcl: -maximum value must now be non-zero, else + divide by 0 occurs [bug 1145523]; use double() calculations to + prevent integer overflow with very large -maximum values [bug + 900165] + + * PagesManager man page: clarified [add] behavior and default + state [bug 1305988] + +2006-02-08 J. Tang + + * combobox.tcl: allow -autocomplete with uppercase chars [bug + 996569]; added -autopost option [patch 1359041] + + * dynamic help man page: added clarification to -variable + +2006-01-25 J. Tang + + * buttonbox.tcl: fixed -homogeneous calculation [bug 1362899] + +2005-11-01 Jeff Hobbs + + * color.tcl (SelectColor::menu): use native dialog for palette + menu item where possible (and Widget::theme is used). + +2005-10-31 Jeff Hobbs + + * statusbar.tcl: correct Widget::theme typos + +2005-10-12 Jeff Hobbs + + * mainframe.tcl (MainFrame::configure): need to ignore -bg change + check when themed. + +2005-09-28 Jeff Hobbs + + * mainframe.tcl (MainFrame::_create_menubar): ignore -bg -bd opts + when themed + +2005-09-22 Jeff Hobbs + + * font.tcl (SelectFont::_getfont): fix tile compat to still set + data(family) and data(size) in any case. + +2005-09-19 Jeff Hobbs + + * mainframe.tcl: + * font.tcl: remove tile compat options that aren't valid. + +2005-08-23 Jeff Hobbs + + * mainframe.tcl: extend ttk theme awareness to subframes/separators + +2005-08-10 Jeff Hobbs + + * mainframe.tcl (MainFrame::create): make ttk theme aware + +2005-07-27 Jeff Hobbs + + * statusbar.tcl: if themed, use ttk::separator + * scrollframe.tcl: if themed, use ttk::frame + * font.tcl: if themed, use ttk::comboboxes and ttk::checkbuttons + * widget.tcl: encapsulate all .#BWidget* hidden widgets into a + single frame .#BWidget to clean up main '.' childspace. + Add 'Widget::theme ?boolean?' that, if enabled, has BWidgets try + to use some ttk themed widgets (*very* incomplete). + + * init.tcl (Widget::_opt_defaults): make a proc for opt defaults, + recognize aqua as a platform + +2005-02-25 Jeff Hobbs + + * lang/da.rc (new): Danish language file [Bug 1151534] (elhaard) + +2005-01-25 Jeff Hobbs + + * notebook.tcl: reverted lester patch - too many bugs related to + deleting and reinsertion of tabs. + +2004-12-01 Jeff Hobbs + + * notebook.tcl: speed improvements via array hashing for many tabs + (lester). + +2004-10-09 Rolf Ade + + * mainframe.tcl: (MainFrame::_parse_accelerator) made + accelerator Ctrl-f in -menu definitions work. [Bug 1043107] + +2004-09-24 Jeff Hobbs + + * color.tcl: use toplevel instead of menu for dropdown color menu + and do better focus/grab restoration. + + * utils.tcl (BWidget::RestoreFocusGrab,SetFocusGrab): add BWidget + equivalents of what Tk uses for better stacked grab/focus mgmt. + + * dialog.tcl (Dialog::create): withdraw topleve immediately after + creation. + +2004-09-14 Jeff Hobbs + + * listbox.tcl: add FocusIn redirector to %W.c, add explicit + -takefocus 0 to the frame parent. + + * widget.tcl (Widget::focusPrev): hack to avoid focus into direct + parent when it is a megawidget. [Bug 765667] + + * notebook.tcl (NoteBook::_draw_page): adjust height for bottom + drawn tabs. [Bug 988628] + +2004-09-09 Jeff Hobbs + + * panelframe.tcl (new): new PanelFrame widget which creates a + * pkgIndex.tcl: frame with boxed title area that accepts + * Makefile.in: additional widgets. + * BWman/contents.html: + * BWman/navtree.html: + * BWman/PanelFrame.html (new): + + * statusbar.tcl: improve init to use bwidget's automated arg + passing for subwidgets. Simplify delete subcommand to call remove. + + * xpm2image.tcl (xpm-to-image): correctly recognize None with + -nocase + +2004-09-02 Jeff Hobbs + + * buttonbox.tcl, combobox.tcl: code safety fixes + + * dialog.tcl: default button width to -11 on Win8.4, 8 otherwise + + * color.tcl, font.tcl, messagedlg.tcl: + * passwddlg.tcl, progressdlg.tcl: change dialogs to anchor buttons e + + * statusbar.tcl: better -bg handling (configure too), and tighten + up spacing on resize control to place it flush bottom right + +2004-09-01 Jeff Hobbs + + * statusbar.tcl: add -showseparator optional horizontal separator. + +2004-08-31 Jeff Hobbs + + * statusbar.tcl: correct name of image for use on unix. + Try to use of PNG image at each create (it just looks better). + +2004-08-26 Jeff Hobbs + + * tree.tcl (Tree::delete): call -selectcommand if we delete + something that was selected. + +2004-08-25 Jeff Hobbs + + * statusbar.tcl: correct use of PNG vs. GIF image. + Don't abort creation of statusbar when gridded - just don't try + to resize. + Correct example to use label -width 1 + +2004-08-20 Jeff Hobbs + + * statusbar.tcl (new): Addition of a statusbar container widget + * pkgIndex.tcl: with resize control + * Makefile.in: + * BWman/contents.html: + * BWman/navtree.html: + * BWman/StatusBar.html (new): + +2004-05-12 Jeff Hobbs + + * font.tcl (SelectFont::create): don't hardcode -bd 2 when + creating the style selectbuttons. + + * dynhelp.tcl (_show_help): account for OS X help style + +2004-05-04 Jeff Hobbs + + * listbox.tcl (_keyboard_navigation): make sure you can see the + item that you key navigate to. (aas) + +2004-04-26 Jeff Hobbs + + * tree.tcl (_update_nodes): align with _draw_nodes code, + specifically correcting placement of cross on new nodes and anchor + of changed window/image. + +2004-04-23 Jeff Hobbs + + * listbox.tcl (create): don't force -highlightthickness 1 as it + prevents the user changing it on creation. + (_draw_item): pass more cached info from _redraw_items for speed. + (_redraw_selection): correct drawing of selfill for items that + extend beyond the width of the window. + +2004-04-22 Jeff Hobbs + + * tree.tcl (edit): correct inversion of verifycmd emptiness test. + * listbox.tcl: correct eval/after/lists usage. + (_redraw_listbox): call _update_select_fill on redraw, otherwise + the insert of items causes wonkiness. + (_redraw_items): call update idle after changing cursor. + (create): Insert $path into the canvas bindings, so that anyone + binding directly onto the widget will see their bindings activated + when the canvas has focus. Add slightly modified up/down bindings + to the canvas, in case it gets the focus (like with -autofocus). + +2004-04-21 Jeff Hobbs + + * tree.tcl (_draw_subnodes): Adjust the drawing of the line to the + first root node to start at the vertical point (not go up). + + * entry.tcl, arrow.tcl, combobox.tcl: better space/list handling + + * entry.tcl: make the icursor not appear for non-editable and/or + state disabled comboboxes. + +2004-03-08 Joe English + + * init.tcl: (bugfix) Use <> virtual event instead + of event for back-tab binding. + +2004-02-07 Jeff Hobbs + + * progressbar.tcl (ProgressBar::_modify): convert rect coords to + ints to prevent left-over lines that are likely due to a bug in + core Tk related to fractional coord refresh. + +2004-02-03 Jeff Hobbs + + * scrollw.tcl (ScrolledWindow::create): correctly set -relief and + -bd at creation time. [Bug #873666] + + * init.tcl: don't modify *Listbox.background and *Button.padY + options - leave core widgets alone. + + * mainframe.tcl (MainFrame::_create_menubar): set the bg for menus + only on unix (otherwise disturbs menu native L&F) + Correct some eval/list issues. + + * BWman/MainFrame.html: + * mainframe.tcl (MainFrame::_create_entries): correct 'cascade' + spelling, but support old 'cascad' as well. + +2004-01-28 Reinhard Max + + * configure.in: bumped to v1.7. + This should have happened before releasing 1.7.0. + + * Makefile.in: fixed support for DESTDIR. + +2004-01-05 Damon Courtney + + * init.tcl: Added a binding to the Tk spinbox to handle + traversal as loading BWidgets seems to screw up the default + handling for Tk. [Bug #867604] + + * utils.tcl: Fixed a bug that would cause some geometry calculations + in BWidget::place to behave incorrectly. This would occasionally + make it appear as though a drawn dialog would freeze the application. + [Bug #868315] + +2003-12-18 Bob Techentin + + **** BWIDGET 1.7.0 TAGGED **** + + * README.txt: Changed revision to 1.7.0. Note that + 1.7.0 does not include 2003-11-26 mod to notebook.tcl. + +2003-11-26 Jeff Hobbs + + * notebook.tcl (NoteBook::bindtabs): correct tab name returned. (groth) + +2003-11-17 Jeff Hobbs + + * entry.tcl (Entry::create): add missing line continuation. + [Patch #843932] (oehlmann) + +2003-11-10 Damon Courtney + + * entry.tcl: Use a button widget for -disabled options if + we're using 8.3 [Bug 839469] + +2003-11-05 Damon Courtney + + * combobox.tcl: Fixed dropdown listbox selection for + standard Tk listbox [Bug 831496]. + +2003-11-05 Jeff Hobbs + + * scrollview.tcl (ScrollView::_set_view): correct :canvas to + renamed :cmd. + +2003-10-30 Jeff Hobbs + + * scrollw.tcl (ScrolledWindow::setwidget): check that the old + widget associated still exists before unconfiguring it. [Bug #833034] + +2003-10-27 Damon Courtney + + * combobox.tcl, listbox.tcl: Fixed keyboard navigation in the + combobox drop down [Bug 831496]. + + * listbox.tcl: Added curselection subcommand to mimic Tk listbox + behavior. + + Added keyboard navigation to the listbox. + + * widget.tcl: Added Widget::exists command to return whether a + widget is a BWidget (based on whether it exists in the _class array). + + Widget::destroy now properly unsets the widget's variable in + the _class array. + +2003-10-27 Joe English + * DragSite.html, DropSite.html: Fix markup errors [Bug #740484] + +2003-10-20 Damon Courtney + * arrow.tcl, bitmap.tcl, button.tcl, buttonbox.tcl, color.tcl, + * combobox.tcl, dialog.tcl, dragsite.tcl, dropsite.tcl, entry.tcl + * font.tcl, label.tcl, labelentry.tcl, labelframe.tcl, listbox.tcl + * mainframe.tcl, messagedlg.tcl, notebook.tcl, pagesmgr.tcl + * panedw.tcl, passwddlg.tcl, progressbar.tcl, progressdlg.tcl + * scrollframe.tcl, scrollview.tcl, scrollw.tcl, separator.tcl + * spinbox.tcl, titleframe.tcl, tree.tcl, utils.tcl, widget.tcl + * xpm2image.tcl: Revamp again to let core Widget commands handle + most of the esoteric work of creating and destroying widgets + properly in the BWidget environment. + + The command Widget::define defines a class, its filename and a + list of classes which it uses. This command handles creating + the command to create new widgets, creates a ::use command for + the class and calls the ::use command for each class included. + + The command Widget::create does the renaming of the widget to + $path:cmd and creates the proc to redirect the widget commands. + + Widget::destroy now does the rename $path "" that almost all + widgets do. + + * button.tcl: Added a -state option to configure the state of the + entire box at once. + + Added new insert and delete subcommands. + + Added an after cancel to stop button repeat upon release. + [Bug 697022] + + * combobox.tcl: Added -bwlistbox, -listboxwidth and -hottrack options. + -images option already existed, but now it actually does something. + + Added getlistbox, get, icursor, post and unpost subcommands. + + * dynhelp.tcl: Added add subcommand to replace the (now) deprecated + register command. The new command adds for a lot more flexibility + in applying dynamic help. + + Help popup now comes up -topmost 1 on Windows if available. + + * entry.tcl: Added -disabledbackground option so that the BWidget + entry more closely resembles the standard Tk entry. + [Bug 638236]. + + * init.tcl: Moved Widget::traverseTo into widget.tcl. + + * label.tcl: Renamed BWLabel class to just Label. + + * listbox.tcl: Added a default -dropcmd so that if -dragenabled + and -dropenabled are true, drag-and-drop within the same widget + is possible without any other options. + + Added -autofocus option to specify that clicking within the listbox + should draw the focus in order to handle mouse wheel events. + + Added -selectfill option for drawing a full selection rectangle + around selected items instead of just around the item. + + Added getcanvas subcommand. [Bug 436762]. + + bindImage and bindText now map %W to $path in order to get an + accurate path in events. This can probably be fixed better + when we have more control over event parameters. [Bug 607745] + + Added mouse wheel bindings by default. + + Added <> event when selection changes. + + * mainframe.tcl: Fixed bug for adding CTRL-F items to a mainframe + [Bug 784269] + + * messagedlg.tcl: Added -buttonwidth option. + + * notebook.tcl: Added dynamic help to tabs. + + Added -tabpady option to specify the padding between the text and + the tab. + + Notebooks now handle multi-line text properly. [Bug 565284] + + * scrollview.tcl: Rewritten to use a variable per path instead of + a big array. + + * tree.tcl: Added -anchor option to nodes to specify the anchor for + an image or window when displayed. + + Added -crossopenimage, -crosscloseimage, -crossopenbitmap and + -crossclosebitmap options to change the open / close cross. + + Added mouse wheel bindings by default. + + Added toggle subcommand to toggle a single tree node. + + Added <> event when selection changes. + + The characters "& | ^ !" are all converted to | silently in + node names. This is to avoid errors because these characters + are special to the canvas widget. [Bug 746960] + + bindImage and bindText now map %W to $path in order to get an + accurate path in events. This can probably be fixed better + when we have more control over event parameters. [Bug 607745] + + * utils.tcl: Added BWidget::wrongNumArgsString command to return + a standard wrong # args error string. + + Added BWidget::classes command that returns a list of all classes + required by a given class. + + Added BWidget::inuse command to determine if a given class is inuse. + + Added BWidget::library command to return a body of code that can + be saved into a project or other code based on the given classes. + When called with a list of classes, all the classes and code + necessary to use those classes is returned in a large string which + can then be written out to a file. + + Added BWidget::write command to write to a given file the current + set of classes that are in use. + + Added BWidget::bindMouseWheel command to setup default mouse + bindings on a given widget. + + * widget.tcl: Added a new option type 'Padding' which will accept + the standard padding arguments in Tcl 8.4+. + + Added Widget::define command to define a new BWidget class. + + Added Widget::create command to create a BWidget properly. + + Widget::destroy now attempts to delete a widget command created + through Widget::create. + + Added Widget::options command to return the current options of + a given widget in a style that can be used to serialize a widget. + + Added Widget::getOption command to get options based on children + having the same option. + + * wizard.tcl: Added new Wizard widget. + + +2003-10-17 Jeff Hobbs + + * arrow.tcl, bitmap.tcl, button.tcl, buttonbox.tcl, color.tcl, + * combobox.tcl, dialog.tcl, dragsite.tcl, dropsite.tcl, entry.tcl + * font.tcl, label.tcl, labelentry.tcl, labelframe.tcl, listbox.tcl + * mainframe.tcl, messagedlg.tcl, notebook.tcl, pagesmgr.tcl + * panedw.tcl, passwddlg.tcl, progressbar.tcl, progressdlg.tcl + * scrollframe.tcl, scrollview.tcl, scrollw.tcl, separator.tcl + * spinbox.tcl, titleframe.tcl, tree.tcl, utils.tcl, widget.tcl + * xpm2image.tcl: major revamp to reduce incorrect use of eval and + other list-safetiness evils. Also change !strcomp to streq. + +2003-08-06 Jeff Hobbs + + * listbox.tcl: Correct Listbox selection drawing [Bug #781652] + +2003-07-17 Joe English + * init.tcl, combobox.tcl: Fix for [Bug 720032] "BWidget + breaks Tk entry behaviour". Highlight the entry + in a <> binding, instead of doing so + on every event. Change the global + and bindings to generate <> + and <> events. + +2003-07-17 Jeff Hobbs + + * notebook.tcl: Use list with eval for safety. + Use lsearch -exact instead of default -glob in all uses. + + * listbox.tcl (_multiple_select): correct shift-selection when + selectmode is multiple. [Bug 653266] + Use lsearch -exact instead of default -glob in all uses. + Use list with eval for safety. + + * BWman/ScrolledWindow.html: clarify management of embedded widget. + +2003-06-23 Damon Courtney + * combobox.tcl: Added a little better handling of keys in the + auto-complete. + +2003-06-06 Damon Courtney + * combobox.tcl: Added a rudimentary auto-complete function + with option (-autocomplete) that is turned off by default. + Over time, I'm sure this function can be improved, but I + think it works pretty well for now. + + * BWman/ComboBox.tcl: Added documentation for -autocomplete. + +2003-06-05 Damon Courtney + * listbox.tcl: Liberal use of list where appropriate to make + the code safe for space-containing node names. + +2003-05-23 Bob Techentin + + **** BWIDGET 1.6.0 TAGGED **** + + * README.txt: + +2003-05-18 Jeff Hobbs + + * progressbar.tcl: correctly handle progressbar being quickly + created and deleted by deleting afters and checking var existence. + +2003-05-18 Joe English + + * widget.tcl (Widget::focusOK): Don't assume that '-editable' + option is always 1 or 0 for all widgets. [Bug 710658] + +2003-05-14 Jeff Hobbs + + * demo/tree.tcl: make the tree scrollview make sense in demo. + [Bug 684462] + + * notebook.tcl: ensure that bd is min 1 at all times. [Bug 688227] + Correct use of eval with list. + + * tree.tcl: correct node lsearch'ing to use -exact to allow for [] + containing nodes [Bug 628041] (decoster) + +2003-05-07 Jeff Hobbs + + * dynhelp.tcl (DynamicHelp::_motion_balloon): correctly listify + after delayed _show_help callback. + +2003-05-06 Jeff Hobbs + + * scrollw.tcl (ScrolledWindow::setwidget): remove any existing + widget before setting the next. + +2003-05-01 Jeff Hobbs + + * tree.tcl (Tree::configure, Tree::_draw_node): add a full-width + box underneath the text and image/window that will react to the + node binding if -selectfill is true. It is an empty box that is + overly wide, but it could be improved to resize on Configure to + just the window width and replace the sel box. + +2003-04-23 Jeff Hobbs + + * tree.tcl: liberal use of list where appropriate to make the code + safe for space-containing node names. + Make use of string equal instead of !string compare. + (Tree::_redraw_selection): correct -selectfill to include the + image, in any, in the bbox calculation since it may be larger. + +2003-04-15 Damon Courtney + + * listbox.tcl + * tree.tcl: Added a #auto substitution for inserting new items + into a tree or listbox. + + * BWman/ListBox.html + * BWman/Tree.html: Added documentation for #auto substitution. + +2003-04-14 Jeff Hobbs + + * utils.tcl (BWidget::focus): add optional refocus arg + * combobox.tcl: make droplist use solid 1-pixel relief more in + accordance with Windows style. Set topmost attribute on droplist. + Add bindings that unmap the droplist if we lose focus to another + application (where [focus] == ""), without refocusing to the entry. + +2003-04-11 Jeff Hobbs + + * combobox.tcl (ComboBox::_expand): add tab expansion behavior + when -expand tab is specified + (ComboBox::_focus_in): autohighlight full contents only when no + existing selection exists. [Bug #720024] + + * BWman/ComboBox.html: doc -expand none|tab + +2003-03-12 Damon Courtney + + * listbox.tcl: Added dynamic help support to listbox items. + + * tree.tcl: Fixed a little inconsistency in the tree dynamic help. + We don't need to save the whole path in the help array, just the + node. + +2003-02-25 Jeff Hobbs + + * scrollw.tcl: add lock around grid remove scrollbar to prevent + infinite loop in small window situations. (kienzle) + + * pkgIndex.tcl: + * configure.in: bumped to v1.6 + + * scrollw.tcl: complete rewrite of ScrolledWindow widget to + address infinite loop scrollbar problems. This one is much + simpler and does not suffer the infinite loop. There still seems + to be an issue with shrinking smaller than one scrollbar width / + height in size, but that's not common (nor fatal). Addresses + [Patch #671821, #520903] [Bug #472718, #564691] + This may introduce new incompatabilities, but it does work as + expected for noted bugs and in the demos. + + * widget.tcl: code cleanup + * scrollframe.tcl: code cleanup + +2003-02-24 Jeff Hobbs + + * panedw.tcl (_realize): only allow _realize to be called once the + Configure binding has triggered once. [Bug #613134] + [Patch #63500] (decoster) + +2003-02-17 Jeff Hobbs + + * font.tcl: comment out the adding of default style bits for bold + and italic. The allows setting the font to something like + "Courier 8", clicking B on and off and getting "Courier 8" back + again (otherwise gave "Courier 8 normal roman"). + +2003-02-08 Damon Courtney + * BWman/SelectColor.html + * color.tcl: Cleaned up some of the documentation of SelectColor + and made it actually work like the documentation says it does. + + * BWman/DynamicHelp.html + * dynhelp.tcl: Added -topbackground, -padx and -pady options to + allow a little more flexibility in the look-and-feel of balloons. + + Added the ability to bind dynamic help to individual items or tags + on a canvas. + + * BWman/Tree.html + * tree.tcl: Added -padx and -deltax options to individual nodes + within a tree. Each option defaults to -1, meaning to take its + value from the global option of the same name. + + Added dynamic help to nodes within a tree. Adds the following + options: -helptext, -helptype and -helpvar to each node. + + * BWman/BWidget.html + * utils.tcl: Added BWidget::badOptionString utility to return a + standard error string when a given option doesn't match a list. + + * BWman/Widget.html + * widget.tcl: Added Widget::getVariable proc to create a reference + to a variable relative to the given widget path. + +2003-01-26 Damon Courtney + * BWman/DynamicHelp.html: + * dynhelp.tcl: Added -state option to disable help balloons on a + global scale. + + * BWman/Tree.html: + * tree.tcl: Added -crossfill option to allow the + / - bitmap to + be filled with a different color than the connecting node lines. + -linesfill is now accurate in its help entry and only adjusts + the foreground color of the lines between the nodes. + +2003-01-24 Joe English + * tree.tcl (Tree::delete, Tree::_subdelete): remove all deleted + nodes from the the selection [Bug #621178]. + +2003-01-17 Pat Thoyts + + * labelentry.tcl: fixed -textvariable option [bug #649383] + +2002-10-14 Jeff Hobbs + + * pkgIndex.tcl: + * configure.in: bump version to 1.5 + + * button.tcl: remove -repeatdelay and -repeatinterval for 8.4 to + allow Button to override them. [Bug #620103] + + * combobox.tcl: make -entrybg also control the listbox background. + [Bug #519189] (chevreux) + + * tree.tcl (_see): change to always show left edge of requested + item. [Patch #556077] (english) [NOTE: also included Patch #621331 + "Allow delete of selected Tree nodes"] + + * dynhelp.tcl: allow variable and balloon help simultaneously. + [Patch #567982] (decoster) + + * BWman/LabelFrame.html: + * labelframe.tcl: allow -bitmap -image and -textvariable options + of the BWLabel component of a LabelFrame. [Patch #620753] (decoster) + + * widget.tcl (_get_tkwidget_options): withdraw toplevel if it is + the TkResource base widget. [Patch #620754] (decoster) + + * tree.tcl (delete): correct tree deletion with selected nodes. + [Patch #621331] (decoster) + + * progressbar.tcl (_modify): use updated idletasks instead of + update. [Patch #622927] (decoster) + +2002-09-25 Jeff Hobbs + + * Makefile.in: better DESTDIR/libdir support (steffen) + +2002-09-11 Jeff Hobbs + + * color.tcl (SelectColor::menu): added tkwait and update to make + sure that the grab doesn't fail on Unix. + + * listbox.tcl: corrected multiple selectmode bindings. + [Patch #483838, Bug #594853] (decoster) + +2002-08-23 Andreas Kupries + + * tree.tcl: Modified subcommand 'includes' of the method + 'selection to properly extract its argument. ... Revamped the + whole subcommand to properly extract and check its arguments. + + (create) Added Control-Button-1 bindings to allow toggling the + selection of a node. I will do no bindings for shift-selecting + and/or drag-selecting ranges. To complex for me right now. + + Moved the code executing the -selectcommand callback to an + internal procedure, and added calls to that procedure to all + subcommands which change the selection. This fixes SF Bwidget + Bug #547245. + + * BWman/Tree.html: Documented the 'includes' and 'range' + subcommands of the method 'selection' of tree widgets. + Documented the node option '-selectable'. Documented that the + subcommands extending or setting the selection silently ignore + unselectable nodes. Documented new 'toggle' subcommand of method + 'selection'. Documented option --slectcommand'. Fixed bogus + table html in option lists. + +2002-06-04 Jeff Hobbs + + **** BWIDGET 1.4.1 TAGGED **** + + * README.txt: + * configure.in: + * pkgIndex.tcl: up'ed version to 1.4.1 + + * listbox.tcl: corrected use of 'end' as move index. [Bug #561391] + * buttonbox.tcl: + * tree.tcl: force frame -padx/-pady to 0 to handle 8.4+ frame + padding options. [Bug #545119] + + * scrollframe.tcl: corrected scrollregion configuration on + Configure of frame to use full width/height of canvas when the + canvas is larger. This ensures that scrolling "anchors" properly + to topleft. + + * dialog.tcl: prevent dialog from freezing on Windows with tkwait + visibility on withdrawn toplevels. [Patch #521386] (chevreux) + + * font.tcl: reworked loadfont to not sort font names unless + requested. [Patch #524353] (kienzle, hobbs) + + * panedw.tcl: corrected handling of weighted panes following a + Configure event. [Patch #513320] (decoster) + + * progressbar.tcl: Fixed display of vertical progressbar. + [Patch #561403] + +2002-05-29 Andreas Kupries + + * combobox.tcl: Changed relief of popup list to ridge, for Win* + platforms. + +2002-05-09 Andreas Kupries + + * dynhelp.tcl: Accepted patch for bug 528929. Reported by + , patch also by him. + +2002-04-25 Andreas Kupries + + * notebook.tcl: Accepted patch for bug #532246, fixing the + appearance of the tabs so that text is always visible + completely. + +2002-01-26 Pat Thoyts + + * utils.tcl: Modified BWidget::place to support multiple screens + under Windows. Better support would require Tk modifications. + * demo/tree.tcl: Fixed for starting on secondary monitor under + windows. + * BWMan/BWidget.html: added documentation for BWidget::place. + +2002-01-22 Jeff Hobbs + + **** BWidget 1.4.0 tagged **** + + * widget.tcl: added Color as an optional type, with _test_color + test. [RFE #443124]. + +2002-01-15 Jeff Hobbs + + * BWman/ComboBox.html: removed reference to label options that + were removed when the LabelFrame was dropped. [Bug #477130] + + * listbox.tcl: allowed drop handler to work in empty listbox. + [Bug #456883] + + * mainframe.tcl: correct unprotected eval calls. [Patch #501210] + (chevreux) + +2001-12-28 Jeff Hobbs + + * BWman/Dialog.html: + * dialog.tcl: Added '-transient' and '-place' flags. + [Patch #483838] (decoster) + + * BWman/Tree.html: + * tree.tcl: Added a 'recursive' argument to 'Tree::opentree' and + 'Tree::closetree'. [Patch #483838] (decoster) + + * BWman/ProgressBar.html: + * progressbar.tcl: Added new type 'nonincremental_infinite' and + modified movement of progressbar when in 'infinite' or + 'nonincremental_infinite' mode. The 'nonincremental_infinite' can + be used when a certain process monitored by a ProgressBar returns + a total count and not an increment count. [Patch #483838] (decoster) + + * BWman/PanedWindow.html: + * panedw.tcl: Added '-weights' flag with possible value 'extra' or + 'available'. Since BWidget-1.3.1, the meaning of the '-weight' + flag for the 'PanedWindow::add' command was changed. This made it + difficult to create a layout where the panes occupy a certain + amount of the screen. When using the '-weights extra' flag when + creating a PanedWindow widget, the >=1.3.1 behavior is used: the + weights for the different panes are only used for extra space. + When using the '-weights available' flag, the weights for the + different panes are used to set the size of each panes relative to + the total available space. [Patch #483838] (decoster) + + * BWman/ListBox.html: + * listbox.tcl: Added '-selectmode' flag and 2 possible + select-modes: single and multiple. [Patch #483838] (decoster) + + * widget.tcl: Select element 4 (was 3) from the config-options to + get value from optiondb. [Patch #483838] (decoster) + + * utils.tcl: added else case to place is called with location + different from 'at' and 'center' and without a parent. + [Patch #484123] (decoster) + + * mainframe.tcl: added options -menubarfont, -menuentryfont and + -statusbarfont at creation time of the widget as well as + subsequent configures. [Patch #479935] (chevreux) + + * listbox.tcl: added multipleinsert command to allow faster + inserts of multiple items. [Patch #458446] (chevreux) + * widget.tcl: added Widget::copyinit. [Patch #458446] (chevreux) + + * BWman/NoteBook.html: + * notebook.tcl: added options for enhanced tab shape in notebooks. + [Patch #402466] (haneef) + + * configure.in: + * pkgIndex.tcl: + * README.txt: bumped version to 1.4.0 (not released) + + * mainframe.tcl (_create_menubar): start tagstate initially on. + [Patch #470273] (chevreux) + (_parse_accelerator): improve F* function key accelerator support. + [Patch #444172] (venski) + +2001-10-14 Jeff Hobbs + + * pagesmgr.tcl: reverted fix of 2001-10-11 - it was bogus. + +2001-10-11 Jeff Hobbs + + * pagesmgr.tcl: allowed the ability to specify page by name, + not just number. + +2001-09-11 Andreas Kupries + + * notebook.tcl: Removed 'Canvas' from the list of bindtags for the + internal canvas to prevent interference from application + specific bindings with our special widget. [459033]. + +2001-09-06 Andreas Kupries + + * passwddlg.tcl: Accepted change by Bastien Chevreux + adding a -logineditable option to + the password dialog. [436340]. + +2001-09-05 Andreas Kupries + + * panedw.tcl: Added option -activator to allow user to choose sash + activator. Reduced minimum allowed sash width. [442474]. Request + made by Bastien Chevreux . + + * label.tcl: Corrected typo in BWlabel::configure [454505], report + and fix by Bastien Chevreux . + + * arrow.tcl: Changed containing frame to be more invisible + (borderwidth 0). Fixes [458301], by Georgios Petasis + . + +2001-08-08 Andreas Kupries + + * tree.tcl (Tree::_keynav): Added code to call the open and close + commands when the open-status of a node is toggled with the + space bar. Bug [449284]. + + * color.tcl: Added the missing definition of the main + 'SelectColor' procedure. This prevented users from creating + these widgets in the documented way. Bug [449276]. + +2001-06-21 eric melski + + * tree.tcl: Corrected keyboard navigation so that open/close + commands are invoked when right/left arrows are used to open/close + nodes, patch from [Bug #435097]. Also corrected keyboard + navigation on right arrow press; previously only opened closed + nodes that had children, but should always open nodes, regardless + of whether it has children. + +2001-06-11 Jeff Hobbs + + * pkgIndex.tcl: bumped version to 1.3.1 and added Tk 8.1.1 package + require as Tcl 8.1.1 is needed in certain core areas for the new + string methods. + + * mainframe.tcl: corrected state interpretation. It doesn't do + exact argument matching, but it is consistent with the rest of + BWidget. [Bug #224476] + + * demo/demo.tcl: fixed demo script to run when called from + another directory + + * messagedlg.tcl: corrected winfo exists call + + * listbox.tcl: fixed string compare call + + * combobox.tcl: added package require Tk 8.3. + + * passwddlg.tcl: + * xpm2image.tcl: + * mainframe.tcl: + * panedw.tcl: + * utils.tcl: + * entry.tcl: + * dynhelp.tcl: + * dragsite.tcl: + * color.tcl: added braces to expr where appropriate + +2000-10-31 Dan Kuchler + + * combobox.tcl: Added the '-exact' option to the 'lsearch' + commands in the combobox code so that the correct index + of items will be returned even when there are glob/regexp + characters. + +2000-10-10 Dan Kuchler + + * dynhelp.tcl: Added the '-screen' option to the toplevel that + is created to display the help text to fix a bug reported by + Tupone Alfredo. + +2000-10-01 Eric Melski + + * notebook.tcl: Fixed typo in _draw_page that incorrectly placed + images on tabs. + +2000-09-17 Eric Melski + + * widget.tcl (_test_boolean): Altered to return strictly 0 or 1 + (for false and true, respectively), rather than allowing the + string booleans (false, true, off, on, etc). + +2000-09-07 Sven Delmas + + * mainframe.tcl: Fixed the typo of Alt (Atl) as reported in bug # + 6079. + +2000-09-05 Eric Melski + + * label.tcl: Corrected bindtags for BWidgets Label components: + primary component widget now includes the megawidget pathname in + its bindtags list, so that bindings on the megawidget pathname are + applied properly. + +2000-08-10 Eric Melski + + * widget.tcl: Corrected a problem caused by the destruction of the + special .#BWidget* widgets, which are used by BWidgets for some + option value validations; formerly, if these were destroyed, it + could confuse the BWidgets system's internal state, and creating + BWidgets after destroying these helper widgets would throw an error. + +2000-06-14 Dan Kuchler + + * dialog.tcl + * dropsite.tcl + * dynhelp.tcl + * scrollview.tcl: Replaced several catch {unset varname} calls with + if {[info exists varname]} {unset varname}. This avoids using the + catch, and also prevents the ::errorInfo corruption that was happening + in BWidgets. + +2000-05-14 Dan Kuchler + + * tree.tcl: Fixed a typing error in the Tree::find procedure. + The procedure wouldn't work because there was a 'llengh' where there + should have been a 'llength'. + +2000-05-08 Dan Kuchler + + * titleframe.tcl: Added a '-state' flag that is associated to the + state of the label. Now that labels can be disabled (in 8.3 and + beyond) this allows for the titleframe to have a disabled appearence. + +2000-05-02 Eric Melski + + * tree.tcl: Did some fancy focus footwork [Bug: 4491]. Now you + can do this: "Tree .t ; bind .t foo", and it will do + the right thing. This will enable the use of proper + focus-on-mouse-click bindings for trees, which in turn will fix + the focus problem described in 4491. In addition, I added a + binding to the canvas widget in the tree that redirects focus when + it leaves the canvas and goes to the frame, just in case. + + * dialog.tcl: Added a -geometry option, to allow the specification + of geometry for the dialog. No particular care is taken to + validate the geometry string, so if it is bogus, you lose. [RFE: + 5188]. + +2000-04-27 Eric Melski + + * entry.tcl: Added smarts to handle Copy for non-editable entries + (it should be allowed, but was not previously) [Bug: 3755]. + + * notebook.tcl: Small tweaks for placement of images on tabs. + + * combobox.tcl: Added code to ensure that non-editable (but + enabled) comboboxes could still be tabbed in to. + +2000-04-26 Dan Kuchler + + * button.tcl: Fixed the bindings that get setup on buttons with + an underline specified to be case insensitive (i.e if 'A' or 'a' + was the underline character, Alt-A and Alt-a would both be bound + to the button. + +2000-03-29 Sven Delmas + + * tree.tcl: Added protection for the left arrow key click in case + we are already at the root node. This used to throw a Tcl error + (fixes bug # 4619). + +2000-03-20 Eric Melski + + * progressbar.tcl: (configure) Added test for change to -maximum + value, so that bar is redrawn if maximum changes. [Bug: 4399]. + + * BWman/SpinBox.html: Removed references to -label* options. + + * demo/select.tcl: Removed use of -label* options on ComboBox and + SpinBox. [Bug: 4394]. + +2000-03-14 Eric Melski + + * button.tcl: (configure) replaced several hasChanged calls with + one hasChangedX call. + + * dynhelp.tcl: (sethelp) replaced several hasChanged calls with + one hasChangedX call. + + * entry.tcl: Replaced stack of hasChanged calls with one + hasChangedX (in configure); replaced a couple cget's with + getMegawidgetOption's. + + * spinbox.tcl: Updated _test_options to use setMegawidgetOption, + and to only do that if it has to, instead of always doing it. + + * tree.tcl: Worked on itemcget; instead of upvar'ing the + one-time-use variable, just refer to it directly. + + * widget.tcl: One problem with [set + ${class}::${path}:opt($option)] -- if path contains "foo(foo)", + the command will choke. Removed that particular + micro-optimization. Added setMegawidgetOption to compliment + getMegawidgetOption; extended hasChangedX to accept multiple + options to check. This allows us to compress stacks of hasChanged + calls into a single call (so there's a single function call, and a + single upvar...). + +2000-03-13 Eric Melski + + * combobox.tcl: Tweaked bg/background options so that button + didn't pick up entry background. + + * widget.tcl: Removed dead code; micro-optimizations to initFromODB. + + * tree.tcl: Added option for default -fill of tree nodes on windows. + + * notebook.tcl: Removed commented code. + + * button.tcl: + * tree.tcl: + * spinbox.tcl: + * entry.tcl: + * dropsite.tcl: + * dragsite.tcl: + * arrow.tcl: Replaced selected cget/getoption calls with + getMegawidgetOption calls. + + * combobox.tcl: Removed LabelFrame from ComboBox (30% faster). + + * widget.tcl: Added getMegawidgetOption function, which allows + direct access to megawidget-specific options (those that do not + map to a component widget option). This is dangerous, because it + bypasses some checks, and it will only work with options that are + specific to the megawidget. However, it is much faster, and + enables some functions (like visiblenodes) to be much faster. + + * tree.tcl: Reworked visiblenodes function to do a tree walk to + find visible nodes. This is faster and more correct than the + previous implementation, which queried all the nodes in the tree + for their open bit. + + +2000-03-10 Eric Melski + + * widget.tcl: Replaced an upvar with a direct reference to the + variable in initFromODB. + + * dynhelp.tcl: Changed sethelp function to use new hasChangedX + function instead of hasChanged, which avoids an unneeded upvar, + for a little better speed. + + * button.tcl: Changed to parseArgs/initFromODB format for a small + (25%) speedup in creation time. + +2000-03-10 Sven Delmas + + * tree.tcl: Changed the allnodes procedure to visiblenodes, and + also the mechanism of retrieving those nodes. This took care of + the previously required update. + +2000-03-09 Eric Melski + + * entry.tcl: Added code to re-sync the -text option with the + contents of the entry widget before doing configuration; this + fixes [Bug: 4304]. + +2000-03-09 Sven Delmas + + * tree.tcl: Disabled the update before the find withtag in the + allnodes procedure. The nodes are apparently created delayed, so + before this procedure is called, the program has to do an + update. I don't do this in the procedure anymore, because it + caused multiple updates, making the app slower. + +2000-03-08 Sven Delmas + + * tree.tcl: The new allnodes procedure was not handling the + "current" tag correctly. This is now stripped of. + +2000-03-07 Eric Melski + + * button.tcl: Added check for -state flag, to initialize it properly. + + * entry.tcl: Changed to parseArgs/initFromODB format; added check + for -text flag to initialize it properly. + + * labelentry.tcl: Changed to use parseArgs/initFromODB format. + +2000-03-03 Eric Melski + + * spinbox.tcl: Added a call in setvalue to scan the current value into + a float to trim out any 0 padding on the number (otherwise the zero's + make it look like octal to tcl, which chokes on numbers > 8) + +2000-03-07 Sven Delmas + + * passwddlg.tcl: Reenabled the binding to activate the ok + button. + + * dragsite.tcl: I added an extra protection into the _begin_drag + procedure to guard against a motion event that (sometimes) arrives + before the press event. This fixes bug # 4324. + +2000-03-03 Eric Melski + + * spinbox.tcl: Removed LabelFrame from SpinBox (BACKWARDS + INCOMPATIBLE) to speed creation; updated configure proc to use + hasChangedX instead of hasChanged, as it didn't really need the + values of the options it was checking. + +2000-03-01 Eric Melski + + * spinbox.tcl: Changed bindings to be on class SpinBox instead of + BwSpinBox, and added class SpinBoxEntry to the bindtags of the + SpinBox entry component. + + * configure.in: + * pkgIndex.tcl: Bumped version to 1.3.0. + + * tree.tcl: Changed focus redirect to use {after idle} to avoid + focus loops. + + * label.tcl: Added -bd 0 -highlight... etc to wrapper frame; moved + class bindings to the frame instead of the component label. + + * utils.tcl: Added helper function BWidget::refocus, to handle + focus redirection calls. + + * spinbox.tcl: Changed focus redirect to use {after idle} to avoid + focus loops. + + * combobox.tcl: Changed init to parseArgs/initFromODB style; + changed focus redirect to use {after idle} to avoid focus loops. + +2000-02-29 Eric Melski + + * widget.tcl: Added bits to handle + $path#subclass_that_inherits_from_other_bw_class megawidget names. + + * passwddlg.tcl: + * progressdlg.tcl: + * progressbar.tcl: Changed init to parseArgs/initFromODB style. + + * pkgIndex.tcl: Changed Label -> BWLabel + + * messagedlg.tcl: Changed initialization to parseArgs/initFromODB + style. Changed to use tk_messageBox on UNIX. + + * labelframe.tcl: Updated to use BWLabel instead of Label. + + * labelentry.tcl: Added -class LabelEntry to widget. + + * label.tcl: Changed class name to BWLabel (to avoid option db + clashes with tk labels), changed initialization to + parseArgs/initFromODB style. + + * init.tcl: dropped obsolete Tree option from init. + + * dialog.tcl: changed initialization to parseArgs/initFromODB style. + + * notebook.tcl: Added -bd 0 -highlightthickness 0 -relief flat to + the notebook container frame so geometries are correct. + + * entry.tcl: Fixed a conflict with configuring the Entry -text and + textvariables. + + * dialog.tcl: added a -class option to the dialog, to allow the + class of the dialog to be set (this enables proper optiondb use + for things like the PasswdDlg). + +2000-02-28 Eric Melski + + * widget.tcl: Added Widget::varForOption function, which returns a + variable name that can be used to trace changes to an option for a + particular megawidget (such as the -values option of a combobox). + + * entry.tcl: Made cget -text a little more efficient by + shortcircuiting in that case. + + * combobox.tcl: Fixed bug #4248 by making the listbox use a + -listvariable instead of trying to micromanage the listbox contents. + + * tests/entry.test: tests for the Entry widget. + + * widget.tcl: minor code cleanup. + + * tree.tcl: Was not getting proper default bg color on Windows, + and keyboard navigation was goofy because of internal structure + changes. + + * entry.tcl: Fixed an issue with initial foreground color not + being picked up correctly. + +2000-02-28 Sven Delmas + + * tree.tcl: Added a procedure called "allnodes" to retrieve the + names of all currently defined treenodes. Apparently the internal + widget structure of tree was changed recently. I adjusted the + "allnodes" procedure to that. + +2000-02-25 Eric Melski + + * combobox.tcl: Fixed a problem with non-editable comboboxes and + selecting values. + + * arrow.tcl: + Fixed a problem with the invoke method (doing one too many winfo + parents in some cases) + + * button.tcl: + * buttonbox.tcl: + * combobox.tcl: + * dialog.tcl: + * dynhelp.tcl: + * entry.tcl: (also fixed validation) + * label.tcl: + * labelframe.tcl: + * listbox.tcl: + * mainframe.tcl: + * notebook.tcl: + * pagesmgr.tcl: + * panedw.tcl: + * progressbar.tcl: + * scrollview.tcl: + * scrollw.tcl: + * separator.tcl: + * spinbox.tcl: + * titleframe.tcl: + * tree.tcl: Updated to new megawidget architecture. + + * widget.tcl: Changed internal architecture. When possible, + megawidget options are stored in component widgets instead of in + an intermediary array. Also, made use of option database to make + megawidget creation more efficient. + +2000-02-24 Eric Melski + + * LICENSE.txt: Removed LGPL license; added Tcl-license terms. + +2000-02-23 Eric Melski + + * widget.tcl: Replaced _test_boolean function with a more efficient + implementation. + +2000-02-18 Eric Melski + + * images/target.xbm: Placeholder for actual icon. + + * color.tcl: Change env(BWIDGET_LIBRARY) to ::BWIDGET::LIBRARY; + changed proc "dialogue" to "dialog" + + * pkgIndex.tcl: Updated function spec for color.tcl. + + * widget.tcl: Various minor speed tweaks; added a reverse mapping + from component widget options -> mega-widget options so that + subcget can be faster. + + * entry.tcl: + * dropsite.tcl: + * dragsite.tcl: + * arrow.tcl: Tcl list'd the specs for Widget::declare calls. + + * combobox.tcl: Removed extraneous ListBox::use call. + + +2000-02-17 Eric Melski + + * notebook.tcl: Added an extra check to move the leftmost tab a + touch to the right when it is not selected (again, to make the + tabs more Windows-like). Also replaced redundant [string equal] + checks with a stored pre-check (ie, set foo [string equal ...]). + +2000-02-16 Eric Melski + + * notebook.tcl: Changed appearance of tabs; leftmost tab is now + flush with the left of the notebook, and the tabs look more + Windows-like. + +2000-02-16 Sven Delmas + + * dialog.tcl: Added a new parameter to the draw procedure that + allows me to pass in the desired geometry for the window. This was + needed to support tracking of dialog window geometries. + + * tree.tcl: Changed the binding to use "+", so it + will not overwrite existing bindings (if there are any). Also + added some extra protection in the keynav procedure against the + user typing on a root node (this used to cause a stack + trace). + +2000-02-11 Eric Melski + + * tree.tcl: Integrated changes from Eric Boudaillier: + [itemconfigure -open ...] + optimized to only call redraw_idle 3 if node has subnodes. + _cross_event: + itemconfigure -open called before -opencmd/closecmd; no more + call to _redraw_idle (handled by other procedures) + _over_cmd: + allow position {root 0} when tree is empty + new [find] command: + [find @x,y ?confine?] + if confine is "confine" returns the node at window + coordinate x,y (x,y must be inside the bbox of the + node) else returns the node found on the line (in + pixel) pixel y + [find line] + returns the node on the line $line (in -deltay coords) + new [line] command: + [line node] + returns the line where node is drawn + -selectfill option added: + if true, selection is draw on full width of tree (instead of + just highlighting the bbox of the selected nodes) + + * combobox.tcl: Integrated changes from Eric Boudaillier: + internal widget restructuring. + + * tree.tcl: Added "range" subcommand to selection. Given two + nodes, node1 and node2, it will set the selection to the visible + nodes between (and including) node1 and node2. If node1 or node2 + is not visible, it will find the first visible ancestor of the + node and use that as the start/end point instead. + + * listbox.tcl: Integrated changes from Eric Boudaillier: + _over_cmd: allow position 0 when listbox is empty + find command, similar to tree find command. + + * spinbox.tcl: Integrated changes from Eric Boudaillier: + cosmetic changes. + + * color.tcl: Integrated changes from Eric Boudaillier: + split widget into two commands: SelectColor::menu and + SelectColor::dialog. + + * progressbar.tcl: Integrated changes from Eric Boudaillier: + added -idle option to prevent call to update in case where task is + done in idle (ie, fileevents) + + * scrollview.tcl: Integrated changes from Eric Boudaillier: + bindings changed. + + * scrollw.tcl: Integrated changes from Eric Boudaillier: + -managed option: if true, scrollbar are managed during creation, + so their size are included in the requested size of the + ScrolledWindow. If false, they are not. + -sides option: specifies the side of the scrollbar. + -size option: specifies size of scrollbar. + -ipad option: specifies pad between scrollbar and scrolled widget. + + * mainframe.tcl: Integrated changes from Eric Boudaillier: support + for function keys in accelerators, support for no modifier in + accelerators. + + * notebook.tcl: Integrated changes from Eric Boudaillier: + -internalborderwidth (-ibd) option specifies pad around pages; + -foreground, -background, -activeforeground, -activebackground, + -disabledforeground options for each tab. + Code cleanup. + +1999-12-23 Sven Delmas + + * scrollw.tcl: Added "update idletask" to scrollbar update to + prevent loss of update events. + +1999-12-14 Sven Delmas + + * combobox.tcl: When the selected item is changed, the selection + is now set to the entire string. + +1999-12-13 Eric Melski + + * buttonbox.tcl: Added a getbuttonstate function, which retrieves + the value of a tag used on a button in the buttonbox. + +1999-12-08 Eric Melski + + * combobox.tcl: Removed code that cleared entry selection on focus out + events, as this crippled exportselection. + +1999-10-29 Eric Melski + + * buttonbox.tcl: Added a gettags function, which allows the user + to query the tags that are used on buttons in the buttonbox. + +1999-10-29 Eric Melski + + * font.tcl: Added one new flag: -querysystem. This lets the user + control whether the font selector queries the system + (via font families) for the list of fonts, or if it uses a preset + list of fonts (which is much faster and less likely to crash some + systems). + +1999-10-25 Eric Melski + + * font.tcl: Added support for two new flags: -families and -styles; + -families allows you to specify one of all, fixed, or variable, to + limit the choice of fonts to those fonts; -styles allows you to + specify a list of styles that can be set with the widget (ie, + bold, italic, etc). + +1999-10-22 Eric Melski + + * tree.tcl: Fixed some problems with keyboard traversal. Added + support for left/right arrows a la MS Explorer. + Added support for keyboard-based scrolling. + +1999-10-21 Sven Delmas + + * combobox.tcl: Added support for keyboard traversal. The widget + will now tab in even when it is not editable. Also the entry + widget content will be selected when the user tabs in. The key + bindings now allow a traversal of the list ( brings up the + list). The arrow button no longer switches to an up button, but + instead changes relief. The button is now more Windows NT like + (for Windows NT). Changed keyboard bindings: down/up now + display/hide the listbox; control-{up|down|prev|next} move through + the options without displaying the listbox. + +1999-10-21 Eric Melski + + * tree.tcl: Added a -selectable option to tree nodes, which + controls whether or not a given node is selectable (duh). This + works with the new -selectcommand option for the tree, and with + keyboard traversal (also new). Now, whenever the tree gets a + "selection set", it calls the given -selectcommand with the name + of the tree and the list of selected nodes, which makes it easier + to just drop in place and use. + +1999-10-15 Eric Melski + + * panedw.tcl: Added a -class PanedWindow option to the main frame + (the megawidget) of the paned window. + +1999-10-15 Eric Melski + + * dialog.tcl: Added an overrideredirect option to Dialog::draw, which + allows the user to control the overrideredirect state of the dialog. + +1999-09-19 Eric Melski + + * mainframe.tcl: Fixed _destroy to unset ALL state variables, so that + when a new MainFrame of the same name as an old one is created, it + doesn't pick up residual state from the old one. + +1999-09-17 Eric Melski + + * notebook.tcl: Added some (non-functional) code for doing + tab-notebooks with the tabs on the bottom. + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/LICENSE.txt b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/LICENSE.txt new file mode 100644 index 00000000..1e301097 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/LICENSE.txt @@ -0,0 +1,41 @@ +BWidget ToolKit +Copyright (c) 1998-1999 UNIFIX. +Copyright (c) 2001-2002 ActiveState Corp. + +The following terms apply to all files associated with the software +unless explicitly disclaimed in individual files. + +The authors hereby grant permission to use, copy, modify, distribute, +and license this software and its documentation for any purpose, provided +that existing copyright notices are retained in all copies and that this +notice is included verbatim in any distributions. No written agreement, +license, or royalty fee is required for any of the authorized uses. +Modifications to this software may be copyrighted by their authors +and need not follow the licensing terms described here, provided that +the new terms are clearly indicated on the first page of each file where +they apply. + +IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY +FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES +ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY +DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. + +THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE +IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE +NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR +MODIFICATIONS. + +GOVERNMENT USE: If you are acquiring this software on behalf of the +U.S. government, the Government shall have only "Restricted Rights" +in the software and related documentation as defined in the Federal +Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you +are acquiring the software on behalf of the Department of Defense, the +software shall be classified as "Commercial Computer Software" and the +Government shall have only "Restricted Rights" as defined in Clause +252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the +authors grant the U.S. Government and others acting in its behalf +permission to use and distribute the software in accordance with the +terms specified in this license. diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/README.txt b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/README.txt new file mode 100644 index 00000000..388ca91c --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/README.txt @@ -0,0 +1,127 @@ +BWidget ToolKit 1.9.15 December 2021 +Copyright (c) 1998-1999 UNIFIX. +Copyright (c) 2001-2002 ActiveState Corp. + +See the file LICENSE.txt for license info (uses Tcl's BSD-style license). + +-------------------------------------------------------------------------- + +WHAT IS BWIDGET ? + +The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using +native Tcl/Tk 8.x namespaces. + +The BWidgets have a professional look&feel as in other well known +Toolkits (Tix or Incr Widgets), but the concept is radically different +because everything is pure Tcl/Tk. No platform dependencies, and no +compiling required. The code is 100% Pure Tcl/Tk. + +The BWidget library was originally developed by UNIFIX Online, and +released under both the GNU Public License and the Tcl license. +BWidget is now maintained as a community project, hosted by +Sourceforge. Scores of fixes and enhancements have been added by +community developers. See the ChangeLog file for details. + +-------------------------------------------------------------------------- + +WIDGET LIST (1.9) + +Simple Widgets + Label Extended Label widget + Entry Extended Entry widget + Button Extended Button widget + ArrowButton Button widget with an arrow shape. + ProgressBar Progress indicator widget + ScrollView Display the visible area of a scrolled window + Separator 3D separator widget + +Manager Widgets + MainFrame Manage toplevel with menu, toolbar and statusbar + LabelFrame Frame with a Label + TitleFrame Frame with a title + ScrolledWindow Generic scrolled widget + ScrollableFrame Scrollable frame containing widget + PanedWindow Tiled layout manager widget + ButtonBox Set of buttons with horizontal or vertical layout + PagesManager Pages manager widget + NoteBook Notebook manager widget + Dialog Dialog abstraction with custom buttons + +Composite Widgets + LabelEntry LabelFrame containing an Entry widget. + ComboBox ComboBox widget + SpinBox SpinBox widget + Tree Tree widget + ListBox ListBox widget + MessageDlg Message dialog box + ProgressDlg Progress indicator dialog box + PasswdDlg Login/Password dialog box (contributed by Stephane Lavirotte) + SelectFont Font selection widget + SelectColor Color selection widget + +Commands Classes + Widget The Widget base class + DynamicHelp Provide help to Tk widget or BWidget + DragSite Commands set for Drag facilities + DropSite Commands set for Drop facilities + BWidget Utilities + +-------------------------------------------------------------------------- +INSTALLATION AND USE + +- On Unix Platform: + Uncompress the file BWidget-.tar.Z|gz + + To use the BWidget: + - If you have uncompressed the archive file under the Tcl Library Path + directory, you only need to do: + % package require BWidget + - If not, you have to specify the BWidget installation path in auto_path + global variable: + % lappend auto_path + % package require BWidget + + To launch the demo, you need to cd into the demo subdirectory: + $ cd /demo + $ wish demo.tcl + +- On Windows and others Platforms: + Uncompress the file BWidget-.zip + + To use the BWidget: + - If you uncompressed the archive file under the Tcl Library Path + directory, you only need to do: + % package require BWidget + - If not, you have to specify the BWidget installation path in auto_path + global variable: + % lappend auto_path your_path + % package require BWidget + + To launch the demo : + Double click on demo.tcl in the demo subdirectory + + +Distribution contains these directories: + +BWidget- Root directory and BWidget Tcl sources + BWman HTML manual pages + images images used by BWidget + lang Resources for language customization + demo Demo sources + tests BWidgets test suite + + +-------------------------------------------------------------------------- + +DOCUMENTATION + +HTML manual pages are available in the BWman subdirectory. Point to +index.html for frame version with tree navigation, or to contents.html +for no frame version. + +-------------------------------------------------------------------------- + +CONTACTS + +The BWidget toolkit is maintained on Sourceforge, at +http://www.sourceforge.net/projects/tcllib/ diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/arrow.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/arrow.tcl new file mode 100644 index 00000000..e51753a9 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/arrow.tcl @@ -0,0 +1,551 @@ +# ------------------------------------------------------------------------------ +# arrow.tcl +# This file is part of Unifix BWidget Toolkit +# ------------------------------------------------------------------------------ +# Index of commands: +# Public commands +# - ArrowButton::create +# - ArrowButton::configure +# - ArrowButton::cget +# - ArrowButton::invoke +# Private commands (redraw commands) +# - ArrowButton::_redraw +# - ArrowButton::_redraw_state +# - ArrowButton::_redraw_relief +# - ArrowButton::_redraw_whole +# Private commands (event bindings) +# - ArrowButton::_destroy +# - ArrowButton::_enter +# - ArrowButton::_leave +# - ArrowButton::_press +# - ArrowButton::_release +# - ArrowButton::_repeat +# ------------------------------------------------------------------------------ + +namespace eval ArrowButton { + Widget::define ArrowButton arrow DynamicHelp + + Widget::tkinclude ArrowButton button .c \ + include [list \ + -borderwidth -bd \ + -relief -highlightbackground \ + -highlightcolor -highlightthickness -takefocus] + + Widget::declare ArrowButton [list \ + [list -type Enum button 0 [list arrow button]] \ + [list -dir Enum top 0 [list top bottom left right]] \ + [list -width Int 15 0 "%d >= 0"] \ + [list -height Int 15 0 "%d >= 0"] \ + [list -ipadx Int 0 0 "%d >= 0"] \ + [list -ipady Int 0 0 "%d >= 0"] \ + [list -clean Int 2 0 "%d >= 0 && %d <= 2"] \ + [list -activeforeground TkResource "" 0 button] \ + [list -activebackground TkResource "" 0 button] \ + [list -disabledforeground TkResource "" 0 button] \ + [list -foreground TkResource "" 0 button] \ + [list -background TkResource "" 0 button] \ + [list -state TkResource "" 0 button] \ + [list -troughcolor TkResource "" 0 scrollbar] \ + [list -arrowbd Int 1 0 "%d >= 0 && %d <= 2"] \ + [list -arrowrelief Enum raised 0 [list raised sunken]] \ + [list -command String "" 0] \ + [list -armcommand String "" 0] \ + [list -disarmcommand String "" 0] \ + [list -repeatdelay Int 0 0 "%d >= 0"] \ + [list -repeatinterval Int 0 0 "%d >= 0"] \ + [list -fg Synonym -foreground] \ + [list -bg Synonym -background] \ + ] + DynamicHelp::include ArrowButton balloon + + bind BwArrowButtonC {ArrowButton::_enter %W} + bind BwArrowButtonC {ArrowButton::_leave %W} + bind BwArrowButtonC {ArrowButton::_press %W} + bind BwArrowButtonC {ArrowButton::_release %W} + bind BwArrowButtonC {ArrowButton::invoke %W; break} + bind BwArrowButtonC {ArrowButton::invoke %W; break} + bind BwArrowButton {ArrowButton::_redraw_whole %W %w %h} + bind BwArrowButton {ArrowButton::_destroy %W} + + variable _grab + variable _moved + + array set _grab {current "" pressed "" oldstate "normal" oldrelief ""} +} + + +# ----------------------------------------------------------------------------- +# Command ArrowButton::create +# ----------------------------------------------------------------------------- +proc ArrowButton::create { path args } { + # Initialize configuration mappings and parse arguments + array set submaps [list ArrowButton [list ] .c [list ]] + array set submaps [Widget::parseArgs ArrowButton $args] + + # Create the class frame (so we can do the option db queries) + frame $path -class ArrowButton -borderwidth 0 -highlightthickness 0 + Widget::initFromODB ArrowButton $path $submaps(ArrowButton) + + # Create the canvas with the initial options + eval [list canvas $path.c] $submaps(.c) + + # Compute the width and height of the canvas from the width/height + # of the ArrowButton and the borderwidth/hightlightthickness. + set w [Widget::getMegawidgetOption $path -width] + set h [Widget::getMegawidgetOption $path -height] + set bd [Widget::cget $path -borderwidth] + set ht [Widget::cget $path -highlightthickness] + set pad [expr {2*($bd+$ht)}] + + $path.c configure -width [expr {$w-$pad}] -height [expr {$h-$pad}] + bindtags $path [list $path BwArrowButton [winfo toplevel $path] all] + bindtags $path.c [list $path.c BwArrowButtonC [winfo toplevel $path.c] all] + pack $path.c -expand yes -fill both + + DynamicHelp::sethelp $path $path.c 1 + + set ::ArrowButton::_moved($path) 0 + + return [Widget::create ArrowButton $path] +} + + +# ----------------------------------------------------------------------------- +# Command ArrowButton::configure +# ----------------------------------------------------------------------------- +proc ArrowButton::configure { path args } { + set res [Widget::configure $path $args] + + set ch1 [expr {[Widget::hasChanged $path -width w] | + [Widget::hasChanged $path -height h] | + [Widget::hasChanged $path -borderwidth bd] | + [Widget::hasChanged $path -highlightthickness ht]}] + set ch2 [expr {[Widget::hasChanged $path -type val] | + [Widget::hasChanged $path -ipadx val] | + [Widget::hasChanged $path -ipady val] | + [Widget::hasChanged $path -arrowbd val] | + [Widget::hasChanged $path -clean val] | + [Widget::hasChanged $path -dir val]}] + + if { $ch1 } { + set pad [expr {2*($bd+$ht)}] + $path.c configure \ + -width [expr {$w-$pad}] -height [expr {$h-$pad}] \ + -borderwidth $bd -highlightthickness $ht + set ch2 1 + } + if { $ch2 } { + _redraw_whole $path [winfo width $path] [winfo height $path] + } else { + _redraw_relief $path + _redraw_state $path + } + DynamicHelp::sethelp $path $path.c + + return $res +} + + +# ----------------------------------------------------------------------------- +# Command ArrowButton::cget +# ----------------------------------------------------------------------------- +proc ArrowButton::cget { path option } { + return [Widget::cget $path $option] +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::invoke +# ------------------------------------------------------------------------------ +proc ArrowButton::invoke { path } { + if { ![string equal [winfo class $path] "ArrowButton"] } { + set path [winfo parent $path] + } + if { ![string equal [Widget::getoption $path -state] "disabled"] } { + set oldstate [Widget::getoption $path -state] + if { [string equal [Widget::getoption $path -type] "button"] } { + set oldrelief [Widget::getoption $path -relief] + configure $path -state active -relief sunken + } else { + set oldrelief [Widget::getoption $path -arrowrelief] + configure $path -state active -arrowrelief sunken + } + update idletasks + if {[llength [set cmd [Widget::getoption $path -armcommand]]]} { + uplevel \#0 $cmd + } + after 10 + if { [string equal [Widget::getoption $path -type] "button"] } { + configure $path -state $oldstate -relief $oldrelief + } else { + configure $path -state $oldstate -arrowrelief $oldrelief + } + if {[llength [set cmd [Widget::getoption $path -disarmcommand]]]} { + uplevel \#0 $cmd + } + if {[llength [set cmd [Widget::getoption $path -command]]]} { + uplevel \#0 $cmd + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_redraw +# ------------------------------------------------------------------------------ +proc ArrowButton::_redraw { path width height } { + variable _moved + + set _moved($path) 0 + set type [Widget::getoption $path -type] + set dir [Widget::getoption $path -dir] + set bd [expr {[$path.c cget -borderwidth] + [$path.c cget -highlightthickness] + 1}] + set clean [Widget::getoption $path -clean] + if { [string equal $type "arrow"] } { + if { [set id [$path.c find withtag rect]] == "" } { + $path.c create rectangle $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] -tags rect + } else { + $path.c coords $id $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] + } + $path.c lower rect + set arrbd [Widget::getoption $path -arrowbd] + set bd [expr {$bd+$arrbd-1}] + } else { + $path.c delete rect + } + # w and h are max width and max height of arrow + set w [expr {$width - 2*([Widget::getoption $path -ipadx]+$bd)}] + set h [expr {$height - 2*([Widget::getoption $path -ipady]+$bd)}] + + if { $w < 2 } {set w 2} + if { $h < 2 } {set h 2} + + if { $clean > 0 } { + # arrange for base to be odd + if { [string equal $dir "top"] || [string equal $dir "bottom"] } { + if { !($w % 2) } { + incr w -1 + } + if { $clean == 2 } { + # arrange for h = (w+1)/2 + set h2 [expr {($w+1)/2}] + if { $h2 > $h } { + set w [expr {2*$h-1}] + } else { + set h $h2 + } + } + } else { + if { !($h % 2) } { + incr h -1 + } + if { $clean == 2 } { + # arrange for w = (h+1)/2 + set w2 [expr {($h+1)/2}] + if { $w2 > $w } { + set h [expr {2*$w-1}] + } else { + set w $w2 + } + } + } + } + + set x0 [expr {($width-$w)/2}] + set y0 [expr {($height-$h)/2}] + set x1 [expr {$x0+$w-1}] + set y1 [expr {$y0+$h-1}] + + switch $dir { + top { + set xd [expr {($x0+$x1)/2}] + if { [set id [$path.c find withtag poly]] == "" } { + $path.c create polygon $x0 $y1 $x1 $y1 $xd $y0 -tags poly + } else { + $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0 + } + if { [string equal $type "arrow"] } { + if { [set id [$path.c find withtag bot]] == "" } { + $path.c create line $x0 $y1 $x1 $y1 $xd $y0 -tags bot + } else { + $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0 + } + if { [set id [$path.c find withtag top]] == "" } { + $path.c create line $x0 $y1 $xd $y0 -tags top + } else { + $path.c coords $id $x0 $y1 $xd $y0 + } + $path.c itemconfigure top -width $arrbd + $path.c itemconfigure bot -width $arrbd + } else { + $path.c delete top + $path.c delete bot + } + } + bottom { + set xd [expr {($x0+$x1)/2}] + if { [set id [$path.c find withtag poly]] == "" } { + $path.c create polygon $x1 $y0 $x0 $y0 $xd $y1 -tags poly + } else { + $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1 + } + if { [string equal $type "arrow"] } { + if { [set id [$path.c find withtag top]] == "" } { + $path.c create line $x1 $y0 $x0 $y0 $xd $y1 -tags top + } else { + $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1 + } + if { [set id [$path.c find withtag bot]] == "" } { + $path.c create line $x1 $y0 $xd $y1 -tags bot + } else { + $path.c coords $id $x1 $y0 $xd $y1 + } + $path.c itemconfigure top -width $arrbd + $path.c itemconfigure bot -width $arrbd + } else { + $path.c delete top + $path.c delete bot + } + } + left { + set yd [expr {($y0+$y1)/2}] + if { [set id [$path.c find withtag poly]] == "" } { + $path.c create polygon $x1 $y0 $x1 $y1 $x0 $yd -tags poly + } else { + $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd + } + if { [string equal $type "arrow"] } { + if { [set id [$path.c find withtag bot]] == "" } { + $path.c create line $x1 $y0 $x1 $y1 $x0 $yd -tags bot + } else { + $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd + } + if { [set id [$path.c find withtag top]] == "" } { + $path.c create line $x1 $y0 $x0 $yd -tags top + } else { + $path.c coords $id $x1 $y0 $x0 $yd + } + $path.c itemconfigure top -width $arrbd + $path.c itemconfigure bot -width $arrbd + } else { + $path.c delete top + $path.c delete bot + } + } + right { + set yd [expr {($y0+$y1)/2}] + if { [set id [$path.c find withtag poly]] == "" } { + $path.c create polygon $x0 $y1 $x0 $y0 $x1 $yd -tags poly + } else { + $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd + } + if { [string equal $type "arrow"] } { + if { [set id [$path.c find withtag top]] == "" } { + $path.c create line $x0 $y1 $x0 $y0 $x1 $yd -tags top + } else { + $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd + } + if { [set id [$path.c find withtag bot]] == "" } { + $path.c create line $x0 $y1 $x1 $yd -tags bot + } else { + $path.c coords $id $x0 $y1 $x1 $yd + } + $path.c itemconfigure top -width $arrbd + $path.c itemconfigure bot -width $arrbd + } else { + $path.c delete top + $path.c delete bot + } + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_redraw_state +# ------------------------------------------------------------------------------ +proc ArrowButton::_redraw_state { path } { + set state [Widget::getoption $path -state] + if { [string equal [Widget::getoption $path -type] "button"] } { + switch $state { + normal {set bg -background; set fg -foreground} + active {set bg -activebackground; set fg -activeforeground} + disabled {set bg -background; set fg -disabledforeground} + } + set fg [Widget::getoption $path $fg] + $path.c configure -background [Widget::getoption $path $bg] + $path.c itemconfigure poly -fill $fg -outline $fg + } else { + switch $state { + normal {set stipple ""; set bg [Widget::getoption $path -background] } + active {set stipple ""; set bg [Widget::getoption $path -activebackground] } + disabled {set stipple gray50; set bg black } + } + set thrc [Widget::getoption $path -troughcolor] + $path.c configure -background [Widget::getoption $path -background] + $path.c itemconfigure rect -fill $thrc -outline $thrc + $path.c itemconfigure poly -fill $bg -outline $bg -stipple $stipple + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_redraw_relief +# ------------------------------------------------------------------------------ +proc ArrowButton::_redraw_relief { path } { + variable _moved + + if { [string equal [Widget::getoption $path -type] "button"] } { + if { [string equal [Widget::getoption $path -relief] "sunken"] } { + if { !$_moved($path) } { + $path.c move poly 1 1 + set _moved($path) 1 + } + } else { + if { $_moved($path) } { + $path.c move poly -1 -1 + set _moved($path) 0 + } + } + } else { + set col3d [BWidget::get3dcolor $path [Widget::getoption $path -background]] + switch [Widget::getoption $path -arrowrelief] { + raised {set top [lindex $col3d 1]; set bot [lindex $col3d 0]} + sunken {set top [lindex $col3d 0]; set bot [lindex $col3d 1]} + } + $path.c itemconfigure top -fill $top + $path.c itemconfigure bot -fill $bot + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_redraw_whole +# ------------------------------------------------------------------------------ +proc ArrowButton::_redraw_whole { path width height } { + _redraw $path $width $height + _redraw_relief $path + _redraw_state $path +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_enter +# ------------------------------------------------------------------------------ +proc ArrowButton::_enter { path } { + variable _grab + set path [winfo parent $path] + set _grab(current) $path + if { ![string equal [Widget::getoption $path -state] "disabled"] } { + set _grab(oldstate) [Widget::getoption $path -state] + configure $path -state active + if { $_grab(pressed) == $path } { + if { [string equal [Widget::getoption $path -type] "button"] } { + set _grab(oldrelief) [Widget::getoption $path -relief] + configure $path -relief sunken + } else { + set _grab(oldrelief) [Widget::getoption $path -arrowrelief] + configure $path -arrowrelief sunken + } + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_leave +# ------------------------------------------------------------------------------ +proc ArrowButton::_leave { path } { + variable _grab + set path [winfo parent $path] + set _grab(current) "" + if { ![string equal [Widget::getoption $path -state] "disabled"] } { + configure $path -state $_grab(oldstate) + if { $_grab(pressed) == $path } { + if { [string equal [Widget::getoption $path -type] "button"] } { + configure $path -relief $_grab(oldrelief) + } else { + configure $path -arrowrelief $_grab(oldrelief) + } + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_press +# ------------------------------------------------------------------------------ +proc ArrowButton::_press { path } { + variable _grab + set path [winfo parent $path] + if { ![string equal [Widget::getoption $path -state] "disabled"] } { + set _grab(pressed) $path + if { [string equal [Widget::getoption $path -type] "button"] } { + set _grab(oldrelief) [Widget::getoption $path -relief] + configure $path -relief sunken + } else { + set _grab(oldrelief) [Widget::getoption $path -arrowrelief] + configure $path -arrowrelief sunken + } + if {[llength [set cmd [Widget::getoption $path -armcommand]]]} { + uplevel \#0 $cmd + if { [set delay [Widget::getoption $path -repeatdelay]] > 0 || + [set delay [Widget::getoption $path -repeatinterval]] > 0 } { + after $delay [list ArrowButton::_repeat $path] + } + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_release +# ------------------------------------------------------------------------------ +proc ArrowButton::_release { path } { + variable _grab + set path [winfo parent $path] + if { $_grab(pressed) == $path } { + set _grab(pressed) "" + if { [string equal [Widget::getoption $path -type] "button"] } { + configure $path -relief $_grab(oldrelief) + } else { + configure $path -arrowrelief $_grab(oldrelief) + } + if {[llength [set cmd [Widget::getoption $path -disarmcommand]]]} { + uplevel \#0 $cmd + } + if { $_grab(current) == $path && + ![string equal [Widget::getoption $path -state] "disabled"] && + [llength [set cmd [Widget::getoption $path -command]]]} { + uplevel \#0 $cmd + } + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_repeat +# ------------------------------------------------------------------------------ +proc ArrowButton::_repeat { path } { + variable _grab + if { $_grab(current) == $path && $_grab(pressed) == $path && + ![string equal [Widget::getoption $path -state] "disabled"] && + [llength [set cmd [Widget::getoption $path -armcommand]]]} { + uplevel \#0 $cmd + } + if { $_grab(pressed) == $path && + ([set delay [Widget::getoption $path -repeatinterval]] > 0 || + [set delay [Widget::getoption $path -repeatdelay]] > 0) } { + after $delay [list ArrowButton::_repeat $path] + } +} + + +# ------------------------------------------------------------------------------ +# Command ArrowButton::_destroy +# ------------------------------------------------------------------------------ +proc ArrowButton::_destroy { path } { + variable _moved + Widget::destroy $path + unset _moved($path) +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/bitmap.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/bitmap.tcl new file mode 100644 index 00000000..3e157d52 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/bitmap.tcl @@ -0,0 +1,94 @@ +# ------------------------------------------------------------------------------ +# bitmap.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: bitmap.tcl,v 1.4 2003/10/20 21:23:52 damonc Exp $ +# ------------------------------------------------------------------------------ +# Index of commands: +# - Bitmap::get +# - Bitmap::_init +# ---------------------------------------------------------------------------- +namespace eval Bitmap { + Widget::define Bitmap bitmap -classonly + + variable path + variable _bmp + variable _types { + photo .gif + photo .ppm + bitmap .xbm + photo .xpm + } + + proc use {} {} +} + + +# ---------------------------------------------------------------------------- +# Command Bitmap::get +# ---------------------------------------------------------------------------- +proc Bitmap::get { name } { + variable path + variable _bmp + variable _types + + if {[info exists _bmp($name)]} { + return $_bmp($name) + } + + # --- Nom de fichier avec extension --------------------------------- + set ext [file extension $name] + if { $ext != "" } { + if { ![info exists _bmp($ext)] } { + error "$ext not supported" + } + + if { [file exists $name] } { + if {[string equal $ext ".xpm"]} { + set _bmp($name) [xpm-to-image $name] + return $_bmp($name) + } + if {![catch {set _bmp($name) [image create $_bmp($ext) -file $name]}]} { + return $_bmp($name) + } + } + } + + foreach dir $path { + foreach {type ext} $_types { + if { [file exists [file join $dir $name$ext]] } { + if {[string equal $ext ".xpm"]} { + set _bmp($name) [xpm-to-image [file join $dir $name$ext]] + return $_bmp($name) + } else { + if {![catch {set _bmp($name) [image create $type -file [file join $dir $name$ext]]}]} { + return $_bmp($name) + } + } + } + } + } + + return -code error "$name not found" +} + + +# ---------------------------------------------------------------------------- +# Command Bitmap::_init +# ---------------------------------------------------------------------------- +proc Bitmap::_init { } { + global env + variable path + variable _bmp + variable _types + + set path [list "." [file join $::BWIDGET::LIBRARY images]] + set supp [image types] + foreach {type ext} $_types { + if { [lsearch $supp $type] != -1} { + set _bmp($ext) $type + } + } +} + + +Bitmap::_init diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/button.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/button.tcl new file mode 100644 index 00000000..d6591dde --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/button.tcl @@ -0,0 +1,399 @@ +# ---------------------------------------------------------------------------- +# button.tcl +# This file is part of Unifix BWidget Toolkit +# ---------------------------------------------------------------------------- +# Index of commands: +# Public commands +# - Button::create +# - Button::configure +# - Button::cget +# - Button::invoke +# Private commands (event bindings) +# - Button::_destroy +# - Button::_enter +# - Button::_leave +# - Button::_press +# - Button::_release +# - Button::_repeat +# ---------------------------------------------------------------------------- + +namespace eval Button { + Widget::define Button button DynamicHelp + + # Using namespace variable without variable may set global variables + # Fixed in TCL 9, so no correction here + set remove [list -command -relief -text -textvariable -underline -state] + if {[info tclversion] > 8.3} { + lappend remove -repeatdelay -repeatinterval + } + if {$::Widget::_theme} { + lappend remove -activebackground -activeforeground -anchor -background\ + -bitmap -borderwidth -disabledforeground -font -foreground\ + -height -highlightbackground -highlightcolor -highlightthickness\ + -justify -overrelief -padx -pady -relief -wraplength + } + Widget::tkinclude Button button :cmd remove $remove + + Widget::declare Button { + {-name String "" 0} + {-text String "" 0} + {-textvariable String "" 0} + {-underline Int -1 0 "%d >= -1"} + {-armcommand String "" 0} + {-disarmcommand String "" 0} + {-command String "" 0} + {-state TkResource "" 0 button} + {-repeatdelay Int 0 0 "%d >= 0"} + {-repeatinterval Int 0 0 "%d >= 0"} + {-relief Enum raised 0 {raised sunken flat ridge solid groove link}} + } + + DynamicHelp::include Button balloon + + variable _current "" + variable _pressed "" + + bind BwButton {Button::_enter %W} + bind BwButton {Button::_leave %W} + bind BwButton {Button::_press %W} + bind BwButton {Button::_release %W} + bind BwButton {Button::invoke %W; break} + bind BwButton {Button::invoke %W; break} + bind BwButton <> {Button::invoke %W; break} + bind BwButton {Widget::destroy %W} +} + + +# ---------------------------------------------------------------------------- +# Command Button::create +# ---------------------------------------------------------------------------- +proc Button::create { path args } { + array set maps [list Button {} :cmd {}] + array set maps [Widget::parseArgs Button $args] + if {$::Widget::_theme} { + eval [concat [list ttk::button $path] $maps(:cmd)] + } else { + eval [concat [list button $path] $maps(:cmd)] + } + Widget::initFromODB Button $path $maps(Button) + + # Do some extra configuration on the button + set var [Widget::getMegawidgetOption $path -textvariable] + set st [Widget::getMegawidgetOption $path -state] + if { ![string length $var] } { + set desc [BWidget::getname [Widget::getMegawidgetOption $path -name]] + if { [llength $desc] } { + set text [lindex $desc 0] + set under [lindex $desc 1] + Widget::configure $path [list -text $text] + Widget::configure $path [list -underline $under] + } else { + set text [Widget::getMegawidgetOption $path -text] + set under [Widget::getMegawidgetOption $path -underline] + } + } else { + set under -1 + set text "" + Widget::configure $path [list -underline $under] + } + + $path configure -text $text -underline $under \ + -textvariable $var -state $st + # Map relief flat on Toolbutton for ttk + set relief [Widget::getMegawidgetOption $path -relief] + if {$::Widget::_theme} { + if { [string equal $relief "link"] } { + $path configure -style Toolbutton + } + } else { + if { [string equal $relief "link"] } { + set relief "flat" + } + $path configure -relief $relief + } + bindtags $path [list $path BwButton [winfo toplevel $path] all] + + set accel1 [string tolower [string index $text $under]] + set accel2 [string toupper $accel1] + if { $accel1 != "" } { + bind [winfo toplevel $path] [list Button::invoke $path] + bind [winfo toplevel $path] [list Button::invoke $path] + } + + DynamicHelp::sethelp $path $path 1 + + return [Widget::create Button $path] +} + + +# ---------------------------------------------------------------------------- +# Command Button::configure +# ---------------------------------------------------------------------------- +proc Button::configure { path args } { + set oldunder [$path:cmd cget -underline] + if { $oldunder > -1 } { + set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]] + set oldaccel2 [string toupper $oldaccel1] + } else { + set oldaccel1 "" + set oldaccel2 "" + } + set res [Widget::configure $path $args] + + # Extract all the modified bits we're interested in + foreach {cr cs cv cn ct cu} [Widget::hasChangedX $path \ + -relief -state -textvariable -name -text -underline] break + if { $cr || $cs } { + set relief [Widget::cget $path -relief] + set state [Widget::cget $path -state] + if { $::Widget::_theme} { + if { [string equal $relief "link"] } { + $path:cmd configure -style Toolbutton + } else { + $path:cmd configure -style "" + } + } else { + if { [string equal $relief "link"] } { + if { [string equal $state "active"] } { + set relief "raised" + } else { + set relief "flat" + } + } + $path:cmd configure -relief $relief + } + $path:cmd configure -state $state + } + + if { $cv || $cn || $ct || $cu } { + set var [Widget::cget $path -textvariable] + set text [Widget::cget $path -text] + set under [Widget::cget $path -underline] + if { ![string length $var] } { + set desc [BWidget::getname [Widget::cget $path -name]] + if { [llength $desc] } { + set text [lindex $desc 0] + set under [lindex $desc 1] + } + } else { + set under -1 + set text "" + } + set top [winfo toplevel $path] + if { $oldaccel1 != "" } { + bind $top {} + bind $top {} + } + set accel1 [string tolower [string index $text $under]] + set accel2 [string toupper $accel1] + if { $accel1 != "" } { + bind $top [list Button::invoke $path] + bind $top [list Button::invoke $path] + } + $path:cmd configure -text $text -underline $under -textvariable $var + } + DynamicHelp::sethelp $path $path + + set res +} + + +# ---------------------------------------------------------------------------- +# Command Button::cget +# ---------------------------------------------------------------------------- +proc Button::cget { path option } { + Widget::cget $path $option +} + + +# ---------------------------------------------------------------------------- +# Command Button::identify +# ---------------------------------------------------------------------------- +proc Button::identify { path args } { + eval $path:cmd identify $args +} + + +# ---------------------------------------------------------------------------- +# Command Button::instate +# ---------------------------------------------------------------------------- +proc Button::instate { path args } { + eval $path:cmd instate $args +} + + +# ---------------------------------------------------------------------------- +# Command Button::state +# ---------------------------------------------------------------------------- +proc Button::state { path args } { + eval $path:cmd state $args +} + + +# ---------------------------------------------------------------------------- +# Command Button::invoke +# ---------------------------------------------------------------------------- +proc Button::invoke { path } { + if { ![string equal [$path:cmd cget -state] "disabled"] } { + if { $::Widget::_theme} { + $path:cmd configure -state active + $path:cmd state pressed + } else { + $path:cmd configure -state active -relief sunken + } + update idletasks + set cmd [Widget::getMegawidgetOption $path -armcommand] + if { $cmd != "" } { + uplevel \#0 $cmd + } + after 100 + $path:cmd configure -state [Widget::getMegawidgetOption $path -state] + if { $::Widget::_theme} { + $path:cmd state !pressed + } else { + set relief [Widget::getMegawidgetOption $path -relief] + if { [string equal $relief "link"] } { + set relief flat + } + $path:cmd configure -relief $relief + } + set cmd [Widget::getMegawidgetOption $path -disarmcommand] + if { $cmd != "" } { + uplevel \#0 $cmd + } + set cmd [Widget::getMegawidgetOption $path -command] + if { $cmd != "" } { + uplevel \#0 $cmd + } + } +} + +# ---------------------------------------------------------------------------- +# Command Button::_enter +# ---------------------------------------------------------------------------- +proc Button::_enter { path } { + variable _current + variable _pressed + + set _current $path + if { ![string equal [$path:cmd cget -state] "disabled"] } { + $path:cmd configure -state active + if { $::Widget::_theme } { + # $path:cmd state active + } else { + if { $_pressed == $path } { + $path:cmd configure -relief sunken + } elseif { [string equal [Widget::cget $path -relief] "link"] } { + $path:cmd configure -relief raised + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command Button::_leave +# ---------------------------------------------------------------------------- +proc Button::_leave { path } { + variable _current + variable _pressed + + set _current "" + if { ![string equal [$path:cmd cget -state] "disabled"] } { + $path:cmd configure -state [Widget::cget $path -state] + if { $::Widget::_theme } { + } else { + set relief [Widget::cget $path -relief] + if { $_pressed == $path } { + if { [string equal $relief "link"] } { + set relief raised + } + $path:cmd configure -relief $relief + } elseif { [string equal $relief "link"] } { + $path:cmd configure -relief flat + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command Button::_press +# ---------------------------------------------------------------------------- +proc Button::_press { path } { + variable _pressed + + if { ![string equal [$path:cmd cget -state] "disabled"] } { + set _pressed $path + if { $::Widget::_theme} { + ttk::clickToFocus $path + $path state pressed + } else { + $path:cmd configure -relief sunken + } + set cmd [Widget::getMegawidgetOption $path -armcommand] + if { $cmd != "" } { + uplevel \#0 $cmd + set repeatdelay [Widget::getMegawidgetOption $path -repeatdelay] + set repeatint [Widget::getMegawidgetOption $path -repeatinterval] + if { $repeatdelay > 0 } { + after $repeatdelay "Button::_repeat $path" + } elseif { $repeatint > 0 } { + after $repeatint "Button::_repeat $path" + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command Button::_release +# ---------------------------------------------------------------------------- +proc Button::_release { path } { + variable _current + variable _pressed + + if { $_pressed == $path } { + set _pressed "" + after cancel "Button::_repeat $path" + if { $::Widget::_theme} { + $path state !pressed + } else { + set relief [Widget::getMegawidgetOption $path -relief] + if { [string equal $relief "link"] } { + set relief raised + } + $path:cmd configure -relief $relief + } + set cmd [Widget::getMegawidgetOption $path -disarmcommand] + if { $cmd != "" } { + uplevel \#0 $cmd + } + if { $_current == $path && + ![string equal [$path:cmd cget -state] "disabled"] && \ + [set cmd [Widget::getMegawidgetOption $path -command]] != "" } { + uplevel \#0 $cmd + } + } +} + + +# ---------------------------------------------------------------------------- +# Command Button::_repeat +# ---------------------------------------------------------------------------- +proc Button::_repeat { path } { + variable _current + variable _pressed + + if { $_current == $path && $_pressed == $path && + ![string equal [$path:cmd cget -state] "disabled"] && + [set cmd [Widget::getMegawidgetOption $path -armcommand]] != "" } { + uplevel \#0 $cmd + } + if { $_pressed == $path && + ([set delay [Widget::getMegawidgetOption $path -repeatinterval]] >0 || + [set delay [Widget::getMegawidgetOption $path -repeatdelay]] > 0) } { + after $delay "Button::_repeat $path" + } +} + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/buttonbox.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/buttonbox.tcl new file mode 100644 index 00000000..b5f36a0e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/buttonbox.tcl @@ -0,0 +1,419 @@ +# ---------------------------------------------------------------------------- +# buttonbox.tcl +# This file is part of Unifix BWidget Toolkit +# ---------------------------------------------------------------------------- +# Index of commands: +# - ButtonBox::create +# - ButtonBox::configure +# - ButtonBox::cget +# - ButtonBox::add +# - ButtonBox::itemconfigure +# - ButtonBox::itemcget +# - ButtonBox::setfocus +# - ButtonBox::invoke +# - ButtonBox::index +# - ButtonBox::_destroy +# ---------------------------------------------------------------------------- + +namespace eval ButtonBox { + Widget::define ButtonBox buttonbox Button + + Widget::declare ButtonBox { + {-background TkResource "" 0 frame} + {-orient Enum horizontal 1 {horizontal vertical}} + {-state Enum "normal" 0 {normal disabled}} + {-homogeneous Boolean 1 1} + {-spacing Int 10 0 "%d >= 0"} + {-padx TkResource "" 0 button} + {-pady TkResource "" 0 button} + {-default Int -1 0 "%d >= -1"} + {-bg Synonym -background} + } + + Widget::addmap ButtonBox "" :cmd {-background {}} + + bind ButtonBox [list ButtonBox::_destroy %W] +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::create +# ---------------------------------------------------------------------------- +proc ButtonBox::create { path args } { + Widget::init ButtonBox $path $args + + variable $path + upvar 0 $path data + + eval [list frame $path] [Widget::subcget $path :cmd] \ + [list -class ButtonBox -takefocus 0 -highlightthickness 0] + # For 8.4+ we don't want to inherit the padding + catch {$path configure -padx 0 -pady 0} + + set data(max) 0 + set data(nbuttons) 0 + set data(buttons) [list] + set data(default) [Widget::getoption $path -default] + + return [Widget::create ButtonBox $path] +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::configure +# ---------------------------------------------------------------------------- +proc ButtonBox::configure { path args } { + variable $path + upvar 0 $path data + + set res [Widget::configure $path $args] + + if { [Widget::hasChanged $path -default val] } { + if { $data(default) != -1 && $val != -1 } { + set but $path.b$data(default) + if { [winfo exists $but] } { + $but configure -default normal + } + set but $path.b$val + if { [winfo exists $but] } { + $but configure -default active + } + set data(default) $val + } else { + Widget::setoption $path -default $data(default) + } + } + + if {[Widget::hasChanged $path -state val]} { + foreach i $data(buttons) { + $path.b$i configure -state $val + } + } + + return $res +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::cget +# ---------------------------------------------------------------------------- +proc ButtonBox::cget { path option } { + return [Widget::cget $path $option] +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::add +# ---------------------------------------------------------------------------- +proc ButtonBox::add { path args } { + return [eval [linsert $args 0 insert $path end]] +} + + +proc ButtonBox::insert { path idx args } { + variable $path + upvar 0 $path data + + set but $path.b$data(nbuttons) + set spacing [Widget::getoption $path -spacing] + + ## Save the current spacing setting for this button. Buttons + ## appended to the end of the box have their spacing applied + ## to their left while all other have their spacing applied + ## to their right. + if {$idx == "end"} { + set data(spacing,$data(nbuttons)) [list left $spacing] + lappend data(buttons) $data(nbuttons) + } else { + set data(spacing,$data(nbuttons)) [list right $spacing] + set data(buttons) [linsert $data(buttons) $idx $data(nbuttons)] + } + + if { $data(nbuttons) == $data(default) } { + set style active + } elseif { $data(default) == -1 } { + set style disabled + } else { + set style normal + } + + array set flags $args + set tags "" + if { [info exists flags(-tags)] } { + set tags $flags(-tags) + unset flags(-tags) + set args [array get flags] + } + + if { $::Widget::_theme} { + eval [list Button::create $but] \ + $args [list -default $style] + } else { + eval [list Button::create $but \ + -background [Widget::getoption $path -background]\ + -padx [Widget::getoption $path -padx] \ + -pady [Widget::getoption $path -pady]] \ + $args [list -default $style] + } + + # ericm@scriptics.com: set up tags, just like the menu items + foreach tag $tags { + lappend data(tags,$tag) $but + if { ![info exists data(tagstate,$tag)] } { + set data(tagstate,$tag) 0 + } + } + set data(buttontags,$but) $tags + # ericm@scriptics.com + + _redraw $path + + incr data(nbuttons) + + return $but +} + + +proc ButtonBox::delete { path idx } { + variable $path + upvar 0 $path data + + set i [lindex $data(buttons) $idx] + set data(buttons) [lreplace $data(buttons) $idx $idx] + destroy $path.b$i +} + + +# ButtonBox::setbuttonstate -- +# +# Set the state of a given button tag. If this makes any buttons +# enable-able (ie, all of their tags are TRUE), enable them. +# +# Arguments: +# path the button box widget name +# tag the tag to modify +# state the new state of $tag (0 or 1) +# +# Results: +# None. + +proc ButtonBox::setbuttonstate {path tag state} { + variable $path + upvar 0 $path data + # First see if this is a real tag + if { [info exists data(tagstate,$tag)] } { + set data(tagstate,$tag) $state + foreach but $data(tags,$tag) { + set expression "1" + foreach buttontag $data(buttontags,$but) { + append expression " && $data(tagstate,$buttontag)" + } + if { [expr $expression] } { + set state normal + } else { + set state disabled + } + $but configure -state $state + } + } + return +} + +# ButtonBox::getbuttonstate -- +# +# Retrieve the state of a given button tag. +# +# Arguments: +# path the button box widget name +# tag the tag to modify +# +# Results: +# None. + +proc ButtonBox::getbuttonstate {path tag} { + variable $path + upvar 0 $path data + # First see if this is a real tag + if { [info exists data(tagstate,$tag)] } { + return $data(tagstate,$tag) + } else { + error "unknown tag $tag" + } +} + +# ---------------------------------------------------------------------------- +# Command ButtonBox::itemconfigure +# ---------------------------------------------------------------------------- +proc ButtonBox::itemconfigure { path index args } { + if { [set idx [lsearch $args -default]] != -1 } { + set args [lreplace $args $idx [expr {$idx+1}]] + } + return [eval [list Button::configure $path.b[index $path $index]] $args] +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::itemcget +# ---------------------------------------------------------------------------- +proc ButtonBox::itemcget { path index option } { + return [Button::cget $path.b[index $path $index] $option] +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::setfocus +# ---------------------------------------------------------------------------- +proc ButtonBox::setfocus { path index } { + set but $path.b[index $path $index] + if { [winfo exists $but] } { + focus $but + } +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::invoke +# ---------------------------------------------------------------------------- +proc ButtonBox::invoke { path index } { + set but $path.b[index $path $index] + if { [winfo exists $but] } { + Button::invoke $but + } +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::index +# ---------------------------------------------------------------------------- +proc ButtonBox::index { path index } { + variable $path + upvar 0 $path data + + set n [expr {$data(nbuttons) - 1}] + + if {[string equal $index "default"]} { + set res [Widget::getoption $path -default] + } elseif {$index == "end" || $index == "last"} { + set res $n + } elseif {![string is integer -strict $index]} { + ## It's not an integer. Search the text of each button + ## in the box and return the index that matches. + foreach i $data(buttons) { + set w $path.b$i + lappend text [$w cget -text] + lappend names [$w cget -name] + } + set res [lsearch -exact [concat $names $text] $index] + } else { + set res $index + if {$index > $n} { set res $n } + } + return $res +} + + +# ButtonBox::gettags -- +# +# Return a list of all the tags on all the buttons in a buttonbox. +# +# Arguments: +# path the buttonbox to query. +# +# Results: +# taglist a list of tags on the buttons in the buttonbox + +proc ButtonBox::gettags {path} { + upvar ::ButtonBox::$path data + set taglist {} + foreach tag [array names data "tags,*"] { + lappend taglist [string range $tag 5 end] + } + return $taglist +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::_redraw +# ---------------------------------------------------------------------------- +proc ButtonBox::_redraw { path } { + variable $path + upvar 0 $path data + Widget::getVariable $path buttons + + # For tk >= 8.4, -uniform gridding option is used. + # Otherwise, there is the constraint, that button size may not change after + # creation. + set uniformAvailable [expr {0 <= [package vcompare [info patchlevel] 8.4.0]}] + + ## We re-grid the buttons from left-to-right. As we go through + ## each button, we check its spacing and which direction the + ## spacing applies to. Once spacing has been applied to an index, + ## it is not changed. This means spacing takes precedence from + ## left-to-right. + + set idx 0 + set idxs [list] + foreach i $data(buttons) { + set dir [lindex $data(spacing,$i) 0] + set spacing [lindex $data(spacing,$i) 1] + set but $path.b$i + if {[string equal [Widget::getoption $path -orient] "horizontal"]} { + grid $but -column $idx -row 0 -sticky nsew + if { [Widget::getoption $path -homogeneous] } { + if {$uniformAvailable} { + grid columnconfigure $path $idx -uniform koen -weight 1 + } else { + set req [winfo reqwidth $but] + if { $req > $data(max) } { + grid columnconfigure $path [expr {2*$i}] -minsize $req + set data(max) $req + } + grid columnconfigure $path $idx -weight 1 + } + } else { + grid columnconfigure $path $idx -weight 0 + } + + set col [expr {$idx - 1}] + if {[string equal $dir "right"]} { set col [expr {$idx + 1}] } + if {$col > 0 && [lsearch $idxs $col] < 0} { + lappend idxs $col + grid columnconfigure $path $col -minsize $spacing + } + } else { + grid $but -column 0 -row $idx -sticky nsew + grid rowconfigure $path $idx -weight 0 + + set row [expr {$idx - 1}] + if {[string equal $dir "right"]} { set row [expr {$idx + 1}] } + if {$row > 0 && [lsearch $idxs $row] < 0} { + lappend idxs $row + grid rowconfigure $path $row -minsize $spacing + } + } + incr idx 2 + } + + if {!$uniformAvailable} { + # Now that the maximum size has been calculated, go back through + # and correctly set the size for homogeneous horizontal buttons. + if { [string equal [Widget::getoption $path -orient] "horizontal"] && [Widget::getoption $path -homogeneous] } { + set idx 0 + foreach i $data(buttons) { + grid columnconfigure $path $idx -minsize $data(max) + incr idx 2 + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command ButtonBox::_destroy +# ---------------------------------------------------------------------------- +proc ButtonBox::_destroy { path } { + variable $path + upvar 0 $path data + Widget::destroy $path + unset -nocomplain data +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/color.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/color.tcl new file mode 100644 index 00000000..5489acbd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/color.tcl @@ -0,0 +1,941 @@ +namespace eval SelectColor { + Widget::define SelectColor color Dialog + + Widget::declare SelectColor { + {-title String "Select a color" 0} + {-parent String "" 0} + {-command String "" 0} + {-help Boolean 0 1} + {-color TkResource "" 0 {label -background}} + {-type Enum "dialog" 1 {dialog popup}} + {-placement String "center" 1} + {-background TkResource "" 0 {label -background}} + } + + variable _baseColors { + \#0000ff \#00ff00 \#00ffff \#ff0000 \#ff00ff \#ffff00 + \#000099 \#009900 \#009999 \#990000 \#990099 \#999900 + \#000000 \#333333 \#666666 \#999999 \#cccccc \#ffffff + } + + variable _userColors { + \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff + \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff + } + + # Namespace variables overwrite global variables in TCL8 + # Not changed here, as fixed in TCL9 + if {[string equal $::tcl_platform(platform) "unix"]} { + set useTkDialogue 0 + } else { + set useTkDialogue 1 + } + + variable _selectype + variable _selection + variable _wcolor + variable _image + variable _hsv + + variable _command + variable _unsavedSelection + variable _oldColor + variable _entryColor + variable _bgColor + variable _fgColor + variable _rounds +} + +proc SelectColor::create { path args } { + Widget::init SelectColor $path $args + + set type [Widget::cget $path -type] + + switch -- [Widget::cget $path -type] { + "dialog" { + return [eval [list SelectColor::dialog $path] $args] + } + + "popup" { + set list [list at center left right above below] + set placement [Widget::cget $path -placement] + set where [lindex $placement 0] + + if {[lsearch $list $where] < 0} { + return -code error \ + [BWidget::badOptionString placement $placement $list] + } + + ## If they specified a parent and didn't pass a second argument + ## in the placement, set the placement relative to the parent. + set parent [Widget::cget $path -parent] + if {[string length $parent]} { + if {[llength $placement] == 1} { lappend placement $parent } + } + return [eval [list SelectColor::menu $path $placement] $args] + } + } +} + +proc SelectColor::menu {path placement args} { + variable _baseColors + variable _userColors + variable _wcolor + variable _selectype + variable _selection + variable _command + variable _bgColor + variable _rounds + + Widget::init SelectColor $path $args + set top [toplevel $path] + set parent [winfo toplevel [winfo parent $top]] + wm withdraw $top + wm transient $top $parent + wm overrideredirect $top 1 + catch { wm attributes $top -topmost 1 } + + set _command [Widget::cget $path -command] + set _bgColor [Widget::cget $path -background] + set _rounds {} + + set frame [frame $top.frame \ + -highlightthickness 0 \ + -relief raised -borderwidth 2] + set col 0 + set row 0 + set count 0 + set colors [concat $_baseColors $_userColors] + foreach color $colors { + set f [frame $frame.c$count \ + -highlightthickness 2 \ + -highlightcolor white \ + -relief solid -borderwidth 1 \ + -width 16 -height 16 -background $color] + bind $f <1> "set SelectColor::_selection $count; break" + bind $f {focus %W} + grid $f -column $col -row $row + incr count + if {[incr col] == 6 } { + set col 0 + incr row + } + } + set f [label $frame.c$count \ + -highlightthickness 2 \ + -highlightcolor white \ + -relief flat -borderwidth 0 \ + -width 16 -height 16 -image [Bitmap::get palette]] + grid $f -column $col -row $row + bind $f <1> "set SelectColor::_selection $count; break" + bind $f {focus %W} + pack $frame + + bind $top <1> {set SelectColor::_selection -1} + bind $top {set SelectColor::_selection -2} + bind $top [subst {if {"%W" == "$top"} \ + {set SelectColor::_selection -2}}] + + # set background color for menu + $f configure -bg $_bgColor + $frame configure -bg $_bgColor + foreach w [winfo children $frame] { + $w configure -highlightcolor $_bgColor -highlightbackground $_bgColor + } + + eval [list BWidget::place $top 0 0] $placement + + wm deiconify $top + raise $top + if {$::tcl_platform(platform) == "unix"} { + tkwait visibility $top + update + } + BWidget::SetFocusGrab $top $frame.c0 + + vwait SelectColor::_selection + BWidget::RestoreFocusGrab $top $frame.c0 destroy + Widget::destroy $top + if {$_selection == $count} { + array set opts { + -parent -parent + -title -title + -color -initialcolor + } + if {[Widget::theme]} { + set native 1 + set nativecmd [list tk_chooseColor -parent $parent] + foreach {key val} $args { + if {![info exists opts($key)]} { + set native 0 + break + } + lappend nativecmd $opts($key) $val + } + if {$native} { + # Call native dialog + return [eval $nativecmd] + } + } + # Call BWidget dialog + return [eval [list dialog $path] $args] + } else { + # The user has either selected one of the palette colors, or has + # cancelled. The full BWidget/native dialog was not called. + # Unless the user has cancelled, pass the selected + # color to _userCommand. + set tmpCol [lindex $colors $_selection] + if {[string equal $tmpCol ""]} { + # User has cancelled - no need to call _userCommand. + } else { + _userCommand $tmpCol + } + return $tmpCol + } +} + + +proc SelectColor::_userCommand {color} { + variable _command + if {[string equal $_command {}]} { + return + } + uplevel #0 $_command [list $color] + return +} + + +proc SelectColor::dialog {path args} { + variable _baseColors + variable _userColors + variable _widget + variable _selection + variable _image + variable _hsv + variable _command + variable _unsavedSelection + variable _oldColor + variable _entryColor + variable _bgColor + variable _fgColor + variable _rounds + + + Widget::init SelectColor $path:SelectColor $args + set top [Dialog::create $path \ + -title [Widget::cget $path:SelectColor -title] \ + -parent [Widget::cget $path:SelectColor -parent] \ + -separator 0 -default 0 -cancel 1 -anchor e] + wm resizable $top 0 0 + set dlgf [$top getframe] + set fg [frame $dlgf.fg] + set desc [list \ + base _baseColors "Base colors" \ + user _userColors "User colors"] + + set help [Widget::cget $path:SelectColor -help] + set _command [Widget::cget $path:SelectColor -command] + set _bgColor [Widget::cget $path:SelectColor -background] + set _rounds {} + set mouseHelpText "" + if {$help} { + append mouseHelpText [subst -nocommands -novariables\ + [lindex [BWidget::getname mouseHelpText] 0]] + } + + set count 0 + foreach {type varcol defTitle} $desc { + set col 0 + set lin 0 + set title [lindex [BWidget::getname "${type}Colors"] 0] + if {![string length $title]} { + set title $defTitle + } + set titf [TitleFrame $fg.$type -text $title] + set subf [$titf getframe] + foreach color [set $varcol] { + set fround [frame $fg.round$count \ + -highlightthickness 1 \ + -relief sunken -borderwidth 2] + set fcolor [frame $fg.color$count -width 16 -height 12 \ + -highlightthickness 0 \ + -relief flat -borderwidth 0 \ + -background $color] + pack $fcolor -in $fround + grid $fround -in $subf -row $lin -column $col -padx 1 -pady 1 + + bind $fround [list SelectColor::_select_rgb $count] + bind $fcolor [list SelectColor::_select_rgb $count] + + DynamicHelp::add $fround -text $mouseHelpText + DynamicHelp::add $fcolor -text $mouseHelpText + + bind $fround \ + "SelectColor::_select_rgb [list $count]; [list $top] invoke 0" + bind $fcolor \ + "SelectColor::_select_rgb [list $count]; [list $top] invoke 0" + + # Record list of $fround values in _rounds + lappend _rounds $fround + + incr count + if {[incr col] == 6} { + incr lin + set col 0 + } + } + pack $titf -anchor w -pady 2 + } + + # Record these colors for later use + set _fgColor [$fg.round0 cget -highlightcolor] + + # Add a TitleFrame $titf to wrap $fg.round and $fg.value + set name [lindex [BWidget::getname yourSelection] 0] + set titf [TitleFrame $fg.choice -text $name] + set subf [$titf getframe] + pack $titf -anchor w -pady 2 -expand yes -fill both + + # Add an entry widget $fg.value for the #RRGGBB value + if {$::tk_version > 8.4} { + set fixedFont TkFixedFont + } else { + set fixedFont Courier + } + set subf2 $fg.vround + frame $subf2 -highlightthickness 0 -relief sunken -borderwidth 2 + entry $fg.value -width 8 -relief sunken -bd 0 -highlightthickness 0 \ + -bg white -textvariable ::SelectColor::_entryColor -font $fixedFont + pack $subf2 -in $subf -anchor w -side left + pack $fg.value -in $subf2 -anchor w -side left + + if {$help} { + DynamicHelp::add $fg.value -text [subst -nocommands -novariables\ + [lindex [BWidget::getname keyboardHelpText] 0]] + } + + # Remove focus from the entry widget by clicking anywhere... + bind $top <1> [list ::SelectColor::_CheckFocus %W] + + # ... or by pressing Return/Escape. + bind $fg.value [list ::SelectColor::_CheckFocus .] + bind $fg.value [list ::SelectColor::_CheckFocus .] + bind $fg.value {+break} + bind $fg.value {+break} + # Break so that the bindings to these events on the toplevel are not + # executed. + + # MODS - record the Tk window path for the entry widget. + set _widget(en) $fg.value + + set fround [frame $fg.round \ + -highlightthickness 0 \ + -relief sunken -borderwidth 2] + set fcolor [frame $fg.color \ + -width 50 \ + -highlightthickness 0 \ + -relief flat -borderwidth 0] + pack $fcolor -in $fround -fill y -expand yes + pack $fround -in $subf -side right -anchor e -pady 2 -fill y -expand yes + + # Add a TitleFrame $dlgf.fd to wrap the canvas selectors. The + # labels are referenced by the DynamicHelp tooltip. + set name [lindex [BWidget::getname colorSelectors] 0] + set fd0 [TitleFrame $dlgf.fd -text $name] + set fd [$fd0 getframe] + set f1 [frame $fd.f1 -relief sunken -borderwidth 2] + set f2 [frame $fd.f2 -relief sunken -borderwidth 2] + set c1 [canvas $f1.c -width 200 -height 200 -bd 0 -highlightthickness 0] + set c2 [canvas $f2.c -width 15 -height 200 -bd 0 -highlightthickness 0] + + for {set val 0} {$val < 40} {incr val} { + $c2 create rectangle 0 [expr {5*$val}] 15 [expr {5*$val+5}] -tags val[expr {39-$val}] + } + $c2 create polygon 0 0 10 5 0 10 -fill black -outline white -tags target + + pack $c1 $c2 + pack $f1 $f2 -side left -padx 10 -anchor n + + pack $fg $fd0 -side left -anchor n -fill y + pack configure $fd0 -pady 2 -padx {4 0} + + bind $c1 [list SelectColor::_select_hue_sat %x %y] + bind $c1 [list SelectColor::_select_hue_sat %x %y] + + bind $c2 [list SelectColor::_select_value %x %y] + bind $c2 [list SelectColor::_select_value %x %y] + + if {![info exists _image] || [catch {image type $_image}]} { + set _image [image create photo -width 200 -height 200] + for {set x 0} {$x < 200} {incr x 4} { + for {set y 0} {$y < 200} {incr y 4} { + $_image put \ + [eval [list format "\#%04x%04x%04x"] \ + [hsvToRgb [expr {$x/196.0}] [expr {(196-$y)/196.0}] 0.85]] \ + -to $x $y [expr {$x+4}] [expr {$y+4}] + } + } + } + $c1 create image 0 0 -anchor nw -image $_image + $c1 create bitmap 0 0 \ + -bitmap @[file join $::BWIDGET::LIBRARY "images" "target.xbm"] \ + -anchor nw -tags target + + set _selection -1 + set _widget(fcolor) $fg + set _widget(chs) $c1 + set _widget(cv) $c2 + set rgb [winfo rgb $path [Widget::cget $path:SelectColor -color]] + set _hsv [eval rgbToHsv $rgb] + _set_rgb [eval [list format "\#%04x%04x%04x"] $rgb] + _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1] + _set_value [lindex $_hsv 2] + + # Initialize _oldColor which is used to reset the color supplied to + # _userCommand if the user cancels. + set _oldColor [set _unsavedSelection] + set tmp24 [::SelectColor::_24BitRgb $_oldColor] + if {[_ValidateColorEntry forced $tmp24]} { + set ::SelectColor::_entryColor $tmp24 + } else { + # Value $tmp24 does not pass entry widget validation and if used + # would disable validation. Use this default instead. + set _entryColor # + } + + # Validate input to the entry field. + # To avoid conflict with the entry -variable (_entryColor), do not set the + # latter directly (because a failed validation will switch off subsequent + # validations). Either call _SetEntryValue, or set _unsavedSelection which + # triggers the trace. + + $fg.value configure -validate all -validatecommand \ + [list SelectColor::_ValidateColorEntry %V %P] + + # Trace _unsavedSelection + # Subsequent modifications to _unsavedSelection will update the entry + # widget, if the value is valid. + # From now on, this is the only way that: + # (1) ::SelectColor::_SetEntryValue is called + # (2) ::SelectColor::_entryColor is modified (except by the user typing in + # the entry widget) + + trace add variable _unsavedSelection write ::SelectColor::_SetEntryValue + + $top add -text [lindex [BWidget::getname ok] 0] + $top add -text [lindex [BWidget::getname cancel] 0] + + # Override background color + ReColor $path $_bgColor + + set res [$top draw] + if {$res == 0} { + set color [$fg.color cget -background] + } else { + # User has cancelled - call _userCommand to undo any changes made + # in the caller. + _userCommand $_oldColor + set color "" + } + + trace remove variable _unsavedSelection write ::SelectColor::_SetEntryValue + + destroy $top + return $color +} + + +# ---------------------------------------------------------------------------- +# Command SelectColor::setbasecolor +# ---------------------------------------------------------------------------- +# Exported command, to allow the caller to set the base colors of the palette. + +proc SelectColor::setbasecolor { idx color } { + variable _baseColors + set _baseColors [lreplace $_baseColors $idx $idx $color] +} + +# ---------------------------------------------------------------------------- +# Command SelectColor::setcolor +# ---------------------------------------------------------------------------- + +proc SelectColor::setcolor { idx color } { + variable _userColors + set _userColors [lreplace $_userColors $idx $idx $color] +} + +proc SelectColor::_select_rgb {count} { + variable _baseColors + variable _userColors + variable _selection + variable _widget + variable _hsv + variable _unsavedSelection + variable _bgColor + variable _fgColor + + set frame $_widget(fcolor) + + # Use highlight color instead of focus to identify the selected + # palette color. Tab traversal of focus now works correctly. + if {$_selection >= 0} { + $frame.round$_selection configure \ + -relief sunken -highlightthickness 1 -borderwidth 2 \ + -highlightbackground $_bgColor + } + $frame.round$count configure \ + -relief flat -highlightthickness 2 -borderwidth 1 \ + -highlightbackground $_fgColor + set _selection $count + set bg [$frame.color$count cget -background] + set user [expr {$_selection-[llength $_baseColors]}] + if {$user >= 0 && + [string equal \ + [winfo rgb $frame.color$_selection $bg] \ + [winfo rgb $frame.color$_selection white]]} { + set bg [$frame.color cget -bg] + $frame.color$_selection configure -background $bg + set _userColors [lreplace $_userColors $user $user $bg] + } else { + set _hsv [eval rgbToHsv [winfo rgb $frame.color$count $bg]] + _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1] + _set_value [lindex $_hsv 2] + $frame.color configure -background $bg + + # Display selected color in entry widget (via trace on + # ::SelectColor::_unsavedSelection), and notify caller. + set _unsavedSelection $bg + _userCommand $bg + } +} + + +proc SelectColor::_set_rgb {rgb} { + variable _selection + variable _baseColors + variable _userColors + variable _widget + variable _unsavedSelection + + set frame $_widget(fcolor) + $frame.color configure -background $rgb + + # Display selected color in entry widget (via trace on + # ::SelectColor::_unsavedSelection), and notify caller. + set _unsavedSelection $rgb + _userCommand $rgb + set user [expr {$_selection-[llength $_baseColors]}] + if {$user >= 0} { + $frame.color$_selection configure -background $rgb + set _userColors [lreplace $_userColors $user $user $rgb] + } +} + + +proc SelectColor::_select_hue_sat {x y} { + variable _widget + variable _hsv + + if {$x < 0} { + set x 0 + } elseif {$x > 200} { + set x 200 + } + if {$y < 0 } { + set y 0 + } elseif {$y > 200} { + set y 200 + } + set hue [expr {$x/200.0}] + set sat [expr {(200-$y)/200.0}] + set _hsv [lreplace $_hsv 0 1 $hue $sat] + $_widget(chs) coords target [expr {$x-9}] [expr {$y-9}] + _draw_values $hue $sat + _set_rgb [eval [list format "\#%04x%04x%04x"] [eval [list hsvToRgb] $_hsv]] +} + + +proc SelectColor::_set_hue_sat {hue sat} { + variable _widget + + set x [expr {$hue*200-9}] + set y [expr {(1-$sat)*200-9}] + $_widget(chs) coords target $x $y + _draw_values $hue $sat +} + + + +proc SelectColor::_select_value {x y} { + variable _widget + variable _hsv + + if {$y < 0} { + set y 0 + } elseif {$y > 200} { + set y 200 + } + $_widget(cv) coords target 0 [expr {$y-5}] 10 $y 0 [expr {$y+5}] + set _hsv [lreplace $_hsv 2 2 [expr {(200-$y)/200.0}]] + _set_rgb [eval [list format "\#%04x%04x%04x"] [eval [list hsvToRgb] $_hsv]] +} + + +proc SelectColor::_draw_values {hue sat} { + variable _widget + + for {set val 0} {$val < 40} {incr val} { + set l [hsvToRgb $hue $sat [expr {$val/39.0}]] + set col [eval [list format "\#%04x%04x%04x"] $l] + $_widget(cv) itemconfigure val$val -fill $col -outline $col + } +} + + +proc SelectColor::_set_value {value} { + variable _widget + + set y [expr {int((1-$value)*200)}] + $_widget(cv) coords target 0 [expr {$y-5}] 10 $y 0 [expr {$y+5}] +} + + +# -- +# Taken from tk8.0/demos/tcolor.tcl +# -- +# The procedure below converts an HSB value to RGB. It takes hue, saturation, +# and value components (floating-point, 0-1.0) as arguments, and returns a +# list containing RGB components (integers, 0-65535) as result. The code +# here is a copy of the code on page 616 of "Fundamentals of Interactive +# Computer Graphics" by Foley and Van Dam. + +proc SelectColor::hsvToRgb {hue sat val} { + set v [expr {round(65535.0*$val)}] + if {$sat == 0} { + return [list $v $v $v] + } else { + set hue [expr {$hue*6.0}] + if {$hue >= 6.0} { + set hue 0.0 + } + set i [expr {int($hue)}] + set f [expr {$hue-$i}] + set p [expr {round(65535.0*$val*(1 - $sat))}] + set q [expr {round(65535.0*$val*(1 - ($sat*$f)))}] + set t [expr {round(65535.0*$val*(1 - ($sat*(1 - $f))))}] + switch $i { + 0 {return [list $v $t $p]} + 1 {return [list $q $v $p]} + 2 {return [list $p $v $t]} + 3 {return [list $p $q $v]} + 4 {return [list $t $p $v]} + 5 {return [list $v $p $q]} + } + } +} + + +# -- +# Taken from tk8.0/demos/tcolor.tcl +# -- +# The procedure below converts an RGB value to HSB. It takes red, green, +# and blue components (0-65535) as arguments, and returns a list containing +# HSB components (floating-point, 0-1) as result. The code here is a copy +# of the code on page 615 of "Fundamentals of Interactive Computer Graphics" +# by Foley and Van Dam. + +proc SelectColor::rgbToHsv {red green blue} { + if {$red > $green} { + set max $red.0 + set min $green.0 + } else { + set max $green.0 + set min $red.0 + } + if {$blue > $max} { + set max $blue.0 + } else { + if {$blue < $min} { + set min $blue.0 + } + } + set range [expr {$max-$min}] + if {$max == 0} { + set sat 0 + } else { + set sat [expr {($max-$min)/$max}] + } + if {$sat == 0} { + set hue 0 + } else { + set rc [expr {($max - $red)/$range}] + set gc [expr {($max - $green)/$range}] + set bc [expr {($max - $blue)/$range}] + if {$red == $max} { + set hue [expr {.166667*($bc - $gc)}] + } else { + if {$green == $max} { + set hue [expr {.166667*(2 + $rc - $bc)}] + } else { + set hue [expr {.166667*(4 + $gc - $rc)}] + } + } + if {$hue < 0.0} { + set hue [expr {$hue + 1.0}] + } + } + return [list $hue $sat [expr {$max/65535}]] +} + +# ------------------------------------------------------------------------------ +# Command SelectColor::ReColor +# ------------------------------------------------------------------------------ +# Command to change the background color for the dialog. +# +# FIXME Ideally this would be called by "$w configure -background $value". +# Currently a "configure -background" command is passed to Dialog and Widget +# but does not change SelectColor. +# HaO: it might also be possible that this is controled by the option data base. +# ------------------------------------------------------------------------------ + +proc SelectColor::ReColor {path newColor} { + variable _bgColor + variable _rounds + + set _bgColor $newColor + + $path configure -bg $_bgColor + + # Use the internal names of the dialog widget - it would be nicer to + # use a colored dialog widget. + foreach child { + fd fd.f.f1 fd.f.f2 + fg fg.base fg.choice + fg.user fg.round fg.vround + } { + $path.frame.$child configure -background $_bgColor + } + + # Special treatment for Aqua native buttons. + # FIXME implement a general fix for BWidget Button/ButtonBox/Dialog + if {[string equal [tk windowingsystem] "aqua"]} { + $path.bbox.b0 configure -highlightbackground $_bgColor \ + -highlightthickness 0 + $path.bbox.b1 configure -highlightbackground $_bgColor \ + -highlightthickness 0 + } else { + $path.bbox.b0 configure -bg $_bgColor -activebackground $_bgColor \ + -highlightbackground $_bgColor + $path.bbox.b1 configure -bg $_bgColor -activebackground $_bgColor \ + -highlightbackground $_bgColor + } + + foreach fround $_rounds { + $fround configure -highlightbackground $_bgColor -bg $_bgColor + } + + return +} + + +# ------------------------------------------------------------------------------ +# Command SelectColor::_24BitRgb +# ------------------------------------------------------------------------------ +# Command to convert a hex 12n-bit RGB color to 24-bit, n > 0. +# Convert anything else to {}. +# Used to process the display in the entry widget. +# ------------------------------------------------------------------------------ + +proc SelectColor::_24BitRgb {col} { + set lenny [string length $col] + incr lenny -1 + + if { ($lenny % 3) + || ($lenny == 0) + || (![regexp {^#[a-fA-F0-9]*$} $col]) + } { + # Not a multiple of 3, or not leading #, or nothing after #, + # or non-HEX digits. + return {} + } elseif {$lenny == 3} { + # 12-bit, pad to 24-bit + set val $col + set val [string replace $val 3 3 "[string index $val 3]0"] + set val [string replace $val 2 2 "[string index $val 2]0"] + set val [string replace $val 1 1 "[string index $val 1]0"] + return $val + } elseif {$lenny == 6} { + # 24-bit, return unchanged + return $col + } else { + # Truncate to 24-bit + set delta [expr {$lenny / 3}] + set delta2 [expr {$delta * 2}] + set deltaP1 [incr delta] + set deltaP2 [incr delta] + set delta2P1 [incr delta2] + set delta2P2 [incr delta2] + set result # + append result [string range $col 1 2] + append result [string range $col $deltaP1 $deltaP2] + append result [string range $col $delta2P1 $delta2P2] + return $result + } +} + + +# ------------------------------------------------------------------------------ +# Command SelectColor::_SetEntryValue +# ------------------------------------------------------------------------------ +# Command to update the (hexadecimal color displayed in the) entry widget +# when there is a change in the color currently selected in the GUI, which is +# stored in _unsavedSelection. +# +# This command is called by a write trace on _unsavedSelection; if the +# value of this variable is a valid color (i.e. "#" followed by 3N hex digits), +# this command converts the value to 24 bits and sets ::SelectColor::_entryColor +# to the result, thereby displaying it in the entry widget. Therefore, +# when the user chooses a color by means other than the entry widget, this +# command updates the entry widget. +# +# This command does not update the GUI when the user changes the value in the +# entry widget: that is done instead by the -vcmd of the entry widget, which +# is SelectColor::_ValidateColorEntry. When the user chooses a color by typing +# in the entry widget, the command _ValidateColorEntry copies the value to +# _unsavedSelection if a keystroke in the widget makes its contents 3N hex +# digits long. +# ------------------------------------------------------------------------------ + +proc SelectColor::_SetEntryValue {argVarName var2 op} { + variable _entryColor + variable _unsavedSelection + + # get the full qualified name + set fqname [uplevel 1 [list namespace which -variable $argVarName]] + + if {[string equal $fqname ::SelectColor::_unsavedSelection] && + [string equal $var2 {}] && [string equal $op "write"]} { + # OK + } else { + # Unexpected call + return -code error "Unexpected trace of variable\ + \"$argVarName\", \"$var2\", \"$op\"" + } + + set col24bit [_24BitRgb [set $fqname]] + + if {[_ValidateColorEntry forced $col24bit]} { + set _entryColor $col24bit + } else { + # Value is invalid, and if written to _entryColor this would disable + # validation. + } + + return +} + + +# ------------------------------------------------------------------------------ +# Command SelectColor::_CheckFocus +# ------------------------------------------------------------------------------ +# This command is called with argument %W as a binding to <1> on the toplevel. +# It is also called with argument {.}, by bindings on the entry widget to +# , . +# +# The command does something only if the entry widget has focus, and the +# argument (the clicked window) is the Tk window path of somewhere else. Then, +# the command removes focus from the entry widget to the default button. +# ------------------------------------------------------------------------------ + +proc SelectColor::_CheckFocus {w} { + variable _widget + + if { (! [string equal $w $_widget(en)]) && + ([string equal [focus] $_widget(en)])} { + set top [winfo toplevel $_widget(en)] + $top setfocus default + } + + return +} + + +# ------------------------------------------------------------------------------ +# Command SelectColor::_ValidateColorEntry +# ------------------------------------------------------------------------------ +# This command is the "-validate all -vcmd" of the entry widget. +# It is also called by SelectColor::dialog and SelectColor::_SetEntryValue to +# check values assigned to _entryColor. +# +# When the user chooses a color by typing in the entry widget, this command +# copies the value to _unsavedSelection if a keystroke in the widget makes its +# contents 3N hex digits long. +# ------------------------------------------------------------------------------ + +proc SelectColor::_ValidateColorEntry {percentV percentP} { + variable _unsavedSelection + + set result [regexp -- {^#[0-9a-fA-F]*$} $percentP] + if {$result} { + # Check for a valid rgb color, which needs 3n+1 characters, n > 0 + set lenny [string length $percentP] + set entryincomplete [expr {($lenny - 1) % 3 || $lenny == 1}] + } else { + # Check for named colors + set result [regexp -- {^[a-zA-Z0-9 ]*$} $percentP] + # We do not accept the key stroke + if {!$result} { + return 0 + } + # Check for complete named color + set entryincomplete [catch {winfo rgb . $percentP} rgblist] + if {!$entryincomplete} { + set red [expr {[lindex $rgblist 0]/0x100}] + set green [expr {[lindex $rgblist 1]/0x100}] + set blue [expr {[lindex $rgblist 2]/0x100}] + set percentP [format "#%02X%02X%02X" $red $green $blue] + } + } + + if {[string equal $percentV "forced"]} { + # Validation only. Don't want a loop. + } elseif {[string equal $percentV "key"]} { + # Copy to GUI if a valid color. + if {!$entryincomplete} { + after idle [list SelectColor::_SetWithoutTrace $percentP] + } + } elseif {[string equal $percentV "focusout"]} { + # If the color is valid it will already have been copied to the GUI + # and to _userCommand by the "key" validation above. + # + # The code below only needs to reset the value in the entry widget. + # Remove an invalid value, convert a valid one to 24-bit. + # Ignore $percentP, just fire the trace on _unsavedSelection. + set color $_unsavedSelection + after idle [list set SelectColor::_unsavedSelection $color] + } + + return 1 +} + + +# ------------------------------------------------------------------------------ +# Command SelectColor::_SetWithoutTrace +# ------------------------------------------------------------------------------ +# This command sets _unsavedSelection (using _set_rgb) without firing the trace +# that copies the value to _entryColor. +# The command is called by SelectColor::_ValidateColorEntry to avoid a loop. +# ------------------------------------------------------------------------------ + +proc SelectColor::_SetWithoutTrace {value} { + variable _hsv + variable _unsavedSelection + + trace remove variable _unsavedSelection write ::SelectColor::_SetEntryValue + _set_rgb $value + set _hsv [eval rgbToHsv [winfo rgb . $value]] + _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1] + _set_value [lindex $_hsv 2] + trace add variable _unsavedSelection write ::SelectColor::_SetEntryValue + return +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/combobox.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/combobox.tcl new file mode 100644 index 00000000..88a47a3b --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/combobox.tcl @@ -0,0 +1,955 @@ +# ---------------------------------------------------------------------------- +# combobox.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: combobox.tcl,v 1.42.2.3 2012/04/02 09:53:41 oehhar Exp $ +# ---------------------------------------------------------------------------- +# Index of commands: +# - ComboBox::create +# - ComboBox::configure +# - ComboBox::cget +# - ComboBox::setvalue +# - ComboBox::getvalue +# - ComboBox::clearvalue +# - ComboBox::getentry +# - ComboBox::_create_popup +# - ComboBox::_mapliste +# - ComboBox::_unmapliste +# - ComboBox::_select +# - ComboBox::_modify_value +# ---------------------------------------------------------------------------- + +# ComboBox uses the 8.3 -listvariable listbox option +package require Tk 8.3 9 + +namespace eval ComboBox { + Widget::define ComboBox combobox ArrowButton Entry ListBox + + Widget::tkinclude ComboBox frame :cmd \ + include {-relief -borderwidth -bd -background} \ + initialize {-relief sunken -borderwidth 2} + + if {[Widget::theme]} { + Widget::bwinclude ComboBox Entry .e + } else { + Widget::bwinclude ComboBox Entry .e \ + remove {-relief -bd -borderwidth -bg} \ + rename {-background -entrybg} + } + + Widget::declare ComboBox { + {-height TkResource 0 0 listbox} + {-values String "" 0} + {-images String "" 0} + {-indents String "" 0} + {-modifycmd String "" 0} + {-postcommand String "" 0} + {-expand Enum none 0 {none tab}} + {-autocomplete Boolean 0 0} + {-autopost Boolean 0 0} + {-bwlistbox Boolean 0 0} + {-listboxwidth Int 0 0} + {-hottrack Boolean 0 0} + } + + if {[Widget::theme]} { + Widget::addmap ComboBox ArrowButton .a { + -background {} -state {} + } + } else { + Widget::addmap ComboBox ArrowButton .a { + -background {} -foreground {} -disabledforeground {} -state {} + } + } + + ::bind BwComboBox [list after idle {BWidget::refocus %W %W.e}] + ::bind BwComboBox [list ComboBox::_destroy %W] + + ::bind ListBoxHotTrack { + %W selection clear 0 end + %W activate @%x,%y + %W selection set @%x,%y + } + + variable _index +} + + +# ComboBox::create -- +# +# Create a combobox widget with the given options. +# +# Arguments: +# path name of the new widget. +# args optional arguments to the widget. +# +# Results: +# path name of the new widget. + +proc ComboBox::create { path args } { + array set maps [list ComboBox {} :cmd {} .e {} .a {}] + array set maps [Widget::parseArgs ComboBox $args] + + eval [list frame $path] $maps(:cmd) \ + [list -highlightthickness 0 -takefocus 0 -class ComboBox] + Widget::initFromODB ComboBox $path $maps(ComboBox) + + bindtags $path [list $path BwComboBox [winfo toplevel $path] all] + + if {[Widget::theme]} { + set entry [eval [list Entry::create $path.e] $maps(.e) \ + [list -takefocus 1]] + } else { + set entry [eval [list Entry::create $path.e] $maps(.e) \ + [list -relief flat -borderwidth 0 -takefocus 1]] + } + + ::bind $path.e [list $path _focus_out] + ::bind $path <> [list $path _traverse_in] + + if {[Widget::cget $path -autocomplete]} { + ::bind $path.e [list $path _auto_complete %K] + } + + if {[Widget::cget $path -autopost]} { + ::bind $path.e +[list $path _auto_post %K] + } else { + ::bind $entry [list ComboBox::_unmapliste $path] + ::bind $entry [list ComboBox::_mapliste $path] + } + + if {[string equal [tk windowingsystem] "x11"]} { + set ipadx 0 + set width 11 + } else { + set ipadx 2 + set width 15 + } + set height [winfo reqheight $entry] + set arrow [eval [list ArrowButton::create $path.a] $maps(.a) \ + [list -width $width -height $height \ + -highlightthickness 0 -borderwidth 1 -takefocus 0 \ + -dir bottom -type button -ipadx $ipadx \ + -command [list ComboBox::_mapliste $path] \ + ]] + + pack $arrow -side right -fill y + pack $entry -side left -fill both -expand yes + + set editable [Widget::cget $path -editable] + Entry::configure $path.e -editable $editable + if {$editable} { + ::bind $entry [list ComboBox::_unmapliste $path] + } else { + ::bind $entry [list ArrowButton::invoke $path.a] + if { ![string equal [Widget::cget $path -state] "disabled"] } { + Entry::configure $path.e -takefocus 1 + } + } + + ::bind $path [list ComboBox::_unmapliste $path] + ::bind $entry [list ComboBox::_modify_value $path previous] + ::bind $entry [list ComboBox::_modify_value $path next] + ::bind $entry [list ComboBox::_modify_value $path first] + ::bind $entry [list ComboBox::_modify_value $path last] + + if {$editable} { + set expand [Widget::cget $path -expand] + if {[string equal "tab" $expand]} { + # Expand entry value on Tab (from -values) + ::bind $entry "[list ComboBox::_expand $path]; break" + } elseif {[string equal "auto" $expand]} { + # Expand entry value anytime (from -values) + #::bind $entry "[list ComboBox::_expand $path]; break" + } + } + + ## If we have images, we have to use a BWidget ListBox. + set bw [Widget::cget $path -bwlistbox] + if {[llength [Widget::cget $path -images]]} { + Widget::configure $path [list -bwlistbox 1] + } else { + Widget::configure $path [list -bwlistbox $bw] + } + + set ::ComboBox::_index($path) -1 + + return [Widget::create ComboBox $path] +} + + +# ComboBox::configure -- +# +# Configure subcommand for ComboBox widgets. Works like regular +# widget configure command. +# +# Arguments: +# path Name of the ComboBox widget. +# args Additional optional arguments: +# ?-option? +# ?-option value ...? +# +# Results: +# Depends on arguments. If no arguments are given, returns a complete +# list of configuration information. If one argument is given, returns +# the configuration information for that option. If more than one +# argument is given, returns nothing. + +proc ComboBox::configure { path args } { + set res [Widget::configure $path $args] + set entry $path.e + + + set list [list -images -values -bwlistbox -hottrack -autocomplete -autopost] + foreach {ci cv cb ch cac cap} [eval [linsert $list 0 Widget::hasChangedX $path]] { break } + + if { $ci } { + set images [Widget::cget $path -images] + if {[llength $images]} { + Widget::configure $path [list -bwlistbox 1] + } else { + Widget::configure $path [list -bwlistbox 0] + } + } + + ## If autocomplete toggled, turn bindings on/off + if { $cac } { + if {[Widget::cget $path -autocomplete]} { + ::bind $entry +[list $path _auto_complete %K] + } else { + set bindings [split [::bind $entry ] \n] + if {[set idx [lsearch $bindings [list $path _auto_complete %K]]] != -1} { + ::bind $entry [join [lreplace $bindings $idx $idx] \n] + } + } + } + + ## If autopost toggled, turn bindings on/off + if { $cap } { + if {[Widget::cget $path -autopost]} { + ::bind $entry +[list $path _auto_post %K] + set bindings [split [::bind $entry ] \n] + if {[set idx [lsearch $bindings [list ComboBox::_unmapliste $path]]] != -1} { + ::bind $entry [join [lreplace $bindings $idx $idx] \n] + } + set bindings [split [::bind $entry ] \n] + if {[set idx [lsearch $bindings [list ComboBox::_mapliste $path]]] != -1} { + ::bind $entry [join [lreplace $bindings $idx $idx] \n] + } + } else { + set bindings [split [::bind $entry ] \n] + if {[set idx [lsearch $bindings [list $path _auto_post %K]]] != -1} { + ::bind $entry [join [lreplace $bindings $idx $idx] \n] + } + ::bind $entry +[list ComboBox::_unmapliste $path] + ::bind $entry +[list ComboBox::_mapliste $path] + } + } + + set bw [Widget::cget $path -bwlistbox] + + ## If the images, bwlistbox, hottrack or values have changed, + ## destroy the shell so that it will re-create itself the next + ## time around. + if { $ci || $cb || $ch || ($bw && $cv) } { + destroy $path.shell + } + + set chgedit [Widget::hasChangedX $path -editable] + if {$chgedit} { + if {[Widget::cget $path -editable]} { + ::bind $entry [list ComboBox::_unmapliste $path] + Entry::configure $entry -editable true + } else { + ::bind $entry [list ArrowButton::invoke $path.a] + Entry::configure $entry -editable false + + # Make sure that non-editable comboboxes can still be tabbed to. + + if { ![string equal [Widget::cget $path -state] "disabled"] } { + Entry::configure $entry -takefocus 1 + } + } + } + + if {$chgedit || [Widget::hasChangedX $path -expand]} { + # Unset what we may have created. + ::bind $entry {} + if {[Widget::cget $path -editable]} { + set expand [Widget::cget $path -expand] + if {[string equal "tab" $expand]} { + # Expand entry value on Tab (from -values) + ::bind $entry "[list ComboBox::_expand $path]; break" + } elseif {[string equal "auto" $expand]} { + # Expand entry value anytime (from -values) + #::bind $entry "[list ComboBox::_expand $path]; break" + } + } + } + + # if state changed to normal and -editable false, the edit must take focus + if { [Widget::hasChangedX $path -state] \ + && ![string equal [Widget::cget $path -state] "disabled"] \ + && ![Widget::cget $path -editable] } { + Entry::configure $entry -takefocus 1 + } + + # if the dropdown listbox is shown, simply force the actual entry + # colors into it. If it is not shown, the next time the dropdown + # is shown it'll get the actual colors anyway + if {[winfo exists $path.shell.listb]} { + $path.shell.listb configure \ + -bg [_getbg $path] \ + -fg [_getfg $path] + if {![Widget::theme]} { + $path.shell.listb configure \ + -selectbackground [Widget::cget $path -selectbackground] \ + -selectforeground [Widget::cget $path -selectforeground] + } + } + + return $res +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::cget +# ---------------------------------------------------------------------------- +proc ComboBox::cget { path option } { + return [Widget::cget $path $option] +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::setvalue +# ---------------------------------------------------------------------------- +proc ComboBox::setvalue { path index } { + variable _index + + set values [Widget::getMegawidgetOption $path -values] + set value [Entry::cget $path.e -text] + switch -- $index { + next { + if { [set idx [lsearch -exact $values $value]] != -1 } { + incr idx + } else { + set idx [lsearch -exact $values "$value*"] + } + } + previous { + if { [set idx [lsearch -exact $values $value]] != -1 } { + incr idx -1 + } else { + set idx [lsearch -exact $values "$value*"] + } + } + first { + set idx 0 + } + last { + set idx [expr {[llength $values]-1}] + } + default { + if { [string index $index 0] == "@" } { + set idx [string range $index 1 end] + if { ![string is integer -strict $idx] } { + return -code error "bad index \"$index\"" + } + } else { + return -code error "bad index \"$index\"" + } + } + } + if { $idx >= 0 && $idx < [llength $values] } { + set newval [lindex $values $idx] + set _index($path) $idx + Entry::configure $path.e -text $newval + return 1 + } + return 0 +} + + +proc ComboBox::icursor { path idx } { + return [$path.e icursor $idx] +} + + +proc ComboBox::get { path } { + return [$path.e get] +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::getvalue +# ---------------------------------------------------------------------------- +proc ComboBox::getvalue { path } { + variable _index + set values [Widget::getMegawidgetOption $path -values] + set value [Entry::cget $path.e -text] + # Check if an index was saved by the last setvalue operation + # If this index still matches it is returned + # This is necessary for the case when values is not unique + if { $_index($path) >= 0 \ + && $_index($path) < [llength $values] \ + && $value eq [lindex $values $_index($path)]} { + return $_index($path) + } + + return [lsearch -exact $values $value] +} + + +proc ComboBox::getlistbox { path } { + _create_popup $path + return $path.shell.listb +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::post +# ---------------------------------------------------------------------------- +proc ComboBox::post { path } { + _mapliste $path + return +} + + +proc ComboBox::unpost { path } { + _unmapliste $path + return +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::bind +# ---------------------------------------------------------------------------- +proc ComboBox::bind { path args } { + return [eval [list ::bind $path.e] $args] +} + + +proc ComboBox::insert { path idx args } { + upvar #0 [Widget::varForOption $path -values] values + + if {[Widget::cget $path -bwlistbox]} { + set l [$path getlistbox] + set i [eval [linsert $args 0 $l insert $idx #auto]] + set text [$l itemcget $i -text] + if {$idx == "end"} { + lappend values $text + } else { + set values [linsert $values $idx $text] + } + } else { + set values [eval [list linsert $values $idx] $args] + } +} + +# ---------------------------------------------------------------------------- +# Command ComboBox::clearvalue +# ---------------------------------------------------------------------------- +proc ComboBox::clearvalue { path } { + Entry::configure $path.e -text "" +} + +# ---------------------------------------------------------------------------- +# Command ComboBox::getentry +# ---------------------------------------------------------------------------- +proc ComboBox::getentry { path } { + return $path.e +} + +proc ComboBox::_getfg {path} { + # First try to retrieve option + set fg [Widget::cget $path -foreground]; + if { 0 == [string length $fg] && [Widget::theme] } { + # fall back to style settings when not configured for widget + return [::ttk::style lookup TEntry -foreground]; + } + return $fg; +} +proc ComboBox::_getbg {path} { + if {[Widget::theme]} { + # First try to retrieve option + set bg [Widget::cget $path -background]; + if {0 == [string length $bg]} { + # fall back to style settings when not configured for widget + return [::ttk::style lookup TEntry -backround]; + } + } else { + # fetch the entrybg resource value + set bg [Widget::cget $path -entrybg] + } + return $bg; +} +# ---------------------------------------------------------------------------- +# Command ComboBox::_create_popup +# ---------------------------------------------------------------------------- +proc ComboBox::_create_popup { path } { + set shell $path.shell + + if {[winfo exists $shell]} { return } + + set lval [Widget::cget $path -values] + set h [Widget::cget $path -height] + set bw [Widget::cget $path -bwlistbox] + + if { $h <= 0 } { + set len [llength $lval] + if { $len < 3 } { + set h 3 + } elseif { $len > 10 } { + set h 10 + } else { + set h $len + } + } + + if {[string equal [tk windowingsystem] "x11"]} { + set sbwidth 11 + } else { + set sbwidth 15 + } + + toplevel $shell -relief solid -bd 1 + wm withdraw $shell + wm overrideredirect $shell 1 + # these commands cause the combobox to behave strangely on OS X + if {! $::Widget::_aqua } { + update idle + wm transient $shell [winfo toplevel $path] + catch { wm attributes $shell -topmost 1 } + } + + set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0] + + if {$bw} { + if {[Widget::theme]} { + set listb [ListBox $shell.listb \ + -relief flat -borderwidth 0 -highlightthickness 0 \ + -selectmode single -selectfill 1 -autofocus 0 -height $h \ + -font [Widget::cget $path -font] \ + -bg [_getbg $path] \ + -fg [_getfg $path]] + } else { + set listb [ListBox $shell.listb \ + -relief flat -borderwidth 0 -highlightthickness 0 \ + -selectmode single -selectfill 1 -autofocus 0 -height $h \ + -font [Widget::cget $path -font] \ + -bg [_getbg $path] \ + -fg [_getfg $path] \ + -selectbackground [Widget::cget $path -selectbackground] \ + -selectforeground [Widget::cget $path -selectforeground]] + } + + set values [Widget::cget $path -values] + set images [Widget::cget $path -images] + foreach value $values image $images { + $listb insert end #auto -text $value -image $image + } + $listb bindText <1> [list ComboBox::_select $path] + $listb bindImage <1> [list ComboBox::_select $path] + if {[Widget::cget $path -hottrack]} { + $listb bindText [list $listb selection set] + $listb bindImage [list $listb selection set] + } + } else { + if {[Widget::theme]} { + set listb [listbox $shell.listb \ + -relief flat -borderwidth 0 -highlightthickness 0 \ + -exportselection false \ + -font [Widget::cget $path -font] \ + -height $h \ + -bg [_getbg $path] \ + -fg [_getfg $path] \ + -listvariable [Widget::varForOption $path -values]] + } else { + set listb [listbox $shell.listb \ + -relief flat -borderwidth 0 -highlightthickness 0 \ + -exportselection false \ + -font [Widget::cget $path -font] \ + -height $h \ + -bg [_getbg $path] \ + -fg [_getfg $path] \ + -selectbackground [Widget::cget $path -selectbackground] \ + -selectforeground [Widget::cget $path -selectforeground] \ + -listvariable [Widget::varForOption $path -values]] + } + ::bind $listb [list ComboBox::_select $path @%x,%y] + + if {[Widget::cget $path -hottrack]} { + bindtags $listb [concat [bindtags $listb] ListBoxHotTrack] + } + } + pack $sw -fill both -expand yes + $sw setwidget $listb + + ::bind $listb "ComboBox::_select [list $path] \[$listb curselection\]" + ::bind $listb [list ComboBox::_unmapliste $path] + ::bind $listb [list ComboBox::_focus_out $path] +} + + +proc ComboBox::_recreate_popup { path } { + variable background + variable foreground + + set shell $path.shell + set lval [Widget::cget $path -values] + set h [Widget::cget $path -height] + set bw [Widget::cget $path -bwlistbox] + + if { $h <= 0 } { + set len [llength $lval] + if { $len < 3 } { + set h 3 + } elseif { $len > 10 } { + set h 10 + } else { + set h $len + } + } + + if { [string equal [tk windowingsystem] "x11"] } { + set sbwidth 11 + } else { + set sbwidth 15 + } + + _create_popup $path + + if {![Widget::cget $path -editable]} { + if {[info exists background]} { + $path.e configure -bg $background + $path.e configure -fg $foreground + unset background + unset foreground + } + } + + set listb $shell.listb + destroy $shell.sw + set sw [ScrolledWindow $shell.sw -managed 1 -size $sbwidth -ipad 0] + $listb configure \ + -height $h \ + -font [Widget::cget $path -font] \ + -bg [_getbg $path] \ + -fg [_getfg $path] + if {![Widget::theme]} { + $listb configure \ + -selectbackground [Widget::cget $path -selectbackground] \ + -selectforeground [Widget::cget $path -selectforeground] + } + pack $sw -fill both -expand yes + $sw setwidget $listb + raise $listb +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_mapliste +# ---------------------------------------------------------------------------- +proc ComboBox::_mapliste { path } { + set listb $path.shell.listb + if {[winfo exists $path.shell] && + [string equal [wm state $path.shell] "normal"]} { + _unmapliste $path + return + } + + if { [Widget::cget $path -state] == "disabled" } { + return + } + if {[llength [set cmd [Widget::getMegawidgetOption $path -postcommand]]]} { + uplevel \#0 $cmd + } + if { ![llength [Widget::getMegawidgetOption $path -values]] } { + return + } + + _recreate_popup $path + + ArrowButton::configure $path.a -relief sunken + update + + set bw [Widget::cget $path -bwlistbox] + + $listb selection clear 0 end + set values [Widget::getMegawidgetOption $path -values] + set curval [Entry::cget $path.e -text] + if { [set idx [lsearch -exact $values $curval]] != -1 || + [set idx [lsearch -exact $values "$curval*"]] != -1 } { + if {$bw} { + set idx [$listb items $idx] + } else { + $listb activate $idx + } + $listb selection set $idx + $listb see $idx + } else { + set idx 0 + if {$bw} { + set idx [$listb items 0] + } else { + $listb activate $idx + } + $listb selection set $idx + $listb see $idx + } + + set width [Widget::cget $path -listboxwidth] + if {!$width} { set width [winfo width $path] } + BWidget::place $path.shell $width 0 below $path + wm deiconify $path.shell + raise $path.shell + BWidget::focus set $listb + if {! $::Widget::_aqua } { + BWidget::grab global $path + } +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_unmapliste +# ---------------------------------------------------------------------------- +proc ComboBox::_unmapliste { path {refocus 1} } { + # On aqua, state is zoomed, otherwise normal + if {[winfo exists $path.shell] && \ + ( [string equal [wm state $path.shell] "normal"] || + [string equal [wm state $path.shell] "zoomed"] ) } { + if {! $::Widget::_aqua } { + BWidget::grab release $path + BWidget::focus release $path.shell.listb $refocus + # Update now because otherwise [focus -force...] makes the app hang! + if {$refocus} { + update + focus -force $path.e + } + } + wm withdraw $path.shell + ArrowButton::configure $path.a -relief raised + } +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_select +# ---------------------------------------------------------------------------- +proc ComboBox::_select { path index } { + set index [$path.shell.listb index $index] + _unmapliste $path + if { $index != -1 } { + if { [setvalue $path @$index] } { + set cmd [Widget::getMegawidgetOption $path -modifycmd] + if {[llength $cmd]} { + uplevel \#0 $cmd + } + } + } + $path.e selection clear + if {[$path.e cget -exportselection]} { + $path.e selection range 0 end + } +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_modify_value +# ---------------------------------------------------------------------------- +proc ComboBox::_modify_value { path direction } { + if {[setvalue $path $direction] + && [llength [set cmd [Widget::getMegawidgetOption $path -modifycmd]]]} { + uplevel \#0 $cmd + } +} + +# ---------------------------------------------------------------------------- +# Command ComboBox::_expand +# ---------------------------------------------------------------------------- +proc ComboBox::_expand {path} { + set values [Widget::getMegawidgetOption $path -values] + if {![llength $values]} { + bell + return 0 + } + + set found {} + set curval [Entry::cget $path.e -text] + set curlen [$path.e index insert] + if {$curlen < [string length $curval]} { + # we are somewhere in the middle of a string. + # if the full value matches some string in the listbox, + # reorder values to start matching after that string. + set idx [lsearch -exact $values $curval] + if {$idx >= 0} { + set values [concat [lrange $values [expr {$idx+1}] end] \ + [lrange $values 0 $idx]] + } + } + if {$curlen == 0} { + set found $values + } else { + foreach val $values { + if {[string equal -length $curlen $curval $val]} { + lappend found $val + } + } + } + if {[llength $found]} { + Entry::configure $path.e -text [lindex $found 0] + if {[llength $found] > 1} { + set best [_best_match $found [string range $curval 0 $curlen]] + set blen [string length $best] + $path.e icursor $blen + $path.e selection range $blen end + } + } else { + bell + } + return [llength $found] +} + +# best_match -- +# finds the best unique match in a list of names +# The extra $e in this argument allows us to limit the innermost loop a +# little further. +# Arguments: +# l list to find best unique match in +# e currently best known unique match +# Returns: +# longest unique match in the list +# +proc ComboBox::_best_match {l {e {}}} { + set ec [lindex $l 0] + if {[llength $l]>1} { + set e [string length $e]; incr e -1 + set ei [string length $ec]; incr ei -1 + foreach l $l { + while {$ei>=$e && [string first $ec $l]} { + set ec [string range $ec 0 [incr ei -1]] + } + } + } + return $ec +} +# possibly faster +#proc match {string1 string2} { +# set i 1 +# while {[string equal -length $i $string1 $string2]} { incr i } +# return [string range $string1 0 [expr {$i-2}]] +#} +#proc matchlist {list} { +# set list [lsort $list] +# return [match [lindex $list 0] [lindex $list end]] +#} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_traverse_in +# Called when widget receives keyboard focus due to keyboard traversal. +# ---------------------------------------------------------------------------- +proc ComboBox::_traverse_in { path } { + if {[$path.e selection present] != 1} { + # Autohighlight the selection, but not if one existed + $path.e selection range 0 end + } +} + + +# ---------------------------------------------------------------------------- +# Command ComboBox::_focus_out +# ---------------------------------------------------------------------------- +proc ComboBox::_focus_out { path } { + if {[string first $path [focus]] != 0} { + # we lost focus to some other app or window, so remove the listbox + return [_unmapliste $path 0] + } +} + +proc ComboBox::_auto_complete { path key } { + ## Any key string with more than one character and is not entirely + ## lower-case is considered a function key and is thus ignored. + if {[string length $key] > 1 && [string tolower $key] != $key} { return } + + set text [string map [list {[} {\[} {]} {\]}] [$path.e get]] + if {[string equal $text ""]} { return } + set values [Widget::cget $path -values] + set x [lsearch $values $text*] + if {$x < 0} { return } + + set idx [$path.e index insert] + $path.e configure -text [lindex $values $x] + $path.e icursor $idx + $path.e select range insert end +} + +proc ComboBox::_auto_post { path key } { + if {[string equal $key "Escape"] || [string equal $key "Return"]} { + _unmapliste $path + return + } + if {[catch {$path.shell.listb curselection} x] || $x == ""} { + if {[string equal $key "Up"]} { + _unmapliste $path + return + } + set x -1 + } + if {([string length $key] > 1 && [string tolower $key] != $key) && \ + [string equal $key "BackSpace"] != 0 && \ + [string equal $key "Up"] != 0 && \ + [string equal $key "Down"] != 0} { + return + } + + # post the listbox + _create_popup $path + set width [Widget::cget $path -listboxwidth] + if {!$width} { set width [winfo width $path] } + BWidget::place $path.shell $width 0 below $path + wm deiconify $path.shell + BWidget::grab release $path + BWidget::focus release $path.shell.listb 1 + focus -force $path.e + + set values [Widget::cget $path -values] + switch -- $key { + Up { + if {[incr x -1] < 0} { + set x 0 + } else { + Entry::configure $path.e -text [lindex $values $x] + } + } + Down { + if {[incr x] >= [llength $values]} { + set x [expr {[llength $values] - 1}] + } else { + Entry::configure $path.e -text [lindex $values $x] + } + } + default { + # auto-select within the listbox the item closest to the entry's value + set text [string map [list {[} {\[} {]} {\]}] [$path.e get]] + if {[string equal $text ""]} { + set x 0 + } else { + set x [lsearch $values $text*] + } + } + } + + if {$x >= 0} { + $path.shell.listb selection clear 0 end + $path.shell.listb selection set $x + $path.shell.listb see $x + } +} +# ------------------------------------------------------------------------------ +# Command ComboBox::_destroy +# ------------------------------------------------------------------------------ +proc ComboBox::_destroy { path } { + variable _index + Widget::destroy $path + unset _index($path) +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/basic.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/basic.tcl new file mode 100644 index 00000000..02564d27 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/basic.tcl @@ -0,0 +1,200 @@ + +namespace eval DemoBasic { + variable var + variable count 0 + variable id "" +} + + +proc DemoBasic::create { nb } { + set frame [$nb insert end demoBasic -text "Basic"] + + set topf [frame $frame.topf] + set titf1 [TitleFrame $topf.titf1 -text "Label"] + set titf2 [TitleFrame $topf.titf2 -text "Entry"] + set titf3 [TitleFrame $frame.titf3 -text "Button and ArrowButton"] + + _label [$titf1 getframe] + _entry [$titf2 getframe] + _button [$titf3 getframe] + + pack $titf1 $titf2 -side left -fill both -padx 4 -expand yes + pack $topf -pady 2 -fill x + pack $titf3 -pady 2 -padx 4 -fill x + + return $frame +} + + +proc DemoBasic::_label { parent } { + variable var + + set lab [Label $parent.label -text "This is a Label widget" \ + -helptext "Label widget"] + set chk [checkbutton $parent.chk -text "Disabled" \ + -variable DemoBasic::var($lab,-state) \ + -onvalue disabled -offvalue normal \ + -command "$lab configure -state \$DemoBasic::var($lab,-state)"] + pack $lab -anchor w -pady 4 + pack $chk -anchor w +} + + +proc DemoBasic::_entry { parent } { + set ent [Entry $parent.entry -text "Press enter" \ + -command {set DemoBasic::var(entcmd) "-command called" ; after 500 {set DemoBasic::var(entcmd) ""}} \ + -helptext "Entry widget"] + set chk1 [checkbutton $parent.chk1 -text "Disabled" \ + -variable DemoBasic::var($ent,state) \ + -onvalue disabled -offvalue normal \ + -command "$ent configure -state \$DemoBasic::var($ent,state)"] + set chk2 [checkbutton $parent.chk2 -text "Non editable" \ + -variable DemoBasic::var($ent,editable) \ + -onvalue false -offvalue true \ + -command "$ent configure -editable \$DemoBasic::var($ent,editable)"] + set lab [label $parent.cmd -textvariable DemoBasic::var(entcmd) -foreground red] + pack $ent -pady 4 -anchor w + pack $chk1 $chk2 -anchor w + pack $lab -pady 4 +} + + +proc DemoBasic::_button { parent } { + variable var + + set frame [frame $parent.butfr] + set but [Button $frame.but -text "Press me!" \ + -repeatdelay 300 \ + -command "DemoBasic::_butcmd command" \ + -helptext "This is a Button widget"] + set sep1 [Separator $frame.sep1 -orient vertical] + set arr1 [ArrowButton $frame.arr1 -type button \ + -width 25 -height 25 \ + -repeatdelay 300 \ + -command "DemoBasic::_butcmd command" \ + -helptext "This is an ArrowButton widget\nof type button"] + set sep2 [Separator $frame.sep2 -orient vertical] + set arr2 [ArrowButton $frame.arr2 -type arrow \ + -width 25 -height 25 -relief sunken -ipadx 0 -ipady 0 \ + -repeatdelay 300 \ + -command "DemoBasic::_butcmd command" \ + -helptext "This is an ArrowButton widget\nof type arrow"] + + pack $but -side left -padx 4 + pack $sep1 -side left -padx 4 -fill y + pack $arr1 -side left -padx 4 + pack $sep2 -side left -padx 4 -fill y + pack $arr2 -side left -padx 4 + pack $frame + + set sep3 [Separator $parent.sep3 -orient horizontal] + pack $sep3 -fill x -pady 10 + + set labf1 [LabelFrame $parent.labf1 -text "Command" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf1 getframe] + set chk1 [checkbutton $subf.chk1 -text "Disabled" \ + -variable DemoBasic::var(bstate) -onvalue disabled -offvalue normal \ + -command "DemoBasic::_bstate \$DemoBasic::var(bstate) $but $arr1 $arr2"] + set chk2 [checkbutton $subf.chk2 -text "Use -armcommand/\n-disarmcommand" \ + -justify left \ + -variable DemoBasic::var(barmcmd) \ + -command "DemoBasic::_barmcmd \$DemoBasic::var(barmcmd) $but $arr1 $arr2"] + pack $chk1 $chk2 -anchor w + + set label [label $parent.label -textvariable DemoBasic::var(butcmd) -foreground red] + pack $label -side bottom -pady 4 + + set labf2 [LabelFrame $parent.labf2 -text "Direction" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf2 getframe] + set var(bside) top + foreach dir {top left bottom right} { + set rad [radiobutton $subf.$dir -text "$dir arrow" \ + -variable DemoBasic::var(bside) -value $dir \ + -command "DemoBasic::_bside \$DemoBasic::var(bside) $arr1 $arr2"] + pack $rad -anchor w + } + + set labf3 [LabelFrame $parent.labf3 -text "Relief" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf3 getframe] + set var(brelief) raised + foreach {f lrelief} {f1 {raised sunken ridge groove} f2 {flat solid link}} { + set f [frame $subf.$f] + foreach relief $lrelief { + set rad [radiobutton $f.$relief -text $relief \ + -variable DemoBasic::var(brelief) -value $relief \ + -command "DemoBasic::_brelief \$DemoBasic::var(brelief) $but $arr1 $arr2"] + pack $rad -anchor w + } + pack $f -side left -padx 2 -anchor n + } + pack $labf1 $labf2 $labf3 -side left -fill y -padx 4 +} + + +proc DemoBasic::_bstate { state but arr1 arr2 } { + foreach but [list $but $arr1 $arr2] { + $but configure -state $state + } +} + + +proc DemoBasic::_brelief { relief but arr1 arr2 } { + $but configure -relief $relief + if { $relief != "link" } { + foreach arr [list $arr1 $arr2] { + $arr configure -relief $relief + } + } +} + + +proc DemoBasic::_bside { side args } { + foreach arr $args { + $arr configure -dir $side + } +} + + +proc DemoBasic::_barmcmd { value but arr1 arr2 } { + if { $value } { + $but configure \ + -armcommand "DemoBasic::_butcmd arm" \ + -disarmcommand "DemoBasic::_butcmd disarm" \ + -command {} + foreach arr [list $arr1 $arr2] { + $arr configure \ + -armcommand "DemoBasic::_butcmd arm" \ + -disarmcommand "DemoBasic::_butcmd disarm" \ + -command {} + } + } else { + $but configure -armcommand {} -disarmcommand {} \ + -command "DemoBasic::_butcmd command" + foreach arr [list $arr1 $arr2] { + $arr configure -armcommand {} -disarmcommand {} \ + -command "DemoBasic::_butcmd command" + } + } +} + + +proc DemoBasic::_butcmd { reason } { + variable count + variable id + variable var + + catch {after cancel $id} + if { $reason == "arm" } { + incr count + set var(butcmd) "$reason command called ($count)" + } else { + set count 0 + set var(butcmd) "$reason command called" + } + set id [after 500 {set DemoBasic::var(butcmd) ""}] +} + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/bwidget.xbm b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/bwidget.xbm new file mode 100644 index 00000000..5451ebb9 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/bwidget.xbm @@ -0,0 +1,46 @@ +#define bwidget_width 76 +#define bwidget_height 64 +static char bwidget_bits[] = { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0x00,0xb6,0x6d,0xdb,0x16,0x00,0x00,0x00,0x00,0xf0, + 0x00,0xdb,0xb6,0x6d,0xab,0x00,0x00,0x00,0x00,0xf0,0x00,0x55,0x55,0x55,0x75, + 0x01,0x00,0x00,0x00,0xf0,0x00,0x6d,0xdb,0xb6,0xad,0x02,0x00,0x00,0x00,0xf0, + 0x00,0xb6,0x6d,0xdb,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0x55,0x55,0x55,0x55, + 0x05,0x00,0x00,0x00,0xf0,0x00,0xda,0xb6,0xad,0x6d,0x0b,0x00,0x00,0x00,0xf0, + 0x00,0x6b,0x03,0xc0,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0x56,0x05,0x00,0x55, + 0x0d,0x00,0x00,0x00,0xf0,0x00,0xbb,0x05,0x80,0xdb,0x06,0x00,0x00,0x00,0xf0, + 0x00,0xca,0x06,0x00,0x6c,0x0b,0x00,0x00,0x00,0xf0,0x00,0xb6,0x02,0x00,0xaa, + 0x0a,0x00,0x00,0x00,0xf0,0x00,0xab,0x05,0x00,0x6c,0x0b,0x00,0x00,0x00,0xf0, + 0x00,0xdd,0x06,0x00,0xb6,0x05,0x00,0x00,0x00,0xf0,0x00,0xaa,0x02,0x00,0x55, + 0x05,0x00,0x00,0x00,0xf0,0x00,0xb7,0x05,0xc0,0xda,0x02,0x00,0x00,0x00,0xf0, + 0x00,0xd9,0x06,0x50,0x6b,0x01,0x00,0x00,0x00,0xf0,0x00,0x56,0xb5,0xad,0xad, + 0x00,0x00,0x00,0x00,0xf0,0x00,0xdb,0xd6,0x76,0x15,0x00,0x00,0x00,0x00,0xf0, + 0x00,0x6a,0xab,0xaa,0x2d,0x00,0x00,0x00,0x00,0xf0,0x00,0x56,0x75,0xad,0xb6, + 0x02,0x00,0x00,0x00,0xf0,0x00,0xbb,0xad,0xd6,0xaa,0x05,0x00,0x00,0x00,0xf0, + 0x00,0xca,0xb6,0x6b,0xdb,0x2a,0x00,0x00,0x00,0xf0,0x00,0x77,0xd5,0x5c,0x6d, + 0x2d,0x00,0x00,0x00,0xf0,0x00,0x99,0x05,0x00,0xaa,0x56,0x00,0x00,0x00,0xf0, + 0x00,0xee,0x06,0x00,0x6c,0xbb,0x00,0x00,0x00,0xf0,0x00,0xaa,0x02,0x00,0xb0, + 0x55,0x00,0x00,0x00,0xf0,0x00,0x55,0x05,0x00,0xa8,0xd6,0x00,0x00,0x00,0xf0, + 0x00,0xee,0x06,0x00,0xd0,0x6a,0x00,0x00,0x00,0xf0,0x00,0x55,0x03,0x00,0x68, + 0xb7,0xfc,0x00,0x7e,0xf0,0x00,0x6d,0x05,0x00,0xa8,0xaa,0xfc,0x80,0x7e,0xf0, + 0x00,0xb6,0x05,0x00,0x50,0xbb,0xfe,0x01,0x7e,0xf0,0x00,0x55,0x05,0x00,0x78, + 0xad,0xfe,0x81,0x1f,0xf0,0x00,0xb6,0x05,0x00,0xa4,0xb5,0xfe,0x81,0x1f,0xf0, + 0x00,0x5b,0x05,0x80,0xba,0x56,0xfe,0x83,0x1f,0xf0,0x00,0xaa,0x6b,0x5b,0xd5, + 0x5a,0xff,0x85,0x1f,0xf0,0x00,0xdb,0x5a,0xad,0x57,0x2b,0xff,0xc7,0x0f,0xf0, + 0x00,0x6d,0xad,0xd5,0x6a,0x0d,0xff,0xc7,0x0f,0xf0,0x00,0xaa,0xd6,0xb6,0xba, + 0x05,0xdf,0xc7,0x0f,0xf0,0x00,0xb7,0xb5,0x5a,0xab,0x8a,0xdf,0xcf,0x0f,0xf0, + 0x00,0xd9,0x5a,0xab,0x6d,0x8f,0xcf,0xef,0x07,0xf0,0x00,0x56,0xad,0x75,0xb5, + 0xaf,0x8f,0xef,0x07,0xf0,0x00,0xb5,0xeb,0x5a,0x00,0x9f,0xcf,0xef,0x07,0xf0, + 0x00,0x00,0x00,0x00,0x00,0xff,0x8f,0xff,0x07,0xf0,0x00,0x00,0x00,0x00,0x00, + 0xfe,0x87,0xff,0x03,0xf0,0x00,0x00,0x00,0x00,0x00,0xff,0x03,0xff,0x03,0xf0, + 0x00,0x00,0x00,0x00,0x00,0xfe,0x03,0xff,0x03,0xf0,0x00,0x00,0x00,0x00,0x00, + 0xfe,0x03,0xff,0x01,0xf0,0x00,0x00,0x00,0x00,0x00,0xfc,0x01,0xff,0x03,0xf0, + 0x00,0x00,0x00,0x00,0x00,0xfe,0x01,0xfe,0x01,0xf0,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x01,0xfe,0x01,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0}; diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/demo.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/demo.tcl new file mode 100644 index 00000000..a6e708ad --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/demo.tcl @@ -0,0 +1,273 @@ +#!/bin/sh +# The next line is executed by /bin/sh, but not tcl \ +exec wish "$0" ${1+"$@"} +package require Tk + +namespace eval Demo { + variable _wfont + + variable notebook + variable mainframe + variable status + variable prgtext + variable prgindic + variable font + variable font_name + variable toolbar1 1 + variable toolbar2 1 + + set pwd [pwd] + cd [file dirname [info script]] + variable DEMODIR [pwd] + cd $pwd + + foreach script { + manager.tcl basic.tcl select.tcl dnd.tcl tree.tcl tmpldlg.tcl + } { + namespace inscope :: source $DEMODIR/$script + } +} + +image create photo bwidget16 -data { + R0lGODlhEAAQAOMJABat6IGYffaBCUSku/KCDcCMPomXdgCy//+AANnZ2dnZ2dnZ2dnZ2dnZ2dnZ + 2dnZ2SH5BAEKAA8ALAAAAAAQABAAAAQ58MlJq70U6a0x/9c2iRb5mNmHjmpXuiecIpRA0JWJDEfw + HIffoWU4AIBBYKuABAoxSGEQ6oxins8IADs= +} + +image create photo faded16 -data { + R0lGODlhEAAQAKEDAAAAAICAgKCgoP///yH5BAEKAAMALAAAAAAQABAAAAIjnI+py+1vQEABsDoH + blUI+XyAAImk033Zsmng8hoVRNd2XQAAOw== +} + +image create photo stop16 -data { + R0lGODlhEAAQAMIFAAAAAC8DA3gKCpYMDPAUFP///////////yH5BAEKAAcALAAAAAAQABAAAAMm + SLrc/jDKqYBgAsB8CY/ZMFjTGAzUEACoFI7d83nkUysZpe/8ngAAOw== +} + +proc Demo::create { } { + global tk_patchLevel + variable _wfont + variable notebook + variable mainframe + variable font + variable prgtext + variable prgindic + + set prgtext "Please wait while loading font..." + set prgindic -1 + _create_intro + update + SelectFont::loadfont + + bind all { catch {console show} } + + # Menu description + set descmenu { + "&File" all file 0 { + {command "E&xit" {} "Exit BWidget demo" {} -command exit} + } + "&Options" all options 0 { + {checkbutton "Toolbar &1" {all option} "Show/hide toolbar 1" {} + -variable Demo::toolbar1 + -command {$Demo::mainframe showtoolbar 0 $Demo::toolbar1} + } + {checkbutton "Toolbar &2" {all option} "Show/hide toolbar 2" {} + -variable Demo::toolbar2 + -command {$Demo::mainframe showtoolbar 1 $Demo::toolbar2} + } + } + } + + set prgtext "Creating MainFrame..." + set prgindic 0 + set mainframe [MainFrame .mainframe \ + -menu $descmenu \ + -textvariable Demo::status \ + -progressvar Demo::prgindic] + + # toolbar 1 creation + incr prgindic + set tb1 [$mainframe addtoolbar] + set bbox [ButtonBox $tb1.bbox1 -spacing 0 -padx 1 -pady 1] + $bbox add -image [Bitmap::get new] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Create a new file" + $bbox add -image [Bitmap::get open] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Open an existing file" + $bbox add -image [Bitmap::get save] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Save file" + pack $bbox -side left -anchor w + + set sep [Separator $tb1.sep -orient vertical] + pack $sep -side left -fill y -padx 4 -anchor w + + incr prgindic + set bbox [ButtonBox $tb1.bbox2 -spacing 0 -padx 1 -pady 1] + $bbox add -image [Bitmap::get cut] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Cut selection" + $bbox add -image [Bitmap::get copy] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Copy selection" + $bbox add -image [Bitmap::get paste] \ + -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1 -padx 1 -pady 1 \ + -helptext "Paste selection" + pack $bbox -side left -anchor w + + # toolbar 2 creation + incr prgindic + set tb2 [$mainframe addtoolbar] + set _wfont [SelectFont $tb2.font -type toolbar \ + -command "Demo::update_font \[$tb2.font cget -font\]"] + set font [$_wfont cget -font] + pack $_wfont -side left -anchor w + + $mainframe addindicator -text "BWidget [package provide BWidget]" + $mainframe addindicator -textvariable tk_patchLevel + + # NoteBook creation + set frame [$mainframe getframe] + set notebook [NoteBook $frame.nb] + + set prgtext "Creating Manager..." + incr prgindic + set f0 [DemoManager::create $notebook] + set prgtext "Creating Basic..." + incr prgindic + set f1 [DemoBasic::create $notebook] + set prgtext "Creating Select..." + incr prgindic + set f2 [DemoSelect::create $notebook] + set prgtext "Creating Dialog..." + incr prgindic + set f3b [DemoDlg::create $notebook] + set prgtext "Creating Drag and Drop..." + incr prgindic + set f4 [DemoDnd::create $notebook] + set prgtext "Creating Tree..." + incr prgindic + set f5 [DemoTree::create $notebook] + + foreach page [$notebook pages] { + $notebook itemconfigure $page \ + -image bwidget16 \ + -rimage faded16 \ + -ractiveimage stop16 \ + -rimagecmd {::Demo::_close_tab} + } + + set prgtext "Done" + incr prgindic + $notebook compute_size + pack $notebook -fill both -expand yes -padx 4 -pady 4 + $notebook raise [$notebook page 0] + + pack $mainframe -fill both -expand yes + update idletasks + destroy .intro +} + +proc Demo::_close_tab { tabSet tabName } { + after idle [list $tabSet delete $tabName] + + set tabIndex [$tabSet index $tabName] + set tabList [$tabSet pages] + set tabTot [llength $tabList] + + # Pick another tab to raise. + if {$tabTot == 1} { + # No other tabs. + exit + } elseif {$tabIndex < $tabTot - 1} { + # Raise the tab to the right. + set raiseTabName [lindex $tabList [expr {$tabIndex + 1}]] + } else { + # This tab is furthest to the right. Raise the tab to the left. + set raiseTabName [lindex $tabList [expr {$tabIndex - 1}]] + } + + $tabSet raise $raiseTabName + $tabSet see $raiseTabName + return +} + + + +proc Demo::update_font { newfont } { + variable _wfont + variable notebook + variable font + variable font_name + + . configure -cursor watch + if { $font != $newfont } { + $_wfont configure -font $newfont + $notebook configure -font $newfont + set font $newfont + } + . configure -cursor "" +} + + +proc Demo::_create_intro { } { + variable DEMODIR + + set top [toplevel .intro -relief raised -borderwidth 2] + + wm withdraw $top + wm overrideredirect $top 1 + + set ximg [label $top.x -bitmap @$DEMODIR/x1.xbm \ + -foreground grey90 -background white] + set bwimg [label $ximg.bw -bitmap @$DEMODIR/bwidget.xbm \ + -foreground grey90 -background white] + set frame [frame $ximg.f -background white] + set lab1 [label $frame.lab1 -text "Loading demo" \ + -background white -font {times 8}] + set lab2 [label $frame.lab2 -textvariable Demo::prgtext \ + -background white -font {times 8} -width 35] + set prg [ProgressBar $frame.prg -width 50 -height 10 -background white \ + -variable Demo::prgindic -maximum 10] + pack $lab1 $lab2 $prg + place $frame -x 0 -y 0 -anchor nw + place $bwimg -relx 1 -rely 1 -anchor se + pack $ximg + BWidget::place $top 0 0 center + wm deiconify $top +} + + +proc Demo::main {} { + variable DEMODIR + + lappend ::auto_path [file dirname $DEMODIR] + package require BWidget + + option add *TitleFrame.l.font {helvetica 11 bold italic} + + if {$::tk_version < 8.5} { + set helpFont {helvetica 12} + } else { + set helpFont {TkDefaultFont 10} + } + + DynamicHelp::configure \ + -background #FFFFC0 \ + -foreground #141312 \ + -padx 3 \ + -font $helpFont + + wm withdraw . + wm title . "BWidget demo" + + Demo::create + BWidget::place . 0 0 center + wm deiconify . + raise . + focus -force . +} + +Demo::main +wm geom . [wm geom .] diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/dnd.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/dnd.tcl new file mode 100644 index 00000000..fe4e1b41 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/dnd.tcl @@ -0,0 +1,42 @@ + +namespace eval DemoDnd { +} + + +proc DemoDnd::create { nb } { + + set frame [$nb insert end demoDnd -text "Drag and Drop"] + + set titf1 [TitleFrame $frame.titf1 -text "Drag sources"] + set subf [$titf1 getframe] + + set ent1 [LabelEntry $subf.e1 -label "Entry" -labelwidth 14 -dragenabled 1 -dragevent 3] + set labf1 [LabelFrame $subf.f1 -text "Label (text)" -width 14] + set f [$labf1 getframe] + set lab [Label $f.l -text "Drag this text" -dragenabled 1 -dragevent 3] + pack $lab + + set labf2 [LabelFrame $subf.f2 -text "Label (bitmap)" -width 14] + set f [$labf2 getframe] + set lab [Label $f.l -bitmap info -dragenabled 1 -dragevent 3] + pack $lab + + pack $ent1 $labf1 $labf2 -side top -fill x -pady 4 + + set titf2 [TitleFrame $frame.titf2 -text "Drop targets"] + set subf [$titf2 getframe] + + set ent1 [LabelEntry $subf.e1 -label "Entry" -labelwidth 14 -dropenabled 1] + set labf1 [LabelFrame $subf.f1 -text "Label" -width 14] + set f [$labf1 getframe] + set lab [Label $f.l -dropenabled 1 -highlightthickness 1] + pack $lab -fill x + + pack $ent1 $labf1 -side top -fill x -pady 4 + + pack $titf1 $titf2 -pady 4 + + return $frame +} + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/manager.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/manager.tcl new file mode 100644 index 00000000..2beac26d --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/manager.tcl @@ -0,0 +1,141 @@ + + +namespace eval DemoManager { + variable _progress 0 + variable _afterid "" + variable _status "Compute in progress..." + variable _homogeneous 0 +} + + +proc DemoManager::create { nb } { + set frame [$nb insert end demoManager -text "Manager"] + + set topf [frame $frame.topf] + set titf1 [TitleFrame $topf.titf1 -text "MainFrame"] + set titf2 [TitleFrame $topf.titf2 -text "NoteBook"] + set titf3 [TitleFrame $frame.titf3 -text "Paned & ScrolledWindow"] + + _mainframe [$titf1 getframe] + _notebook [$titf2 getframe] + _paned [$titf3 getframe] + + pack $titf1 $titf2 -padx 4 -side left -fill both -expand yes + pack $topf -fill x -pady 2 + pack $titf3 -pady 2 -padx 4 -fill both -expand yes + + return $frame +} + + +proc DemoManager::_mainframe { parent } { + set labf1 [LabelFrame $parent.labf1 -text "Toolbar" -side top -anchor w \ + -relief sunken -borderwidth 2] + set subf [$labf1 getframe] + checkbutton $subf.chk1 -text "View toolbar 1" -variable Demo::toolbar1 \ + -command {$Demo::mainframe showtoolbar 0 $Demo::toolbar1} + checkbutton $subf.chk2 -text "View toolbar 2" -variable Demo::toolbar2 \ + -command {$Demo::mainframe showtoolbar 1 $Demo::toolbar2} + pack $subf.chk1 $subf.chk2 -anchor w -fill x + pack $labf1 -fill both + + set labf2 [LabelFrame $parent.labf2 -text "Status bar" -side top -anchor w \ + -relief sunken -borderwidth 2] + set subf [$labf2 getframe] + checkbutton $subf.chk1 -text "Show Progress\nindicator" -justify left \ + -variable DemoManager::_progress \ + -command {DemoManager::_show_progress} + pack $subf.chk1 -anchor w -fill x + + pack $labf1 $labf2 -side left -padx 4 -fill both +} + + +proc DemoManager::_notebook { parent } { + checkbutton $parent.chk1 -text "Homogeneous label" \ + -variable DemoManager::_homogeneous \ + -command {$Demo::notebook configure -homogeneous $DemoManager::_homogeneous} + pack $parent.chk1 -side left -anchor n -fill x +} + + + +proc DemoManager::_paned { parent } { + set pw1 [PanedWindow $parent.pw -side top] + set pane [$pw1 add -minsize 100] + + set pw2 [PanedWindow $pane.pw -side left] + set pane1 [$pw2 add -minsize 100] + set pane2 [$pw2 add -minsize 100] + set pane3 [$pw1 add -minsize 100] + + foreach pane [list $pane1 $pane2] { + set sw [ScrolledWindow $pane.sw] + set lb [listbox $sw.lb -height 8 -width 20 -highlightthickness 0] + for {set i 1} {$i <= 8} {incr i} { + $lb insert end "Value $i" + } + $sw setwidget $lb + pack $sw -fill both -expand yes + } + + set sw [ScrolledWindow $pane3.sw -relief sunken -borderwidth 2] + set sf [ScrollableFrame $sw.f] + $sw setwidget $sf + set subf [$sf getframe] + set lab [label $subf.lab -text "This is a ScrollableFrame"] + set chk [checkbutton $subf.chk -text "Constrained width" \ + -variable DemoManager::_constw \ + -command "$sf configure -constrainedwidth \$DemoManager::_constw"] + pack $lab + pack $chk -anchor w + bind $chk "$sf see $chk" + for {set i 0} {$i <= 20} {incr i} { + pack [entry $subf.ent$i -width 50] -fill x -pady 4 + bind $subf.ent$i "$sf see $subf.ent$i" + $subf.ent$i insert end "Text field $i" + } + + pack $sw $pw2 $pw1 -fill both -expand yes +} + + +proc DemoManager::_show_progress { } { + variable _progress + variable _afterid + variable _status + + if { $_progress } { + set ::Demo::status "Compute in progress..." + set ::Demo::prgindic 0 + $::Demo::mainframe showstatusbar progression + if { $_afterid == "" } { + set _afterid [after 30 DemoManager::_update_progress] + } + } else { + set ::Demo::status "" + $::Demo::mainframe showstatusbar status + set _afterid "" + } +} + + +proc DemoManager::_update_progress { } { + variable _progress + variable _afterid + + if { $_progress } { + if { $::Demo::prgindic < 100 } { + incr ::Demo::prgindic 5 + set _afterid [after 30 DemoManager::_update_progress] + } else { + set _progress 0 + $::Demo::mainframe showstatusbar status + set ::Demo::status "Done" + set _afterid "" + after 500 {set Demo::status ""} + } + } else { + set _afterid "" + } +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/select.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/select.tcl new file mode 100644 index 00000000..000acdbd --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/select.tcl @@ -0,0 +1,59 @@ +namespace eval DemoSelect { + variable var +} + + +proc DemoSelect::create { nb } { + set frame [$nb insert end demoSelect -text "Spin & Combo"] + + set titf1 [TitleFrame $frame.titf1 -text SpinBox] + set subf [$titf1 getframe] + set spin [SpinBox $subf.spin \ + -range {1 100 1} -textvariable DemoSelect::var(spin,var) \ + -helptext "This is the SpinBox"] + set ent [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \ + -textvariable DemoSelect::var(spin,var) -editable 0 \ + -helptext "This is an Entry reflecting\nthe linked var of SpinBox"] + set labf [LabelFrame $subf.options -text "Options" -side top -anchor w \ + -relief sunken -borderwidth 1 \ + -helptext "Modify some options of SpinBox"] + set subf [$labf getframe] + set chk1 [checkbutton $subf.chk1 -text "Non editable" \ + -variable DemoSelect::var(spin,editable) -onvalue false -offvalue true \ + -command "$spin configure -editable \$DemoSelect::var(spin,editable)"] + set chk2 [checkbutton $subf.chk2 -text "Disabled" \ + -variable DemoSelect::var(spin,state) -onvalue disabled -offvalue normal \ + -command "$spin configure -state \$DemoSelect::var(spin,state)"] + + pack $chk1 $chk2 -side left -anchor w + pack $spin $ent $labf -pady 4 -fill x + pack $titf1 + + set titf2 [TitleFrame $frame.titf2 -text ComboBox] + set subf [$titf2 getframe] + set combo [ComboBox $subf.combo \ + -textvariable DemoSelect::var(combo,var) \ + -values {"first value" "second value" "third value" "fourth value" "fifth value"} \ + -helptext "This is the ComboBox"] + set ent [LabelEntry $subf.ent -label "Linked var" -labelwidth 10 -labelanchor w \ + -textvariable DemoSelect::var(combo,var) -editable 0 \ + -helptext "This is an Entry reflecting\nthe linked var of ComboBox"] + set labf [LabelFrame $subf.options -text "Options" -side top -anchor w \ + -relief sunken -borderwidth 1 \ + -helptext "Modify some options of SpinBox"] + set subf [$labf getframe] + set chk1 [checkbutton $subf.chk1 -text "Non editable" \ + -variable DemoSelect::var(combo,editable) -onvalue false -offvalue true \ + -command "$combo configure -editable \$DemoSelect::var(combo,editable)"] + set chk2 [checkbutton $subf.chk2 -text "Disabled" \ + -variable DemoSelect::var(combo,state) -onvalue disabled -offvalue normal \ + -command "$combo configure -state \$DemoSelect::var(combo,state)"] + + pack $chk1 $chk2 -side left -anchor w + pack $combo $ent $labf -pady 4 -fill x + + pack $titf1 $titf2 -pady 4 + + return $frame +} + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tmpldlg.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tmpldlg.tcl new file mode 100644 index 00000000..203543e0 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tmpldlg.tcl @@ -0,0 +1,215 @@ + +namespace eval DemoDlg { + variable tmpl + variable msg + variable progmsg + variable progval + variable resources "en" +} + + +proc DemoDlg::create { nb } { + set frame [$nb insert end demoDlg -text "Dialog"] + + set titf1 [TitleFrame $frame.titf1 -text "Resources"] + set titf2 [TitleFrame $frame.titf2 -text "Template Dialog"] + set titf3 [TitleFrame $frame.titf3 -text "Message Dialog"] + set titf4 [TitleFrame $frame.titf4 -text "Other dialog"] + + set subf [$titf1 getframe] + set cmd {option read [file join $::BWIDGET::LIBRARY "lang" $DemoDlg::resources.rc]} + set rad1 [radiobutton $subf.rad1 -text "English" \ + -variable DemoDlg::resources -value en \ + -command $cmd] + set rad2 [radiobutton $subf.rad2 -text "French" \ + -variable DemoDlg::resources -value fr \ + -command $cmd] + set rad3 [radiobutton $subf.rad3 -text "German" \ + -variable DemoDlg::resources -value de \ + -command $cmd] + pack $rad1 $rad2 $rad3 -side left + + _tmpldlg [$titf2 getframe] + _msgdlg [$titf3 getframe] + _stddlg [$titf4 getframe] + + pack $titf1 -fill x -pady 2 -padx 2 + pack $titf4 -side bottom -fill x -pady 2 -padx 2 + pack $titf2 $titf3 -side left -padx 2 -fill both -expand yes +} + + +proc DemoDlg::_tmpldlg { parent } { + variable tmpl + + set tmpl(side) bottom + set tmpl(anchor) c + + set labf1 [LabelFrame $parent.labf1 -text "Button side" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf1 getframe] + radiobutton $subf.rad1 -text "Bottom" \ + -variable DemoDlg::tmpl(side) -value bottom -anchor w + radiobutton $subf.rad2 -text "Left" \ + -variable DemoDlg::tmpl(side) -value left -anchor w + radiobutton $subf.rad3 -text "Right" \ + -variable DemoDlg::tmpl(side) -value right -anchor w + radiobutton $subf.rad4 -text "Top" \ + -variable DemoDlg::tmpl(side) -value top -anchor w + + pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w + + set labf2 [LabelFrame $parent.labf2 -text "Button anchor" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf2 getframe] + radiobutton $subf.rad1 -text "North" \ + -variable DemoDlg::tmpl(anchor) -value n -anchor w + radiobutton $subf.rad2 -text "West" \ + -variable DemoDlg::tmpl(anchor) -value w -anchor w + radiobutton $subf.rad3 -text "East" \ + -variable DemoDlg::tmpl(anchor) -value e -anchor w + radiobutton $subf.rad4 -text "South" \ + -variable DemoDlg::tmpl(anchor) -value s -anchor w + radiobutton $subf.rad5 -text "Center" \ + -variable DemoDlg::tmpl(anchor) -value c -anchor w + + pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 -fill x -anchor w + + set sep [Separator $parent.sep -orient horizontal] + set button [button $parent.but -text "Show" -command DemoDlg::_show_tmpldlg] + + pack $button -side bottom + pack $sep -side bottom -fill x -pady 10 + pack $labf1 $labf2 -side left -padx 4 -anchor n +} + + +proc DemoDlg::_msgdlg { parent } { + variable msg + + set msg(type) ok + set msg(icon) info + + set labf1 [LabelFrame $parent.labf1 -text "Type" -side top \ + -anchor w -relief sunken -borderwidth 1] + set subf [$labf1 getframe] + radiobutton $subf.rad1 -text "Ok" -variable DemoDlg::msg(type) -value ok -anchor w + radiobutton $subf.rad2 -text "Ok, Cancel" -variable DemoDlg::msg(type) -value okcancel -anchor w + radiobutton $subf.rad3 -text "Retry, Cancel" -variable DemoDlg::msg(type) -value retrycancel -anchor w + radiobutton $subf.rad4 -text "Yes, No" -variable DemoDlg::msg(type) -value yesno -anchor w + radiobutton $subf.rad5 -text "Yes, No, Cancel" -variable DemoDlg::msg(type) -value yesnocancel -anchor w + radiobutton $subf.rad6 -text "Abort, Retry, Ignore" -variable DemoDlg::msg(type) -value abortretryignore -anchor w + radiobutton $subf.rad7 -text "User" -variable DemoDlg::msg(type) -value user -anchor w + Entry $subf.user -textvariable DemoDlg::msg(buttons) + + pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 $subf.rad5 $subf.rad6 -fill x -anchor w + pack $subf.rad7 $subf.user -side left + + set labf2 [LabelFrame $parent.labf2 -text "Icon" -side top -anchor w -relief sunken -borderwidth 1] + set subf [$labf2 getframe] + radiobutton $subf.rad1 -text "Information" -variable DemoDlg::msg(icon) -value info -anchor w + radiobutton $subf.rad2 -text "Question" -variable DemoDlg::msg(icon) -value question -anchor w + radiobutton $subf.rad3 -text "Warning" -variable DemoDlg::msg(icon) -value warning -anchor w + radiobutton $subf.rad4 -text "Error" -variable DemoDlg::msg(icon) -value error -anchor w + pack $subf.rad1 $subf.rad2 $subf.rad3 $subf.rad4 -fill x -anchor w + + + set sep [Separator $parent.sep -orient horizontal] + set button [button $parent.but -text "Show" -command DemoDlg::_show_msgdlg] + + pack $button -side bottom + pack $sep -side bottom -fill x -pady 10 + pack $labf1 $labf2 -side left -padx 4 -anchor n +} + + +proc DemoDlg::_stddlg { parent } { + set but0 [button $parent.but0 \ + -text "Select a color " \ + -command "DemoDlg::_show_color $parent.but0"] + set but1 [button $parent.but1 \ + -text "Font selector dialog" \ + -command DemoDlg::_show_fontdlg] + set but2 [button $parent.but2 \ + -text "Progression dialog" \ + -command DemoDlg::_show_progdlg] + set but3 [button $parent.but3 \ + -text "Password dialog" \ + -command DemoDlg::_show_passdlg] + + pack $but0 $but1 $but2 $but3 -side left -padx 5 -anchor w +} + +proc DemoDlg::_show_color {w} { + set color [SelectColor::menu $w.color [list below $w] \ + -color [$w cget -background] \ + -command [list $w configure -background]] + if {[string length $color]} { + $w configure -background $color + } +} + +proc DemoDlg::_show_tmpldlg { } { + variable tmpl + + set dlg [Dialog .tmpldlg -parent . -modal local \ + -separator 1 \ + -title "Template dialog" \ + -side $tmpl(side) \ + -anchor $tmpl(anchor) \ + -default 0 -cancel 1] + $dlg add -name ok + $dlg add -name cancel + set msg [message [$dlg getframe].msg -text "Template\nDialog" -justify center -anchor c] + pack $msg -fill both -expand yes -padx 100 -pady 100 + $dlg draw + destroy $dlg +} + + +proc DemoDlg::_show_msgdlg { } { + variable msg + + destroy .msgdlg + MessageDlg .msgdlg -parent . \ + -message "Message for MessageBox" \ + -type $msg(type) \ + -icon $msg(icon) \ + -buttons $msg(buttons) +} + + +proc DemoDlg::_show_fontdlg { } { + set font [SelectFont .fontdlg -parent . -font $::Demo::font] + if { $font != "" } { + Demo::update_font $font + } +} + + +proc DemoDlg::_show_progdlg { } { + set ::DemoDlg::progmsg "Compute in progress..." + set ::DemoDlg::progval 0 + + ProgressDlg .progress -parent . -title "Wait..." \ + -type infinite \ + -width 20 \ + -textvariable DemoDlg::progmsg \ + -variable DemoDlg::progval \ + -stop "Stop" \ + -command {destroy .progress} + _update_progdlg +} + + +proc DemoDlg::_update_progdlg { } { + if { [winfo exists .progress] } { + set ::DemoDlg::progval 2 + after 20 DemoDlg::_update_progdlg + } +} + +proc DemoDlg::_show_passdlg { } { + PasswdDlg .passwd -parent . +} + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tree.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tree.tcl new file mode 100644 index 00000000..3ec036d2 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/tree.tcl @@ -0,0 +1,260 @@ + +namespace eval DemoTree { + variable count + variable dblclick +} + + +proc DemoTree::create { nb } { + set frame [$nb insert end demoTree -text "Tree"] + set pw [PanedWindow $frame.pw -side top] + + set pane [$pw add -weight 1] + set title [TitleFrame $pane.lf -text "Directory tree"] + set sw [ScrolledWindow [$title getframe].sw \ + -relief sunken -borderwidth 2] + set tree [Tree $sw.tree \ + -relief flat -borderwidth 0 -width 15 -highlightthickness 0\ + -redraw 0 -dropenabled 1 -dragenabled 1 \ + -dragevent 3 \ + -droptypes { + TREE_NODE {copy {} move {} link {}} + LISTBOX_ITEM {copy {} move {} link {}} + } \ + -opencmd "DemoTree::moddir 1 $sw.tree" \ + -closecmd "DemoTree::moddir 0 $sw.tree"] + $sw setwidget $tree + + pack $sw -side top -expand yes -fill both + pack $title -fill both -expand yes + + set pane [$pw add -weight 2] + set lf [TitleFrame $pane.lf -text "Content"] + set sw [ScrolledWindow [$lf getframe].sw \ + -scrollbar horizontal -auto none -relief sunken -borderwidth 2] + set list [ListBox::create $sw.lb \ + -relief flat -borderwidth 0 \ + -dragevent 3 \ + -dropenabled 1 -dragenabled 1 \ + -width 20 -highlightthickness 0 -multicolumn true \ + -redraw 0 -dragenabled 1 \ + -droptypes { + TREE_NODE {copy {} move {} link {}} + LISTBOX_ITEM {copy {} move {} link {}}}] + $sw setwidget $list + + pack $sw $lf -fill both -expand yes + + pack $pw -fill both -expand yes + + $tree bindText "DemoTree::select tree 1 $tree $list" + $tree bindText "DemoTree::select tree 2 $tree $list" + $list bindText "DemoTree::select list 1 $tree $list" + $list bindText "DemoTree::select list 2 $tree $list" + $list bindImage "DemoTree::select list 2 $tree $list" + + $nb itemconfigure demoTree \ + -createcmd "DemoTree::init $tree $list" \ + -raisecmd { + # on windows you can get 100x100+-200+200 [PT] + regexp {[0-9]+x[0-9]+([+-]{1,2}[0-9]+)([+-]{1,2}[0-9]+)} \ + [wm geom .] global_foo global_w global_h + # {}'s left off on purpose. [PT] + BWidget::place .top 0 0 at [expr $global_w-[winfo screenwidth .]] $global_h + wm deiconify .top + bind . {wm withdraw .top} + bind . {wm deiconify .top} + bind . { + if { ![string compare %W "."] } { + # see above re: windows geometry + regexp {[0-9]+x[0-9]+([+-]{1,2}[0-9]+)([+-]{1,2}[0-9]+)} \ + [wm geom .] global_foo global_w global_h + BWidget::place .top 0 0 at [expr $global_w-[winfo screenwidth .]] $global_h + } + } + } \ + -leavecmd { + wm withdraw .top + bind . {} + bind . {} + bind . {} + return 1 + } +} + + +proc DemoTree::init { tree list args } { + global tcl_platform env + variable count + + set count 0 + if { $tcl_platform(platform) == "unix" } { + set rootdir [glob $env(HOME)] + } else { + set rootdir "c:\\" + } + $tree insert end root home -text $rootdir -data $rootdir -open 1 \ + -image [Bitmap::get openfold] + getdir $tree home $rootdir + DemoTree::select tree 1 $tree $list home + $tree configure -redraw 1 + $list configure -redraw 1 + + # ScrollView + set w .top + toplevel $w + wm withdraw $w + wm protocol $w WM_DELETE_WINDOW { + # don't kill me + } + wm resizable $w 0 0 + wm title $w "Drag rectangle to scroll directory tree" + wm transient $w . + ScrollView $w.sv -window $tree -fill white -relief sunken -bd 1 \ + -width 300 -height 300 + pack $w.sv -fill both -expand yes +} + + +proc DemoTree::getdir { tree node path } { + variable count + + set lentries [glob -nocomplain [file join $path "*"]] + set lfiles {} + foreach f $lentries { + set tail [file tail $f] + if { [file isdirectory $f] } { + $tree insert end $node n:$count \ + -text $tail \ + -image [Bitmap::get folder] \ + -drawcross allways \ + -data $f + incr count + } else { + lappend lfiles $tail + } + } + $tree itemconfigure $node -drawcross auto -data $lfiles +} + + +proc DemoTree::moddir { idx tree node } { + if { $idx && [$tree itemcget $node -drawcross] == "allways" } { + getdir $tree $node [$tree itemcget $node -data] + if { [llength [$tree nodes $node]] } { + $tree itemconfigure $node -image [Bitmap::get openfold] + } else { + $tree itemconfigure $node -image [Bitmap::get folder] + } + } else { + $tree itemconfigure $node -image [Bitmap::get [lindex {folder openfold} $idx]] + } +} + + +proc DemoTree::select { where num tree list node } { + variable dblclick + + set dblclick 1 + if { $num == 1 } { + if { $where == "tree" && [lsearch [$tree selection get] $node] != -1 } { + unset dblclick + after 500 "DemoTree::edit tree $tree $list $node" + return + } + if { $where == "list" && [lsearch [$list selection get] $node] != -1 } { + unset dblclick + after 500 "DemoTree::edit list $tree $list $node" + return + } + if { $where == "tree" } { + select_node $tree $list $node + } else { + $list selection set $node + } + } elseif { $where == "list" && [$tree exists $node] } { + set parent [$tree parent $node] + while { $parent != "root" } { + $tree itemconfigure $parent -open 1 + set parent [$tree parent $parent] + } + select_node $tree $list $node + } +} + + +proc DemoTree::select_node { tree list node } { + $tree selection set $node + update + eval $list delete [$list item 0 end] + + set dir [$tree itemcget $node -data] + if { [$tree itemcget $node -drawcross] == "allways" } { + getdir $tree $node $dir + set dir [$tree itemcget $node -data] + } + + foreach subnode [$tree nodes $node] { + $list insert end $subnode \ + -text [$tree itemcget $subnode -text] \ + -image [Bitmap::get folder] + } + set num 0 + foreach f $dir { + $list insert end f:$num \ + -text $f \ + -image [Bitmap::get file] + incr num + } +} + + +proc DemoTree::edit { where tree list node } { + variable dblclick + + if { [info exists dblclick] } { + return + } + + if { $where == "tree" && [lsearch [$tree selection get] $node] != -1 } { + set res [$tree edit $node [$tree itemcget $node -text]] + if { $res != "" } { + $tree itemconfigure $node -text $res + if { [$list exists $node] } { + $list itemconfigure $node -text $res + } + $tree selection set $node + } + return + } + + if { $where == "list" } { + set res [$list edit $node [$list itemcget $node -text]] + if { $res != "" } { + $list itemconfigure $node -text $res + if { [$tree exists $node] } { + $tree itemconfigure $node -text $res + } else { + set cursel [$tree selection get] + set index [expr {[$list index $node]-[llength [$tree nodes $cursel]]}] + set data [$tree itemcget $cursel -data] + set data [lreplace $data $index $index $res] + $tree itemconfigure $cursel -data $data + } + $list selection set $node + } + } +} + + +proc DemoTree::expand { tree but } { + if { [set cur [$tree selection get]] != "" } { + if { $but == 0 } { + $tree opentree $cur + } else { + $tree closetree $cur + } + } +} + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/x1.xbm b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/x1.xbm new file mode 100644 index 00000000..6137a118 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/demo/x1.xbm @@ -0,0 +1,2258 @@ +#define x1_width 626 +#define x1_height 428 +static char x1_bits[] = { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0x03,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x0f, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0x3f,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xe0,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7c,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0x03,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x07,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0x01,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0xf8,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0x3f,0x00,0x00,0x00,0xc0,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x3f,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xe0,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0x1f,0x00,0x00, + 0x00,0xf0,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0xfc,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xfe,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xfe,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00, + 0xf8,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0x00,0xfe,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x80,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xc0,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00, + 0xe0,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0x00,0x00,0xf8,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0xfc,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0xfe,0xff,0x0f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x80,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xc0,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0xe0,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0xf0,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0x3f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x1f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0x0f,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xfd,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xf8,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0x03,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0x01,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0x01,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x00,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0x7f,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xff,0x7f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0x3f,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0x1f,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0xff,0x1f,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0x0f,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0x07,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0x07,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0x03,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0x01,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0x01,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0x7f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0x7f,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x3f,0x00,0x00,0x00,0xe0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x0f,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x3f, + 0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x1f,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0e,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0e,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x06,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfd,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xfd,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xfc,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xfc, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0xfc,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xfc,0x00,0x00,0x00,0x00,0xf8,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xfc,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0xfc,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0xfc,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0xfc,0x00,0x00,0x00,0x00,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xfc,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0xfc,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0xfc,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0xfc,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0xfc,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0xfc,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0xfc,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xfc,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xfc, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0xfc,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0xfc,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0xfc,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0xfc,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0xfc,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0xfc,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0xfc,0x00,0x00, + 0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0xfc,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0xfc,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0xfc,0x00,0x00,0xe0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0xfc,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0xfc,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0xfc,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0xfc,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0xfc, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0xfc,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0x00,0xfc,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0xfc,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0xfc,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0xfc,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0xfc,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0xfc,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0xfc,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0xfc,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0xfc,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0xfc,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0xfc,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0xfc,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0xfc,0x00,0xf0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0xfc, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0xfc,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xfc,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xfc,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0xfc,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0xfc,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xfc,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xfc,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0xfc,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0xfc,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0xfc,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xfc,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0xfc,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0xfc,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xfc,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xfc, + 0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0xfc,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xfc,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xfc,0xe0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0xfc,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0xfc,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xfc,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xfc,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00, + 0x00,0xfc,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0xfc,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0xfc,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0xfc,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0xfc,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0xfc,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0xfc,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0xfc, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00, + 0x00,0x00,0x00,0xfc,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0xfc,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0xfc,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x80,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0xc0,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xc0,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0xe0, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0xf0,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xf8,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0xfc,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00, + 0xfc,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0xfe,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x80,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x80,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0xc0,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0xe0,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xf0,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0xf8,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0x00,0xf8,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xfc,0xff,0xff,0x03,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0xfe,0xff, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xe0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0x3f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0x07,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0xf0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff, + 0xff,0xff,0x03,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0x01, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0x3f,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x3f, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xf0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0x1f,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xf0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0x0f,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0x07,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0x07,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0x01,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff, + 0x01,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xe0,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0x7f,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x1f,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0x3f,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0x03,0x00, + 0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xc0,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xfe,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0x07,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xf8,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0, + 0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0x01,0x00,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0x1f,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0x01,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xc0,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0x7f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xf8,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xfc, + 0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0x01,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfe,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0x07,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xc0,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0xc0,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8, + 0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf8,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x7f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0x1f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x80,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x3f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x80,0xff,0xff, + 0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf8,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7e,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0xf8, + 0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0xf8,0xff, + 0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0xf8,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00, + 0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff, + 0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x30,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe, + 0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x80,0x0f,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0xc0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x80, + 0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x80,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0x7f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xe0,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfc,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0xfc}; diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dialog.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dialog.tcl new file mode 100644 index 00000000..1569d0d0 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dialog.tcl @@ -0,0 +1,361 @@ +# ---------------------------------------------------------------------------- +# dialog.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: dialog.tcl,v 1.15.2.1 2010/08/04 13:07:59 oehhar Exp $ +# ---------------------------------------------------------------------------- +# Index of commands: +# - Dialog::create +# - Dialog::configure +# - Dialog::cget +# - Dialog::getframe +# - Dialog::add +# - Dialog::itemconfigure +# - Dialog::itemcget +# - Dialog::invoke +# - Dialog::setfocus +# - Dialog::enddialog +# - Dialog::draw +# - Dialog::withdraw +# - Dialog::_destroy +# ---------------------------------------------------------------------------- + +# JDC: added -transient and -place flag + +namespace eval Dialog { + Widget::define Dialog dialog ButtonBox + + Widget::bwinclude Dialog ButtonBox .bbox \ + remove {-orient} \ + initialize {-spacing 10 -padx 10} + + Widget::declare Dialog { + {-title String "" 0} + {-geometry String "" 0} + {-modal Enum local 0 {none local global}} + {-bitmap TkResource "" 1 label} + {-image TkResource "" 1 label} + {-separator Boolean 0 1} + {-cancel Int -1 0 "%d >= -1"} + {-parent String "" 0} + {-side Enum bottom 1 {bottom left top right}} + {-anchor Enum c 1 {n e w s c}} + {-class String Dialog 1} + {-transient Boolean 1 1} + {-place Enum center 0 {none center left right above below}} + } + + Widget::addmap Dialog "" :cmd {-background {}} + Widget::addmap Dialog "" .frame {-background {}} + + bind BwDialog [list Dialog::_destroy %W] + + variable _widget +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::create +# ---------------------------------------------------------------------------- +proc Dialog::create { path args } { + global tcl_platform + variable _widget + + array set maps [list Dialog {} .bbox {}] + array set maps [Widget::parseArgs Dialog $args] + + # Check to see if the -class flag was specified + set dialogClass "Dialog" + array set dialogArgs $maps(Dialog) + if { [info exists dialogArgs(-class)] } { + set dialogClass $dialogArgs(-class) + } + + if { [string equal $tcl_platform(platform) "unix"] } { + set re raised + set bd 1 + } else { + set re flat + set bd 0 + } + toplevel $path -relief $re -borderwidth $bd -class $dialogClass + wm withdraw $path + + Widget::initFromODB Dialog $path $maps(Dialog) + + bindtags $path [list $path BwDialog all] + wm overrideredirect $path 1 + wm title $path [Widget::cget $path -title] + set parent [Widget::cget $path -parent] + if { ![winfo exists $parent] } { + set parent [winfo parent $path] + } + # JDC: made transient optional + if { [Widget::getoption $path -transient] } { + wm transient $path [winfo toplevel $parent] + } + + set side [Widget::cget $path -side] + if { [string equal $side "left"] || [string equal $side "right"] } { + set orient vertical + } else { + set orient horizontal + } + + set bbox [eval [list ButtonBox::create $path.bbox] $maps(.bbox) \ + -orient $orient] + set frame [frame $path.frame -relief flat -borderwidth 0] + set bg [Widget::cget $path -background] + $path configure -background $bg + $frame configure -background $bg + if { [set bitmap [Widget::getoption $path -image]] != "" } { + set label [label $path.label -image $bitmap -background $bg] + } elseif { [set bitmap [Widget::getoption $path -bitmap]] != "" } { + set label [label $path.label -bitmap $bitmap -background $bg] + } + if { [Widget::getoption $path -separator] } { + Separator::create $path.sep -orient $orient -background $bg + } + set _widget($path,realized) 0 + set _widget($path,nbut) 0 + + set cancel [Widget::getoption $path -cancel] + bind $path [list ButtonBox::invoke $path.bbox $cancel] + if {$cancel != -1} { + wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel] + } + bind $path [list ButtonBox::invoke $path.bbox default] + # Tk8.5 (TIP158) separated numeric keyboard enter and main keyboard + # enter on Unix. So bind for both. This does not harm on Tk8.4 so no + # check required. BWidget Ticket [3e31f04367]. + bind $path [list ButtonBox::invoke $path.bbox default] + + return [Widget::create Dialog $path] +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::configure +# ---------------------------------------------------------------------------- +proc Dialog::configure { path args } { + set res [Widget::configure $path $args] + + if { [Widget::hasChanged $path -title title] } { + wm title $path $title + } + if { [Widget::hasChanged $path -background bg] } { + if { [winfo exists $path.label] } { + $path.label configure -background $bg + } + if { [winfo exists $path.sep] } { + Separator::configure $path.sep -background $bg + } + } + if { [Widget::hasChanged $path -cancel cancel] } { + bind $path [list ButtonBox::invoke $path.bbox $cancel] + if {$cancel == -1} { + wm protocol $path WM_DELETE_WINDOW "" + } else { + wm protocol $path WM_DELETE_WINDOW [list ButtonBox::invoke $path.bbox $cancel] + } + } + return $res +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::cget +# ---------------------------------------------------------------------------- +proc Dialog::cget { path option } { + return [Widget::cget $path $option] +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::getframe +# ---------------------------------------------------------------------------- +proc Dialog::getframe { path } { + return $path.frame +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::add +# ---------------------------------------------------------------------------- +proc Dialog::add { path args } { + variable _widget + + if {[string equal $::tcl_platform(platform) "windows"] + && $::tk_version >= 8.4} { + set width -11 + } else { + set width 8 + } + set cmd [list ButtonBox::add $path.bbox -width $width \ + -command [list Dialog::enddialog $path $_widget($path,nbut)]] + set res [eval $cmd $args] + incr _widget($path,nbut) + return $res +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::itemconfigure +# ---------------------------------------------------------------------------- +proc Dialog::itemconfigure { path index args } { + return [eval [list ButtonBox::itemconfigure $path.bbox $index] $args] +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::itemcget +# ---------------------------------------------------------------------------- +proc Dialog::itemcget { path index option } { + return [ButtonBox::itemcget $path.bbox $index $option] +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::invoke +# ---------------------------------------------------------------------------- +proc Dialog::invoke { path index } { + ButtonBox::invoke $path.bbox $index +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::setfocus +# ---------------------------------------------------------------------------- +proc Dialog::setfocus { path index } { + ButtonBox::setfocus $path.bbox $index +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::enddialog +# ---------------------------------------------------------------------------- +proc Dialog::enddialog { path result } { + variable _widget + + set _widget($path,result) $result +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::draw +# ---------------------------------------------------------------------------- +proc Dialog::draw { path {focus ""} {overrideredirect 0} {geometry ""}} { + variable _widget + + set parent [Widget::getoption $path -parent] + if { !$_widget($path,realized) } { + set _widget($path,realized) 1 + if { [llength [winfo children $path.bbox]] } { + set side [Widget::getoption $path -side] + if {[string equal $side "left"] || [string equal $side "right"]} { + set pad -padx + set fill y + } else { + set pad -pady + set fill x + } + pack $path.bbox -side $side -padx 1m -pady 1m \ + -anchor [Widget::getoption $path -anchor] + if { [winfo exists $path.sep] } { + pack $path.sep -side $side -fill $fill $pad 2m + } + } + if { [winfo exists $path.label] } { + pack $path.label -side left -anchor n -padx 3m -pady 3m + } + pack $path.frame -padx 1m -pady 1m -fill both -expand yes + } + + set geom [Widget::getMegawidgetOption $path -geometry] + if { $geom != "" } { + wm geometry $path $geom + } + + if { [string equal $geometry ""] && ($geom == "") } { + set place [Widget::getoption $path -place] + if { ![string equal $place none] } { + if { [winfo exists $parent] } { + BWidget::place $path 0 0 $place $parent + } else { + BWidget::place $path 0 0 $place + } + } + } else { + if { $geom != "" } { + wm geometry $path $geom + } else { + wm geometry $path $geometry + } + } + update idletasks + wm overrideredirect $path $overrideredirect + wm deiconify $path + + # patch by Bastien Chevreux (bach@mwgdna.com) + # As seen on Windows systems *sigh* + # When the toplevel is withdrawn, the tkwait command will wait forever. + # So, check that we are not withdrawn + if {![winfo exists $parent] || \ + ([wm state [winfo toplevel $parent]] != "withdrawn")} { + tkwait visibility $path + } + BWidget::focus set $path + if { [winfo exists $focus] } { + focus -force $focus + } else { + ButtonBox::setfocus $path.bbox default + } + + if { [set grab [Widget::cget $path -modal]] != "none" } { + BWidget::grab $grab $path + if {[info exists _widget($path,result)]} { + unset _widget($path,result) + } + tkwait variable Dialog::_widget($path,result) + if { [info exists _widget($path,result)] } { + set res $_widget($path,result) + unset _widget($path,result) + } else { + set res -1 + } + withdraw $path + return $res + } + return "" +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::withdraw +# ---------------------------------------------------------------------------- +proc Dialog::withdraw { path } { + BWidget::grab release $path + BWidget::focus release $path + if { [winfo exists $path] } { + wm withdraw $path + } +} + + +# ---------------------------------------------------------------------------- +# Command Dialog::_destroy +# ---------------------------------------------------------------------------- +proc Dialog::_destroy { path } { + variable _widget + + Dialog::enddialog $path -1 + + BWidget::grab release $path + BWidget::focus release $path + if {[info exists _widget($path,result)]} { + unset _widget($path,result) + } + unset _widget($path,realized) + unset _widget($path,nbut) + + Widget::destroy $path +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dragsite.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dragsite.tcl new file mode 100644 index 00000000..bb7b3e7e --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dragsite.tcl @@ -0,0 +1,197 @@ +# ------------------------------------------------------------------------------ +# dragsite.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: dragsite.tcl,v 1.8 2003/10/20 21:23:52 damonc Exp $ +# ------------------------------------------------------------------------------ +# Index of commands: +# - DragSite::include +# - DragSite::setdrag +# - DragSite::register +# - DragSite::_begin_drag +# - DragSite::_init_drag +# - DragSite::_end_drag +# - DragSite::_update_operation +# ---------------------------------------------------------------------------- + +namespace eval DragSite { + Widget::define DragSite dragsite -classonly + + Widget::declare DragSite [list \ + [list -dragevent Enum 1 0 [list 1 2 3]] \ + [list -draginitcmd String "" 0] \ + [list -dragendcmd String "" 0] \ + ] + + variable _topw ".drag" + variable _tabops + variable _state + variable _x0 + variable _y0 + + bind BwDrag1 {DragSite::_begin_drag press %W %s %X %Y} + bind BwDrag1 {DragSite::_begin_drag motion %W %s %X %Y} + bind BwDrag2 {DragSite::_begin_drag press %W %s %X %Y} + bind BwDrag2 {DragSite::_begin_drag motion %W %s %X %Y} + bind BwDrag3 {DragSite::_begin_drag press %W %s %X %Y} + bind BwDrag3 {DragSite::_begin_drag motion %W %s %X %Y} + + proc use {} {} +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::include +# ---------------------------------------------------------------------------- +proc DragSite::include { class type event } { + set dragoptions [list \ + [list -dragenabled Boolean 0 0] \ + [list -draginitcmd String "" 0] \ + [list -dragendcmd String "" 0] \ + [list -dragtype String $type 0] \ + [list -dragevent Enum $event 0 [list 1 2 3]] \ + ] + Widget::declare $class $dragoptions +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::setdrag +# Widget interface to register +# ---------------------------------------------------------------------------- +proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} { + set cen [Widget::hasChanged $path -dragenabled en] + set cdragevt [Widget::hasChanged $path -dragevent dragevt] + if { $en } { + if { $force || $cen || $cdragevt } { + register $subpath \ + -draginitcmd $initcmd \ + -dragendcmd $endcmd \ + -dragevent $dragevt + } + } else { + register $subpath + } +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::register +# ---------------------------------------------------------------------------- +proc DragSite::register { path args } { + upvar \#0 DragSite::$path drag + + if { [info exists drag] } { + bind $path $drag(evt) {} + unset drag + } + Widget::init DragSite .drag$path $args + set event [Widget::getMegawidgetOption .drag$path -dragevent] + set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd] + set endcmd [Widget::getMegawidgetOption .drag$path -dragendcmd] + set tags [bindtags $path] + set idx [lsearch $tags "BwDrag*"] + Widget::destroy .drag$path + if { $initcmd != "" } { + if { $idx != -1 } { + bindtags $path [lreplace $tags $idx $idx BwDrag$event] + } else { + bindtags $path [concat $tags BwDrag$event] + } + set drag(initcmd) $initcmd + set drag(endcmd) $endcmd + set drag(evt) $event + } elseif { $idx != -1 } { + bindtags $path [lreplace $tags $idx $idx] + } +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::_begin_drag +# ---------------------------------------------------------------------------- +proc DragSite::_begin_drag { event source state X Y } { + variable _x0 + variable _y0 + variable _state + + switch -- $event { + press { + set _x0 $X + set _y0 $Y + set _state "press" + } + motion { + if { ![info exists _state] } { + # This is just extra protection. There seem to be + # rare cases where the motion comes before the press. + return + } + if { [string equal $_state "press"] } { + if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } { + set _state "done" + _init_drag $source $state $X $Y + } + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::_init_drag +# ---------------------------------------------------------------------------- +proc DragSite::_init_drag { source state X Y } { + variable _topw + upvar \#0 DragSite::$source drag + + destroy $_topw + toplevel $_topw + wm withdraw $_topw + wm overrideredirect $_topw 1 + + set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]] + if { $info != "" } { + set type [lindex $info 0] + set ops [lindex $info 1] + set data [lindex $info 2] + + if { [winfo children $_topw] == "" } { + if { [string equal $type "BITMAP"] || [string equal $type "IMAGE"] } { + label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0 + } else { + label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0 + } + pack $_topw.l + } + wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}] + wm deiconify $_topw + if {[catch {tkwait visibility $_topw}]} { + return + } + BWidget::grab set $_topw + BWidget::focus set $_topw + + bindtags $_topw [list $_topw DragTop] + DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data + } else { + destroy $_topw + } +} + + +# ---------------------------------------------------------------------------- +# Command DragSite::_end_drag +# ---------------------------------------------------------------------------- +proc DragSite::_end_drag { source target op type data result } { + variable _topw + upvar \#0 DragSite::$source drag + + BWidget::grab release $_topw + BWidget::focus release $_topw + destroy $_topw + if { $drag(endcmd) != "" } { + uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result] + } +} + + diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dropsite.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dropsite.tcl new file mode 100644 index 00000000..39652b13 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dropsite.tcl @@ -0,0 +1,461 @@ +# ------------------------------------------------------------------------------ +# dropsite.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: dropsite.tcl,v 1.8 2009/06/30 16:17:37 oehhar Exp $ +# ------------------------------------------------------------------------------ +# Index of commands: +# - DropSite::include +# - DropSite::setdrop +# - DropSite::register +# - DropSite::setcursor +# - DropSite::setoperation +# - DropSite::_update_operation +# - DropSite::_compute_operation +# - DropSite::_draw_operation +# - DropSite::_init_drag +# - DropSite::_motion +# - DropSite::_release +# ---------------------------------------------------------------------------- + + +namespace eval DropSite { + Widget::define DropSite dropsite -classonly + + Widget::declare DropSite [list \ + [list -dropovercmd String "" 0] \ + [list -dropcmd String "" 0] \ + [list -droptypes String "" 0] \ + ] + + proc use {} {} + + variable _top ".drag" + variable _opw ".drag.\#op" + variable _target "" + variable _status 0 + variable _tabops + variable _defops + variable _source + variable _type + variable _data + variable _evt + # key win unix + # shift 1 | 1 -> 1 + # control 4 | 4 -> 4 + # alt 8 | 16 -> 24 + # meta | 64 -> 88 + + array set _tabops { + mod,none 0 + mod,shift 1 + mod,control 4 + mod,alt 24 + ops,copy 1 + ops,move 1 + ops,link 1 + } + + if { $::tcl_platform(platform) == "unix" } { + set _tabops(mod,alt) 8 + } else { + set _tabops(mod,alt) 16 + } + array set _defops \ + [list \ + copy,mod shift \ + move,mod control \ + link,mod alt \ + copy,img @[file join $::BWIDGET::LIBRARY "images" "opcopy.xbm"] \ + move,img @[file join $::BWIDGET::LIBRARY "images" "opmove.xbm"] \ + link,img @[file join $::BWIDGET::LIBRARY "images" "oplink.xbm"]] + + bind DragTop {DropSite::_update_operation [expr %s | 1]} + bind DragTop {DropSite::_update_operation [expr %s | 1]} + bind DragTop {DropSite::_update_operation [expr %s | 4]} + bind DragTop {DropSite::_update_operation [expr %s | 4]} + if { $::tcl_platform(platform) == "unix" } { + bind DragTop {DropSite::_update_operation [expr %s | 8]} + bind DragTop {DropSite::_update_operation [expr %s | 8]} + } else { + bind DragTop {DropSite::_update_operation [expr %s | 16]} + bind DragTop {DropSite::_update_operation [expr %s | 16]} + } + + bind DragTop {DropSite::_update_operation [expr %s & ~1]} + bind DragTop {DropSite::_update_operation [expr %s & ~1]} + bind DragTop {DropSite::_update_operation [expr %s & ~4]} + bind DragTop {DropSite::_update_operation [expr %s & ~4]} + if { $::tcl_platform(platform) == "unix" } { + bind DragTop {DropSite::_update_operation [expr %s & ~8]} + bind DragTop {DropSite::_update_operation [expr %s & ~8]} + } else { + bind DragTop {DropSite::_update_operation [expr %s & ~16]} + bind DragTop {DropSite::_update_operation [expr %s & ~16]} + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::include +# ---------------------------------------------------------------------------- +proc DropSite::include { class types } { + set dropoptions [list \ + [list -dropenabled Boolean 0 0] \ + [list -dropovercmd String "" 0] \ + [list -dropcmd String "" 0] \ + [list -droptypes String $types 0] \ + ] + Widget::declare $class $dropoptions +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::setdrop +# Widget interface to register +# ---------------------------------------------------------------------------- +proc DropSite::setdrop { path subpath dropover drop {force 0}} { + set cen [Widget::hasChanged $path -dropenabled en] + set ctypes [Widget::hasChanged $path -droptypes types] + if { $en } { + if { $force || $cen || $ctypes } { + register $subpath \ + -droptypes $types \ + -dropcmd $drop \ + -dropovercmd $dropover + } + } else { + register $subpath + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::register +# ---------------------------------------------------------------------------- +proc DropSite::register { path args } { + variable _tabops + variable _defops + upvar \#0 DropSite::$path drop + + Widget::init DropSite .drop$path $args + if { [info exists drop] } { + unset drop + } + set dropcmd [Widget::getMegawidgetOption .drop$path -dropcmd] + set types [Widget::getMegawidgetOption .drop$path -droptypes] + set overcmd [Widget::getMegawidgetOption .drop$path -dropovercmd] + Widget::destroy .drop$path + if { $dropcmd != "" && $types != "" } { + set drop(dropcmd) $dropcmd + set drop(overcmd) $overcmd + foreach {type ops} $types { + set drop($type,ops) {} + set masklist {} + foreach {descop lmod} $ops { + if { ![llength $descop] || [llength $descop] > 3 } { + return -code error "invalid operation description \"$descop\"" + } + foreach {subop baseop imgop} $descop { + set subop [string trim $subop] + if { ![string length $subop] } { + return -code error "sub operation is empty" + } + if { ![string length $baseop] } { + set baseop $subop + } + if { [info exists drop($type,ops,$subop)] } { + return -code error "operation \"$subop\" already defined" + } + if { ![info exists _tabops(ops,$baseop)] } { + return -code error "invalid base operation \"$baseop\"" + } + if { ![string equal $subop $baseop] && + [info exists _tabops(ops,$subop)] } { + return -code error "sub operation \"$subop\" is a base operation" + } + if { ![string length $imgop] } { + set imgop $_defops($baseop,img) + } + } + if { [string equal $lmod "program"] } { + set drop($type,ops,$subop) $baseop + set drop($type,img,$subop) $imgop + } else { + if { ![string length $lmod] } { + set lmod $_defops($baseop,mod) + } + set mask 0 + foreach mod $lmod { + if { ![info exists _tabops(mod,$mod)] } { + return -code error "invalid modifier \"$mod\"" + } + set mask [expr {$mask | $_tabops(mod,$mod)}] + } + if { ($mask == 0) != ([string equal $subop "default"]) } { + return -code error "sub operation default can only be used with modifier \"none\"" + } + set drop($type,mod,$mask) $subop + set drop($type,ops,$subop) $baseop + set drop($type,img,$subop) $imgop + lappend masklist $mask + } + } + if { ![info exists drop($type,mod,0)] } { + set drop($type,mod,0) default + set drop($type,ops,default) copy + set drop($type,img,default) $_defops(copy,img) + lappend masklist 0 + } + set drop($type,ops,force) copy + set drop($type,img,force) $_defops(copy,img) + foreach mask [lsort -integer -decreasing $masklist] { + lappend drop($type,ops) $mask $drop($type,mod,$mask) + } + } + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::setcursor +# ---------------------------------------------------------------------------- +proc DropSite::setcursor { cursor } { + catch {.drag configure -cursor $cursor} +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::setoperation +# ---------------------------------------------------------------------------- +proc DropSite::setoperation { op } { + variable _curop + variable _dragops + variable _target + variable _type + upvar \#0 DropSite::$_target drop + + if { [info exist drop($_type,ops,$op)] && + $_dragops($drop($_type,ops,$op)) } { + set _curop $op + } else { + # force to a copy operation + set _curop force + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::_init_drag +# ---------------------------------------------------------------------------- +proc DropSite::_init_drag { top evt source state X Y type ops data } { + variable _top + variable _source + variable _type + variable _data + variable _target + variable _status + variable _state + variable _dragops + variable _opw + variable _evt + + if {[info exists _dragops]} { + unset _dragops + } + array set _dragops {copy 1 move 0 link 0} + foreach op $ops { + set _dragops($op) 1 + } + set _target "" + set _status 0 + set _top $top + set _source $source + set _type $type + set _data $data + + label $_opw -relief flat -bd 0 -highlightthickness 0 \ + -foreground black -background white + + bind $top {DropSite::_release %X %Y} + bind $top {DropSite::_motion %X %Y} + bind $top {DropSite::_release %X %Y} + set _state $state + set _evt $evt + _motion $X $Y +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::_update_operation +# ---------------------------------------------------------------------------- +proc DropSite::_update_operation { state } { + variable _top + variable _status + variable _state + + if { $_status & 3 } { + set _state $state + _motion [winfo pointerx $_top] [winfo pointery $_top] + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::_compute_operation +# ---------------------------------------------------------------------------- +proc DropSite::_compute_operation { target state type } { + variable _curop + variable _dragops + upvar \#0 DropSite::$target drop + + foreach {mask op} $drop($type,ops) { + if { ($state & $mask) == $mask } { + if { $_dragops($drop($type,ops,$op)) } { + set _curop $op + return + } + } + } + set _curop force +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::_draw_operation +# ---------------------------------------------------------------------------- +proc DropSite::_draw_operation { target type } { + variable _opw + variable _curop + variable _dragops + variable _tabops + variable _status + + upvar \#0 DropSite::$target drop + + if { !($_status & 1) } { + catch {place forget $_opw} + return + } + + if { 0 } { + if { ![info exist drop($type,ops,$_curop)] || + !$_dragops($drop($type,ops,$_curop)) } { + # force to a copy operation + set _curop copy + catch { + $_opw configure -bitmap $_tabops(img,copy) + place $_opw -relx 1 -rely 1 -anchor se + } + } + } elseif { [string equal $_curop "default"] } { + catch {place forget $_opw} + } else { + catch { + $_opw configure -bitmap $drop($type,img,$_curop) + place $_opw -relx 1 -rely 1 -anchor se + } + } +} + + +# ---------------------------------------------------------------------------- +# Command DropSite::_motion +# ---------------------------------------------------------------------------- +proc DropSite::_motion { X Y } { + variable _top + variable _target + variable _status + variable _state + variable _curop + variable _type + variable _data + variable _source + variable _evt + + set script [bind $_top ] + bind $_top {} + bind $_top {} + wm geometry $_top "+[expr {$X+1}]+[expr {$Y+1}]" + update + if { ![winfo exists $_top] } { + return + } + set path [winfo containing $X $Y] + if { ![string equal $path $_target] } { + # path != current target + if { $_status & 2 } { + # current target is valid and has recall status + # generate leave event + upvar \#0 DropSite::$_target drop + uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data] + } + set _target $path + upvar \#0 DropSite::$_target drop + if { [info exists drop($_type,ops)] } { + # path is a valid target + _compute_operation $_target $_state $_type + if { $drop(overcmd) != "" } { + set arg [list $_target $_source enter $X $Y $_curop $_type $_data] + set _status [uplevel \#0 $drop(overcmd) $arg] + } else { + set _status 1 + catch {$_top configure -cursor based_arrow_down} + } + _draw_operation $_target $_type + update + catch { + bind $_top {DropSite::_motion %X %Y} + bind $_top {DropSite::_release %X %Y} + } + return + } else { + set _status 0 + catch {$_top configure -cursor dot} + _draw_operation "" "" + } + } elseif { $_status & 2 } { + upvar \#0 DropSite::$_target drop + _compute_operation $_target $_state $_type + set arg [list $_target $_source motion $X $Y $_curop $_type $_data] + set _status [uplevel \#0 $drop(overcmd) $arg] + _draw_operation $_target $_type + } + update + catch { + bind $_top {DropSite::_motion %X %Y} + bind $_top {DropSite::_release %X %Y} + } +} + + + +# ---------------------------------------------------------------------------- +# Command DropSite::_release +# ---------------------------------------------------------------------------- +proc DropSite::_release { X Y } { + variable _target + variable _status + variable _curop + variable _source + variable _type + variable _data + + if { $_status & 1 } { + upvar \#0 DropSite::$_target drop + + # Ticket [1ef1f56cd1] wke/amc 2022-10-12 + # Prevent motion events to be handled as + # drop events when handler calls update and causes pending + # motion events to fire. + set _status [expr {$_status & ~1}]; + set res [uplevel \#0 $drop(dropcmd) [list $_target $_source $X $Y $_curop $_type $_data]] + DragSite::_end_drag $_source $_target $drop($_type,ops,$_curop) $_type $_data $res + } else { + if { $_status & 2 } { + # notify leave event + upvar \#0 DropSite::$_target drop + uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data] + } + DragSite::_end_drag $_source "" "" $_type $_data 0 + } +} diff --git a/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dynhelp.tcl b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dynhelp.tcl new file mode 100644 index 00000000..f1bc68b3 --- /dev/null +++ b/src/vfs/punk9win.vfs/lib_tcl9/BWidget1.10.1/dynhelp.tcl @@ -0,0 +1,798 @@ +# ---------------------------------------------------------------------------- +# dynhelp.tcl +# This file is part of Unifix BWidget Toolkit +# $Id: dynhelp.tcl,v 1.20.2.1 2009/08/12 07:20:21 oehhar Exp $ +# ---------------------------------------------------------------------------- +# Index of commands: +# - DynamicHelp::configure +# - DynamicHelp::include +# - DynamicHelp::sethelp +# - DynamicHelp::register +# - DynamicHelp::_motion_balloon +# - DynamicHelp::_motion_info +# - DynamicHelp::_leave_info +# - DynamicHelp::_menu_info +# - DynamicHelp::_show_help +# - DynamicHelp::_init +# ---------------------------------------------------------------------------- + +namespace eval DynamicHelp { + Widget::define DynamicHelp dynhelp -classonly + + # Namespace variables overwrite global variables in TCL8 + # Not changed here, as fixed in TCL9 + if {$::tcl_version >= 8.5} { + set fontdefault TkTooltipFont + } elseif {$::Widget::_aqua} { + set fontdefault {helvetica 11} + } else { + set fontdefault {helvetica 8} + } + + Widget::declare DynamicHelp [list\ + {-foreground TkResource black 0 label}\ + {-topbackground TkResource black 0 {label -foreground}}\ + {-background TkResource "#FFFFC0" 0 label}\ + {-borderwidth TkResource 1 0 label}\ + {-justify TkResource left 0 label}\ + [list -font TkResource $fontdefault 0 label]\ + {-delay Int 600 0 "%d >= 100 & %d <= 2000"}\ + {-state Enum "normal" 0 {normal disabled}}\ + {-padx TkResource 1 0 label}\ + {-pady TkResource 1 0 label}\ + {-bd Synonym -borderwidth}\ + {-bg Synonym -background}\ + {-fg Synonym -foreground}\ + {-topbg Synonym -topbackground}\ + ] + + proc use {} {} + + variable _registered + variable _canvases + variable _texts + + variable _top ".help_shell" + variable _id "" + variable _delay 600 + variable _current_balloon "" + variable _current_variable "" + variable _saved + + Widget::init DynamicHelp $_top {} + + bind BwHelpBalloon {DynamicHelp::_motion_balloon enter %W %X %Y} + bind BwHelpBalloon {DynamicHelp::_motion_balloon motion %W %X %Y} + bind BwHelpBalloon {DynamicHelp::_motion_balloon leave %W %X %Y} + bind BwHelpBalloon