Index: .fossil-settings/ignore-glob ================================================================== --- .fossil-settings/ignore-glob +++ .fossil-settings/ignore-glob @@ -85,10 +85,15 @@ zlib/inst/* zlib/out zlib/out/* zlib/src zlib/src/* +critcl/build/* +critcl/build.log +critcl/inst/* +critcl/out/* +critcl/src/* tcc4tcl/build tcc4tcl/build/* tcc4tcl/build.log tcc4tcl/inst tcc4tcl/inst/* Index: critcl/build.sh ================================================================== --- critcl/build.sh +++ critcl/build.sh @@ -3,10 +3,11 @@ # BuildCompatible: KitCreator version='3.1.18.1' url="http://github.com/andreas-kupries/critcl/tarball/${version}/critcl-${version}.tar.gz" sha256='c26893bda46dfda332d2e7d7410ae998eafda697169ea25b4256295d293089de' +deps_dir="$(pwd)/deps" function configure() { : } @@ -15,20 +16,80 @@ } function install() { local tclmajminvers local critcl_cdir + local critcl_target_info + + # Setup cross-compilation in the way Critcl expects, as best as possible + if [ "${KC_CROSSCOMPILE}" = '0' ]; then + critcl_target_info=() + else + critcl_target_info=(-target) + case "${KC_CROSSCOMPILE_HOST_OS}" in + aarch64-*-linux|aarch64-*-linux-*) + critcl_target_info+=('linux-64-aarch64') + ;; + arm-*-linux-*|arm-*-linux) + critcl_target_info+=('linux-arm') + ;; + i?86-*-linux-*|i?86-*-linux) + critcl_target_info+=('linux-32-x86') + ;; + hppa64-*-hpux*) + critcl_target_info+=('hpux-parisc64-cc') + ;; + i?86-*-solaris2.*) + critcl_target_info+=('solaris-ix86-cc') + #critcl_target_info+=('solaris-x86_64-cc') + ;; + i?86-*-mingw32*) + critcl_target_info+=('mingw32') + ;; + x86_64-*-mingw32*) + critcl_target_info+=('mingw32') + ;; + mips-*-linux-*|mips-*-linux|mipsel-*-linux-*|mipsel-*-linux|mipseb-*-linux-*|mipseb-*-linux) + critcl_target_info+=('linux-32-mips') + ;; + powerpc-*-aix*) + critcl_target_info+=('aix-powerpc-cc') + ;; + sparc-*-solaris2.*) + critcl_target_info+=('solaris-sparc-cc') + #critcl_target_info+=('solaris-sparc64-cc') + ;; + x86_64-*-linux-*|x86_64-*-linux) + critcl_target_info+=('linux-64-x86_64') + ;; + *) + echo "error: Critcl does not support cross-compiling to ${KC_CROSSCOMPILE_HOST_OS}" >&2 + return 1 + ;; + esac + fi + + # Include our Tcl packages directory, to ensure Critcl can be run + export TCLLIBPATH="${deps_dir}" + # Call the Critcl installer mkdir -p "${installdir}/lib" || return 1 + "${TCLSH_NATIVE}" ./build.tcl install "${critcl_target_info[@]}" "${installdir}/lib" || return 1 - tclmajminvers="$(echo "${TCLVERS}" | cut -f 1-2 -d .)" + # Critcl returns success even if it fails, so we need to double-check its work + if [ "${KC_CROSSCOMPILE}" = '0' ]; then + if [ ! -d "$(echo "${installdir}"/lib/*md5c*/)" ]; then + return 1 + fi + fi - "${TCLSH_NATIVE}" ./build.tcl install "${installdir}/lib" || return 1 - + # We only need to keep headers for a single version of Tcl, the one the kit was compiled + # for + tclmajminvers="$(echo "${TCLVERS}" | cut -f 1-2 -d .)" critcl_cdir="$(echo "${installdir}/lib"/critcl*/critcl_c)" mv "${critcl_cdir}/tcl${tclmajminvers}" "${critcl_cdir}/.keep-tcl" || return 1 rm -rf "${critcl_cdir}"/tcl*/ mv "${critcl_cdir}/.keep-tcl" "${critcl_cdir}/tcl${tclmajminvers}" || return 1 return 0 } ADDED critcl/deps/cmdline-1.5/cmdline.tcl Index: critcl/deps/cmdline-1.5/cmdline.tcl ================================================================== --- /dev/null +++ critcl/deps/cmdline-1.5/cmdline.tcl @@ -0,0 +1,912 @@ +# cmdline.tcl -- +# +# This package provides a utility for parsing command line +# arguments that are processed by our various applications. +# It also includes a utility routine to determine the +# application name for use in command line errors. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2001-2015 by Andreas Kupries . +# Copyright (c) 2003 by David N. Welton +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $ + +package require Tcl 8.2 +package provide cmdline 1.5 + +namespace eval ::cmdline { + namespace export getArgv0 getopt getKnownOpt getfiles getoptions \ + getKnownOptions usage +} + +# ::cmdline::getopt -- +# +# The cmdline::getopt works in a fashion like the standard +# C based getopt function. Given an option string and a +# pointer to an array or args this command will process the +# first argument and return info on how to proceed. +# +# Arguments: +# argvVar Name of the argv list that you +# want to process. If options are found the +# arg list is modified and the processed arguments +# are removed from the start of the list. +# optstring A list of command options that the application +# will accept. If the option ends in ".arg" the +# getopt routine will use the next argument as +# an argument to the option. Otherwise the option +# is a boolean that is set to 1 if present. +# optVar The variable pointed to by optVar +# contains the option that was found (without the +# leading '-' and without the .arg extension). +# valVar Upon success, the variable pointed to by valVar +# contains the value for the specified option. +# This value comes from the command line for .arg +# options, otherwise the value is 1. +# If getopt fails, the valVar is filled with an +# error message. +# +# Results: +# The getopt function returns 1 if an option was found, 0 if no more +# options were found, and -1 if an error occurred. + +proc ::cmdline::getopt {argvVar optstring optVar valVar} { + upvar 1 $argvVar argsList + upvar 1 $optVar option + upvar 1 $valVar value + + set result [getKnownOpt argsList $optstring option value] + + if {$result < 0} { + # Collapse unknown-option error into any-other-error result. + set result -1 + } + return $result +} + +# ::cmdline::getKnownOpt -- +# +# The cmdline::getKnownOpt works in a fashion like the standard +# C based getopt function. Given an option string and a +# pointer to an array or args this command will process the +# first argument and return info on how to proceed. +# +# Arguments: +# argvVar Name of the argv list that you +# want to process. If options are found the +# arg list is modified and the processed arguments +# are removed from the start of the list. Note that +# unknown options and the args that follow them are +# left in this list. +# optstring A list of command options that the application +# will accept. If the option ends in ".arg" the +# getopt routine will use the next argument as +# an argument to the option. Otherwise the option +# is a boolean that is set to 1 if present. +# optVar The variable pointed to by optVar +# contains the option that was found (without the +# leading '-' and without the .arg extension). +# valVar Upon success, the variable pointed to by valVar +# contains the value for the specified option. +# This value comes from the command line for .arg +# options, otherwise the value is 1. +# If getopt fails, the valVar is filled with an +# error message. +# +# Results: +# The getKnownOpt function returns 1 if an option was found, +# 0 if no more options were found, -1 if an unknown option was +# encountered, and -2 if any other error occurred. + +proc ::cmdline::getKnownOpt {argvVar optstring optVar valVar} { + upvar 1 $argvVar argsList + upvar 1 $optVar option + upvar 1 $valVar value + + # default settings for a normal return + set value "" + set option "" + set result 0 + + # check if we're past the end of the args list + if {[llength $argsList] != 0} { + + # if we got -- or an option that doesn't begin with -, return (skipping + # the --). otherwise process the option arg. + switch -glob -- [set arg [lindex $argsList 0]] { + "--" { + set argsList [lrange $argsList 1 end] + } + "--*" - + "-*" { + set option [string range $arg 1 end] + if {[string equal [string range $option 0 0] "-"]} { + set option [string range $arg 2 end] + } + + # support for format: [-]-option=value + set idx [string first "=" $option 1] + if {$idx != -1} { + set _val [string range $option [expr {$idx+1}] end] + set option [string range $option 0 [expr {$idx-1}]] + } + + if {[lsearch -exact $optstring $option] != -1} { + # Booleans are set to 1 when present + set value 1 + set result 1 + set argsList [lrange $argsList 1 end] + } elseif {[lsearch -exact $optstring "$option.arg"] != -1} { + set result 1 + set argsList [lrange $argsList 1 end] + + if {[info exists _val]} { + set value $_val + } elseif {[llength $argsList]} { + set value [lindex $argsList 0] + set argsList [lrange $argsList 1 end] + } else { + set value "Option \"$option\" requires an argument" + set result -2 + } + } else { + # Unknown option. + set value "Illegal option \"-$option\"" + set result -1 + } + } + default { + # Skip ahead + } + } + } + + return $result +} + +# ::cmdline::getoptions -- +# +# Process a set of command line options, filling in defaults +# for those not specified. This also generates an error message +# that lists the allowed flags if an incorrect flag is specified. +# +# Arguments: +# arglistVar The name of the argument list, typically argv. +# We remove all known options and their args from it. +# optlist A list-of-lists where each element specifies an option +# in the form: +# (where flag takes no argument) +# flag comment +# +# (or where flag takes an argument) +# flag default comment +# +# If flag ends in ".arg" then the value is taken from the +# command line. Otherwise it is a boolean and appears in +# the result if present on the command line. If flag ends +# in ".secret", it will not be displayed in the usage. +# usage Text to include in the usage display. Defaults to +# "options:" +# +# Results +# Name value pairs suitable for using with array set. + +proc ::cmdline::getoptions {arglistVar optlist {usage options:}} { + upvar 1 $arglistVar argv + + set opts [GetOptionDefaults $optlist result] + + set argc [llength $argv] + while {[set err [getopt argv $opts opt arg]]} { + if {$err < 0} { + set result(?) "" + break + } + set result($opt) $arg + } + if {[info exist result(?)] || [info exists result(help)]} { + Error [usage $optlist $usage] USAGE + } + return [array get result] +} + +# ::cmdline::getKnownOptions -- +# +# Process a set of command line options, filling in defaults +# for those not specified. This ignores unknown flags, but generates +# an error message that lists the correct usage if a known option +# is used incorrectly. +# +# Arguments: +# arglistVar The name of the argument list, typically argv. This +# We remove all known options and their args from it. +# optlist A list-of-lists where each element specifies an option +# in the form: +# flag default comment +# If flag ends in ".arg" then the value is taken from the +# command line. Otherwise it is a boolean and appears in +# the result if present on the command line. If flag ends +# in ".secret", it will not be displayed in the usage. +# usage Text to include in the usage display. Defaults to +# "options:" +# +# Results +# Name value pairs suitable for using with array set. + +proc ::cmdline::getKnownOptions {arglistVar optlist {usage options:}} { + upvar 1 $arglistVar argv + + set opts [GetOptionDefaults $optlist result] + + # As we encounter them, keep the unknown options and their + # arguments in this list. Before we return from this procedure, + # we'll prepend these args to the argList so that the application + # doesn't lose them. + + set unknownOptions [list] + + set argc [llength $argv] + while {[set err [getKnownOpt argv $opts opt arg]]} { + if {$err == -1} { + # Unknown option. + + # Skip over any non-option items that follow it. + # For now, add them to the list of unknownOptions. + lappend unknownOptions [lindex $argv 0] + set argv [lrange $argv 1 end] + while {([llength $argv] != 0) \ + && ![string match "-*" [lindex $argv 0]]} { + lappend unknownOptions [lindex $argv 0] + set argv [lrange $argv 1 end] + } + } elseif {$err == -2} { + set result(?) "" + break + } else { + set result($opt) $arg + } + } + + # Before returning, prepend the any unknown args back onto the + # argList so that the application doesn't lose them. + set argv [concat $unknownOptions $argv] + + if {[info exist result(?)] || [info exists result(help)]} { + Error [usage $optlist $usage] USAGE + } + return [array get result] +} + +# ::cmdline::GetOptionDefaults -- +# +# This internal procedure processes the option list (that was passed to +# the getopt or getKnownOpt procedure). The defaultArray gets an index +# for each option in the option list, the value of which is the option's +# default value. +# +# Arguments: +# optlist A list-of-lists where each element specifies an option +# in the form: +# flag default comment +# If flag ends in ".arg" then the value is taken from the +# command line. Otherwise it is a boolean and appears in +# the result if present on the command line. If flag ends +# in ".secret", it will not be displayed in the usage. +# defaultArrayVar The name of the array in which to put argument defaults. +# +# Results +# Name value pairs suitable for using with array set. + +proc ::cmdline::GetOptionDefaults {optlist defaultArrayVar} { + upvar 1 $defaultArrayVar result + + set opts {? help} + foreach opt $optlist { + set name [lindex $opt 0] + if {[regsub -- {\.secret$} $name {} name] == 1} { + # Need to hide this from the usage display and getopt + } + lappend opts $name + if {[regsub -- {\.arg$} $name {} name] == 1} { + + # Set defaults for those that take values. + + set default [lindex $opt 1] + set result($name) $default + } else { + # The default for booleans is false + set result($name) 0 + } + } + return $opts +} + +# ::cmdline::usage -- +# +# Generate an error message that lists the allowed flags. +# +# Arguments: +# optlist As for cmdline::getoptions +# usage Text to include in the usage display. Defaults to +# "options:" +# +# Results +# A formatted usage message + +proc ::cmdline::usage {optlist {usage {options:}}} { + set str "[getArgv0] $usage\n" + foreach opt [concat $optlist \ + {{- "Forcibly stop option processing"} {help "Print this message"} {? "Print this message"}}] { + set name [lindex $opt 0] + if {[regsub -- {\.secret$} $name {} name] == 1} { + # Hidden option + continue + } + if {[regsub -- {\.arg$} $name {} name] == 1} { + set default [lindex $opt 1] + set comment [lindex $opt 2] + append str [format " %-20s %s <%s>\n" "-$name value" \ + $comment $default] + } else { + set comment [lindex $opt 1] + append str [format " %-20s %s\n" "-$name" $comment] + } + } + return $str +} + +# ::cmdline::getfiles -- +# +# Given a list of file arguments from the command line, compute +# the set of valid files. On windows, file globbing is performed +# on each argument. On Unix, only file existence is tested. If +# a file argument produces no valid files, a warning is optionally +# generated. +# +# This code also uses the full path for each file. If not +# given it prepends [pwd] to the filename. This ensures that +# these files will never conflict with files in our zip file. +# +# Arguments: +# patterns The file patterns specified by the user. +# quiet If this flag is set, no warnings will be generated. +# +# Results: +# Returns the list of files that match the input patterns. + +proc ::cmdline::getfiles {patterns quiet} { + set result {} + if {$::tcl_platform(platform) == "windows"} { + foreach pattern $patterns { + set pat [file join $pattern] + set files [glob -nocomplain -- $pat] + if {$files == {}} { + if {! $quiet} { + puts stdout "warning: no files match \"$pattern\"" + } + } else { + foreach file $files { + lappend result $file + } + } + } + } else { + set result $patterns + } + set files {} + foreach file $result { + # Make file an absolute path so that we will never conflict + # with files that might be contained in our zip file. + set fullPath [file join [pwd] $file] + + if {[file isfile $fullPath]} { + lappend files $fullPath + } elseif {! $quiet} { + puts stdout "warning: no files match \"$file\"" + } + } + return $files +} + +# ::cmdline::getArgv0 -- +# +# This command returns the "sanitized" version of argv0. It will strip +# off the leading path and remove the ".bin" extensions that our apps +# use because they must be wrapped by a shell script. +# +# Arguments: +# None. +# +# Results: +# The application name that can be used in error messages. + +proc ::cmdline::getArgv0 {} { + global argv0 + + set name [file tail $argv0] + return [file rootname $name] +} + +## +# ### ### ### ######### ######### ######### +## +# Now the typed versions of the above commands. +## +# ### ### ### ######### ######### ######### +## + +# typedCmdline.tcl -- +# +# This package provides a utility for parsing typed command +# line arguments that may be processed by various applications. +# +# Copyright (c) 2000 by Ross Palmer Mohn. +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: cmdline.tcl,v 1.28 2011/02/23 17:41:52 andreas_kupries Exp $ + +namespace eval ::cmdline { + namespace export typedGetopt typedGetoptions typedUsage + + # variable cmdline::charclasses -- + # + # Create regexp list of allowable character classes + # from "string is" error message. + # + # Results: + # String of character class names separated by "|" characters. + + variable charclasses + #checker exclude badKey + catch {string is . .} charclasses + variable dummy + regexp -- {must be (.+)$} $charclasses dummy charclasses + regsub -all -- {, (or )?} $charclasses {|} charclasses + unset dummy +} + +# ::cmdline::typedGetopt -- +# +# The cmdline::typedGetopt works in a fashion like the standard +# C based getopt function. Given an option string and a +# pointer to a list of args this command will process the +# first argument and return info on how to proceed. In addition, +# you may specify a type for the argument to each option. +# +# Arguments: +# argvVar Name of the argv list that you want to process. +# If options are found, the arg list is modified +# and the processed arguments are removed from the +# start of the list. +# +# optstring A list of command options that the application +# will accept. If the option ends in ".xxx", where +# xxx is any valid character class to the tcl +# command "string is", then typedGetopt routine will +# use the next argument as a typed argument to the +# option. The argument must match the specified +# character classes (e.g. integer, double, boolean, +# xdigit, etc.). Alternatively, you may specify +# ".arg" for an untyped argument. +# +# optVar Upon success, the variable pointed to by optVar +# contains the option that was found (without the +# leading '-' and without the .xxx extension). If +# typedGetopt fails the variable is set to the empty +# string. SOMETIMES! Different for each -value! +# +# argVar Upon success, the variable pointed to by argVar +# contains the argument for the specified option. +# If typedGetopt fails, the variable is filled with +# an error message. +# +# Argument type syntax: +# Option that takes no argument. +# foo +# +# Option that takes a typeless argument. +# foo.arg +# +# Option that takes a typed argument. Allowable types are all +# valid character classes to the tcl command "string is". +# Currently must be one of alnum, alpha, ascii, control, +# boolean, digit, double, false, graph, integer, lower, print, +# punct, space, true, upper, wordchar, or xdigit. +# foo.double +# +# Option that takes an argument from a list. +# foo.(bar|blat) +# +# Argument quantifier syntax: +# Option that takes an optional argument. +# foo.arg? +# +# Option that takes a list of arguments terminated by "--". +# foo.arg+ +# +# Option that takes an optional list of arguments terminated by "--". +# foo.arg* +# +# Argument quantifiers work on all argument types, so, for +# example, the following is a valid option specification. +# foo.(bar|blat|blah)? +# +# Argument syntax miscellany: +# Options may be specified on the command line using a unique, +# shortened version of the option name. Given that program foo +# has an option list of {bar.alpha blah.arg blat.double}, +# "foo -b fob" returns an error, but "foo -ba fob" +# successfully returns {bar fob} +# +# Results: +# The typedGetopt function returns one of the following: +# 1 a valid option was found +# 0 no more options found to process +# -1 invalid option +# -2 missing argument to a valid option +# -3 argument to a valid option does not match type +# +# Known Bugs: +# When using options which include special glob characters, +# you must use the exact option. Abbreviating it can cause +# an error in the "cmdline::prefixSearch" procedure. + +proc ::cmdline::typedGetopt {argvVar optstring optVar argVar} { + variable charclasses + + upvar $argvVar argsList + + upvar $optVar retvar + upvar $argVar optarg + + # default settings for a normal return + set optarg "" + set retvar "" + set retval 0 + + # check if we're past the end of the args list + if {[llength $argsList] != 0} { + + # if we got -- or an option that doesn't begin with -, return (skipping + # the --). otherwise process the option arg. + switch -glob -- [set arg [lindex $argsList 0]] { + "--" { + set argsList [lrange $argsList 1 end] + } + + "-*" { + # Create list of options without their argument extensions + + set optstr "" + foreach str $optstring { + lappend optstr [file rootname $str] + } + + set _opt [string range $arg 1 end] + + set i [prefixSearch $optstr [file rootname $_opt]] + if {$i != -1} { + set opt [lindex $optstring $i] + + set quantifier "none" + if {[regexp -- {\.[^.]+([?+*])$} $opt dummy quantifier]} { + set opt [string range $opt 0 end-1] + } + + if {[string first . $opt] == -1} { + set retval 1 + set retvar $opt + set argsList [lrange $argsList 1 end] + + } elseif {[regexp -- "\\.(arg|$charclasses)\$" $opt dummy charclass] + || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} { + if {[string equal arg $charclass]} { + set type arg + } elseif {[regexp -- "^($charclasses)\$" $charclass]} { + set type class + } else { + set type oneof + } + + set argsList [lrange $argsList 1 end] + set opt [file rootname $opt] + + while {1} { + if {[llength $argsList] == 0 + || [string equal "--" [lindex $argsList 0]]} { + if {[string equal "--" [lindex $argsList 0]]} { + set argsList [lrange $argsList 1 end] + } + + set oneof "" + if {$type == "arg"} { + set charclass an + } elseif {$type == "oneof"} { + set oneof ", one of $charclass" + set charclass an + } + + if {$quantifier == "?"} { + set retval 1 + set retvar $opt + set optarg "" + } elseif {$quantifier == "+"} { + set retvar $opt + if {[llength $optarg] < 1} { + set retval -2 + set optarg "Option requires at least one $charclass argument$oneof -- $opt" + } else { + set retval 1 + } + } elseif {$quantifier == "*"} { + set retval 1 + set retvar $opt + } else { + set optarg "Option requires $charclass argument$oneof -- $opt" + set retvar $opt + set retval -2 + } + set quantifier "" + } elseif {($type == "arg") + || (($type == "oneof") + && [string first "|[lindex $argsList 0]|" "|$charclass|"] != -1) + || (($type == "class") + && [string is $charclass [lindex $argsList 0]])} { + set retval 1 + set retvar $opt + lappend optarg [lindex $argsList 0] + set argsList [lrange $argsList 1 end] + } else { + set oneof "" + if {$type == "arg"} { + set charclass an + } elseif {$type == "oneof"} { + set oneof ", one of $charclass" + set charclass an + } + set optarg "Option requires $charclass argument$oneof -- $opt" + set retvar $opt + set retval -3 + + if {$quantifier == "?"} { + set retval 1 + set optarg "" + } + set quantifier "" + } + if {![regexp -- {[+*]} $quantifier]} { + break; + } + } + } else { + Error \ + "Illegal option type specification: must be one of $charclasses" \ + BAD OPTION TYPE + } + } else { + set optarg "Illegal option -- $_opt" + set retvar $_opt + set retval -1 + } + } + default { + # Skip ahead + } + } + } + + return $retval +} + +# ::cmdline::typedGetoptions -- +# +# Process a set of command line options, filling in defaults +# for those not specified. This also generates an error message +# that lists the allowed options if an incorrect option is +# specified. +# +# Arguments: +# arglistVar The name of the argument list, typically argv +# optlist A list-of-lists where each element specifies an option +# in the form: +# +# option default comment +# +# Options formatting is as described for the optstring +# argument of typedGetopt. Default is for optionally +# specifying a default value. Comment is for optionally +# specifying a comment for the usage display. The +# options "--", "-help", and "-?" are automatically included +# in optlist. +# +# Argument syntax miscellany: +# Options formatting and syntax is as described in typedGetopt. +# There are two additional suffixes that may be applied when +# passing options to typedGetoptions. +# +# You may add ".multi" as a suffix to any option. For options +# that take an argument, this means that the option may be used +# more than once on the command line and that each additional +# argument will be appended to a list, which is then returned +# to the application. +# foo.double.multi +# +# If a non-argument option is specified as ".multi", it is +# toggled on and off for each time it is used on the command +# line. +# foo.multi +# +# If an option specification does not contain the ".multi" +# suffix, it is not an error to use an option more than once. +# In this case, the behavior for options with arguments is that +# the last argument is the one that will be returned. For +# options that do not take arguments, using them more than once +# has no additional effect. +# +# Options may also be hidden from the usage display by +# appending the suffix ".secret" to any option specification. +# Please note that the ".secret" suffix must be the last suffix, +# after any argument type specification and ".multi" suffix. +# foo.xdigit.multi.secret +# +# Results +# Name value pairs suitable for using with array set. + +proc ::cmdline::typedGetoptions {arglistVar optlist {usage options:}} { + variable charclasses + + upvar 1 $arglistVar argv + + set opts {? help} + foreach opt $optlist { + set name [lindex $opt 0] + if {[regsub -- {\.secret$} $name {} name] == 1} { + # Remove this extension before passing to typedGetopt. + } + if {[regsub -- {\.multi$} $name {} name] == 1} { + # Remove this extension before passing to typedGetopt. + + regsub -- {\..*$} $name {} temp + set multi($temp) 1 + } + lappend opts $name + if {[regsub -- "\\.(arg|$charclasses|\\(.+).?\$" $name {} name] == 1} { + # Set defaults for those that take values. + # Booleans are set just by being present, or not + + set dflt [lindex $opt 1] + if {$dflt != {}} { + set defaults($name) $dflt + } + } + } + set argc [llength $argv] + while {[set err [typedGetopt argv $opts opt arg]]} { + if {$err == 1} { + if {[info exists result($opt)] + && [info exists multi($opt)]} { + # Toggle boolean options or append new arguments + + if {$arg == ""} { + unset result($opt) + } else { + set result($opt) "$result($opt) $arg" + } + } else { + set result($opt) "$arg" + } + } elseif {($err == -1) || ($err == -3)} { + Error [typedUsage $optlist $usage] USAGE + } elseif {$err == -2 && ![info exists defaults($opt)]} { + Error [typedUsage $optlist $usage] USAGE + } + } + if {[info exists result(?)] || [info exists result(help)]} { + Error [typedUsage $optlist $usage] USAGE + } + foreach {opt dflt} [array get defaults] { + if {![info exists result($opt)]} { + set result($opt) $dflt + } + } + return [array get result] +} + +# ::cmdline::typedUsage -- +# +# Generate an error message that lists the allowed flags, +# type of argument taken (if any), default value (if any), +# and an optional description. +# +# Arguments: +# optlist As for cmdline::typedGetoptions +# +# Results +# A formatted usage message + +proc ::cmdline::typedUsage {optlist {usage {options:}}} { + variable charclasses + + set str "[getArgv0] $usage\n" + foreach opt [concat $optlist \ + {{help "Print this message"} {? "Print this message"}}] { + set name [lindex $opt 0] + if {[regsub -- {\.secret$} $name {} name] == 1} { + # Hidden option + + } else { + if {[regsub -- {\.multi$} $name {} name] == 1} { + # Display something about multiple options + } + + if {[regexp -- "\\.(arg|$charclasses)\$" $name dummy charclass] + || [regexp -- {\.\(([^)]+)\)} $opt dummy charclass]} { + regsub -- "\\..+\$" $name {} name + set comment [lindex $opt 2] + set default "<[lindex $opt 1]>" + if {$default == "<>"} { + set default "" + } + append str [format " %-20s %s %s\n" "-$name $charclass" \ + $comment $default] + } else { + set comment [lindex $opt 1] + append str [format " %-20s %s\n" "-$name" $comment] + } + } + } + return $str +} + +# ::cmdline::prefixSearch -- +# +# Search a Tcl list for a pattern; searches first for an exact match, +# and if that fails, for a unique prefix that matches the pattern +# (i.e, first "lsearch -exact", then "lsearch -glob $pattern*" +# +# Arguments: +# list list of words +# pattern word to search for +# +# Results: +# Index of found word is returned. If no exact match or +# unique short version is found then -1 is returned. + +proc ::cmdline::prefixSearch {list pattern} { + # Check for an exact match + + if {[set pos [::lsearch -exact $list $pattern]] > -1} { + return $pos + } + + # Check for a unique short version + + set slist [lsort $list] + if {[set pos [::lsearch -glob $slist $pattern*]] > -1} { + # What if there is nothing for the check variable? + + set check [lindex $slist [expr {$pos + 1}]] + if {[string first $pattern $check] != 0} { + return [::lsearch -exact $list [lindex $slist $pos]] + } + } + return -1 +} +# ::cmdline::Error -- +# +# Internal helper to throw errors with a proper error-code attached. +# +# Arguments: +# message text of the error message to throw. +# args additional parts of the error code to use, +# with CMDLINE as basic prefix added by this command. +# +# Results: +# An error is thrown, always. + +proc ::cmdline::Error {message args} { + return -code error -errorcode [linsert $args 0 CMDLINE] $message +} ADDED critcl/deps/cmdline-1.5/pkgIndex.tcl Index: critcl/deps/cmdline-1.5/pkgIndex.tcl ================================================================== --- /dev/null +++ critcl/deps/cmdline-1.5/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.2]} {return} +package ifneeded cmdline 1.5 [list source [file join $dir cmdline.tcl]] ADDED critcl/patches/critcl-3.1.18.1-usetclmd5.diff Index: critcl/patches/critcl-3.1.18.1-usetclmd5.diff ================================================================== --- /dev/null +++ critcl/patches/critcl-3.1.18.1-usetclmd5.diff @@ -0,0 +1,36 @@ +diff -uNr andreas-kupries-critcl-f7fdaa5.orig/build.tcl andreas-kupries-critcl-f7fdaa5-usetclmd5/build.tcl +--- andreas-kupries-critcl-f7fdaa5.orig/build.tcl 2020-02-18 22:07:06.000000000 -0600 ++++ andreas-kupries-critcl-f7fdaa5-usetclmd5/build.tcl 2020-04-15 00:14:19.173179709 -0500 +@@ -486,6 +486,10 @@ + + puts "${prefix}Installed application: $theapp" + ++ # Critcl does not meaningfully support cross-compilation, elide ++ # these packages when being cross-compiled ++if {$target eq {}} { ++ + # Special package: critcl_md5c + # Local MD5 hash implementation. + +@@ -558,6 +562,7 @@ + puts "${prefix}Installed package: $dst" + puts "${prefix}Installed headers: [ + file join $dsti critcl_callback]" ++} + + } msg]} { + if {![string match {*permission denied*} $msg]} { +diff -uNr andreas-kupries-critcl-f7fdaa5.orig/lib/critcl/critcl.tcl andreas-kupries-critcl-f7fdaa5-usetclmd5/lib/critcl/critcl.tcl +--- andreas-kupries-critcl-f7fdaa5.orig/lib/critcl/critcl.tcl 2020-02-18 22:07:06.000000000 -0600 ++++ andreas-kupries-critcl-f7fdaa5-usetclmd5/lib/critcl/critcl.tcl 2020-04-15 00:15:51.782180320 -0500 +@@ -55,8 +55,8 @@ + if {$v::uuidcounter} { + return [format %032d [incr v::uuidcounter]] + } +- package require critcl_md5c +- binary scan [md5c $s] H* md; return $md ++ package require md5 ++ binary scan [::md5 $s] H* md; return $md + } + + # # ## ### ##### ######## ############# #####################