Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch eagleBeta37 Excluding Merge-Ins
This is equivalent to a diff from 64dd02f948 to 7e48c9127f
2016-09-04
| ||
00:24 | Update Eagle in externals to the beta 37 release. check-in: 127ce06a16 user: mistachkin tags: trunk | |
2016-09-03
| ||
23:39 | Update Eagle in externals to the beta 37 release. Closed-Leaf check-in: 7e48c9127f user: mistachkin tags: eagleBeta37 | |
2016-09-02
| ||
22:51 | Prepare to import Eagle beta 37 from upstream. check-in: 7d8ceb2843 user: mistachkin tags: eagleBeta37 | |
2016-08-31
| ||
23:50 | Refactor project system and test suite handling of mixed-mode files. check-in: 64dd02f948 user: mistachkin tags: trunk | |
23:35 | Fix test issues with the .NET Framework 4.6.2. Closed-Leaf check-in: 5b6f731c24 user: mistachkin tags: interopPostBuild | |
19:21 | Import the custom MSBuild targets file from the appropriate interop assembly project files. check-in: 46d5646194 user: mistachkin tags: trunk | |
Changes to Externals/Eagle/bin/Eagle.dll.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/EagleShell.exe.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/EagleShell.exe.config.
︙ | ︙ | |||
29 30 31 32 33 34 35 | <runtime> <!-- NOTE: These are known to be useful with Eagle. Some of these only work on the .NET Framework 4.0. --> <!-- <legacyCorruptedStateExceptionsPolicy enabled="true" /> | < > | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | <runtime> <!-- NOTE: These are known to be useful with Eagle. Some of these only work on the .NET Framework 4.0. --> <!-- <legacyCorruptedStateExceptionsPolicy enabled="true" /> <generatePublisherEvidence enabled="false" /> <NetFx40_LegacySecurityPolicy enabled="true" /> --> <!-- NOTE: Most of these have not been tested with Eagle. Some of these only work on the .NET Framework 2.0 -OR- .NET Framework 4.0. --> <!-- |
︙ | ︙ |
Changes to Externals/Eagle/bin/EagleShell32.exe.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/x64/Spilornis.dll.
cannot compute difference between binary files
Changes to Externals/Eagle/bin/x86/Spilornis.dll.
cannot compute difference between binary files
Added Externals/Eagle/lib/Eagle1.0/auxiliary.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | ############################################################################### # # auxiliary.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Auxiliary Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns the value of an environment variable, if # it actually exists; otherwise, an empty string is returned. # proc getEnvironmentVariable { name } { global env return [expr {[info exists env($name)] ? $env($name) : ""}] } # # NOTE: This procedure accepts an any number of arguments. The arguments # are appended into one big string, verbatim. The resulting string # is returned. Normally, this procedure is used to avoid undesired # string interpolation operations. # proc appendArgs { args } { set result ""; eval append result $args } # # NOTE: This procedure attempts to locate the first named value we are # interested in. The dictionary argument must be a list with an # even number of elements in the following format: # # <name1> <value1> <name2> <value2> ... <nameN> <valueN> # proc getDictionaryValue { dictionary name {default ""} {wrap ""} } { foreach {pairName pairValue} $dictionary { # # NOTE: Does this name match the one specified by the caller? # if {$pairName eq $name} then { # # NOTE: Return the value, optionally wrapped. # return [appendArgs $wrap $pairValue $wrap] } } # # NOTE: No match was found, return the default value. # return $default } # # NOTE: This procedure exports one or more commands from the specified # namespace and imports them into the global namespace, optionally # forgetting all previous imports from the specified namespace. # proc exportAndImportPackageCommands { namespace exports forget force } { # # NOTE: Forget any previous commands that were imported from # this namespace into the global namespace? # if {$forget} then { namespace eval :: [list namespace forget [appendArgs $namespace ::*]] } # # NOTE: Process each command to be exported from the specified # namespace and import it into the global namespace, if # necessary. # foreach export $exports { # # NOTE: Force importing of our exported commands into the global # namespace? Otherwise, see if the command is already # present in the global namespace before trying to import # it. # if {$force || \ [llength [info commands [appendArgs :: $export]]] == 0} then { # # NOTE: Export the specified command from the specified namespace. # namespace eval $namespace [list namespace export $export] # # NOTE: Import the specified command into the global namespace. # set namespaceExport [appendArgs $namespace :: $export] if {$force} then { namespace eval :: [list namespace import -force $namespaceExport] } else { namespace eval :: [list namespace import $namespaceExport] } } } } # # NOTE: Provide the Eagle "auxiliary" package to the interpreter. # package provide Eagle.Auxiliary \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/compat.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | ############################################################################### # # compat.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle [Native Tcl] Compatibility Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure attempts to query the size from the host, in terms # of columns and rows; failing that, it returns a reasonable default # value. Generally, this procedure is intended to be used only by # the other procedures in this file. # proc getHostSize {} { if {[catch {host size} result] == 0} then { return $result } return [list 80 25]; # TODO: Good default? } # # NOTE: This procedure emulates the behavior of the native Tcl [parray] # procedure: it prints (to stdout) the names and values contained # in the specified array, or a subset of those names based on the # specified pattern. # proc parray { a args } { if {[llength $args] > 2} then { error "wrong # args: should be \"parray a ?pattern?\"" } upvar 1 $a array if {![array exists array]} { error [appendArgs \" $a "\" isn't an array"] } set names [lsort [eval array names array $args]] set maxLength 0 foreach name $names { set length [string length $name] if {$length > $maxLength} { set maxLength $length } } set stringMap [list \b " " \t " " \r \xB6 \n \xB6] set maxLength [expr {$maxLength + [string length $a] + 2}] set hostLength [lindex [getHostSize] 0] set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... " foreach name $names { # # NOTE: Format the array element name for display. # set nameString [string map $stringMap [appendArgs $a ( $name )]] # # NOTE: If the value by itself is too long to fit on one host line, # just truncate and ellipsis it. # set valueString [string map $stringMap $array($name)] if {[string length $valueString] > $valueLength} then { set valueString [appendArgs [string range $valueString 0 \ [expr {$valueLength - 4}]] " ..."] } # # HACK: Mono does not currently support calling the String.Format # overload that takes a variable number of arguments via # reflection (Mono bug #636939). # if {![isMono]} then { set line [string format -verbatim -- [appendArgs "\{0,-" \ $maxLength "\} = {1}"] $nameString $valueString] } elseif {[llength [info commands object]] > 0} then { set line [object invoke String Format [appendArgs "\{0,-" \ $maxLength "\} = {1}"] $nameString $valueString] } else { set line [format [appendArgs "%-" $maxLength "s = %s"] \ $nameString $valueString] } puts stdout $line } } # # NOTE: This procedure emulates the behavior of the native Tcl [parray] # procedure: it prints (to stdout) the names and values contained # in the specified dictionary, or a subset of those names based on # the specified pattern. # proc pdict { d } { set maxLength 0 foreach {name value} $d { set length [string length $name] if {$length > $maxLength} { set maxLength $length } } set hostLength [lindex [getHostSize] 0] set valueLength [expr {$hostLength - $maxLength - 5}]; # " ... " foreach {name value} $d { # # NOTE: If the value by itself is too long to fit on one host line, # just truncate and ellipsis it. # set valueString $value if {[string length $valueString] > $valueLength} then { set valueString [appendArgs [string range $valueString 0 \ [expr {$valueLength - 4}]] " ..."] } # # HACK: Mono does not currently support calling the String.Format # overload that takes a variable number of arguments via # reflection (Mono bug #636939). # if {![isMono]} then { set line [string format -verbatim -- [appendArgs "\{0,-" \ $maxLength "\} = {1}"] $name $valueString] } elseif {[llength [info commands object]] > 0} then { set line [object invoke String Format [appendArgs "\{0,-" \ $maxLength "\} = {1}"] $name $valueString] } else { set line [format [appendArgs "%-" $maxLength "s = %s"] \ $name $valueString] } puts stdout $line } } # # NOTE: This procedure emulates the behavior of the native Tcl [test] # command as provided by its bundled "tcltest" package. It is # designed to automatically detect and handle the type of test # specified by the various arguments, which may be an old style # test or a new style test. # proc test { name description args } { # # NOTE: Determine if the caller is trying to run an old style or # new style test and use the appropriate command. # if {[string index [lindex $args 0] 0] eq "-"} then { # # NOTE: New style test, use [test2] command. # set command test2 } else { # # NOTE: Old style test, use [test1] command. # set command test1 } return [uplevel 1 [list $command $name $description] $args] } # # NOTE: This procedure emulates the behavior of the native Tcl [tclLog] # command. # proc tclLog { string } { # # NOTE: This should work properly in both Tcl and Eagle. # catch {puts stderr $string} } # # NOTE: Provide the Eagle "Tcl compatibility" package to the interpreter. # package provide Eagle.Tcl.Compatibility \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/csharp.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 | ############################################################################### # # csharp.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle CSharp Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure is used to dynamically compile some C# code from # within a script. While this procedure was originally designed # to be used by the test suite, it can be quite useful in non-test # scripts as well. # proc compileCSharp { string memory symbols strict resultsVarName errorsVarName args } { # # NOTE: The [object] command is required by this procedure. If it # is not available, bail out now. # if {[llength [info commands object]] == 0} then { # # NOTE: We cannot even attempt to compile anything, fail. # set code Error # # NOTE: Prepare to transfer error messages to the caller. # if {[string length $errorsVarName] > 0} then { upvar 1 $errorsVarName local_errors } # # NOTE: Append to the list of errors. # lappend local_errors "cannot compile, missing \"object\" command" # # NOTE: Return the overall result to the caller. # return $code } # # NOTE: Create the C# code provider object (i.e. the compiler). # set provider [object create -alias Microsoft.CSharp.CSharpCodeProvider] # # NOTE: Create the object that provides various parameters to the C# # code provider (i.e. the compiler options). # set parameters [object create -alias \ System.CodeDom.Compiler.CompilerParameters] # # NOTE: Do we not want to persist the generated assembly to disk? # if {$memory} then { $parameters GenerateInMemory true } # # NOTE: Do we want symbols to be generated for the generated assembly? # if {$symbols} then { $parameters IncludeDebugInformation true } # # NOTE: Make sure that the "standard" preprocessor defines match those # for the platform (i.e. the ones used to compile the Eagle core # library assembly). # set platformOptions [expr { \ [info exists ::eagle_platform(compileOptions)] ? \ $::eagle_platform(compileOptions) : [list]}] # # NOTE: Permit extra C# compiler options to be passed via the global # array element "csharpOptions", if it exists. # set csharpOptions [expr { \ [info exists ::eagle_platform(csharpOptions)] ? \ $::eagle_platform(csharpOptions) : [list]}] if {[llength $platformOptions] > 0 || \ [llength $csharpOptions] > 0} then { # # NOTE: Grab the existing compiler options, if any. # set compilerOptions [$parameters CompilerOptions] if {"DEBUG" in $platformOptions} then { if {[string length $compilerOptions] > 0} then { append compilerOptions " " } append compilerOptions /define:DEBUG } if {"TRACE" in $platformOptions} then { if {[string length $compilerOptions] > 0} then { append compilerOptions " " } append compilerOptions /define:TRACE } # # NOTE: Append the configured extra C# compiler options configured # via the global array element "csharpOptions", if any. # foreach csharpOption $csharpOptions { if {[string length $compilerOptions] > 0} then { append compilerOptions " " } append compilerOptions $csharpOption } # # NOTE: Reset the compiler options to the pre-existing ones plus the # extra defines we may have added (above). # $parameters CompilerOptions $compilerOptions } # # NOTE: Process any extra compiler settings the caller may have # provided. # foreach {name value} $args { $parameters -nocase $name $value } # # NOTE: Prepare to transfer the object reference to the caller. We # must use upvar here because otherwise the object is lost when # the procedure call frame is cleaned up. # if {[string length $resultsVarName] > 0} then { upvar 1 $resultsVarName results } # # NOTE: Attempt to compile the specified string as C# and capture the # results into the variable provided by the caller. # set results [$provider -alias CompileAssemblyFromSource $parameters \ $string] # # NOTE: We no longer need the C# code provider object (i.e. the # compiler); therefore, dispose it now. # unset provider; # dispose # # NOTE: Fetch the collection of compiler errors (which may be empty). # set errors [$results -alias Errors] # # NOTE: It is assumed that no assembly was generated if there were # any compiler errors. Ignore all compiler warnings unless # we are in strict mode. # if {[$errors HasErrors] || ($strict && [$errors HasWarnings])} then { # # NOTE: Compilation of the assembly failed. # set code Error # # NOTE: Prepare to transfer error messages to the caller. # if {[string length $errorsVarName] > 0} then { upvar 1 $errorsVarName local_errors } # # NOTE: How many compile errors? # set count [$errors Count] # # NOTE: Grab each error object and append the string itself to # the overall list of errors. # for {set index 0} {$index < $count} {incr index} { # # NOTE: Get the compiler error object at this index. # set error [$errors -alias Item $index] # # NOTE: Convert it to a string and append it to the list of # errors. # lappend local_errors [$error ToString] # # NOTE: Since the error itself is actually an object, we must # dispose it. # unset error; # dispose } } else { # # NOTE: Compilation of the assembly succeeded. # set code Ok } # # NOTE: We no longer need the collection of compiler errors; # therefore, dispose it now. # unset errors; # dispose # # NOTE: Return the overall result to the caller. # return $code } # # NOTE: Provide the Eagle "C#" package to the interpreter. # package provide Eagle.CSharp \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/database.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | ############################################################################### # # database.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Database Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns the value of the specified database column # within the specified database row value, optionally wrapping the # returned value with another string -OR- returning the specified # default value when the specified database column is not found. # proc getColumnValue { row column {default ""} {wrap ""} } { # # NOTE: Start with the default value. # set result $default # # NOTE: Locate the index of the named column we are interested in. # This requires Tcl 8.5 (or higher) or Eagle. # set index [lsearch -exact -index 0 $row $column] # # NOTE: Did we find the column name in the row? # if {$index != -1} then { # # NOTE: Grab the column value. # set result [appendArgs $wrap [lindex [lindex $row $index] end] $wrap] } return $result } # # NOTE: This procedure returns the value of the specified database column # within the specified array of database row values, optionally # wrapping the returned value with another string -OR- returning # the specified default value when the specified database column is # not found. # proc getRowColumnValue { varName id column {default ""} {wrap ""} } { # # NOTE: Start with the default value. # set result $default # # NOTE: We need acccess to the result array (from the context of the # caller). # upvar 1 $varName rows # # NOTE: Make sure we have the first result row. # if {[info exists rows($id)]} then { # # NOTE: Grab the entire row we are interested in. # set row $rows($id) # # NOTE: Grab the value at the specified column. # set result [getColumnValue $row $column $default $wrap] } return $result } # # NOTE: Provide the Eagle "database" package to the interpreter. # package provide Eagle.Database \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/embed.eagle.
1 2 3 4 5 | ############################################################################### # # embed.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | ############################################################################### # # embed.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Application Embedding Initialization File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ |
︙ | ︙ |
Added Externals/Eagle/lib/Eagle1.0/exec.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | ############################################################################### # # exec.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Execute Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure executes a native Tcl or Eagle sub-shell using the # specified arguments and returns the captured output, verbatim. # proc execShell { options args } { # # NOTE: Start out with just the base [exec] command. # set command [list exec] # # NOTE: Add options for the [exec] command, if any. # if {[llength $options] > 0} then { eval lappend command $options } # # NOTE: Always add the end-of-options marker. # lappend command -- # # NOTE: Check for native Tcl and Mono because this impacts how the # shell executable name is determined. # if {[isEagle] && [isMono]} then { # # HACK: Assume that Mono is somewhere along the PATH. # lappend command mono \ [appendArgs \" [file nativename [info nameofexecutable]] \"] } else { lappend command [info nameofexecutable] } # # NOTE: If possible, check if the current interpreter has security # enabled; if so, add the appropriate command line option for # the sub-process. # if {[isEagle] && [llength [info commands object]] > 0} then { if {[catch { object invoke -flags +NonPublic Interpreter.GetActive HasSecurity } security] == 0 && $security} then { lappend command -security true } } # # NOTE: Add command line arguments to the shell command, if any. # if {[llength $args] > 0} then { eval lappend command $args } # # NOTE: Finally, execute the resulting [exec] command in the context # of the caller, returning its result. # return [uplevel 1 $command] } # # NOTE: Provide the Eagle "execute" package to the interpreter. # package provide Eagle.Execute \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/file1.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | ############################################################################### # # file1.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle File 1 Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure reconfigures the specified channel to full binary # mode. # proc makeBinaryChannel { channel } { fconfigure $channel -encoding binary -translation binary; # BINARY DATA } # # NOTE: This procedure reads all data from the specified binary file and # returns it. # proc readFile { fileName } { set channel [open $fileName RDONLY] makeBinaryChannel $channel set result [read $channel] close $channel return $result } # # NOTE: This procedure writes all data to the specified binary file and # returns an empty string. Previous data contained in the file, # if any, is lost. # proc writeFile { fileName data } { set channel [open $fileName {WRONLY CREAT TRUNC}] makeBinaryChannel $channel puts -nonewline $channel $data close $channel return "" } # # NOTE: This procedure appends data to the specified binary file and # returns an empty string. Previous data contained in the file, # if any, is preserved. # proc appendFile { fileName data } { set channel [open $fileName {WRONLY CREAT APPEND}] makeBinaryChannel $channel puts -nonewline $channel $data close $channel return "" } # # NOTE: Provide the Eagle "file" package to the interpreter. # package provide Eagle.File \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/file2.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 | ############################################################################### # # file2.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle File 2 Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure reconfigures the specified channel to full ASCII # mode. # proc makeAsciiChannel { channel } { fconfigure $channel -encoding ascii -translation auto; # ASCII TEXT } # # NOTE: This procedure reads all data from the specified ASCII file and # returns it. # proc readAsciiFile { fileName } { set channel [open $fileName RDONLY] makeAsciiChannel $channel set result [read $channel] close $channel return $result } # # NOTE: This procedure writes all data to the specified ASCII file and # returns an empty string. Previous data contained in the file, # if any, is lost. # proc writeAsciiFile { fileName data } { set channel [open $fileName {WRONLY CREAT TRUNC}] makeAsciiChannel $channel puts -nonewline $channel $data close $channel return "" } # # NOTE: This procedure reconfigures the specified channel to full Unicode # mode. # proc makeUnicodeChannel { channel } { fconfigure $channel -encoding unicode -translation auto; # UNICODE TEXT } # # NOTE: This procedure reads all data from the specified Unicode file and # returns it. # proc readUnicodeFile { fileName } { set channel [open $fileName RDONLY] makeUnicodeChannel $channel set result [read $channel] close $channel return $result } # # NOTE: This procedure writes all data to the specified Unicode file and # returns an empty string. Previous data contained in the file, # if any, is lost. # proc writeUnicodeFile { fileName data } { set channel [open $fileName {WRONLY CREAT TRUNC}] makeUnicodeChannel $channel puts -nonewline $channel $data close $channel return "" } # # NOTE: This procedure reconfigures the specified channel for use by the # logging subsystem. # proc makeLogChannel { channel } { set translation [expr {[isEagle] ? "protocol" : "auto"}] fconfigure $channel -encoding binary -translation $translation; # LOG DATA } # # NOTE: This procedure appends data to the specified log data file and # returns an empty string. Previous data contained in the file, # if any, is preserved. # proc appendLogFile { fileName data } { set channel [open $fileName {WRONLY CREAT APPEND}] makeLogChannel $channel puts -nonewline $channel $data close $channel return "" } # # NOTE: This procedure appends data to the specified shared log data # file and returns an empty string. Previous data contained in # the file, if any, is preserved. # proc appendSharedLogFile { fileName data } { set command [list open $fileName {WRONLY CREAT APPEND}] # # HACK: Tcl appears to do this by default; however Eagle does not and # will not. Therefore, manually add the -share option to the # command if running in Eagle. # if {[isEagle]} then { lappend command 0 file -share readWrite } # # NOTE: Open the file using the command constructed above, configure # the channel for binary data, and output the data to it. # set channel [eval $command] makeLogChannel $channel puts -nonewline $channel $data; flush $channel close $channel return "" } # # NOTE: This procedure reads all data from the specified shared binary # file and returns it. # proc readSharedFile { fileName } { set command [list open $fileName RDONLY] # # HACK: Tcl appears to do this by default; however Eagle does not and # will not. Therefore, manually add the -share option to the # command if running in Eagle. # if {[isEagle]} then { lappend command 0 file -share readWrite } # # NOTE: Open the file using the command constructed above, configure # the channel for binary data, and output the data to it. # set channel [eval $command] makeBinaryChannel $channel set result [read $channel] close $channel return $result } # # NOTE: This procedure appends data to the specified shared binary file # and returns an empty string. Previous data contained in the # file, if any, is preserved. # proc appendSharedFile { fileName data } { # # NOTE: This should work properly in both Tcl and Eagle. # set command [list open $fileName {WRONLY CREAT APPEND}] # # HACK: Tcl appears to do this by default; however Eagle does not and # will not. Therefore, manually add the -share option to the # command if running in Eagle. # if {[isEagle]} then { lappend command 0 file -share readWrite } # # NOTE: Open the file using the command constructed above, configure # the channel for binary data, and output the data to it. # set channel [eval $command] makeBinaryChannel $channel puts -nonewline $channel $data; flush $channel close $channel return "" } # # NOTE: Provide the Eagle "file types" package to the interpreter. # package provide Eagle.File.Types \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/file3.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 | ############################################################################### # # file3.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle File 3 Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure uses the type of the specified path to figure out # the (possibly normalized) path to add to the finder results. # proc getDirResultPath { pattern path } { # # NOTE: This should work properly in both Tcl and Eagle. # Is the result path itself already absolute? # if {[file pathtype $path] eq "absolute"} then { # # NOTE: Ok, the result path is already absolute. # Normalize and return it. # return [file normalize $path] } elseif {[file pathtype $pattern] eq "absolute"} then { # # NOTE: The pattern refers to an absolute path. Strip # the final part of the pattern and join it with # the result path (which we already know is not # absolute). # return [file normalize [file join [file dirname $pattern] $path]] } else { # # NOTE: Neither the result path nor the input pattern # contain an absolute path; therefore, use the # current directory to hang the result path on. # return [file normalize [file join [pwd] $path]] } } # # NOTE: This procedure returns a list of directories matching the pattern # specified. It does not recurse into sub-directories. # proc findDirectories { pattern } { if {[isEagle]} then { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Eagle only. # set dir ""; set result [list] # # HACK: Optimize the variable access in this procedure to be # as fast as possible. # makeVariableFast dir true; makeVariableFast result true # # NOTE: We will need to grab the ComSpec environment variable. # global env foreach dir [split [exec -unicode $env(ComSpec) /u /c dir \ /ad /b [appendArgs \" [file nativename $pattern] \"]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] if {[lsearch -variable -exact -nocase result $dir] == -1} then { lappend result $dir } } } foreach dir [split [exec -unicode $env(ComSpec) /u /c dir \ /ahd /b [appendArgs \" [file nativename $pattern] \"]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] if {[lsearch -variable -exact -nocase result $dir] == -1} then { lappend result $dir } } } return $result } else { # # NOTE: This should work properly in Tcl only. # eval lappend result [glob -nocomplain -types {d} \ [file normalize $pattern]] eval lappend result [glob -nocomplain -types {d hidden} \ [file normalize $pattern]] return $result } } # # NOTE: This procedure returns a list of directories matching the pattern # specified. It recurses into sub-directories. # proc findDirectoriesRecursive { pattern } { if {[isEagle]} then { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Eagle only. # set dir ""; set result [list] # # HACK: Optimize the variable access in this procedure to be # as fast as possible. # makeVariableFast dir true; makeVariableFast result true # # NOTE: We will need to grab the ComSpec environment variable. # global env foreach dir [split [exec -unicode $env(ComSpec) /u /c dir \ /ad /s /b [appendArgs \" [file nativename $pattern] \"]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] if {[lsearch -variable -exact -nocase result $dir] == -1} then { lappend result $dir } } } foreach dir [split [exec -unicode $env(ComSpec) /u /c dir \ /ahd /s /b [appendArgs \" [file nativename $pattern] \"]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] if {[lsearch -variable -exact -nocase result $dir] == -1} then { lappend result $dir } } } return $result } else { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Tcl only. # set result [list] # # NOTE: We will need to grab the ComSpec environment variable. # global env # # NOTE: We will also need to check the Tcl version. # global tcl_version catch { foreach dir [split [exec $env(ComSpec) /c dir /ad /s /b \ [file nativename $pattern]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] # # HACK: The -nocase option to [lsearch] is only available # starting with Tcl 8.5. # if {$tcl_version >= 8.5} then { if {[lsearch -exact -nocase $result $dir] == -1} then { lappend result $dir } } else { if {[lsearch -exact [string tolower $result] \ [string tolower $dir]] == -1} then { lappend result $dir } } } } } catch { foreach dir [split [exec $env(ComSpec) /c dir /ahd /s /b \ [file nativename $pattern]] \n] { set dir [string trim $dir] if {[string length $dir] > 0} then { set dir [getDirResultPath $pattern $dir] # # HACK: The -nocase option to [lsearch] is only available # starting with Tcl 8.5. # if {$tcl_version >= 8.5} then { if {[lsearch -exact -nocase $result $dir] == -1} then { lappend result $dir } } else { if {[lsearch -exact [string tolower $result] \ [string tolower $dir]] == -1} then { lappend result $dir } } } } } return $result } } # # NOTE: This procedure returns a list of files matching the pattern # specified. It does not recurse into sub-directories. # proc findFiles { pattern } { if {[isEagle]} then { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Eagle only. # set fileName ""; set result [list] # # HACK: Optimize the variable access in this procedure to be # as fast as possible. # makeVariableFast fileName true; makeVariableFast result true # # NOTE: We will need to grab the ComSpec environment variable. # global env foreach fileName [split [exec -unicode $env(ComSpec) /u /c dir \ /a-d /b [appendArgs \" [file nativename $pattern] \"]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] if {[lsearch -variable -exact -nocase result $fileName] == -1} then { lappend result $fileName } } } foreach fileName [split [exec -unicode $env(ComSpec) /u /c dir \ /ah-d /b [appendArgs \" [file nativename $pattern] \"]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] if {[lsearch -variable -exact -nocase result $fileName] == -1} then { lappend result $fileName } } } return $result } else { # # NOTE: This should work properly in Tcl only. # eval lappend result [glob -nocomplain -types {f} \ [file normalize $pattern]] eval lappend result [glob -nocomplain -types {f hidden} \ [file normalize $pattern]] return $result } } # # NOTE: This procedure returns a list of files matching the pattern # specified. It recurses into sub-directories. # proc findFilesRecursive { pattern } { if {[isEagle]} then { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Eagle only. # set fileName ""; set result [list] # # HACK: Optimize the variable access in this procedure to be # as fast as possible. # makeVariableFast fileName true; makeVariableFast result true # # NOTE: We will need to grab the ComSpec environment variable. # global env foreach fileName [split [exec -unicode $env(ComSpec) /u /c dir \ /a-d /s /b [appendArgs \" [file nativename $pattern] \"]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] if {[lsearch -variable -exact -nocase result $fileName] == -1} then { lappend result $fileName } } } foreach fileName [split [exec -unicode $env(ComSpec) /u /c dir \ /ah-d /s /b [appendArgs \" [file nativename $pattern] \"]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] if {[lsearch -variable -exact -nocase result $fileName] == -1} then { lappend result $fileName } } } return $result } else { # # NOTE: Block non-Windows platforms since this is Windows specific. # if {![isWindows]} then { error "not supported on this operating system" } # # NOTE: This should work properly in Tcl only. # set result [list] # # NOTE: We will need to grab the ComSpec environment variable. # global env # # NOTE: We will also need to check the Tcl version. # global tcl_version catch { foreach fileName [split [exec $env(ComSpec) /c dir /a-d /s /b \ [file nativename $pattern]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] # # HACK: The -nocase option to [lsearch] is only available # starting with Tcl 8.5. # if {$tcl_version >= 8.5} then { if {[lsearch -exact -nocase $result $fileName] == -1} then { lappend result $fileName } } else { if {[lsearch -exact [string tolower $result] \ [string tolower $fileName]] == -1} then { lappend result $fileName } } } } } catch { foreach fileName [split [exec $env(ComSpec) /c dir /ah-d /s /b \ [file nativename $pattern]] \n] { set fileName [string trim $fileName] if {[string length $fileName] > 0} then { set fileName [getDirResultPath $pattern $fileName] # # HACK: The -nocase option to [lsearch] is only available # starting with Tcl 8.5. # if {$tcl_version >= 8.5} then { if {[lsearch -exact -nocase $result $fileName] == -1} then { lappend result $fileName } } else { if {[lsearch -exact [string tolower $result] \ [string tolower $fileName]] == -1} then { lappend result $fileName } } } } } return $result } } # # NOTE: Provide the Eagle "file finder" package to the interpreter. # package provide Eagle.File.Finder \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/info.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 | ############################################################################### # # info.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Information Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns the list of options that were used when # compiling the Eagle core library. # proc getCompileInfo {} { # # NOTE: Return the important compile-time information for use by the # setup or other callers. # return [expr {[isEagle] ? [lappend result \ TimeStamp $::eagle_platform(timeStamp) \ ImageRuntimeVersion $::eagle_platform(imageRuntimeVersion) \ ModuleVersionId $::eagle_platform(moduleVersionId) \ CompileOptions $::eagle_platform(compileOptions)] : ""}] } # # NOTE: This procedure returns the specified Eagle platform information, # if available; otherwise a default value is returned instead. # proc getPlatformInfo { name {default ""} } { # # NOTE: Return the important platform information for use by the test # suite or other callers. # return [expr {[isEagle] && [info exists ::eagle_platform($name)] && \ [string length [string trim $::eagle_platform($name)]] > 0 ? \ $::eagle_platform($name) : $default}] } # # NOTE: This procedure returns the name of the first loaded plugin that # matches the specified pattern. # proc getPluginName { pattern } { # # NOTE: This should work properly in both Tcl and Eagle. # foreach loaded [info loaded] { if {[regexp -- $pattern [lindex $loaded end]]} then { return [lindex $loaded 1] } } return "" } # # NOTE: This procedure returns the fully qualified file name of the first # loaded plugin that matches the specified pattern. # proc getPluginPath { pattern } { # # NOTE: This should work properly in both Tcl and Eagle. # foreach loaded [info loaded] { if {[regexp -- $pattern [lindex $loaded end]]} then { return [lindex $loaded 0] } } return "" } # # NOTE: This procedure returns the Eagle core library base path, e.g. a # value like "C:\Eagle" when loaded from "C:\Eagle\bin\Eagle.dll". # proc getBasePath {} { set assembly [object invoke -flags +NonPublic \ Eagle._Components.Private.GlobalState GetAssembly] return [object invoke -flags +NonPublic \ Eagle._Components.Private.PathOps GetBasePath $assembly \ [file dirname [lindex [info assembly] 1]]] } # # NOTE: This procedure returns the flags for the first loaded plugin that # matches the specified pattern. # proc getPluginFlags { pattern } { foreach loaded [info loaded] { set plugin [lindex $loaded end] if {[regexp -- $pattern $plugin]} then { return [string map [list , " "] \ [getDictionaryValue [info plugin $plugin] flags]] } } return [list] } # # NOTE: This procedure returns non-zero if the Eagle Native Package for # Tcl (Garuda) is loaded into the primary native Tcl interpreter. # proc haveGaruda { {varName ""} } { # # NOTE: Check for a variable name to place the Garuda package Id into. # if {[string length $varName] > 0} then { upvar 1 $varName packageId } # # NOTE: Is the Eagle Package for Tcl (Garuda) available? This check # is different in Eagle and Tcl. # if {[isEagle]} then { return [expr {[llength [info commands tcl]] > 0 && [tcl ready] && \ [catch {tcl eval [tcl master] {package present Garuda}}] == 0 && \ [catch {tcl eval [tcl master] {garuda packageid}} packageId] == 0}] } else { return [expr {[catch {package present Garuda}] == 0 && \ [catch {garuda packageid} packageId] == 0}] } } # # NOTE: This procedure returns non-zero if the specified name represents # a thread managed by the native Tcl integration subsystem of Eagle. # proc isTclThread { name } { # # NOTE: For now, this check only works in Eagle. # set result false if {[isEagle]} then { catch { if {[llength [info commands tcl]] > 0 && [tcl ready] && \ [lsearch -exact -- [tcl threads] $name] != -1} then { # # NOTE: The name specified by the caller appears in the # list of Tcl threads for this Eagle interpreter. # set result true } } } return $result } # # NOTE: Provide the Eagle "info" package to the interpreter. # package provide Eagle.Information \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
1 2 3 4 5 | ############################################################################### # # init.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | > > > | < < < < < < < < | < < < < < < < < < < < | < < < < < < < | < < < < < < < < < < < < < | < < < < < | < < < < | < < < < < < < | < < | | < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < | < < < < | < < < | < < | < < | < < < | < | < < < < < < | < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | < | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < | < < < < < | < < < < < < < < | < < < < < < < < < | < | < < < | < < < < < < < < | | < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < | | < < < < < | | < < | < < < < < < < | | < < < < < < < | < < < < < < < < < < < | < < < < < < < < < < < < < < < | | < | | < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < | | < < < < | < < < < < < | < < < < < | < < < < < | < < < < < < < < < < < < < < | < < < < < < | < < < < < < < < < < < < | < < < < < < | < < < < < | < < < < < < < | < < < < < < | < < | < < | < < < < < | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < | < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < | < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < | < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | < < < < < < < < < < | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | | < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | < < < < < < < | < < < < < < < < < < < < | < < < < | < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > | | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 | ############################################################################### # # init.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Interpreter Initialization File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This is the procedure that detects whether or not we are # running in Eagle (otherwise, we are running in vanilla Tcl). # This procedure must function correctly in both Tcl and Eagle # and must return non-zero only when running in Eagle. This # procedure must be defined in this script file because it is # needed while this script file is being evaluated. # # <bootstrap> proc isEagle {} { # # NOTE: Nothing too fancy or expensive should be done in here. In # theory, use of this routine should be rare; however, in # practice, this routine is actually used quite a bit (e.g. # by the test suite). # return [expr {[info exists ::tcl_platform(engine)] && \ [string compare -nocase eagle $::tcl_platform(engine)] == 0}] } # # NOTE: This procedure is designed to "load" (i.e. [source]) other script # files that logically belong to the package defined in this script # file. Upon success, an empty string will be returned. A script # error may be raised. This should work properly in both Tcl and # Eagle. This procedure must be defined in this script file because # it is needed while this script file is being evaluated. # # <bootstrap> proc loadScripts { directory fileNamesOnly } { # # NOTE: Does the directory specified by the caller contain information # useful in locating the script file? # if {[string length $directory] == 0 || $directory eq "."} then { # # NOTE: The directory specified by the caller contains no useful # information, use the Tcl library directory instead, if # possible. # if {[info exists ::tcl_library] && \ [string length $::tcl_library] > 0 && \ [file isdirectory $::tcl_library]} then { # # NOTE: Ok, use the Tcl library directory. # set directory $::tcl_library } } # # NOTE: Start out with the [source] command. # set baseCommand source # # NOTE: When using Eagle, use the -withinfo option to preserve the # location information for procedures defined in the specified # script file. # if {[isEagle]} then { lappend baseCommand -withinfo true -- } # # NOTE: Load each script file specified by the caller, in the exact # order they were specified. # foreach fileNameOnly $fileNamesOnly { # # NOTE: Start with the base [source] command, maybe with some # options. # set fileCommand $baseCommand # # NOTE: Add the qualified file name, which may or may not be fully # qualified. # lappend fileCommand [file join $directory $fileNameOnly] # # NOTE: Evaluate the resulting command in the callers context. # uplevel 1 $fileCommand } # # NOTE: Success, return an empty string. # return "" } if {![interp issafe]} then { # # NOTE: Load the extra script library files that contain commonly used # procedures that are shared between native Tcl and Eagle. # loadScripts [file dirname [info script]] [list \ auxiliary.eagle database.eagle exec.eagle file1.eagle \ file2.eagle file3.eagle info.eagle list.eagle \ platform.eagle testlog.eagle] # # NOTE: Load the extra script library files that contain procedures that # require a specific language (i.e. either native Tcl or Eagle). # if {[isEagle]} then { loadScripts [file dirname [info script]] [list \ compat.eagle csharp.eagle object.eagle process.eagle \ runopt.eagle unkobj.eagle update.eagle] } else { loadScripts [file dirname [info script]] [list shim.eagle] } } if {[isEagle]} then { ########################################################################### ############################ BEGIN Eagle ONLY ############################# ########################################################################### # # NOTE: This procedure uses the [source] command to evaluate a script # file while preserving the location information for procedures # defined with it. # # <pkgIndex> proc sourceWithInfo { args } { catch { set savedCacheFlags None object invoke -flags +NonPublic Interpreter.GetActive \ BeginNoArgumentCache savedCacheFlags } try { catch { set savedInterpreterFlags None object invoke -flags +NonPublic Interpreter.GetActive \ BeginArgumentLocation savedInterpreterFlags } try { set command [list source]; eval lappend command $args return [uplevel 1 $command] } finally { catch { object invoke -flags +NonPublic Interpreter.GetActive \ EndArgumentLocation savedInterpreterFlags } } } finally { catch { object invoke -flags +NonPublic Interpreter.GetActive \ EndNoArgumentCache savedCacheFlags } } } # # NOTE: This is the [unknown] command for Eagle. It will normally be # executed by the script engine when a command is not found. # By default, it will simply raise a script error; however, if # the "eagleUnknownObjectInvoke" runtime option is set, it will # first attempt to use the (unknown) command name as the name # of a CLR type. # # <create> proc unknown { name args } { # # NOTE: This is an [unknown] procedure that normally produces an # appropriate error message; however, it can optionally try # to invoke a static object method. # # TODO: Add support for auto-loading packages here in the future? # if {[llength [info commands hasRuntimeOption]] > 0 && \ [hasRuntimeOption eagleUnknownObjectInvoke] && \ [llength [info commands object]] > 0 && \ [llength [info commands unknownObjectInvoke]] > 0} then { # # NOTE: In the context of the caller, attempt to invoke a static # object method using the specified arguments (which may # contain variable names). # if {[catch { eval unknownObjectInvoke 1 [list $name] $args |
︙ | ︙ | |||
2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 | return -code error $result } } return -code error [appendArgs "invalid command name \"" $name \"] } namespace eval ::tcl::tm { # # NOTE: Ideally, this procedure should be created in the "::tcl::tm" # namespace. # proc ::tcl::tm::UnknownHandler { original name args } { # # NOTE: Do nothing except call the original handler. # uplevel 1 $original [::linsert $args 0 $name] } } proc tclPkgUnknown { name args } { # # NOTE: Force a rescan of "pkgIndex" files. This must be done in # the global scope so that the special global variable 'dir' # set by the package index loading subsystem can be accessed. # uplevel #0 [list package scan -host -normal -refresh] } | > > > > > > > > > > > > < | | > > | < < | > > > > > > < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > | | | > | | > | | > | | | > | < > | | 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 | return -code error $result } } return -code error [appendArgs "invalid command name \"" $name \"] } # # NOTE: This namespace and the procedure defined within it are used for # compatibility with native Tcl. # namespace eval ::tcl::tm { # # NOTE: Ideally, this procedure should be created in the "::tcl::tm" # namespace. # # <create> proc ::tcl::tm::UnknownHandler { original name args } { # # NOTE: Do nothing except call the original handler. # uplevel 1 $original [::linsert $args 0 $name] } } # # NOTE: This procedure is normally executed by the package management # subsystem of Eagle when a package is requested that cannot be # found. By default, it will force a scan of all known package # indexes. # # <create> proc tclPkgUnknown { name args } { # # NOTE: Force a rescan of "pkgIndex" files. This must be done in # the global scope so that the special global variable 'dir' # set by the package index loading subsystem can be accessed. # uplevel #0 [list package scan -host -normal -refresh] } # # NOTE: This procedure marks a procedure for "fast" execution; for now, # this means disabling anything that makes variable access slower # while the target procedure is executing. # # <experimental> proc makeProcedureFast { name fast } { # # NOTE: This should work properly in Eagle only. # catch { uplevel 1 [list object invoke -flags +NonPublic \ Interpreter.GetActive MakeProcedureFast $name $fast] } } # # NOTE: This procedure marks a variable for "fast" access; for now, this # means disabling anything that makes variable access slower while # the target variable is being read, set, or unset. # # <experimental> proc makeVariableFast { name fast } { # # NOTE: This should work properly in Eagle only. # catch { uplevel 1 [list object invoke -flags +NonPublic \ Interpreter.GetActive MakeVariableFast $name $fast] } } # # NOTE: Add script library files borrowed from native Tcl. # if {![interp issafe]} then { loadScripts [file dirname [info script]] [list word.tcl] } ########################################################################### ############################# END Eagle ONLY ############################## ########################################################################### } else { ########################################################################### ############################# BEGIN Tcl ONLY ############################## ########################################################################### # # NOTE: Exports the necessary commands from this package and import them # into the global namespace. # if {[llength [info commands exportAndImportPackageCommands]] > 0} then { exportAndImportPackageCommands [namespace current] [list \ isEagle loadScripts isWindows isInteractive haveGaruda \ isTclThread isMono isSameFileName getEnvironmentVariable \ combineFlags getCompileInfo getPlatformInfo getPluginName \ getPluginPath appendArgs lappendArgs getDictionaryValue \ getColumnValue getRowColumnValue tqputs tqlog \ makeBinaryChannel makeAsciiChannel makeUnicodeChannel \ makeLogChannel readFile readSharedFile writeFile appendFile \ appendLogFile appendSharedFile appendSharedLogFile \ readAsciiFile writeAsciiFile readUnicodeFile \ writeUnicodeFile getDirResultPath addToPath removeFromPath \ execShell lshuffle ldifference filter map reduce \ getLengthModifier debug findDirectories \ findDirectoriesRecursive findFiles findFilesRecursive \ exportAndImportPackageCommands] false false } ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle "library" package to the interpreter. # package provide Eagle.Library \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/list.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | ############################################################################### # # list.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle List Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure appends all of its arguments as list elements and # returns the resulting list. # proc lappendArgs { args } { # # NOTE: This should work properly in both Tcl and Eagle. # set result [list]; eval lappend result $args } # # NOTE: This procedure pseudo-randomly shuffles the specified list value # and returns the resulting list. # proc lshuffle { list } { # # NOTE: This code for this algorithm was stolen from the Tcl library # struct package and modified to conform with the Eagle style # guide. # set result $list for {set length [llength $result]} \ {$length > 1} {lset result $index $element} { set index [expr {int(rand() * $length)}] set element [lindex $result [incr length -1]] lset result $length [lindex $result $index] } return $result } # # NOTE: This procedure returns a list of elements that are present in the # first list argument and missing from the second list argument -AND- # elements that are present in the second list argument and missing # from the first list argument. # proc ldifference { list1 list2 } { set result [list] foreach element $list1 { if {[lsearch -exact $list2 $element] == -1} then { lappend result $element } } foreach element $list2 { if {[lsearch -exact $list1 $element] == -1} then { lappend result $element } } return $result } # # NOTE: This procedure returns a list of elements from the specified list # that cause the specified script to return non-zero. # proc filter { list script } { set result [list] foreach item $list { if {[uplevel 1 $script [list $item]]} then { lappend result $item } } return $result } # # NOTE: This procedure returns a list of elements from the specified list, # each one having possibly been transformed by the specified script. # proc map { list script } { set result [list] foreach item $list { lappend result [uplevel 1 $script [list $item]] } return $result } # # NOTE: This procedure returns a value that is determined by evaluating the # specified script against the result value produced so far and each # element of the specified list. # proc reduce { list script } { set result "" foreach item $list { set result [uplevel 1 $script [list $result] [list $item]] } return $result } # # NOTE: Provide the Eagle "list" package to the interpreter. # package provide Eagle.List \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/object.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | ############################################################################### # # object.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Object Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure accepts two arguments containing the flag string # that are based on an enumerated CLR type. Flag values that are # contained in these two arguments are combined and returned as # the result. The third flag string argument contains the flags # to exclude from the result. # proc combineFlags { flags1 flags2 {flags3 ""} {noCase false} } { # # NOTE: This should work properly in both Tcl and Eagle. # set result [list] set notFlags [list] if {[string length $flags3] > 0} then { foreach flag [split $flags3 ", "] { set flag [string trim $flag] if {[string length $flag] > 0} then { lappend notFlags $flag } } } foreach flags [list $flags1 $flags2] { foreach flag [split $flags ", "] { set flag [string trim $flag] if {[string length $flag] > 0} then { set addFlag false if {[llength $notFlags] > 0} then { set command [list lsearch -exact] if {$noCase} then { lappend command -nocase } lappend command -- $notFlags $flag if {[eval $command] == -1} then { set addFlag true } } else { set addFlag true } if {$addFlag} then { lappend result $flag } } } } return [join $result ,] } # # NOTE: This procedure returns the type name of the return type for the # specified CLR member. # proc getReturnType { object member } { if {[string length $object] == 0} then { return "" } if {[string length $member] == 0} then { return "" } set code [catch { object foreach -alias memberInfo \ [object invoke -noinvoke $object $member] { # # NOTE: Use the member type to determine which property contains # the type information we want to return. # switch -exact -- [$memberInfo MemberType] { Field { return [$memberInfo FieldType.AssemblyQualifiedName] } Method { return [$memberInfo ReturnType.AssemblyQualifiedName] } Property { return [$memberInfo PropertyType.AssemblyQualifiedName] } default { return "" } } } } result] # # NOTE: If no error was raised above, return the result; otherwise, # return an empty string to indicate a general failure. # return [expr {$code == 2 ? $result : ""}] } # # NOTE: This procedure returns the default value for the specified CLR type. # proc getDefaultValue { typeName } { if {[llength [info commands object]] == 0} then { return "" } if {[string length $typeName] == 0} then { return "" } set type [object invoke -create -alias Type GetType $typeName] if {[string length $type] == 0} then { return "" } return [expr {[$type IsValueType] ? 0 : "null"}] } # # NOTE: This procedure returns a string obtained by using the specified # value as an opaque object handle -OR- a default value (e.g. an # empty string) if the value is not a valid opaque object handle. # proc getStringFromObjectHandle { value {default ""} } { if {[isObjectHandle $value]} then { return [object invoke $value ToString] } if {[string length $default] > 0} then { return $default } return $value } # # NOTE: This procedure returns non-zero if the specified value can be used # as an opaque object handle. # proc isObjectHandle { value } { set pattern [string map [list \\ \\\\ \[ \\\[ \] \\\]] $value] set objects [info objects $pattern] if {[llength $objects] == 1 && [lindex $objects 0] eq $value} then { return true } return false } # # NOTE: This procedure returns non-zero if the specified name represents # a valid CLR type name. # proc isManagedType { name } { if {[llength [info commands object]] > 0} then { if {![isObjectHandle $name]} then { if {[catch { object members -matchnameonly -nameonly -pattern Equals $name } result] == 0 && $result eq "Equals"} then { return true } } } return false } # # NOTE: This procedure returns non-zero if the specified name is usable # as a CLR type name. # proc canGetManagedType { name {varName ""} } { if {[llength [info commands object]] > 0} then { if {![isObjectHandle $name]} then { set cultureInfo [object invoke Interpreter.GetActive CultureInfo] set type null set code [object invoke -create -alias -flags +NonPublic \ Value GetType "" $name null null None $cultureInfo type] if {[$code ToString] eq "Ok"} then { if {[string length $varName] > 0} then { upvar 1 $varName typeName } set typeName [$type AssemblyQualifiedName] if {[isManagedType $typeName]} then { return true } } } } return false } # # NOTE: Provide the Eagle "object" package to the interpreter. # package provide Eagle.Object \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/pkgIndex.eagle.
︙ | ︙ | |||
13 14 15 16 17 18 19 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {![package vsatisfies [package provide Eagle] 1.0]} {return} | > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > | > > | > > > > > | > > > > > > > > | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {![package vsatisfies [package provide Eagle] 1.0]} {return} package ifneeded Eagle.Auxiliary 1.0 \ [list sourceWithInfo [file join $dir auxiliary.eagle]] package ifneeded Eagle.Tcl.Compatibility 1.0 \ [list sourceWithInfo [file join $dir compat.eagle]] package ifneeded Eagle.CSharp 1.0 \ [list sourceWithInfo [file join $dir csharp.eagle]] package ifneeded Eagle.Database 1.0 \ [list sourceWithInfo [file join $dir database.eagle]] package ifneeded Eagle.Execute 1.0 \ [list sourceWithInfo [file join $dir exec.eagle]] package ifneeded Eagle.File 1.0 \ [list sourceWithInfo [file join $dir file1.eagle]] package ifneeded Eagle.File.Types 1.0 \ [list sourceWithInfo [file join $dir file2.eagle]] package ifneeded Eagle.File.Finder 1.0 \ [list sourceWithInfo [file join $dir file3.eagle]] package ifneeded Eagle.Information 1.0 \ [list sourceWithInfo [file join $dir info.eagle]] package ifneeded Eagle.Library 1.0 \ [list sourceWithInfo [file join $dir init.eagle]] package ifneeded Eagle.List 1.0 \ [list sourceWithInfo [file join $dir list.eagle]] package ifneeded Eagle.Object 1.0 \ [list sourceWithInfo [file join $dir object.eagle]] package ifneeded Eagle.Platform 1.0 \ [list sourceWithInfo [file join $dir platform.eagle]] package ifneeded Eagle.Process 1.0 \ [list sourceWithInfo [file join $dir process.eagle]] package ifneeded Eagle.Runtime.Option 1.0 \ [list sourceWithInfo [file join $dir runopt.eagle]] package ifneeded Eagle.Safe 1.0 \ [list sourceWithInfo [file join $dir safe.eagle]] package ifneeded Eagle.Shell 1.0 \ [list sourceWithInfo [file join $dir shell.eagle]] package ifneeded Eagle.Tcl.Shim 1.0 \ [list sourceWithInfo [file join $dir shim.eagle]] package ifneeded Eagle.Test 1.0 \ [list sourceWithInfo [file join $dir test.eagle]] package ifneeded Eagle.Test.Log 1.0 \ [list sourceWithInfo [file join $dir testlog.eagle]] package ifneeded Eagle.Unknown.Object 1.0 \ [list sourceWithInfo [file join $dir unkobj.eagle]] package ifneeded Eagle.Update 1.0 \ [list sourceWithInfo [file join $dir update.eagle]] |
Changes to Externals/Eagle/lib/Eagle1.0/pkgIndex.tcl.
︙ | ︙ | |||
13 14 15 16 17 18 19 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {[string length [package provide Eagle]] > 0} then {return} | > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > > > > > > > > > > > > > > > | > > | > > > > > | > | > > > > > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {[string length [package provide Eagle]] > 0} then {return} package ifneeded Eagle.Auxiliary 1.0 \ [list source [file join $dir auxiliary.eagle]] package ifneeded Eagle.Tcl.Compatibility 1.0 \ [list source [file join $dir compat.eagle]] package ifneeded Eagle.CSharp 1.0 \ [list source [file join $dir csharp.eagle]] package ifneeded Eagle.Database 1.0 \ [list source [file join $dir database.eagle]] package ifneeded Eagle.Execute 1.0 \ [list source [file join $dir exec.eagle]] package ifneeded Eagle.File 1.0 \ [list source [file join $dir file1.eagle]] package ifneeded Eagle.File.Types 1.0 \ [list source [file join $dir file2.eagle]] package ifneeded Eagle.File.Finder 1.0 \ [list source [file join $dir file3.eagle]] package ifneeded Eagle.Information 1.0 \ [list source [file join $dir info.eagle]] package ifneeded Eagle.Library 1.0 \ [list source [file join $dir init.eagle]] package ifneeded Eagle.List 1.0 \ [list source [file join $dir list.eagle]] package ifneeded Eagle.Object 1.0 \ [list source [file join $dir object.eagle]] package ifneeded Eagle.Platform 1.0 \ [list source [file join $dir platform.eagle]] package ifneeded Eagle.Process 1.0 \ [list source [file join $dir process.eagle]] package ifneeded Eagle.Runtime.Option 1.0 \ [list source [file join $dir runopt.eagle]] package ifneeded Eagle.Safe 1.0 \ [list source [file join $dir safe.eagle]] package ifneeded Eagle.Shell 1.0 \ [list source [file join $dir shell.eagle]] package ifneeded Eagle.Tcl.Shim 1.0 \ [list source [file join $dir shim.eagle]] package ifneeded Eagle.Test 1.0 \ [list source [file join $dir test.eagle]] package ifneeded Eagle.Test.Log 1.0 \ [list source [file join $dir testlog.eagle]] package ifneeded Eagle.Unknown.Object 1.0 \ [list source [file join $dir unkobj.eagle]] package ifneeded Eagle.Update 1.0 \ [list source [file join $dir update.eagle]] |
Added Externals/Eagle/lib/Eagle1.0/platform.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 | ############################################################################### # # platform.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Platform Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This is the procedure that detects whether or not we are running # in Eagle (otherwise, it is assumed that we are running in vanilla # Tcl). This procedure must work correctly in both Tcl and Eagle # and must return non-zero only when running in Eagle. # proc isEagle {} { # # NOTE: Nothing too fancy or expensive should be done here. In theory, # use of this procedure should be rare; however, in practice, this # procedure is actually used quite a bit (e.g. by the test suite). # return [expr {[info exists ::tcl_platform(engine)] && \ [string compare -nocase eagle $::tcl_platform(engine)] == 0}] } # # NOTE: This is the procedure that detects whether or not we are running # in Eagle on Mono (otherwise, we are running in Tcl or in Eagle on # the .NET Framework). This procedure must function correctly in # both Tcl and Eagle and must return non-zero only when running in # Eagle on Mono. # proc isMono {} { # # NOTE: Nothing too fancy or expensive should be done here. In theory, # use of this procedure should be rare; however, in practice, this # procedure is actually used quite a bit (e.g. by the test suite). # return [expr {[info exists ::eagle_platform(runtime)] && \ [string compare -nocase mono $::eagle_platform(runtime)] == 0}] } # # NOTE: This procedure returns non-zero if the logged on user has full # administrator rights on this machine. Currently, this only works # in Eagle; however, it may work from native Tcl in the future. # proc isAdministrator {} { return [expr {[info exists ::eagle_platform(administrator)] && \ $::eagle_platform(administrator)}] } # # NOTE: This is the procedure that detects whether or not we are running # on Windows (otherwise, it is assumed that we are running on some # flavor of Unix). This procedure must function correctly in both # Tcl and Eagle and must return non-zero only when on Windows. # proc isWindows {} { # # NOTE: Nothing too fancy or expensive should be done here. In theory, # use of this procedure should be rare; however, in practice, this # procedure is actually used quite a bit (e.g. by the test suite). # return [expr {[info exists ::tcl_platform(platform)] && \ $::tcl_platform(platform) eq "windows"}] } # # NOTE: This procedure should return non-zero if and only if only there # is currently an interactive user that can respond to prompts and # other requests for input. # proc isInteractive {} { # # TODO: Is something more complex required here? # return [expr {[info exists ::tcl_interactive] && $::tcl_interactive}] } # # NOTE: This procedure adds the specified directory to the PATH. It is # designed to work on the various flavors of Windows and Unix. # proc addToPath { dir } { global env global tcl_platform # # NOTE: This should work properly in both Tcl and Eagle. # Normalize to an operating system native path. # set dir [file nativename $dir] # # NOTE: On Windows, use PATH; otherwise (i.e. Unix), use # LD_LIBRARY_PATH. # if {[isWindows]} then { set name PATH } else { set name LD_LIBRARY_PATH } # # NOTE: Make sure the directory is not already in the # loader search path. # if {[info exists tcl_platform(pathSeparator)]} then { set separator $tcl_platform(pathSeparator) } elseif {[isWindows]} then { set separator \; } else { set separator : } # # NOTE: Does the necessary environment variable exist? # if {[info exists env($name)]} then { # # NOTE: Grab the value of the environment variable. # set value $env($name) # # BUGBUG: Consider exact case only for now. # if {[lsearch -exact [split $value $separator] $dir] == -1} then { # # NOTE: Append the directory to the loader search path. # This allows us to subsequently load DLLs that # implicitly attempt to load other DLLs that are # not in the application directory. # set env($name) [join [list $value $dir] $separator] # # NOTE: Yes, we altered the search path. # return true } } else { # # NOTE: Create the loader search path with the directory. # set env($name) $dir # # NOTE: Yes, we created the search path. # return true } # # NOTE: No, we did not alter the search path. # return false } # # NOTE: This procedure removes the specified directory from the PATH. # It is designed to work on the various flavors of Windows and # Unix. # proc removeFromPath { dir } { global env global tcl_platform # # NOTE: This should work properly in both Tcl and Eagle. # Normalize to an operating system native path. # set dir [file nativename $dir] # # NOTE: On Windows, use PATH; otherwise (i.e. Unix), use # LD_LIBRARY_PATH. # if {[isWindows]} then { set name PATH } else { set name LD_LIBRARY_PATH } # # NOTE: Make sure the directory is in the loader search # path. # if {[info exists tcl_platform(pathSeparator)]} then { set separator $tcl_platform(pathSeparator) } elseif {[isWindows]} then { set separator \; } else { set separator : } # # NOTE: Does the necessary environment variable exist? # if {[info exists env($name)]} then { # # NOTE: We need to separate the directories in the path # so that we can selectively remove the one we are # looking for. # set dirs [split $env($name) $separator] # # BUGBUG: Consider exact case only for now. # set index [lsearch -exact $dirs $dir] # # NOTE: Is the directory in the loader search path? # if {$index != -1} then { # # NOTE: Remove the directory from the loader search path. # set dirs [lreplace $dirs $index $index] # # NOTE: Replace the original loader search path with # our modified one. # set env($name) [join $dirs $separator] # # NOTE: Yes, we altered the search path. # return true } } # # NOTE: No, we did not alter the search path. # return false } # # NOTE: This procedure returns non-zero if the specified file names refer # to the same file, using the most robust method available for the # script engine and platform. # proc isSameFileName { fileName1 fileName2 } { if {[isEagle]} then { return [file same $fileName1 $fileName2] } else { if {[isWindows]} then { return [string equal -nocase $fileName1 $fileName2] } else { return [string equal $fileName1 $fileName2] } } } # # NOTE: Provide the Eagle "platform" package to the interpreter. # package provide Eagle.Platform \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/process.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | ############################################################################### # # process.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Process Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns a list of process Ids matching the specified # name -OR- all process Ids if the specified name is an empty string. # proc getProcesses { name } { # # NOTE: Start with an empty list of process Ids. # set result [list] # # NOTE: Are we able to actually query the active processes? # if {[llength [info commands object]] > 0} then { # # NOTE: Does the caller want processes matching a specific name # or all processes on the local machine? # if {[string length $name] > 0} then { # # NOTE: Get the managed array of processes with matching names. # set array [object invoke -alias System.Diagnostics.Process \ GetProcessesByName $name] } else { # # NOTE: Get the managed array of all processes on the local # machine. # set array [object invoke -alias System.Diagnostics.Process \ GetProcesses] } } else { # # NOTE: No, return nothing. # return $result } # # NOTE: For each process in the resulting array, grab the Id. # for {set index 0} {$index < [$array Length]} {incr index} { # # NOTE: Grab the Nth process array element value using the # accessor method. # set process [$array -alias GetValue $index] # # NOTE: Add the Id of the process to the result list. This # may fail on some versions of Mono. # if {[catch {$process Id} id] == 0} then { lappend result $id } # # NOTE: Get rid of the process object, we no longer need it. # Technically, it is not a requirement to explicitly # unset variables that contain object references; # however, it is useful in helping to document the # code. # unset process; # dispose } # # NOTE: Get rid of the managed array of processes, we no longer # need it. # unset array; # dispose # # NOTE: Return the list of process Ids, which may be empty. # return $result } # # NOTE: This procedure waits for the specified number of milliseconds for # processes with the specified Ids to exit (or be terminated). # proc waitForProcesses { ids timeout {collect true} } { # # NOTE: If requested, run the garbage collector now. This may be # necessary to successfully wait for processes that are being # kept alive via runtime callable wrappers for out-of-process # COM servers (e.g. Excel). # if {$collect} then { debug collect true true } # # NOTE: Wait for each process in the list to exit. # foreach id $ids { # # NOTE: Get the process object by its Id. If it does not exist, # this will raise an error. # set result [catch { set process [object invoke -alias System.Diagnostics.Process \ GetProcessById $id] }] # # NOTE: Were we able to grab the process object? # if {$result == 0 && [info exists process]} then { # # NOTE: Wait a while for the process to exit. # $process WaitForExit $timeout } # # NOTE: Get rid of the process (if we actually obtained it to # begin with). # unset -nocomplain process; # dispose } } # # NOTE: Provide the Eagle "process" package to the interpreter. # package provide Eagle.Process \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/runopt.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | ############################################################################### # # runopt.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Runtime Option Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns non-zero if the specified runtime option # is currently set. # proc hasRuntimeOption { name {default false} } { if {[llength [info commands debug]] > 0} then { if {[llength [info subcommands debug runtimeoption]] > 0} then { if {[catch {debug runtimeoption has $name} result] == 0} then { return $result } } } if {[llength [info commands object]] > 0} then { if {[catch { object invoke Interpreter.GetActive HasRuntimeOption $name } result] == 0} then { return $result } } return $default } # # NOTE: This procedure attempts to add the specified runtime option and # returns non-zero if it was actually added. # proc addRuntimeOption { name } { if {[llength [info commands debug]] > 0} then { if {[llength [info subcommands debug runtimeoption]] > 0} then { if {[catch {debug runtimeoption add $name} result] == 0} then { return $result } } } if {[llength [info commands object]] > 0} then { if {[catch { object invoke Interpreter.GetActive AddRuntimeOption $name } result] == 0} then { return $result } } return false } # # NOTE: This procedure attempts to remove the specified runtime option # and returns non-zero if it was actually removed. # proc removeRuntimeOption { name } { if {[llength [info commands debug]] > 0} then { if {[llength [info subcommands debug runtimeoption]] > 0} then { if {[catch {debug runtimeoption remove $name} result] == 0} then { return $result } } } if {[llength [info commands object]] > 0} then { if {[catch { object invoke Interpreter.GetActive RemoveRuntimeOption $name } result] == 0} then { return $result } } return false } # # NOTE: Provide the Eagle "runtime option" package to the interpreter. # package provide Eagle.Runtime.Option \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/safe.eagle.
1 2 3 4 5 | ############################################################################### # # safe.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | > > > > > > > > > | | > > > > > > > > > > > | < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | ############################################################################### # # safe.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Safe Interpreter Initialization File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This is the procedure that detects whether or not we are # running in Eagle (otherwise, we are running in vanilla Tcl). # This procedure must function correctly in both Tcl and Eagle # and must return non-zero only when running in Eagle. This # procedure must be defined in this script file because it is # needed while this script file is being evaluated. # # <bootstrap> proc isEagle {} { # # NOTE: Nothing too fancy or expensive should be done in here. In # theory, use of this routine should be rare; however, in # practice, this routine is actually used quite a bit (e.g. # by the test suite). # return [expr {[info exists ::tcl_platform(engine)] && \ [string compare -nocase eagle $::tcl_platform(engine)] == 0}] } if {[isEagle]} then { ########################################################################### ############################ BEGIN Eagle ONLY ############################# ########################################################################### # # NOTE: This is the [unknown] command for Eagle. It will normally be # executed by the script engine when a command is not found. # It will simply raise a script error. # # <create> proc unknown { name args } { # # NOTE: This is an [unknown] procedure that produces an appropriate # error message. # # TODO: Add support for auto-loading packages here in the future? # return -code error "invalid command name \"$name\"" } # # NOTE: This namespace and the procedure defined within it are used for # compatibility with native Tcl. # namespace eval ::tcl::tm { # # NOTE: Ideally, this procedure should be created in the "::tcl::tm" # namespace. # # <create> proc ::tcl::tm::UnknownHandler { original name args } { # # NOTE: Do nothing except call the original handler. # uplevel 1 $original [::linsert $args 0 $name] } } # # NOTE: This procedure is normally executed by the package management # subsystem of Eagle when a package is requested that cannot be # found. # # <create> proc tclPkgUnknown { name args } { # # NOTE: Do nothing since this is probably a safe interpreter. # return } ########################################################################### ############################# END Eagle ONLY ############################## ########################################################################### |
︙ | ︙ |
Changes to Externals/Eagle/lib/Eagle1.0/shell.eagle.
1 2 3 4 5 | ############################################################################### # # shell.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | ############################################################################### # # shell.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Shell Initialization File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ |
︙ | ︙ | |||
119 120 121 122 123 124 125 | ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 | ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle "shell" package to the interpreter. # package provide Eagle.Shell \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/shim.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 | ############################################################################### # # shim.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle [Native Tcl] Shim Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns the [format] modifier necessary to force # native Tcl to treat the specified value as a 64-bit integer. # proc getLengthModifier { value } { # # NOTE: This should work properly in both Tcl and Eagle. # return [expr {int($value) != wide($value) ? "l" : ""}] } # # NOTE: This procedure is used to intercept calls to the Eagle [debug] # command from native Tcl scripts (e.g. [debug break], etc). It # simply prints a diagnostic message. # proc debug { args } { # # NOTE: This should work properly in both Tcl and Eagle. # puts stdout [lrange $args 2 end] } # # NOTE: Provide the Eagle "Tcl shim" package to the interpreter. # package provide Eagle.Tcl.Shim \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
1 2 3 4 5 | ############################################################################### # # test.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | ############################################################################### # # test.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Test Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ |
︙ | ︙ | |||
316 317 318 319 320 321 322 | try { set code [catch { # # NOTE: First, make sure that the [after] event queue for the # interpreter is totally empty. # | | | 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 | try { set code [catch { # # NOTE: First, make sure that the [after] event queue for the # interpreter is totally empty. # catch {foreach id [after info] {after cancel $id}} # # NOTE: Schedule the event to cancel the script we are about to # evaluate, capturing the name so we can cancel it later, # if necessary. # set event [after $milliseconds [list interp cancel]] |
︙ | ︙ | |||
3334 3335 3336 3337 3338 3339 3340 | } return [catch { # # NOTE: First, make sure that the [after] event queue for the # interpreter is totally empty. # | | | 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 | } return [catch { # # NOTE: First, make sure that the [after] event queue for the # interpreter is totally empty. # catch {foreach id [after info] {after cancel $id}} # # NOTE: Schedule the event to cancel the script we are about to # evaluate, capturing the name so we can cancel it later, if # necessary. # set event [after $milliseconds [list interp cancel]] |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | addConstraint haveOrAddConstraint getConstraints removeConstraint \ fixConstraints fixTimingConstraints calculateBogoCops \ calculateRelativePerformance formatTimeStamp formatElapsedTime \ sourceIfValid processTestArguments getTclShellFileName \ getTemporaryPath getFiles getTestFiles getTestRunId getTestLogId \ getDefaultTestLog getTestLog getLastTestLog getTestSuite \ getTestMachine getTestPlatform getTestConfiguration getTestSuffix \ | | | | | | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 | addConstraint haveOrAddConstraint getConstraints removeConstraint \ fixConstraints fixTimingConstraints calculateBogoCops \ calculateRelativePerformance formatTimeStamp formatElapsedTime \ sourceIfValid processTestArguments getTclShellFileName \ getTemporaryPath getFiles getTestFiles getTestRunId getTestLogId \ getDefaultTestLog getTestLog getLastTestLog getTestSuite \ getTestMachine getTestPlatform getTestConfiguration getTestSuffix \ getTestUncountedLeaks getTestAssemblyName canTestExec testExec \ testClrExec execTestShell isRandomOrder isBreakOnLeak \ isStopOnFailure isStopOnLeak isExitOnComplete returnInfoScript \ runTestPrologue runTestEpilogue hookPuts unhookPuts runTest \ testDebugBreak testArrayGet testShim tsource recordTestStatistics \ reportTestStatistics formatList formatListAsDict pathToRegexp \ inverseLsearchGlob removePathFromFileNames formatDecimal \ clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \ getTestChannelOrDefault tryVerifyTestPath checkForAndSetTestPath \ configureTcltest machineToPlatform getPassPercentage \ getSkipPercentage] false false ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle "test" package to the interpreter. # package provide Eagle.Test \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/testlog.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | ############################################################################### # # testlog.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Test Log Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure emits a message to the specified channel and adds # it to the test log queue. # proc tqputs { channel string } { # # NOTE: If an output channel was provided, use it; otherwise, ignore # the message. # if {[string length $channel] > 0} then { puts -nonewline $channel $string } tqlog $string } # # NOTE: This procedure adds a message to the test log queue. It will be # written to the test log file the next time the [tlog] procedure # is called. If the [tlog] procedure is never called, then it will # never be written to the test log file. # proc tqlog { string } { # # NOTE: If an empty string is supplied by the caller, do nothing. # if {[string length $string] > 0} then { # # NOTE: *SPECIAL* The special global variable "test_log_queue" is used # by the [tlog] script library procedure from the test package to # enable it to emit "queued" data into the test log file prior to # emitting the string requested by its caller. The only job for # this procedure is to populate the "test_log_queue" variable for # later use by the test package. # if {[info exists ::test_log_queue]} then { # # NOTE: Use the next queued test log entry. # set entry [expr {[array size ::test_log_queue] + 1}] } else { # # NOTE: Use the first queued test log entry. # set entry 1 } # # NOTE: Add the new entry to the test log queue. All entries will be # sent to the actual test log file the very next time the [tlog] # command from the test package is executed. # set ::test_log_queue($entry) $string } return "" } # # NOTE: Provide the Eagle "test log" package to the interpreter. # package provide Eagle.Test.Log \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/unkobj.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 | ############################################################################### # # unkobj.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Unknown Object Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This is an [unknown] procedure that attempts to lookup the name # as a CLR type and then attempts to use [object invoke] with it, # merging options and arguments as necessary. # proc unknownObjectInvoke { level name args } { if {[llength [info commands object]] > 0 && \ ([isManagedType $name] || [canGetManagedType $name name])} then { # # NOTE: Get possible options for the [object invoke] sub-command. # set options [object invoke Utility GetInvokeOptions Invoke] # # NOTE: Create argument list for the artificial [object invoke] # alias. This always has two arguments. # set arguments1 [object create ArgumentList object invoke] # # NOTE: Create argument list for the entire command being handled. # There may be options right after the command name itself. # set arguments2 [eval \ object create ArgumentList [concat [list $name] $args]] # # NOTE: Setup output arguments needed for the MergeArguments method. # set arguments3 null; set error null # # NOTE: Attempt to merge the option and non-option arguments into a # single list of arguments. # set code [object invoke -alias -flags +NonPublic \ Interpreter.GetActive MergeArguments $options $arguments1 \ $arguments2 2 1 false false arguments3 error] # # NOTE: Was the argument merging process successful? # if {$code eq "Ok"} then { # # NOTE: Jump up from our call frame (and optionally that of our # caller) and attempt to invoke the specified static object # method with the final list of merged arguments. # return [uplevel [expr {$level + 1}] [$arguments3 ToString]] } else { # # NOTE: Failed to merge the arguments, raise an error. # error [$error ToString] } } continue; # NOTE: Not handled. } # # NOTE: Provide the Eagle "unknown object" package to the interpreter. # package provide Eagle.Unknown.Object \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Added Externals/Eagle/lib/Eagle1.0/update.eagle.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | ############################################################################### # # update.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Update Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { # # NOTE: This procedure returns non-zero if the specified public key token # matches the one in use by the Eagle script engine. # proc matchEnginePublicKeyToken { publicKeyToken } { return [expr {[string length $publicKeyToken] == 0 || \ $publicKeyToken eq [info engine PublicKeyToken]}] } # # NOTE: This procedure returns non-zero if the specified engine name # matches the Eagle script engine. # proc matchEngineName { name } { return [expr {[string length $name] == 0 || \ $name eq [info engine Name]}] } # # NOTE: This procedure returns non-zero if the specified culture matches # the one in use by the Eagle script engine. # proc matchEngineCulture { culture } { return [expr {[string length $culture] == 0 || \ $culture eq [info engine Culture]}] } # # NOTE: This procedure escapes the reserved characters in the specified # update notes and returns the resulting string. # proc escapeUpdateNotes { notes } { # # NOTE: Escape any embedded tab and line-ending characters. # return [string map \ [list & &\; \t &htab\; \v &vtab\; \n &lf\; \r &cr\;] $notes] } # # NOTE: This procedure unescapes reserved characters in the specified # update notes and returns the resulting string. # proc unescapeUpdateNotes { notes } { # # NOTE: Unescape any embedded tab and line-ending characters. # return [string map \ [list &htab\; \t &vtab\; \v &lf\; \n &cr\; \r &\; &] $notes] } # # NOTE: This procedure returns the list of arguments to be passed to the # [uri download] call that performs the auto-update check. # proc getFetchUpdateArgs { baseUri patchLevel type directory extension } { # # NOTE: Initially, set the result to an empty list to indicate # unrecognized input. # set result [list] # # NOTE: Make sure the base URI is valid. # if {[uri isvalid $baseUri]} then { # # NOTE: Make sure the patch level looks valid. # if {[regexp -- {^\d+\.\d+\.\d+\.\d+$} $patchLevel]} then { # # NOTE: Make sure the directory is either empty or an existing # valid directory. # if {[string length $directory] == 0 || \ [file isdirectory $directory]} then { # # NOTE: Make sure the extension is supported. # if {$extension eq ".exe" || $extension eq ".rar"} then { # # NOTE: Start with the URI components common to all download # types. # set components [list $baseUri releases $patchLevel] # # NOTE: Next, figure out what type of download is being # requested. # switch -exact -nocase -- $type { source - setup - binary { # # NOTE: Source code, setup, or binary download. This may be # a RAR or an EXE file. Append the appropriate file # name and then join all the URI components to form the # final URI. # set fileName [appendArgs \ [info engine] [string totitle $type] $patchLevel \ [expr {[string tolower $type] eq "setup" ? ".exe" : \ $extension}]] lappend components $fileName set result [list [eval uri join $components] [file join \ $directory $fileName]] } } } } } } return $result } # # NOTE: This procedure fetches an update package with the specified patch # level and package type and then saves it to the specified local # directory. # proc fetchUpdate { baseUri patchLevel type directory } { # # NOTE: Figure out the appropriate file extension to download for # this platform. # set extension [expr {[isWindows] ? ".exe" : ".rar"}] # # NOTE: Build the necessary arguments for the download. # set args [getFetchUpdateArgs $baseUri $patchLevel $type \ $directory $extension] if {[llength $args] > 0} then { # # NOTE: Start trusting ONLY our self-signed SSL certificate. # set trusted true if {[lindex [uri softwareupdates] end] eq "untrusted"} then { uri softwareupdates true } else { set trusted false; # NOTE: Already trusted. } try { # # NOTE: Download the file from the web site. # eval uri download $args; # synchronous. } finally { if {$trusted && \ [lindex [uri softwareupdates] end] eq "trusted"} then { # # NOTE: Stop trusting ONLY our self-signed SSL certificate. # uri softwareupdates false } } # # NOTE: Return a result indicating what was done. # return [appendArgs "downloaded URI " [lindex $args 0] \ " to directory \"" $directory \"] } else { return "cannot fetch update, the URI is invalid" } } # # NOTE: This procedure runs the updater tool and then immediately exits # the process. # proc runUpdateAndExit { {automatic false} } { global tcl_platform set directory [file dirname [info nameofexecutable]] set command [list exec -shell -- \ [file join $directory Hippogriff.exe] -delay 2000] # # HACK: The native StrongNameSignatureVerificationEx() function does # not appear to work on WOA (Windows-on-ARM) on the Surface RT # tablet; therefore, attempt to disable its use when calling # into the updater on that platform. # if {[isWindows] && \ [info exists tcl_platform(machine)] && \ $tcl_platform(machine) eq "arm"} then { # # NOTE: We appear to be running on WOA (Windows-on-ARM), add the # command line option that skips strong name verification. # lappend command -noStrongNameSigned true } # # NOTE: If requested, enable fully automatic update mode. # if {$automatic} then { lappend command -silent true -confirm false } set baseUri [getUpdateBaseUri] if {[string length $baseUri] > 0} then { lappend command -baseUri $baseUri } set pathAndQuery [getUpdatePathAndQuery] if {[string length $pathAndQuery] > 0} then { lappend command -tagPathAndQuery $pathAndQuery } eval $command &; exit -force } # # NOTE: This procedure returns the base URI that should be used to check # for available updates. # proc getUpdateBaseUri {} { # # NOTE: Check the current base URI for updates against the one baked # into the assembly. If they are different, then the base URI # must have been overridden. In that case, we must return the # current base URI; otherwise, we must return an empty string. # set baseUri(0) [info engine UpdateBaseUri false]; # NOTE: Current. set baseUri(1) [info engine UpdateBaseUri true]; # NOTE: Default. if {[string length $baseUri(0)] > 0 && \ [string length $baseUri(1)] > 0} then { # # NOTE: Ok, they are both valid. Are they different? # if {$baseUri(0) ne $baseUri(1)} then { return $baseUri(0) } } return "" } # # NOTE: This procedure returns the path and query portions of the URI # that should be used to check for available updates. # proc getUpdatePathAndQuery {} { # # NOTE: Check the current tag path and query for updates against the # one baked into the assembly. If they are different, then the # tag path and query must have been overridden. In that case, # we must return the current tag path and query; otherwise, we # must return an empty string. # set pathAndQuery(0) [info engine UpdatePathAndQuery \ false]; # NOTE: Current. set pathAndQuery(1) [info engine UpdatePathAndQuery \ true]; # NOTE: Default. if {[string length $pathAndQuery(0)] > 0 && \ [string length $pathAndQuery(1)] > 0} then { # # NOTE: Ok, they are both valid. Are they different? # if {$pathAndQuery(0) ne $pathAndQuery(1)} then { return $pathAndQuery(0) } } return "" } # # NOTE: This procedure downloads the available update data and returns # it verbatim. # proc getUpdateData { uri } { # # NOTE: Start trusting ONLY our own self-signed SSL certificate. # set trusted true if {[lindex [uri softwareupdates] end] eq "untrusted"} then { uri softwareupdates true } else { set trusted false; # NOTE: Already trusted. } try { # # NOTE: Download the tag file from the web site. # return [uri download -inline $uri]; # synchronous. } finally { if {$trusted && \ [lindex [uri softwareupdates] end] eq "trusted"} then { # # NOTE: Stop trusting ONLY our own self-signed SSL certificate. # uri softwareupdates false } } } # # NOTE: This procedure downloads an update script and then returns it # verbatim. # proc getUpdateScriptData { uri } { # # NOTE: Start trusting ONLY our own self-signed SSL certificate. # set trusted true if {[lindex [uri softwareupdates] end] eq "untrusted"} then { uri softwareupdates true } else { set trusted false; # NOTE: Already trusted. } try { # # NOTE: Download the script file from the web site. # return [interp readorgetscriptfile -- "" $uri]; # synchronous. } finally { if {$trusted && \ [lindex [uri softwareupdates] end] eq "trusted"} then { # # NOTE: Stop trusting ONLY our own self-signed SSL certificate. # uri softwareupdates false } } } # # NOTE: This procedure returns the base URI that should be used to download # available updates, if a specific base URI is not specified via the # manifest of available updates. # proc getDownloadBaseUri {} { # # NOTE: Just return the current base URI for downloads. # return [info engine DownloadBaseUri]; # NOTE: Current. } # # NOTE: This procedure is used to check for new versions -OR- new update # scripts for the runtime when a user executes the interactive # "#check" command. To disable this functionality, simply redefine # this procedure to do nothing. # proc checkForUpdate { {wantScripts false} {quiet false} {prompt false} {automatic false} } { # # NOTE: Grab the base URI for updates. # set updateBaseUri [info engine UpdateBaseUri] # # NOTE: Grab the update path and query string used for updates. # set updatePathAndQuery [info engine UpdatePathAndQuery] # # HACK: Exract the URI type (e.g. "stable" or "latest") from the # update path and query. This code may need to be modified # in the future. # set updateUriType [lindex [split $updatePathAndQuery .] 0] # # NOTE: Combine them to form the complete update URI. # set updateUri [appendArgs $updateBaseUri $updatePathAndQuery] # # NOTE: Fetch the master update data from the distribution site # and normalize to Unix-style line-endings. # set updateData [string map [list \r\n \n] [getUpdateData $updateUri]] # # NOTE: Split the data into lines. # set lines [split $updateData \n] # # NOTE: Keep track of how many update scripts are processed. # array set scriptCount { invalid 0 fail 0 bad 0 ok 0 error 0 } # # NOTE: Check each line to find the build information... # foreach line $lines { # # NOTE: Remove excess whitespace. # set line [string trim $line] # # NOTE: Skip blank lines. # if {[string length $line] > 0} then { # # NOTE: Skip comment lines. # if {[string index $line 0] ne "#" && \ [string index $line 0] ne ";"} then { # # NOTE: Split the tab-delimited line into fields. The format # of all lines in the data must be as follows: # # <startLine> protocolId <tab> publicKeyToken <tab> name # <tab> culture <tab> patchLevel <tab> timeStamp <tab> # baseUri <tab> md5Hash <tab> sha1Hash <tab> sha512Hash # <tab> notes <newLine> # set fields [split $line \t] # # NOTE: Grab the protocol Id field. # set protocolId [lindex $fields 0] # # NOTE: Grab the public key token field. # set publicKeyToken [lindex $fields 1] # # NOTE: Grab the name field. # set name [lindex $fields 2] # # NOTE: Grab the culture field. # set culture [lindex $fields 3] # # NOTE: Figure out which protocol is in use for this line. # The value "1" means this line specifies a build of # the script engine. The value "2" means this line # specifies an update script (via a URI) to evaluate. # All other values are currently reserved and ignored. # set checkBuild [expr {!$wantScripts && $protocolId eq "1"}] set checkScript [expr {$wantScripts && $protocolId eq "2"}] # # NOTE: We only want to find the first line that matches our # engine. The public key token is being used here to # make sure we get the same "flavor" of the engine. # The lines are organized so that the "latest stable # version" is on the first line (for a given public key # token), followed by development builds, experimental # builds, etc. # if {($checkBuild || $checkScript) && \ [matchEnginePublicKeyToken $publicKeyToken] && \ [matchEngineName $name] && \ [matchEngineCulture $culture]} then { # # NOTE: Grab the patch level field. # set patchLevel [lindex $fields 4] if {[string length $patchLevel] == 0} then { set patchLevel 0.0.0.0; # no patch level? } # # NOTE: Grab the time-stamp field. # set timeStamp [lindex $fields 5] if {[string length $timeStamp] == 0} then { set timeStamp 0; #never? } # # NOTE: What should the DateTime format be for display? This # should be some variation on ISO-8601. # set dateTimeFormat yyyy-MM-ddTHH:mm:ss # # NOTE: Does it look like the number of seconds since the epoch # or some kind of date/time string? # if {[string is integer -strict $timeStamp]} then { set dateTime [clock format \ $timeStamp -format $dateTimeFormat] } else { set dateTime [clock format \ [clock scan $timeStamp] -format $dateTimeFormat] } # # NOTE: Grab the patch level for the running engine. # set enginePatchLevel [info engine PatchLevel] # # NOTE: Grab the time-stamp for the running engine. # set engineTimeStamp [info engine TimeStamp] if {[string length $engineTimeStamp] == 0} then { set engineTimeStamp 0; #never? } # # NOTE: Does it look like the number of seconds since the epoch # or some kind of date/time string? # if {[string is integer -strict $engineTimeStamp]} then { set engineDateTime [clock format \ $engineTimeStamp -format $dateTimeFormat] } else { set engineDateTime [clock format \ [clock scan $engineTimeStamp] -format $dateTimeFormat] } # # NOTE: For build lines, compare the patch level from the line # to the one we are currently using using a simple patch # level comparison. # if {$checkBuild} then { set compare [package vcompare $patchLevel $enginePatchLevel] } else { # # NOTE: This is not a build line, no match. # set compare -1 } # # NOTE: For script lines, use regular expression matching. # if {$checkScript} then { # # NOTE: Use [catch] here to prevent raising a script error # due to a malformed patch level regular expression. # if {[catch { regexp -nocase -- $patchLevel $enginePatchLevel } match]} then { # # NOTE: The patch level from the script line was most # likely not a valid regular expression. # set match false } } else { # # NOTE: This is not a script line, no match. # set match false } # # NOTE: Are we interested in further processing this line? # if {($checkBuild && $compare > 0) || ($checkScript && $match)} then { # # NOTE: Grab the base URI field (i.e. it may be a mirror # site). # set baseUri [lindex $fields 6] if {$checkBuild && [string length $baseUri] == 0} then { set baseUri [getDownloadBaseUri]; # primary site. } # # NOTE: Grab the notes field (which may be empty). # set notes [lindex $fields 10] if {[string length $notes] > 0} then { set notes [unescapeUpdateNotes $notes] } # # NOTE: The engine patch level from the line is greater, # we are out-of-date. Return the result of our # checking now. # if {$checkBuild} then { # # NOTE: Are we supposed to prompt the interactive user, # if any, to upgrade now? # set text [appendArgs \ $updateUriType " build " $patchLevel ", dated " \ $dateTime ", is newer than the running build " \ $enginePatchLevel ", dated " $engineDateTime \ ", based on the data from " $updateBaseUri] if {$prompt && [isInteractive]} then { # # NOTE: Is the [object] command available? If not, # this cannot be done. # if {[llength [info commands object]] > 0} then { set messageCaption [appendArgs \ [info engine Name] " (" [lindex [info level 0] 0] \ " script)"] set messageText [appendArgs \ "The " $text \n\n "Run the updater now?"] if {$automatic} then { append messageText \n\n \ "WARNING: The updater process will be run " \ "in automatic mode and there will be no " \ "further prompts." } if {[object invoke -flags +NonPublic \ Eagle._Components.Private.WindowOps YesOrNo \ $messageText $messageCaption false]} then { # # NOTE: Ok, run the updater now and then exit. # runUpdateAndExit $automatic } } } return [list $text [list $baseUri $patchLevel] [list $notes]] } # # NOTE: The script patch level from the line matches the # current engine patch level exactly, this script # should be evaluated if it can be authenticated. # if {$checkScript} then { # # NOTE: First, set the default channel for update script # status messages. If the test channel has been # set (i.e. by the test suite), it will be used # instead. # if {![info exists channel]} then { set channel [expr {[info exists ::test_channel] ? \ $::test_channel : "stdout"}] } # # NOTE: Next, verify the script has a valid base URI. # For update scripts, this must be the location # where the update script data can be downloaded. # if {[string length $baseUri] == 0} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- invalid baseUri value for update script " \ "line: " $line \"\n] } incr scriptCount(invalid); continue } # # NOTE: Next, grab the md5 field and see if it looks valid. # Below, the value of this field will be compared to # that of the actual MD5 hash of the downloaded script # data. # set lineMd5 [lindex $fields 7] if {[string length $lineMd5] == 0} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- invalid md5 value for update script " \ "line: " $line \"\n] } incr scriptCount(invalid); continue } # # NOTE: Next, grab the sha1 field and see if it looks valid. # Below, the value of this field will be compared to # that of the actual SHA1 hash of the downloaded script # data. # set lineSha1 [lindex $fields 8] if {[string length $lineSha1] == 0} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- invalid sha1 value for update script " \ "line: " $line \"\n] } incr scriptCount(invalid); continue } # # NOTE: Next, grab the sha512 field and see if it looks # valid. Below, the value of this field will be # compared to that of the actual SHA512 hash of the # downloaded script data. # set lineSha512 [lindex $fields 9] if {[string length $lineSha512] == 0} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- invalid sha512 value for update script " \ "line: " $line \"\n] } incr scriptCount(invalid); continue } # # NOTE: Next, show the extra information associated with # this update script, if any. # if {!$quiet} then { tqputs $channel [appendArgs \ "---- fetching update script from \"" $baseUri \ "\" (" $dateTime ") with notes:\n"] set trimNotes [string trim $notes] tqputs $channel [appendArgs \ [expr {[string length $trimNotes] > 0 ? $trimNotes : \ "<none>"}] "\n---- end of update script notes\n"] } # # NOTE: Next, attempt to fetch the update script data. # set code [catch {getUpdateScriptData $baseUri} result] if {$code == 0} then { # # NOTE: Success, set the script data from the result. # set scriptData $result } else { # # NOTE: Failure, report the error message to the log. # if {!$quiet} then { tqputs $channel [appendArgs \ "---- failed to fetch update script: " $result \n] } incr scriptCount(fail); continue } # # NOTE: Next, verify that the md5, sha1, and sha512 # hashes of the raw script data match what was # specified in the md5, sha1, and sha512 fields. # set scriptMd5 [hash normal md5 $scriptData] if {![string equal -nocase $lineMd5 $scriptMd5]} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- wrong md5 value \"" $scriptMd5 \ "\" for update script line: " $line \"\n] } incr scriptCount(bad); continue } set scriptSha1 [hash normal sha1 $scriptData] if {![string equal -nocase $lineSha1 $scriptSha1]} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- wrong sha1 value \"" $scriptSha1 \ "\" for update script line: " $line \"\n] } incr scriptCount(bad); continue } set scriptSha512 [hash normal sha512 $scriptData] if {![string equal -nocase $lineSha512 $scriptSha512]} then { if {!$quiet} then { tqputs $channel [appendArgs \ "---- wrong sha512 value \"" $scriptSha512 \ "\" for update script line: " $line \"\n] } incr scriptCount(bad); continue } # # NOTE: Finally, everything looks good. Therefore, just # evaluate the update script and print the result. # if {!$quiet} then { tqputs $channel [appendArgs \ "---- evaluating update script from \"" $baseUri \ \"...\n] } # # NOTE: Reset the variables that will be used to contain # the result of the update script. # set code 0; set result "" # # NOTE: Manually override file name to be returned by # [info script] to refer back to the originally # read script base URI. # set pushed false if {[llength [info commands object]] > 0} then { object invoke -flags +NonPublic Interpreter.GetActive \ PushScriptLocation $baseUri true set pushed true } try { # # NOTE: Evaluate the update script in the context of # the caller. # set code [catch {uplevel 1 $scriptData} result] } finally { # # NOTE: Reset manual override of the script file name # to be returned by [info script]. # if {$pushed} then { object invoke -flags +NonPublic Interpreter.GetActive \ PopScriptLocation true } } # # NOTE: Keep track of the number of update scripts that # generate Ok and Error return codes. # if {$code == 0} then { incr scriptCount(ok) } else { incr scriptCount(error) } if {!$quiet} then { host result $code $result tqputs $channel "\n---- end of update script results\n" } } } elseif {$checkBuild && $compare < 0} then { # # NOTE: The patch level from the line is less, we are more # up-to-date than the latest version? # return [list [appendArgs \ "running build " $enginePatchLevel ", dated " \ $engineDateTime ", is newer than the " $updateUriType \ " build " $patchLevel ", dated " $dateTime \ ", based on the data " "from " $updateBaseUri]] } elseif {$checkBuild} then { # # NOTE: The patch levels are equal, we are up-to-date. # return [list [appendArgs \ "running build " $enginePatchLevel ", dated " \ $engineDateTime ", is the " $updateUriType \ " build, based on the data from " $updateBaseUri]] } } } } } # # NOTE: Figure out what the final result should be. If we get # to this point when checking for a new build, something # must have gone awry. Otherwise, report the number of # update scripts that were successfully processed. # if {$wantScripts} then { set scriptCount(total) [expr [join [array values scriptCount] +]] if {$scriptCount(total) > 0} then { return [list [appendArgs \ "processed " $scriptCount(total) " update scripts: " \ [array get scriptCount]]] } else { return [list "no update scripts were processed"] } } else { return [list \ "could not determine if running build is the latest build"] } } # # NOTE: Provide the Eagle "update" package to the interpreter. # package provide Eagle.Update \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
1 2 3 4 5 | ############################################################################### # # vendor.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 | ############################################################################### # # vendor.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Vendor Initialization File for System.Data.SQLite # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ |
︙ | ︙ |
Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.
1 2 3 4 5 | ############################################################################### # # constraints.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) | | | | | | | | | | > > > > > > > > > > | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | ############################################################################### # # constraints.eagle -- # # Extensible Adaptable Generalized Logic Engine (Eagle) # Eagle Test Constraints Package File # # Copyright (c) 2007-2012 by Joe Mistachkin. All rights reserved. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: $ # ############################################################################### # # NOTE: Use our own namespace here because even though we do not directly # support namespaces ourselves, we do not want to pollute the global # namespace if this script actually ends up being evaluated in Tcl. # namespace eval ::Eagle { proc getKnownBuildTypes {} { return [list \ NetFx20 NetFx35 NetFx40 NetFx45 NetFx451 NetFx452 \ NetFx46 NetFx461 NetFx462 Bare LeanAndMean Database \ MonoOnUnix Development] } proc getKnownCompileOptions {} { return [list \ APPDOMAINS APPROVED_VERBS ARGUMENT_CACHE ARM ARM64 ASSEMBLY_RELEASE \ ASSEMBLY_STRONG_NAME_TAG ASSEMBLY_TAG ASSEMBLY_TEXT ASSEMBLY_URI \ BREAK_ON_EXITING BREAKPOINTS CACHE_ARGUMENT_TOSTRING \ CACHE_ARGUMENTLIST_TOSTRING CACHE_DICTIONARY CACHE_RESULT_TOSTRING \ CACHE_STATISTICS CACHE_STRINGLIST_TOSTRING CALLBACK_QUEUE CAS_POLICY \ CERTIFICATE_PLUGIN CERTIFICATE_POLICY CERTIFICATE_RENEWAL \ CODE_ANALYSIS COM_TYPE_CACHE CONSOLE DAEMON DATA DEAD_CODE DEBUG \ DEBUGGER DEBUGGER_ARGUMENTS DEBUGGER_ENGINE DEBUGGER_EXECUTE \ DEBUGGER_EXPRESSION DEBUGGER_VARIABLE DEBUG_TRACE DEBUG_WRITE DRAWING \ DYNAMIC EAGLE EMBEDDED_LIBRARY EMBED_CERTIFICATE EXECUTE_CACHE \ EXPRESSION_FLAGS FAST_ERRORCODE FAST_ERRORINFO FOR_TEST_USE_ONLY \ HAVE_SIZEOF HISTORY IA64 INTERACTIVE_COMMANDS INTERNALS_VISIBLE_TO \ ISOLATED_INTERPRETERS ISOLATED_PLUGINS LIBRARY LICENSING \ LICENSE_MANAGER LIMITED_EDITION LIST_CACHE MONO MONO_BUILD MONO_HACKS \ MONO_LEGACY NATIVE NATIVE_PACKAGE NATIVE_THREAD_ID NATIVE_UTILITY \ NATIVE_UTILITY_BSTR NETWORK NET_20 NET_20_FAST_ENUM NET_20_ONLY \ NET_20_SP1 NET_20_SP2 NET_30 NET_35 NET_40 NET_45 NET_451 NET_452 \ NET_46 NET_461 NET_462 NON_WORKING_CODE NOTIFY NOTIFY_ACTIVE \ NOTIFY_ARGUMENTS NOTIFY_EXCEPTION NOTIFY_EXECUTE NOTIFY_EXPRESSION \ NOTIFY_GLOBAL NOTIFY_OBJECT OBSOLETE OBFUSCATION OFFICIAL PARSE_CACHE \ PATCHLEVEL PLUGIN_COMMANDS POLICY_TRACE PREVIOUS_RESULT RANDOMIZE_ID \ REMOTING SAMPLE SECURITY SERIALIZATION SHARED_ID_POOL SHELL SOURCE_ID \ SOURCE_TIMESTAMP STATIC TCL TCL_KITS TCL_THREADED TCL_THREADS \ TCL_UNICODE TCL_WRAPPER TEST TEST_PLUGIN THREADING THROW_ON_DISPOSED \ TRACE TYPE_CACHE UNIX USE_APPDOMAIN_FOR_ID USE_NAMESPACES VERBOSE WEB \ WINDOWS WINFORMS WIX_30 WIX_35 WIX_36 WIX_37 WIX_38 WIX_39 WIX_310 \ X64 X86 XML] } proc getKnownMonoVersions { {force false} } { # # NOTE: This job of this procedure is to return the list of "known" # versions of Mono supported by the test suite infrastructure. # # NOTE: Other than version 2.11 (which was officially announced and # released), all of these releases are listed on the official # release history pages: # # https://en.wikipedia.org/wiki/Mono_%28software%29 # https://www.mono-project.com/docs/about-mono/releases/ # # TODO: This list should be manually updated when a new version of # the Mono runtime is released. # if {$force || ![info exists ::no(monoVersions)]} then { return [list \ [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \ [list 2 11] [list 3 0] [list 3 1] [list 3 2] [list 3 4] [list 3 6] \ [list 3 8] [list 3 10] [list 3 12] [list 4 0] [list 4 2] [list 4 4] \ [list 4 6]] } else { return [list] } } proc addKnownMonoConstraints { generic } { # # NOTE: Does the caller want to add the version-specific constraints # or the generic ones? # if {!$generic} then { # # NOTE: Add the necessary constraints for each version of Mono that # we know about. # foreach monoVersion [getKnownMonoVersions] { set constraintVersion [join $monoVersion ""] addConstraint [appendArgs monoToDo $constraintVersion] addConstraint [appendArgs monoToDo $constraintVersion Only] addConstraint [appendArgs monoBug $constraintVersion] addConstraint [appendArgs monoBug $constraintVersion Only] addConstraint [appendArgs monoCrash $constraintVersion] addConstraint [appendArgs monoCrash $constraintVersion Only] } } else { # # NOTE: Also add just the generic Mono constraints that do not have # a trailing version. # set constraints [list monoToDo monoBug monoCrash] foreach constraint $constraints { addConstraint $constraint } } } # # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page # at "http://wiki.tcl.tk/43". It is only intended to be used on very # small lists because of its heavy use of recursion and complexity on |
︙ | ︙ | |||
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | # return true } set reason "skipped, need Eagle" return false } proc checkForTestSuiteFiles { channel } { tputs $channel "---- checking for test suite files... " # # NOTE: Start out with no test suite files to check. # set fileNames [list] # # NOTE: Check if the base package path is available. # if {[info exists ::test_package_path]} then { # # TODO: If additional test suite files are added within the base # package path, add them here as well. # foreach fileNameOnly [list \ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > | | 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 | # return true } set reason "skipped, need Eagle" return false } proc cleanPackageName { package full } { # # NOTE: Start out with the original package name, removing surrounding # whitespace. If this results in an empty string, we are done. # set result [string trim $package] if {[string length $result] == 0} then { return $result } # # NOTE: If the full package name is NOT wanted, use the short name. It # will be whatever occurs before the first comma. If this results # in an empty string, we are done. # if {!$full} then { set result [string trim [lindex [split $result ,] 0]] if {[string length $result] == 0} then { return $result } } # # HACK: This is the list of "special" characters that are documented to # be used when constructing fully qualified .NET Framework type # names. For now, they are all replaced with underscores by this # procedure. Any existing underscores in the string are doubled. # set charMap [list _ __ " " _ + _ , _ . _ = _ \[ _ \\ _ \] _ ` _] return [string map $charMap $result] } proc checkForTestSuiteFiles { channel } { tputs $channel "---- checking for test suite files... " # # NOTE: Start out with no test suite files to check. # set fileNames [list] # # NOTE: Check if the base package path is available. # if {[info exists ::test_package_path]} then { # # TODO: If additional test suite files are added within the base # package path, add them here as well. # foreach fileNameOnly [list \ auxiliary.eagle compat.eagle csharp.eagle database.eagle \ embed.eagle exec.eagle file1.eagle file2.eagle \ file3.eagle info.eagle init.eagle list.eagle \ object.eagle pkgIndex.eagle pkgIndex.tcl platform.eagle \ process.eagle runopt.eagle safe.eagle shell.eagle \ shim.eagle test.eagle testlog.eagle unkobj.eagle \ update.eagle vendor.eagle word.tcl] { # # NOTE: First, check if the file resides in the Eagle-specific # package sub-directory. Failing that, fallback to using # the base package path itself. # set fileName [file join \ $::test_package_path Eagle1.0 $fileNameOnly] |
︙ | ︙ | |||
456 457 458 459 460 461 462 | ########################################################################### if {![isEagle]} then { # # BUGFIX: We do not normally want to skip any Mono bugs in native Tcl. # if {![info exists ::no(runtimeVersion)]} then { | < < < < < < | < < < < < < < | < < < < < < < < < | 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 | ########################################################################### if {![isEagle]} then { # # BUGFIX: We do not normally want to skip any Mono bugs in native Tcl. # if {![info exists ::no(runtimeVersion)]} then { addKnownMonoConstraints true; # running in native Tcl. addKnownMonoConstraints false; # running in native Tcl. } } } proc checkForWindowsVersion { channel } { tputs $channel "---- checking for Windows version... " |
︙ | ︙ | |||
527 528 529 530 531 532 533 | dummy comSpecVersion]} then { # # NOTE: If the value reported to the process does not match # the value returned from the Windows command processor, # replace it. We must know the real Windows version. # if {$osVersion eq $comSpecVersion} then { | | | | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 | dummy comSpecVersion]} then { # # NOTE: If the value reported to the process does not match # the value returned from the Windows command processor, # replace it. We must know the real Windows version. # if {$osVersion eq $comSpecVersion} then { set extra "---- reported and detected Windows versions match\n" } else { set extra [appendArgs \ "==== WARNING: reported and detected Windows versions " \ "do not match: " $osVersion " versus " $comSpecVersion \ ", resetting...\n"] set osVersion $comSpecVersion } } } |
︙ | ︙ | |||
737 738 739 740 741 742 743 744 745 746 747 748 749 750 | } else { addConstraint [appendArgs comSpec_ \ [string map [list * _ - _ ? _ \[ _ \\ _ \] _] $pattern]] } tputs $channel [appendArgs "yes (\"" $::env(ComSpec) "\")\n"] # # NOTE: We are done here, return now. # return } } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 | } else { addConstraint [appendArgs comSpec_ \ [string map [list * _ - _ ? _ \[ _ \\ _ \] _] $pattern]] } tputs $channel [appendArgs "yes (\"" $::env(ComSpec) "\")\n"] # # NOTE: We are done here, return now. # return } } tputs $channel no\n } proc checkForPackage { channel pattern } { tputs $channel [appendArgs \ "---- checking for loaded package matching \"" \ $pattern "\"... "] if {[catch { foreach loaded [info loaded] { if {[regexp -- $pattern [lindex $loaded end]]} then { set package [lindex $loaded 1]; break } } }] == 0} then { # # NOTE: Make sure that a matching package name was found. # if {[info exists package]} then { # # NOTE: Yes, it appears that it is loaded. # addConstraint [appendArgs \ loaded.name. [cleanPackageName $package false]] addConstraint [appendArgs \ loaded.fullName. [cleanPackageName $package true]] # # NOTE: Show that the sub-command was found. # tputs $channel yes\n # # NOTE: We are done here, return now. # return } } |
︙ | ︙ | |||
2556 2557 2558 2559 2560 2561 2562 | # NOTE: No, it appears that we are not running inside Mono. # addConstraint dotNet; # running on .NET. # # NOTE: We do not want to skip Mono bugs on .NET. # | < | < | 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 | # NOTE: No, it appears that we are not running inside Mono. # addConstraint dotNet; # running on .NET. # # NOTE: We do not want to skip Mono bugs on .NET. # addKnownMonoConstraints true; # running on .NET. tputs $channel [appendArgs [expr {[info exists \ ::eagle_platform(runtime)] ? \ $::eagle_platform(runtime) : "Microsoft.NET"}] \n] } } |
︙ | ︙ | |||
2590 2591 2592 2593 2594 2595 2596 | # # NOTE: Keep track of the specific image runtime version for usage in # test constraints. # addConstraint [appendArgs imageRuntime $version] tputs $channel [appendArgs \ | | | 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 | # # NOTE: Keep track of the specific image runtime version for usage in # test constraints. # addConstraint [appendArgs imageRuntime $version] tputs $channel [appendArgs \ $::eagle_platform(imageRuntimeVersion) " (" $dotVersion ")\n"] } else { tputs $channel no\n } } proc checkForFrameworkVersion { channel } { tputs $channel "---- checking for framework version... " |
︙ | ︙ | |||
2622 2623 2624 2625 2626 2627 2628 | # for it now. # if {[string length $version] > 0} then { addConstraint [appendArgs framework $version] } tputs $channel [appendArgs \ | | | 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 | # for it now. # if {[string length $version] > 0} then { addConstraint [appendArgs framework $version] } tputs $channel [appendArgs \ $::eagle_platform(frameworkVersion) " (" $dotVersion ")\n"] } else { tputs $channel no\n } } proc checkForRuntimeVersion { channel } { tputs $channel "---- checking for runtime version... " |
︙ | ︙ | |||
2754 2755 2756 2757 2758 2759 2760 | } # # NOTE: We do not want to skip any Mono bugs on .NET. Add the # necessary constraints for each version of Mono we know # about. # | < < | < < < < < < < | | 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 | } # # NOTE: We do not want to skip any Mono bugs on .NET. Add the # necessary constraints for each version of Mono we know # about. # addKnownMonoConstraints false; # running on .NET. } tputs $channel [appendArgs \ $::eagle_platform(runtimeVersion) " (" $dotVersion ")\n"] } else { tputs $channel no\n } } proc checkForProcessBits { channel } { tputs $channel "---- checking for process bits... " |
︙ | ︙ | |||
2847 2848 2849 2850 2851 2852 2853 | # set command [expr { [llength $arguments] > 0 ? [lindex $arguments 0] : "" }] # # HACK: Make sure the call stack does not end up confusing | | > > > > | > | 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 | # set command [expr { [llength $arguments] > 0 ? [lindex $arguments 0] : "" }] # # HACK: Make sure the call stack does not end up confusing # the tests that rely on absolute call frames. The # [runTestPrologue] is allowed here because it will # not be active on the call stack at the point the # tests are actually run. Actually, the same thing # goes for [checkForTestCallStack] as well. # if {$command in \ [list runTestPrologue checkForTestCallStack]} then { addConstraint testCallStack tputs $channel [appendArgs "yes (\"" $command "\")\n"] # # NOTE: We are done here, return now. # |
︙ | ︙ | |||
3625 3626 3627 3628 3629 3630 3631 | # # NOTE: Keep track of the specific target framework for usage in test # constraints. # addConstraint [appendArgs targetFramework. $targetFramework] | | | 3722 3723 3724 3725 3726 3727 3728 3729 3730 3731 3732 3733 3734 3735 3736 | # # NOTE: Keep track of the specific target framework for usage in test # constraints. # addConstraint [appendArgs targetFramework. $targetFramework] tputs $channel [appendArgs "yes (" $targetFramework ")\n"] } else { tputs $channel no\n } } proc checkForNativeUtility { channel } { tputs $channel "---- checking for native utility... " |
︙ | ︙ | |||
3655 3656 3657 3658 3659 3660 3661 | if {$nativeUtility ni "disabled unavailable"} then { addConstraint nativeUtility } addConstraint [appendArgs nativeUtility. $nativeUtility] tputs $channel [appendArgs \ | | | 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 | if {$nativeUtility ni "disabled unavailable"} then { addConstraint nativeUtility } addConstraint [appendArgs nativeUtility. $nativeUtility] tputs $channel [appendArgs \ $::eagle_platform(nativeUtility) " (" $nativeUtility ")\n"] } else { tputs $channel unknown\n } } else { tputs $channel no\n } } |
︙ | ︙ | |||
3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 | } # # NOTE: We are not running on Windows 10, return the normal value. # return 394271 } proc checkForNetFx4x { channel } { tputs $channel "---- checking for .NET Framework 4.x... " # # NOTE: Platform must be Windows for this constraint to even be # checked (i.e. we require the registry). | > > > > > > > > > > > > > > > > > | 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 | } # # NOTE: We are not running on Windows 10, return the normal value. # return 394271 } proc getFrameworkSetup462Value {} { # # NOTE: Check if we are running on Windows 10 or later. # if {[isWindows] && $::tcl_platform(osVersion) >= 10.0} then { # # NOTE: We are running on Windows 10, return the special value. # return 394802 } # # NOTE: We are not running on Windows 10, return the normal value. # return 394806 } proc checkForNetFx4x { channel } { tputs $channel "---- checking for .NET Framework 4.x... " # # NOTE: Platform must be Windows for this constraint to even be # checked (i.e. we require the registry). |
︙ | ︙ | |||
3803 3804 3805 3806 3807 3808 3809 | # is installed. However, if the "release" value is also # greater than or equal to 379893, then the .NET Framework # 4.5.2 is installed, which is an in-place upgrade to 4.5.1 # (and 4.5). If the "release" value is also greater than or # equal to 393297 (393295 on Windows 10), then the .NET # Framework 4.6 is installed, which is an in-place upgrade # to 4.5.x. Similar handling is necessary for the .NET | | | > > > > > > > > > | 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 | # is installed. However, if the "release" value is also # greater than or equal to 379893, then the .NET Framework # 4.5.2 is installed, which is an in-place upgrade to 4.5.1 # (and 4.5). If the "release" value is also greater than or # equal to 393297 (393295 on Windows 10), then the .NET # Framework 4.6 is installed, which is an in-place upgrade # to 4.5.x. Similar handling is necessary for the .NET # Framework 4.6.1 and 4.6.2. For more information, see: # # https://msdn.microsoft.com/en-us/library/hh925568.aspx # if {$release >= [getFrameworkSetup462Value]} then { addConstraint dotNet451OrHigher addConstraint dotNet452OrHigher addConstraint dotNet46OrHigher addConstraint dotNet461OrHigher addConstraint dotNet462 addConstraint dotNet462OrHigher set version 4.6.2 } elseif {$release >= [getFrameworkSetup461Value]} then { addConstraint dotNet451OrHigher addConstraint dotNet452OrHigher addConstraint dotNet46OrHigher addConstraint dotNet461 addConstraint dotNet461OrHigher set version 4.6.1 |
︙ | ︙ | |||
4061 4062 4063 4064 4065 4066 4067 | # # NOTE: We need several of our test constraint related commands in the # global namespace. # exportAndImportPackageCommands [namespace current] [list \ getKnownBuildTypes getKnownCompileOptions getKnownMonoVersions \ | | | | | | > | | | | | | | | | | | < | | | | 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 | # # NOTE: We need several of our test constraint related commands in the # global namespace. # exportAndImportPackageCommands [namespace current] [list \ getKnownBuildTypes getKnownCompileOptions getKnownMonoVersions \ addKnownMonoConstraints lpermute alwaysFullInterpReady canExecComSpec \ canExecWhoAmI canExecTclShell canExecFossil isTestMono \ isTestAdministrator canPing cleanPackageName checkForTestSuiteFiles \ checkForPlatform checkForWindowsVersion checkForScriptLibrary \ checkForVariable checkForTclOptions checkForWindowsCommandProcessor \ checkForPackage checkForFossil checkForEagle checkForSymbols \ checkForLogFile checkForGaruda checkForShell \ checkForOfficialStableReleaseInProgress checkForDebug checkForTk \ checkForVersion checkForCommand checkForSubCommand checkForNamespaces \ checkForTestExec checkForTestMachine checkForTestPlatform \ checkForTestConfiguration checkForTestSuffix checkForFile \ checkForPathFile checkForNativeCode checkForTip127 checkForTip194 \ checkForTip207 checkForTip241 checkForTip285 checkForTip405 \ checkForTip426 checkForTip429 checkForTip440 checkForTiming \ checkForPerformance checkForBigLists checkForProcessorIntensive \ checkForTimeIntensive checkForFullTest checkForMemoryIntensive \ checkForStackIntensive checkForStackSize checkForInteractive \ checkForInteractiveCommand checkForUserInteraction checkForNetwork \ checkForCompileOption checkForKnownCompileOptions] false false ########################################################################### ############################## END Tcl ONLY ############################### ########################################################################### } # # NOTE: Provide the Eagle "test constraints" package to the interpreter. # package provide Eagle.Test.Constraints \ [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}] } |
Changes to Externals/Eagle/lib/Test1.0/pkgIndex.eagle.
︙ | ︙ | |||
13 14 15 16 17 18 19 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {![package vsatisfies [package provide Eagle] 1.0]} {return} | | | | 13 14 15 16 17 18 19 20 21 | # RCS: @(#) $Id: $ # ############################################################################### if {![package vsatisfies [package provide Tcl] 8.4]} {return} if {![package vsatisfies [package provide Eagle] 1.0]} {return} package ifneeded Eagle.Test.Constraints 1.0 \ [list sourceWithInfo [file join $dir constraints.eagle]] |
Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.
︙ | ︙ | |||
732 733 734 735 736 737 738 739 740 741 742 743 744 745 | # this information will not be visible in the log file. # tputs $test_channel [appendArgs "---- testRunId: " \ [getTestRunId] \n] tputs $test_channel [appendArgs "---- processId: " \ [pid] \n] tputs $test_channel [appendArgs "---- test suite: " \ [expr {[info exists test_suite] ? \ $test_suite : "<none>"}] \n] tputs $test_channel [appendArgs "---- test channel: " \ $test_channel \n] | > > > > > > > > | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 | # this information will not be visible in the log file. # tputs $test_channel [appendArgs "---- testRunId: " \ [getTestRunId] \n] tputs $test_channel [appendArgs "---- processId: " \ [pid] \n] set ppid(0) [catch {info ppid} ppid(1)] tputs $test_channel [appendArgs "---- parentProcessId: " \ [expr {$ppid(0) == 0 ? \ $ppid(1) : "<none>"}] \n] unset ppid tputs $test_channel [appendArgs "---- test suite: " \ [expr {[info exists test_suite] ? \ $test_suite : "<none>"}] \n] tputs $test_channel [appendArgs "---- test channel: " \ $test_channel \n] |
︙ | ︙ | |||
1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 | } } # # NOTE: Has custom test method support been disabled? # if {![info exists no(core)] && ![info exists no(test)]} then { # # NOTE: Has ExecuteCallback testing support been disabled? # if {![info exists no(testExecuteCallback)]} then { # # NOTE: For tests "executeCallback-1.*". # | > > > > > > > > > > > | 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 | } } # # NOTE: Has custom test method support been disabled? # if {![info exists no(core)] && ![info exists no(test)]} then { # # NOTE: Has PackageCallback testing support been disabled? # if {![info exists no(testPackageCallback)]} then { # # NOTE: For test "package-2.1". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestSetPackageFallbackCallback* } # # NOTE: Has ExecuteCallback testing support been disabled? # if {![info exists no(testExecuteCallback)]} then { # # NOTE: For tests "executeCallback-1.*". # |
︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 | # NOTE: Has web client testing been disabled? # if {![info exists no(testWebClient)]} then { # # NOTE: For test "socket-3.50". # checkForObjectMember $test_channel Eagle._Tests.Default \ | | | > > > | 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 | # NOTE: Has web client testing been disabled? # if {![info exists no(testWebClient)]} then { # # NOTE: For test "socket-3.50". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestHasScriptNewWebClientCallback* checkForObjectMember $test_channel Eagle._Tests.Default \ *TestHasErrorNewWebClientCallback* checkForObjectMember $test_channel Eagle._Tests.Default \ *TestSetScriptNewWebClientCallback* } if {![info exists no(testLoad)]} then { # # NOTE: For tests "load-1.6" and "load-1.7". # checkForObjectMember $test_channel Eagle._Tests.Default \ |
︙ | ︙ | |||
1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 | # if {![info exists no(testRemoting)]} then { # # NOTE: For tests "remotingServer-1.*". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestRemoting* } # # NOTE: Has asynchronous testing support been disabled? # if {![info exists no(testAsynchronous)]} then { # | > > > > > > | 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 | # if {![info exists no(testRemoting)]} then { # # NOTE: For tests "remotingServer-1.*". # checkForObjectMember $test_channel Eagle._Tests.Default \ *TestRemoting* checkForObjectMember $test_channel Eagle._Tests.Default \ *TestRemotingHaveChannel* checkForObjectMember $test_channel Eagle._Tests.Default \ *TestRemotingTryGetChannel* } # # NOTE: Has asynchronous testing support been disabled? # if {![info exists no(testAsynchronous)]} then { # |
︙ | ︙ | |||
2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 | ############################################################################# ####################### BEGIN Tcl & Eagle Constraints ####################### ############################################################################# tputs $test_channel \ "---- start of common (Tcl & Eagle) test constraints...\n" # # NOTE: Check for the test suite infrastructure files... # if {![info exists no(testSuiteFiles)]} then { checkForTestSuiteFiles $test_channel } | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 | ############################################################################# ####################### BEGIN Tcl & Eagle Constraints ####################### ############################################################################# tputs $test_channel \ "---- start of common (Tcl & Eagle) test constraints...\n" # # NOTE: Force tests that are normally blocked by Mono issues to run? # if {[info exists no(monoHacks)]} then { addKnownMonoConstraints true addKnownMonoConstraints false tputs $test_channel \ "---- added all known Mono test constraints (forced)\n" } # # NOTE: Check for Eagle core library package names... # if {![info exists no(corePackageNames)]} then { checkForPackage $test_channel {^Eagle\._Plugins\.Core, .*$} checkForPackage $test_channel {^Eagle\._Plugins\.Object, .*$} checkForPackage $test_channel {^Eagle\._Plugins\.Test, .*$} checkForPackage $test_channel {^Eagle\._Plugins\.Trace, .*$} } # # NOTE: Check for Eagle Enterprise Edition package names... # if {![info exists no(enterprisePackageNames)]} then { # # NOTE: These are from various SKUs of the Harpy plugin. # checkForPackage $test_channel {^Licensing\.Core, .*$} checkForPackage $test_channel {^Licensing\.Standard, .*$} checkForPackage $test_channel {^Licensing\.Enterprise, .*$} checkForPackage $test_channel {^Security\.Core, .*$} # # NOTE: These are from various SKUs of the Badge plugin. # checkForPackage $test_channel {^Badge\.Enterprise, .*$} checkForPackage $test_channel {^Security\.Certificates, .*$} } # # NOTE: Check for the test suite infrastructure files... # if {![info exists no(testSuiteFiles)]} then { checkForTestSuiteFiles $test_channel } |
︙ | ︙ |
Changes to Setup/data/verify.lst.
︙ | ︙ | |||
881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | Externals/Eagle/bin/Eagle.dll Externals/Eagle/bin/EagleShell.exe Externals/Eagle/bin/EagleShell32.exe Externals/Eagle/bin/x64/ Externals/Eagle/bin/x64/Spilornis.dll Externals/Eagle/bin/x86/ Externals/Eagle/bin/x86/Spilornis.dll Externals/Eagle/lib/Eagle1.0/embed.eagle Externals/Eagle/lib/Eagle1.0/init.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.tcl Externals/Eagle/lib/Eagle1.0/safe.eagle Externals/Eagle/lib/Eagle1.0/shell.eagle Externals/Eagle/lib/Eagle1.0/test.eagle Externals/Eagle/lib/Eagle1.0/word.tcl Externals/Eagle/lib/Test1.0/all.eagle Externals/Eagle/lib/Test1.0/constraints.eagle Externals/Eagle/lib/Test1.0/epilogue.eagle Externals/Eagle/lib/Test1.0/pkgIndex.eagle Externals/Eagle/lib/Test1.0/pkgIndex.tcl Externals/Eagle/lib/Test1.0/prologue.eagle | > > > > > > > > > > > > > > > > > > > | 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 | Externals/Eagle/bin/Eagle.dll Externals/Eagle/bin/EagleShell.exe Externals/Eagle/bin/EagleShell32.exe Externals/Eagle/bin/x64/ Externals/Eagle/bin/x64/Spilornis.dll Externals/Eagle/bin/x86/ Externals/Eagle/bin/x86/Spilornis.dll Externals/Eagle/lib/Eagle1.0/auxiliary.eagle Externals/Eagle/lib/Eagle1.0/compat.eagle Externals/Eagle/lib/Eagle1.0/csharp.eagle Externals/Eagle/lib/Eagle1.0/database.eagle Externals/Eagle/lib/Eagle1.0/embed.eagle Externals/Eagle/lib/Eagle1.0/exec.eagle Externals/Eagle/lib/Eagle1.0/file1.eagle Externals/Eagle/lib/Eagle1.0/file2.eagle Externals/Eagle/lib/Eagle1.0/file3.eagle Externals/Eagle/lib/Eagle1.0/info.eagle Externals/Eagle/lib/Eagle1.0/init.eagle Externals/Eagle/lib/Eagle1.0/list.eagle Externals/Eagle/lib/Eagle1.0/object.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.tcl Externals/Eagle/lib/Eagle1.0/platform.eagle Externals/Eagle/lib/Eagle1.0/process.eagle Externals/Eagle/lib/Eagle1.0/runopt.eagle Externals/Eagle/lib/Eagle1.0/safe.eagle Externals/Eagle/lib/Eagle1.0/shell.eagle Externals/Eagle/lib/Eagle1.0/shim.eagle Externals/Eagle/lib/Eagle1.0/test.eagle Externals/Eagle/lib/Eagle1.0/testlog.eagle Externals/Eagle/lib/Eagle1.0/unkobj.eagle Externals/Eagle/lib/Eagle1.0/update.eagle Externals/Eagle/lib/Eagle1.0/vendor.eagle Externals/Eagle/lib/Eagle1.0/word.tcl Externals/Eagle/lib/Test1.0/all.eagle Externals/Eagle/lib/Test1.0/constraints.eagle Externals/Eagle/lib/Test1.0/epilogue.eagle Externals/Eagle/lib/Test1.0/pkgIndex.eagle Externals/Eagle/lib/Test1.0/pkgIndex.tcl Externals/Eagle/lib/Test1.0/prologue.eagle |
︙ | ︙ |
Changes to data/exclude_src.txt.
︙ | ︙ | |||
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | Externals/Eagle/bin/EntityFramework.* Externals/Eagle/bin/SQLite.Interop.* Externals/Eagle/bin/sqlite3.* Externals/Eagle/bin/System.* Externals/Eagle/bin/Win32/* Externals/Eagle/bin/x64/* Externals/Eagle/bin/x86/* Externals/Eagle/lib/Eagle1.0/embed.eagle Externals/Eagle/lib/Eagle1.0/init.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.tcl Externals/Eagle/lib/Eagle1.0/safe.eagle Externals/Eagle/lib/Eagle1.0/shell.eagle Externals/Eagle/lib/Eagle1.0/test.eagle Externals/Eagle/lib/Eagle1.0/word.tcl Externals/Eagle/lib/Test1.0/all.eagle Externals/Eagle/lib/Test1.0/constraints.eagle Externals/Eagle/lib/Test1.0/epilogue.eagle Externals/Eagle/lib/Test1.0/pkgIndex.eagle Externals/Eagle/lib/Test1.0/pkgIndex.tcl Externals/Eagle/lib/Test1.0/prologue.eagle | > > > > > > > > > > > > > > > > > > > | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 | Externals/Eagle/bin/EntityFramework.* Externals/Eagle/bin/SQLite.Interop.* Externals/Eagle/bin/sqlite3.* Externals/Eagle/bin/System.* Externals/Eagle/bin/Win32/* Externals/Eagle/bin/x64/* Externals/Eagle/bin/x86/* Externals/Eagle/lib/Eagle1.0/auxiliary.eagle Externals/Eagle/lib/Eagle1.0/compat.eagle Externals/Eagle/lib/Eagle1.0/csharp.eagle Externals/Eagle/lib/Eagle1.0/database.eagle Externals/Eagle/lib/Eagle1.0/embed.eagle Externals/Eagle/lib/Eagle1.0/exec.eagle Externals/Eagle/lib/Eagle1.0/file1.eagle Externals/Eagle/lib/Eagle1.0/file2.eagle Externals/Eagle/lib/Eagle1.0/file3.eagle Externals/Eagle/lib/Eagle1.0/info.eagle Externals/Eagle/lib/Eagle1.0/init.eagle Externals/Eagle/lib/Eagle1.0/list.eagle Externals/Eagle/lib/Eagle1.0/object.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.eagle Externals/Eagle/lib/Eagle1.0/pkgIndex.tcl Externals/Eagle/lib/Eagle1.0/platform.eagle Externals/Eagle/lib/Eagle1.0/process.eagle Externals/Eagle/lib/Eagle1.0/runopt.eagle Externals/Eagle/lib/Eagle1.0/safe.eagle Externals/Eagle/lib/Eagle1.0/shell.eagle Externals/Eagle/lib/Eagle1.0/shim.eagle Externals/Eagle/lib/Eagle1.0/test.eagle Externals/Eagle/lib/Eagle1.0/testlog.eagle Externals/Eagle/lib/Eagle1.0/unkobj.eagle Externals/Eagle/lib/Eagle1.0/update.eagle Externals/Eagle/lib/Eagle1.0/vendor.eagle Externals/Eagle/lib/Eagle1.0/word.tcl Externals/Eagle/lib/Test1.0/all.eagle Externals/Eagle/lib/Test1.0/constraints.eagle Externals/Eagle/lib/Test1.0/epilogue.eagle Externals/Eagle/lib/Test1.0/pkgIndex.eagle Externals/Eagle/lib/Test1.0/pkgIndex.tcl Externals/Eagle/lib/Test1.0/prologue.eagle |
︙ | ︙ |