luke
/
netgen
mirror of https://github.com/RTimothyEdwards/netgen.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into netgen-1.5

This commit is contained in:
Tim Edwards 2025-01-05 02:00:04 -05:00
parent e4a4621b96 021dfa6e8a
commit 7bee1851fa
2 changed files with 124 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
VERSION
View File

@ -1 +1 @@
1.5.290 1.5.291

113
tcltk/tkcon.tcl
View File

@ -44,6 +44,8 @@ exec ${NETGEN_WISH:=wish} "$0" ${1+"$@"}
if {$tcl_version < 8.0} { if {$tcl_version < 8.0} {
return -code error "tkcon requires at least Tcl/Tk8" return -code error "tkcon requires at least Tcl/Tk8"
} else { } else {
# Prevent breaking on version 8.5.2
# package require -exact Tk $tcl_version
package require Tk $tcl_version package require Tk $tcl_version
} }
@ -59,18 +61,6 @@ foreach pkg [info loaded {}] {
} }
catch {unset pkg file name version} catch {unset pkg file name version}
# Tk 8.4 makes previously exposed stuff private.
# FIX: Update tkcon to not rely on the private Tk code.
#
if {![llength [info globals tkPriv]]} {
::tk::unsupported::ExposePrivateVariable tkPriv
}
foreach cmd {SetCursor UpDownLine Transpose ScrollPages} {
if {![llength [info commands tkText$cmd]]} {
::tk::unsupported::ExposePrivateCommand tkText$cmd
}
}
# Initialize the ::tkcon namespace # Initialize the ::tkcon namespace
# #
namespace eval ::tkcon { namespace eval ::tkcon {
@ -196,7 +186,7 @@ proc ::tkcon::Init {} {
tkcon_puts tkcon_gets observe observe_var unalias which what tkcon_puts tkcon_gets observe observe_var unalias which what
} }
version 2.3 version 2.3
RCS {RCS: @(#) $Id: tkcon.tcl,v 1.2 2008/05/23 00:20:17 tim Exp $} RCS {RCS: @(#) $Id: tkcon.tcl,v 1.2 2008/04/18 16:28:13 tim Exp $}
HEADURL {http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tkcon/tkcon/tkcon.tcl?rev=HEAD} HEADURL {http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tkcon/tkcon/tkcon.tcl?rev=HEAD}
docs "http://tkcon.sourceforge.net/" docs "http://tkcon.sourceforge.net/"
email {jeff@hobbs.org} email {jeff@hobbs.org}
@ -745,7 +735,7 @@ proc ::tkcon::EvalCmd {w cmd} {
$w tag bind $tag <Leave> \ $w tag bind $tag <Leave> \
[list $w tag configure $tag -underline 0] [list $w tag configure $tag -underline 0]
$w tag bind $tag <ButtonRelease-1> \ $w tag bind $tag <ButtonRelease-1> \
"if {!\[info exists tkPriv(mouseMoved)\] || !\$tkPriv(mouseMoved)} \ "if {!\[info exists ::tk::Priv(mouseMoved)\] || !\$::tk::Priv(mouseMoved)} \
{[list edit -attach [Attach] -type error -- $PRIV(errorInfo)]}" {[list edit -attach [Attach] -type error -- $PRIV(errorInfo)]}"
} else { } else {
$w insert output $res\n stderr $w insert output $res\n stderr
@ -2474,7 +2464,7 @@ proc ::tkcon::ErrorHighlight w {
$w tag configure $tag -foreground $COLOR(stdout) $w tag configure $tag -foreground $COLOR(stdout)
$w tag bind $tag <Enter> [list $w tag configure $tag -underline 1] $w tag bind $tag <Enter> [list $w tag configure $tag -underline 1]
$w tag bind $tag <Leave> [list $w tag configure $tag -underline 0] $w tag bind $tag <Leave> [list $w tag configure $tag -underline 0]
$w tag bind $tag <ButtonRelease-1> "if {!\$tkPriv(mouseMoved)} \ $w tag bind $tag <ButtonRelease-1> "if {!\$::tk::Priv(mouseMoved)} \
{[list edit -attach $app -type proc -find $what -- $cmd]}" {[list edit -attach $app -type proc -find $what -- $cmd]}"
} }
set info [string range $info $c1 end] set info [string range $info $c1 end]
@ -2503,7 +2493,7 @@ proc ::tkcon::ErrorHighlight w {
$w tag configure $tag -foreground $COLOR(proc) $w tag configure $tag -foreground $COLOR(proc)
$w tag bind $tag <Enter> [list $w tag configure $tag -underline 1] $w tag bind $tag <Enter> [list $w tag configure $tag -underline 1]
$w tag bind $tag <Leave> [list $w tag configure $tag -underline 0] $w tag bind $tag <Leave> [list $w tag configure $tag -underline 0]
$w tag bind $tag <ButtonRelease-1> "if {!\$tkPriv(mouseMoved)} \ $w tag bind $tag <ButtonRelease-1> "if {!\$::tk::Priv(mouseMoved)} \
{[list edit -attach $app -type proc -- $cmd]}" {[list edit -attach $app -type proc -- $cmd]}"
} }
} }
@ -2552,8 +2542,8 @@ proc tkcon {cmd args} {
## 'congets' a replacement for [gets stdin] ## 'congets' a replacement for [gets stdin]
# Use the 'gets' alias of 'tkcon_gets' command instead of # Use the 'gets' alias of 'tkcon_gets' command instead of
# calling the *get* methods directly for best compatability # calling the *get* methods directly for best compatability
if {[llength $args]} { if {[llength $args] > 1} {
return -code error "wrong # args: must be \"tkcon congets\"" return -code error "wrong # args: must be \"tkcon congets [pfix]\""
} }
tkcon show tkcon show
set old [bind TkConsole <<TkCon_Eval>>] set old [bind TkConsole <<TkCon_Eval>>]
@ -2561,7 +2551,12 @@ proc tkcon {cmd args} {
set w $::tkcon::PRIV(console) set w $::tkcon::PRIV(console)
# Make sure to move the limit to get the right data # Make sure to move the limit to get the right data
$w mark set insert end $w mark set insert end
if {[llength $args]} {
$w mark set limit insert $w mark set limit insert
$w insert end $args
} else {
$w mark set limit insert
}
$w see end $w see end
vwait ::tkcon::PRIV(wait) vwait ::tkcon::PRIV(wait)
set line [::tkcon::CmdGet $w] set line [::tkcon::CmdGet $w]
@ -2798,13 +2793,19 @@ proc tkcon_puts args {
foreach {arg1 arg2 arg3} $args { break } foreach {arg1 arg2 arg3} $args { break }
if {$len == 1} { if {$len == 1} {
tkcon console insert output "$arg1\n" stdout set sarg $arg1
set nl 1
set farg stdout
} elseif {$len == 2} { } elseif {$len == 2} {
if {![string compare $arg1 -nonewline]} { if {![string compare $arg1 -nonewline]} {
tkcon console insert output $arg2 stdout set sarg $arg2
set farg stdout
set nl 0
} elseif {![string compare $arg1 stdout] \ } elseif {![string compare $arg1 stdout] \
|| ![string compare $arg1 stderr]} { || ![string compare $arg1 stderr]} {
tkcon console insert output "$arg2\n" $arg1 set sarg $arg2
set farg $arg1
set nl 1
} else { } else {
set len 0 set len 0
} }
@ -2812,11 +2813,15 @@ proc tkcon_puts args {
if {![string compare $arg1 -nonewline] \ if {![string compare $arg1 -nonewline] \
&& (![string compare $arg2 stdout] \ && (![string compare $arg2 stdout] \
|| ![string compare $arg2 stderr])} { || ![string compare $arg2 stderr])} {
tkcon console insert output $arg3 $arg2 set sarg $arg3
set farg $arg2
set nl 0
} elseif {(![string compare $arg1 stdout] \ } elseif {(![string compare $arg1 stdout] \
|| ![string compare $arg1 stderr]) \ || ![string compare $arg1 stderr]) \
&& ![string compare $arg3 nonewline]} { && ![string compare $arg3 nonewline]} {
tkcon console insert output $arg2 $arg1 set sarg $arg2
set farg $arg1
set nl 0
} else { } else {
set len 0 set len 0
} }
@ -2826,7 +2831,42 @@ proc tkcon_puts args {
## $len == 0 means it wasn't handled by tkcon above. ## $len == 0 means it wasn't handled by tkcon above.
## ##
if {$len == 0} {
if {$len != 0} {
## "poor man's" \r substitution---erase everything on the output
## line and print from character after the \r
set rpt [string last \r $sarg]
if {$rpt >= 0} {
tkcon console delete "insert linestart" "insert lineend"
set sarg [string range $sarg [expr {$rpt + 1}] end]
}
set bpt [string first \b $sarg]
if {$bpt >= 0} {
set narg [string range $sarg [expr {$bpt + 1}] end]
set sarg [string range $sarg 0 [expr {$bpt - 1}]]
set nl 0
}
if {$nl == 0} {
tkcon console insert output $sarg $farg
} else {
tkcon console insert output "$sarg\n" $farg
}
if {$bpt >= 0} {
tkcon console delete "insert -1 char" insert
if {$nl == 0} {
tkcon_puts $farg $narg nonewline
} else {
tkcon_puts $farg $narg
}
}
} else {
global errorCode errorInfo global errorCode errorInfo
if {[catch "tkcon_tcl_puts $args" msg]} { if {[catch "tkcon_tcl_puts $args" msg]} {
regsub tkcon_tcl_puts $msg puts msg regsub tkcon_tcl_puts $msg puts msg
@ -4106,7 +4146,7 @@ proc ::tkcon::Bindings {} {
global tcl_platform tk_version global tcl_platform tk_version
#----------------------------------------------------------------------- #-----------------------------------------------------------------------
# Elements of tkPriv that are used in this file: # Elements of ::tk::Priv that are used in this file:
# #
# char - Character position on the line; kept in order # char - Character position on the line; kept in order
# to allow moving up or down past short lines while # to allow moving up or down past short lines while
@ -4134,6 +4174,9 @@ proc ::tkcon::Bindings {} {
foreach ev [bind Text] { bind TkConsole $ev [bind Text $ev] } foreach ev [bind Text] { bind TkConsole $ev [bind Text $ev] }
## We really didn't want the newline insertion ## We really didn't want the newline insertion
bind TkConsole <Control-Key-o> {} bind TkConsole <Control-Key-o> {}
## in 8.6b3, the virtual events <<NextLine>> and <<PrevLine>>
# mess up our history feature
bind TkConsole <<NextLine>> {} bind TkConsole <<NextLine>> {}
bind TkConsole <<PrevLine>> {} bind TkConsole <<PrevLine>> {}
@ -4342,9 +4385,9 @@ proc ::tkcon::Bindings {} {
bind TkConsole <Control-a> { bind TkConsole <Control-a> {
if {[%W compare {limit linestart} == {insert linestart}]} { if {[%W compare {limit linestart} == {insert linestart}]} {
tkTextSetCursor %W limit ::tk::TextSetCursor %W limit
} else { } else {
tkTextSetCursor %W {insert linestart} ::tk::TextSetCursor %W {insert linestart}
} }
} }
bind TkConsole <Key-Home> [bind TkConsole <Control-a>] bind TkConsole <Key-Home> [bind TkConsole <Control-a>]
@ -4368,14 +4411,14 @@ proc ::tkcon::Bindings {} {
} }
bind TkConsole <<TkCon_Previous>> { bind TkConsole <<TkCon_Previous>> {
if {[%W compare {insert linestart} != {limit linestart}]} { if {[%W compare {insert linestart} != {limit linestart}]} {
tkTextSetCursor %W [tkTextUpDownLine %W -1] ::tk::TextSetCursor %W [::tk::TextUpDownLine %W -1]
} else { } else {
::tkcon::Event -1 ::tkcon::Event -1
} }
} }
bind TkConsole <<TkCon_Next>> { bind TkConsole <<TkCon_Next>> {
if {[%W compare {insert linestart} != {end-1c linestart}]} { if {[%W compare {insert linestart} != {end-1c linestart}]} {
tkTextSetCursor %W [tkTextUpDownLine %W 1] ::tk::TextSetCursor %W [::tk::TextUpDownLine %W 1]
} else { } else {
::tkcon::Event 1 ::tkcon::Event 1
} }
@ -4390,7 +4433,7 @@ proc ::tkcon::Bindings {} {
} }
bind TkConsole <<TkCon_Transpose>> { bind TkConsole <<TkCon_Transpose>> {
## Transpose current and previous chars ## Transpose current and previous chars
if {[%W compare insert > "limit+1c"]} { tkTextTranspose %W } if {[%W compare insert > "limit+1c"]} { ::tk::TextTranspose %W }
} }
bind TkConsole <<TkCon_ClearLine>> { bind TkConsole <<TkCon_ClearLine>> {
## Clear command line (Unix shell staple) ## Clear command line (Unix shell staple)
@ -4408,10 +4451,10 @@ proc ::tkcon::Bindings {} {
::tkcon::Insert %W $::tkcon::PRIV(tmp) ::tkcon::Insert %W $::tkcon::PRIV(tmp)
%W see end %W see end
} }
catch {bind TkConsole <Key-Page_Up> { tkTextScrollPages %W -1 }} catch {bind TkConsole <Key-Page_Up> { ::tk::TextScrollPages %W -1 }}
catch {bind TkConsole <Key-Prior> { tkTextScrollPages %W -1 }} catch {bind TkConsole <Key-Prior> { ::tk::TextScrollPages %W -1 }}
catch {bind TkConsole <Key-Page_Down> { tkTextScrollPages %W 1 }} catch {bind TkConsole <Key-Page_Down> { ::tk::TextScrollPages %W 1 }}
catch {bind TkConsole <Key-Next> { tkTextScrollPages %W 1 }} catch {bind TkConsole <Key-Next> { ::tk::TextScrollPages %W 1 }}
bind TkConsole <$PRIV(meta)-d> { bind TkConsole <$PRIV(meta)-d> {
if {[%W compare insert >= limit]} { if {[%W compare insert >= limit]} {
%W delete insert {insert wordend} %W delete insert {insert wordend}
@ -4429,7 +4472,7 @@ proc ::tkcon::Bindings {} {
} }
bind TkConsole <ButtonRelease-2> { bind TkConsole <ButtonRelease-2> {
if { if {
(!$tkPriv(mouseMoved) || $tk_strictMotif) && (!$::tk::Priv(mouseMoved) || $tk_strictMotif) &&
![catch {::tkcon::GetSelection %W} ::tkcon::PRIV(tmp)] ![catch {::tkcon::GetSelection %W} ::tkcon::PRIV(tmp)]
} { } {
if {[%W compare @%x,%y < limit]} { if {[%W compare @%x,%y < limit]} {