"::htext::toggleHideVar $w $varIndex"
+ $w tag add toggle$varIndex $start $end
+ set ::htext::pos($varIndex) $pos
+ set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $varIndex $varIndex $hideVar]
+ incr ::htext::varIndex($w)
+ return [list var var$varIndex]
+}
+
+#Helper procs for show/hide variation
+#when new game is loaded delete all tags with varN
+proc ::htext::deleteToggleVar { w } {
+ foreach i [ lsearch -all -inline [$w tag names] var* ] {
+ $w tag delete $i
+ }
+ set ::htext::amountVar($w) 0
+ set ::htext::hideVarValue($w) { }
+}
+
+#make sure a variation is shown when a move from variation is on the board
+proc ::htext::showVar { w pos } {
+ set tag [lsearch -inline [$w tag names $pos] var*]
+ if { $tag ne "" && [$w tag cget $tag -elide]} {
+ ::htext::toggleHideVar $w [string range $tag 3 end]
+ }
+}
+
+#reset status for hide/show on all variations according hideVar
+proc ::htext::resetToggleVar { w hideVar} {
+ set i [llength $::htext::hideVarValue($w)]
+ while { $i > 0 } {
+ incr i -1
+ toggleHideVar $w $i $hideVar
+ }
+}
+
+#toggle status of hide/show of a variation or set it to hv
+proc ::htext::toggleHideVar { w n {hv ""}} {
+ lassign [$w tag nextrange toggle$n 1.0] start end
+ if { $hv eq "" } {
+ set hv [expr - [$w tag cget var$n -elide] + 1 ];
+ }
+ $w tag configure var$n -elide $hv
+ $w configure -state normal
+ if { $hv } {
+ $w replace $start $end " \[+\] "
+ } else {
+ $w replace $start $end " \[-\] "
+ }
+ $w tag configure var$n -elide $hv
+ $w tag add toggle$n $start $end
+ $w configure -state disabled
+ set ::htext::hideVarValue($w) [lreplace $::htext::hideVarValue($w) $n $n $hv]
+}
+
+proc ::htext::display {w str {section ""} {fixed 1}} {
global helpWin
# set start [clock clicks -milli]
set helpWin(Indent) 0
set ::htext::interrupt 0
$w mark set insert 0.0
$w configure -state normal
- set linkName ""
-
set count 0
- set str $helptext
+ ::htext::countVar $w $str
if {$fixed} {
regsub -all "\n\n" $str "" str
regsub -all "\n" $str " " str
@@ -273,188 +538,37 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} {
regsub -all ">\[ \n\]+" $str "> " str
regsub -all "\[ \n\]+<" $str " <" str
}
- set tagType ""
- set seePoint ""
-
+
if {! [info exists ::htext::updates($w)]} {
set ::htext::updates($w) 100
}
-
+
# Loop through the text finding the next formatting tag:
-
while {1} {
set startPos [string first "<" $str]
if {$startPos < 0} { break }
set endPos [string first ">" $str]
if {$endPos < 1} { break }
-
+
set tagName [string range $str [expr {$startPos + 1}] [expr {$endPos - 1}]]
-
- # Check if it is a starting tag (no "/" at the start):
-
- if {![strIsPrefix "/" $tagName]} {
-
- # Check if it is a link tag:
- if {[strIsPrefix "a " $tagName]} {
- set linkName [::htext::extractLinkName $tagName]
- set sectionName [::htext::extractSectionName $tagName]
- set linkTag "link ${linkName} ${sectionName}"
- set tagName "a"
- $w tag configure "$linkTag" -foreground blue -underline 1
- $w tag bind "$linkTag" \
- "helpWindow $linkName $sectionName"
- $w tag bind $linkTag \
- "$w tag configure \"$linkTag\" -background yellow
- $w configure -cursor hand2"
- $w tag bind $linkTag \
- "$w tag configure \"$linkTag\" -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "url " $tagName]} {
- # Check if it is a URL tag:
- set urlName [string range $tagName 4 end]
- set urlTag "url $urlName"
- set tagName "url"
- $w tag configure "$urlTag" -foreground red -underline 1
- $w tag bind "$urlTag" "openURL {$urlName}"
- $w tag bind $urlTag \
- "$w tag configure \"$urlTag\" -background yellow
- $w configure -cursor hand2"
- $w tag bind $urlTag \
- "$w tag configure \"$urlTag\" -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "run " $tagName]} {
- # Check if it is a Tcl command tag:
- set runName [string range $tagName 4 end]
- set runTag "run $runName"
- set tagName "run"
- $w tag bind "$runTag" "catch {$runName}"
- $w tag bind $runTag \
- "$w tag configure \"$runTag\" -foreground white
- $w tag configure \"$runTag\" -background DodgerBlue4
- $w configure -cursor hand2"
- $w tag bind $runTag \
- "$w tag configure \"$runTag\" -foreground {}
- $w tag configure \"$runTag\" -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "go " $tagName]} {
- # Check if it is a goto tag:
- set goName [string range $tagName 3 end]
- set goTag "go $goName"
- set tagName "go"
- $w tag bind "$goTag" \
- "catch {$w see \[lindex \[$w tag nextrange $goName 1.0\] 0\]}"
- $w tag bind $goTag \
- "$w tag configure \"$goTag\" -foreground yellow
- $w tag configure \"$goTag\" -background maroon
- $w configure -cursor hand2"
- $w tag bind $goTag \
- "$w tag configure \"$goTag\" -foreground {}
- $w tag configure \"$goTag\" -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "pi " $tagName]} {
- # Check if it is a player info tag:
- set playerTag $tagName
- set playerName [string range $playerTag 3 end]
- set tagName "pi"
- $w tag configure "$playerTag" -foreground DodgerBlue3
- $w tag bind "$playerTag" "::pinfo::playerInfo \"$playerName\""
- $w tag bind $playerTag \
- "$w tag configure \"$playerTag\" -foreground white
- $w tag configure \"$playerTag\" -background DodgerBlue4
- $w configure -cursor hand2"
- $w tag bind $playerTag \
- "$w tag configure \"$playerTag\" -foreground DodgerBlue3
- $w tag configure \"$playerTag\" -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "g_" $tagName]} {
- # Check if it is a game-load tag:
- set gameTag $tagName
- set tagName "g"
- set gnum [string range $gameTag 2 end]
- set glCommand "::game::LoadMenu $w [sc_base current] $gnum %X %Y"
- $w tag bind $gameTag $glCommand
- $w tag bind $gameTag \
- "::gbrowser::new [sc_base current] $gnum"
- $w tag bind $gameTag \
- "$w tag configure $gameTag -foreground white
- $w tag configure $gameTag -background DodgerBlue4
- $w configure -cursor hand2"
- $w tag bind $gameTag \
- "$w tag configure $gameTag -foreground {}
- $w tag configure $gameTag -background {}
- $w configure -cursor {}"
- } elseif {[strIsPrefix "m_" $tagName]} {
- # Check if it is a move tag:
- set moveTag $tagName
- set tagName "m"
- ### TODO
- ### Does not work for variations as the var-Tag appears before
- ### the "sc_move pgn [string range $moveTag 2 end]; updateBoard"
- # Bind middle button to popup a PGN board:
- $w tag bind $moveTag "::pgn::ShowBoard .pgnWin.text $moveTag %X %Y"
- $w tag bind $moveTag "::pgn::HideBoard"
- # invoking contextual menu in PGN window
- $w tag bind $moveTag "sc_move pgn [string range $moveTag 2 end]; updateBoard"
- $w tag bind $moveTag "$w tag configure $moveTag -underline 1
- $w configure -cursor hand2"
- $w tag bind $moveTag "$w tag configure $moveTag -underline 0
- $w configure -cursor {}"
- } elseif {[strIsPrefix "c_" $tagName]} {
- # Check if it is a comment tag:
- set commentTag $tagName
- set tagName "c"
- $w tag configure $commentTag -foreground $::pgnColor(Comment) -font font_Regular
- $w tag bind $commentTag "sc_move pgn [string range $commentTag 2 end]; updateBoard; ::makeCommentWin"
- $w tag bind $commentTag "$w tag configure $commentTag -underline 1
- $w configure -cursor hand2"
- $w tag bind $commentTag "$w tag configure $commentTag -underline 0
- $w configure -cursor {}"
- }
-
- if {$tagName == "h1"} {$w insert end "\n"}
-
- }
-
+
# Now insert the text up to the formatting tag:
- $w insert end [string range $str 0 [expr {$startPos - 1}]]
-
- # Check if it is a name tag matching the section we want:
- if {$section != "" && [strIsPrefix "name " $tagName]} {
- set sect [string range $tagName 5 end]
- if {$section == $sect} { set seePoint [$w index insert] }
- }
-
- if {[string index $tagName 0] == "/"} {
- # Get rid of initial "/" character:
- set tagName [string range $tagName 1 end]
- switch -- $tagName {
- h1 - h2 - h3 - h4 - h5 {$w insert end "\n"}
- }
- if {$tagName == "p"} {$w insert end "\n"}
- #if {$tagName == "h1"} {$w insert end "\n"}
- if {$tagName == "menu"} {$w insert end "\]"}
- if {$tagName == "ul"} {
- incr helpWin(Indent) -4
- $w insert end "\n"
- }
- if {[info exists startIndex($tagName)]} {
- switch -- $tagName {
- a {$w tag add $linkTag $startIndex($tagName) [$w index insert]}
- g {$w tag add $gameTag $startIndex($tagName) [$w index insert]}
- c {$w tag add $commentTag $startIndex($tagName) [$w index insert]}
- m {$w tag add $moveTag $startIndex($tagName) [$w index insert]}
- pi {$w tag add $playerTag $startIndex($tagName) [$w index insert]}
- url {$w tag add $urlTag $startIndex($tagName) [$w index insert]}
- run {$w tag add $runTag $startIndex($tagName) [$w index insert]}
- go {$w tag add $goTag $startIndex($tagName) [$w index insert]}
- default {$w tag add $tagName $startIndex($tagName) [$w index insert]}
- }
- unset startIndex($tagName)
- }
- } else {
- switch -- $tagName {
+ set text [string range $str 0 [expr {$startPos - 1}]]
+ $w insert end $text
+
+ # Check if it is a starting tag (no "/" at the start) and process the tag:
+ if {![strIsPrefix "/" $tagName]} {
+ set fullTag($tagName) $tagName
+ set tag $tagName
+ #create basename of tag: m_12 -> m or "pi name" -> pi
+ if { [regexp ".*?\[_ \]" $tagName tag] } { set tag [string range $tag 0 end-1]}
+ switch -- $tag {
+ a - url - run - go - pi - g - m - c - var - img - button - window {
+ lassign [$::htext::proc($tag) $w $tagName] tagName fullTag($tagName) }
+ board { if { [info exists fullTag(m)] } {
+ # fullTag(m) has the movenumber of the last processed move
+ $::htext::proc($tag) $w [string range $fullTag(m) 2 end]} }
+ name { $::htext::proc($tag) $w $tagName $section }
ul {incr helpWin(Indent) 4}
li {
$w insert end "\n"
@@ -462,49 +576,30 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} {
$w insert end " "
}
}
- p {$w insert end "\n"}
- br {$w insert end "\n"}
q {$w insert end "\""}
lt {$w insert end "<"}
gt {$w insert end ">"}
- h2 - h3 - h4 - h5 {$w insert end "\n"}
+ menu {$w insert end "\["}
+ h1 - h2 - h3 - h4 - h5 - p - br {$w insert end "\n"}
}
- #Set the start index for this type of tag:
- set startIndex($tagName) [$w index insert]
- if {$tagName == "menu"} {$w insert end "\["}
}
-
- # Check if it is an image or button tag:
- if {[strIsPrefix "img " $tagName]} {
- set imgName [string range $tagName 4 end]
- #flags are not loaded on start, so check if a flag needs to load
- if { $imgName ne [info commands $imgName] && [string range $imgName 0 3] eq "flag" } {
- set imgName [getFlagImage [string range $imgName [expr [string length $imgName] - 3] end] yes]
+
+ if {[strIsPrefix "/" $tagName]} {
+ # Get rid of initial "/" character:
+ set tagName [string range $tagName 1 end]
+ switch -- $tagName {
+ menu {$w insert end "\]"}
+ ul {incr helpWin(Indent) -4; $w insert end "\n"}
+ h1 - h2 - h3 - h4 - h5 - p {$w insert end "\n"}
}
- set winName $w.$imgName
- while {[winfo exists $winName]} { append winName a }
- ttk::label $winName -image $imgName -relief flat -borderwidth 0 -background white
- $w window create end -window $winName
- }
- if {[strIsPrefix "button " $tagName]} {
- set idx [ string first "-command" $tagName]
- set cmd ""
- if {$idx == -1} {
- set imgName [string range $tagName 7 end]
- } else {
- set imgName [string trim [string range $tagName 7 [expr $idx -1]]]
- set cmd [ string range $tagName [expr $idx +9] end ]
+ if {[info exists startIndex($tagName)]} {
+ $w tag add $fullTag($tagName) $startIndex($tagName) [$w index insert]
+ unset startIndex($tagName)
}
- set winName $w.$imgName
- while {[winfo exists $winName]} { append winName a }
- ttk::button $winName -image $imgName -command $cmd
- $w window create end -window $winName
- }
- if {[strIsPrefix "window " $tagName]} {
- set winName [string range $tagName 7 end]
- $w window create end -window $winName
+ } else {
+ #Set the start index for this type of tag:
+ set startIndex($tagName) [$w index insert]
}
-
# Now eliminate the processed text from the string:
set str [string range $str [expr {$endPos + 1}] end]
incr count
@@ -514,11 +609,9 @@ proc ::htext::display {w helptext {section ""} {fixed 1}} {
return
}
}
-
+
# Now add any remaining text:
if {! $::htext::interrupt} { $w insert end $str }
-
- if {$seePoint != ""} { $w yview $seePoint }
$w configure -state disabled
# set elapsed [expr {[clock clicks -milli] - $start}]
}
diff --git a/tcl/options.tcl b/tcl/options.tcl
index 10256342..af8ee264 100644
--- a/tcl/options.tcl
+++ b/tcl/options.tcl
@@ -279,6 +279,8 @@ set ::pgn::columnFormat 0
set ::pgn::stripMarks 0
set ::pgn::showPhoto 1
set ::pgn::figurine 0
+set ::pgn::hideVar 0
+set ::pgn::showDiagramm 0
set pgnColor(Var) ""
set pgnColor(Nag) {#cf6403}
set pgnColor(Comment) {#008b00}
@@ -630,7 +632,7 @@ proc options.write {} {
puts $optionF ""
foreach i {boardSize boardStyle language ::pgn::showColor \
::pgn::indentVars ::pgn::indentComments ::pgn::showPhoto \
- ::pgn::shortHeader ::pgn::boldMainLine ::pgn::stripMarks ::pgn::figurine \
+ ::pgn::shortHeader ::pgn::boldMainLine ::pgn::stripMarks ::pgn::figurine ::pgn::hideVar ::pgn::showDiagramm \
::pgn::symbolicNags ::pgn::moveNumberSpaces ::pgn::columnFormat \
tree(order) optionsAutoSave ::tree::mask::recentMask \
ecoFile suggestMoves showVarPopup showVarArrows \
diff --git a/tcl/windows/pgn.tcl b/tcl/windows/pgn.tcl
index f345681b..358103fa 100644
--- a/tcl/windows/pgn.tcl
+++ b/tcl/windows/pgn.tcl
@@ -111,6 +111,9 @@ namespace eval pgn {
-variable ::pgn::showPhoto -command {::pgn::Refresh 1}
#ToDo: translate label
+ $w.menu.opt add checkbutton -label "Fold Variations" \
+ -variable ::pgn::hideVar -command {::htext::resetToggleVar .pgnWin.text $::pgn::hideVar}
+ $w.menu.opt add checkbutton -label "Show Diagramms" -variable ::pgn::showDiagramm -command {::pgn::Refresh 1}
$w.menu.opt add checkbutton -label "Notation Figurine" \
-variable ::pgn::figurine -command {::pgn::Refresh 1}
$w.menu.color add command -label PgnColorAnno \
@@ -138,6 +141,7 @@ namespace eval pgn {
grid columnconfigure $w 0 -weight 1
set pgnWin 1
+ bind $w <> "::htext::deleteToggleVar .pgnWin.text"
bind $w { set pgnWin 0 }
# Take input focus even if -state is disabled
@@ -205,6 +209,10 @@ namespace eval pgn {
$mctxt.evals2 add command -label "N" -command {::addNag N}
$mctxt.evals2 add command -label "D" -command {::addNag D}
+ #TODO: translate
+ $mctxt add command -label "Fold all Variations" -command {::htext::resetToggleVar .pgnWin.text 1}
+ $mctxt add command -label "Unfold all Variations" -command {::htext::resetToggleVar .pgnWin.text 0}
+ $mctxt add separator
$mctxt add command -label [tr EditDelete] -state $state -command "::pgn::deleteVar"
$mctxt add command -label [tr EditFirst] -state $state -command "::pgn::firstVar"
$mctxt add command -label [tr EditMain] -state $state -command "::pgn::mainVar"
@@ -294,9 +302,13 @@ namespace eval pgn {
set format plain
if {$::pgn::showColor} {set format color}
set pgnStr [sc_game pgn -symbols $::pgn::symbolicNags \
- -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments \
+ -indentVar $::pgn::indentVars -indentCom $::pgn::indentComments -showDiagram $::pgn::showDiagramm \
-space $::pgn::moveNumberSpaces -format $format -column $::pgn::columnFormat \
-short $::pgn::shortHeader -markCodes $::pgn::stripMarks -unicode $::pgn::figurine]
+ if { $::pgn::showDiagramm } {
+ #Add Diagramm for Chessbase Notation [#] in comment
+ set pgnStr [string map {"\[#\]" "" } $pgnStr]
+ }
set windowTitle [format $::tr(PgnWindowTitle) [sc_game number]]
::setTitle .pgnWin "$windowTitle"
@@ -331,6 +343,7 @@ namespace eval pgn {
.pgnWin.text tag remove Current 1.0 end
set moveRange [.pgnWin.text tag nextrange "m_$offset" 1.0]
if {[llength $moveRange] == 2} {
+ ::htext::showVar .pgnWin.text [lindex $moveRange 0]
.pgnWin.text tag add Current [lindex $moveRange 0] [lindex $moveRange 1]
.pgnWin.text see [lindex $moveRange 1]
} else {