Eskil

TCLKIT_MAC     = $(TCLKIT)/tclkit-mac-867

# Paths to the libraries used.
# If you do not have access to all these, you can get them from an Eskil kit
# as explained below.
TEXTSEARCH = /home/$(USER)/src/textsearch
DIFFUTIL   = /home/$(USER)/src/DiffUtilTcl/lib.vfs/DiffUtil
WCB        = /home/$(USER)/src/packages/wcb3.8
PDF4TCL    = /home/$(USER)/src/pdf4tcl/pkg
SNIT       = /home/$(USER)/src/packages/tcllib/modules/snit
TABLELIST  = /home/$(USER)/src/packages/tablelist6.22
TWAPI      = /home/$(USER)/src/packages/twapi
TKDND      = /home/$(USER)/src/packages/tkdnd/lib/tkdnd2.4
EMBEDFONT  = /usr/share/fonts/truetype/liberation/LiberationMono-Regular.ttf

# Tools
NAGELFAR    = nagelfar

#---------------------------------------------------------*-tcl-*------
#
#  psmenu.tcl
#   Framework for building Tk menu structure
#
#  Copyright (c) 2024, Peter Spjuth  (peter.spjuth@gmail.com)
#
#  Permission is granted to use this code under the same terms as
#  for the Tcl core code.
#
#----------------------------------------------------------------------
#  This is used as a Tcl Module. Use it like this:
#  ::tcl::tm::path add <path-to-dir-with-module>
#  package require psmenu
#  psmenu::psmenu . {
#      definitions...
#  }
#----------------------------------------------------------------------

package provide psmenu 1.0

namespace eval psmenu {
    namespace export psmenu
}

set psmenu::example {
    # All definition blocks are lists.
    # Thus \-newline are not strictly necessary.
    # For compactness, options are kept short
    # -ul  for -underline
    #          "&File"-syntax supported for label
    # -var for -variable
    #          Variable is initialised if not existing
    #          If used with cascade, store menu widget in var
    # -cmd for -command
    #          command part is put through "subst"
    # -acc for -accelerator
    #          Will bind <Key-acc> to command unless -accelerator
    # -def for default value of -var
    #          checkbuttons default to default 0
    #          radiobuttons default to first value seen
    package require psmenu
    psmenu::psmenu . {
        # Comments are ok
        # If an argument looks like a "body" this is a cascade
        "&File" {
            "&Copy Solver URL" -cmd copySolverUrl
            # Separator is --*
            --------------------
            "&Quit" -cmd exit
        }
        "&Config" {
            "&Rules" -var ::mooa {
                "Knight" -var ::ruleset(knight) -cmd changeRuleSet
                "King"   -var ::ruleset(king)   -cmd changeRuleSet
                "No Consecutive" -var ::ruleset(consecutive) -cmd changeRuleSet
                "Grid Size" -var mooo {
                    # TBD allow loops?
                    # Define a bunch of radiobuttons at once.
                    # Without -value it is same as label string
                    _Radio -var ::ruleset(gridsize) -cmd newGame -def 9 {
                        "8"  -value 8
                        "9"  -value 9
                        "10"
                    }
                    # Individual example
                    "6"  -value 6  -var ::ruleset(gridsize) -cmd newGame
                }
            }
            # checkbutton has a -var and possibly -cmd, -onvalue, -offvalue
            "Conflict Check" -var ::uiData(conflict) -cmd autoConflict
        }
        "&Debug" {
            "Reread &Source" -acc F1 -cmd _rs
        }
    }
}

# Main call for psmenu. Optional arguments are for internal use.
proc psmenu::psmenu {top def {Toplevel ""} {Level ""}} {
    if {$top eq "."} {
        set m .m
    } else {
        set m $top.m
    }
    if {$Toplevel ne ""} {
        # Locate a free window name for the menu, for internal call
        while {[winfo exists $m]} {
            if {[regexp {^(.*?)(\d+)$} $m -> prefix index]} {
                incr index
            } else {
                set prefix $m
                set index 0
            }
            set m $prefix$index
        }
    }
    # It might exists for a second user call
    if { ! [winfo exists $m]} {
        # Create
        menu $m -tearoff 0
    }

    if {$Toplevel eq ""} {
        # Store inital level to handle scope when recursing cascades
        set Level [uplevel 1 info level]
        set Toplevel $top
        $top configure -menu $m
    }

    # Comments in definition block
    set def [regsub -all -line {^\s*#.*$} $def ""]

    set state ""
    while {[llength $def] > 0} {
        #puts "Def length [llength $def]"; update
        set entry [PopEntry def]
        set label [lindex $entry 0]
        if {$label eq "_Radio"} {
            set options [lrange $entry 1 end-1]
            set body [lindex $entry end]
            set radioDef {}
            for {set t 0} {$t < [llength $body]} {incr t} {
                set label [lindex $body $t]
                if {[lindex $body $t+1] eq "-value"} {
                    incr t 2
                    set value [lindex $body $t]
                } else {
                    set value $label
                }
                lappend radioDef $label -value $value {*}$options
            }

            # Prepend
            set def [list {*}$radioDef {*}$def]
            # TBD FIXA
            continue
        }

        # Conditionals
        if {$label eq "if"} {
            # TBD support elseif
            set ifExpr [lindex $entry 1]
            set body   [lindex $entry 2]
            set elseBody [lindex $entry 4]
            set cond [uplevel \#$Level [list expr $ifExpr]]
            #puts "if expression '$ifExpr' = $cond"
            if {$cond} {
                # Prepend
                set def [list {*}$body {*}$def]
            } elseif {$elseBody ne ""} {
                set def [list {*}$elseBody {*}$def]
            }
            continue
        }

        # Recognise Cascade by even args "Name ?opts? Def"
        # An item will be "Name ?opts?", i.e odd
        if {[llength $entry] % 2 == 0} {
            # Cascade
            set options [lrange $entry 1 end-1]
            set body [lindex $entry end]
            # Recurse cascade defintion
            set cascade [psmenu $m $body $Toplevel $Level]
            # Since -menu is last, processing below can assume that.
            lappend options -menu $cascade
        } else {
            set options [lrange $entry 1 end]
        }
        #puts "Label   '$label'"
        #puts "Options '$options'"
        # Figure out type
        if {[string match "-*" $label]} {
            set type separator
            set label ""
        } elseif {[dict exists $options -menu]} {
            set type cascade
        } elseif {[dict exists $options -value]} {
            set type radiobutton
        } elseif {[dict exists $options -var]} {
            set type checkbutton
        } else {
            set type command
        }
        # Process options
        set newOptions {}
        if {$label ne ""} {
            lappend newOptions -label $label
        }
        set doBind ""
        set command ""
        set value ""
        set variable ""
        set default 0
        foreach {opt val} $options {
            switch -- $opt {
                -ul - -underline {
                    lappend newOptions -underline $val
                }
                -var - -variable {
                    if {$type eq "cascade"} {
                        set variable $val
                    } else {
                        set variable $val
                        lappend newOptions -variable $val
                    }
                }
                -cmd - -command {
                    set val [uplevel \#$Level [list subst $val]]
                    set command $val
                    lappend newOptions -command $val
                }
                -acc {
                    lappend newOptions -accelerator $val
                    set doBind $val
                }
                -accelerator {
                    lappend newOptions -accelerator $val
                }
                -value {
                    lappend newOptions -value $val
                    set default $val
                }
                -offvalue {
                    lappend newOptions -offvalue $val
                    set default $val
                }
                -onvalue {
                    lappend newOptions -onvalue $val
                }
                -menu {
                    lappend newOptions -menu $val
                    if {$variable ne ""} {
                        uplevel \#$Level [list set $variable $val]
                    }
                }
                -def {
                    set default $val
                }
                default {
                    # Just let through
                    lappend newOptions $opt $val
                }
            }
        }

        if {$variable ne ""} {
            upvar \#$Level $variable __vv
            if {![info exists __vv]} {
                set __vv $default
            }
        }

        # TK helper to handle & in label
        ::tk::AmpMenuArgs $m add $type {*}$newOptions

        if {$doBind ne ""} {
            bind $Toplevel <Key-$doBind> $command
        }
    }

    return $m
}

# Extract one entry from definiton
proc psmenu::PopEntry {defName} {
    upvar 1 $defName def

    set result {}

    if {[lindex $def 0] eq "if"} {
        # TBD support elseif
        if {[lindex $def 0] eq "else"} {
            set result [lrange $def 0 4]
            set def [lrange $def 5 end]
        } else {
            set result [lrange $def 0 2]
            set def [lrange $def 3 end]
        }
        return $result
    }

    set state "label"
    set n -1
    foreach arg $def {
        incr n
        switch $state {
            "label" {
                lappend result $arg
                set state "option"
            }
            "option" {
                if {[string match "--*" $arg]} {
                    incr n -1
                    break
                } elseif {[string match "-*" $arg]} {
                    lappend result $arg
                    set state "value"
                } elseif {[regexp {^\s+.*\s+$} $arg] || $arg eq ""} {
                    # recognise body somehow
                    lappend result $arg
                    break
                } else {
                    # Must be next label
                    incr n -1
                    break
                }
            }
            "value" {
                lappend result $arg
                set state "option"
            }
        }
    }
    incr n
    set def [lrange $def $n end]
    return $result
}

if 0 {
    set mooo "Not set"
    console show
    package require Tk
    update
    wm geometry . 400x400
    update
    eval ${psmenu::example}
    puts "mooo $mooo"
    puts "mooa $mooa"
}

0
1
Added left
x
2
3
4
Added right
y
5
6
7
Changed same
8a
9
10
Changed different
<<<<<<< HEAD
12b
=======
12a
>>>>>>> main
13
14
Deleted left
17
18
Deleted right
20
21
Left: Add+change Right: change
<<<<<<< HEAD
22b
23
24
Left: change Right add+change
yy
25b
26
27
Left: Delete  Right: change
28a
29
30
Left: change  Right: delete
=======
xx
22a
23
24
Left: change Right add+change
25a
26
27
Left: Delete  Right: change
29
30
Left: change  Right: delete
31a
>>>>>>> main
32
33
Added same
xxx
34
35
36
Deleted same
38
39
Changed adjacent
<<<<<<< HEAD
40
41a
42
Left: Add+change Right: change same
=======
40a
41
42
Left: Add+change Right: change same
xxxx
>>>>>>> main
43a
44
45
Left: change same Right: add+change
<<<<<<< HEAD
yyyy
=======
>>>>>>> main
46a
47
48
Left: change Right: deleted block
<<<<<<< HEAD
52
Added different
yyyyy
=======
49
50a
51
52
Added different
xxxxx
>>>>>>> main
53
54
55
Left mixed change
57x
59
60
Right mixed change
61x
63x
64
65
Both added multiple
<<<<<<< HEAD
yy1
yy2
=======
xx1
xx2
>>>>>>> main
66
67

#!/bin/sh
# Build up a merge conflict in git
mkdir apa_git
cd apa_git
git init
cp ../tests/ancestor.txt a.txt
git add a.txt
git commit -m a
git checkout -b b
cp ../tests/right.txt a.txt
git commit -am r
git checkout main
cp ../tests/left.txt  a.txt
git commit -am l
git checkout b
#git merge main
#git mergetool
#git commit -am m

    } else {
        destroy {*}[winfo children $w]
    }
    set anyC $::eskil($top,mergeSelection,AnyConflict)

    wm title $w "Merge result: [TitleTail $top]"

    psmenu::psmenu $w {

        "&File" {

            "&Save" -cmd "saveMerge $top"

            ----
            "&Close" -cmd "closeMerge $top"
        }
        "&Select" {


            _Radio -var ::ruleset($top,curMergeSel) -cmd "selectMerge $top" {
                        "Left+Right" -value 12

                        "&Left"      -value 1

                        "&Right"     -value 2 


                        "Right+Left" -value 21
                    }
            ---
            "All Left"  -cmd "selectMergeAll $top 1"
            "All Right" -cmd "selectMergeAll $top 2"
        }
        "&Goto" {

            "Previous" -accelerator "Up"   -cmd "nextMerge $top -1"
            "Next"     -accelerator "Down" -cmd "nextMerge $top 1"
            if {$anyC} {
                "Previous Conflict" -accelerator "Ctrl-Up" -cmd "nextMerge $top -1000"
                "Next Conflict" -accelerator "Ctrl-Down" -cmd "nextMerge $top 1000"
            }
            "Previous 10" -accelerator "Shift-Up"   -cmd "nextMerge $top -10"
            "Next 10"     -accelerator "Shift-Down" -cmd "nextMerge $top 10"
        }
    }
    # Test how to add more cascade in more calls
    psmenu::psmenu $w {
        "&Config" {
            "Line end LF"   -value lf   -var ::eskil($top,mergetranslation)
            "Line end CRLF" -value crlf -var ::eskil($top,mergetranslation)
            if {$::eskil($top,mode) eq "conflict"} {

                ----
                "Pure" -var ::eskil($top,modetype) \
                        -onvalue "Pure" -offvalue "" -cmd "doDiff $top"
            }
        }
    }

    ttk::frame $w.f

    ttk::radiobutton $w.f.rb1 -text "LR" -value 12 \
            -variable ::eskil($top,curMergeSel) \
            -command "selectMerge $top"

    ::tcl::tm::path add $libDir

    package require Tk 8.6
    catch {package require textSearch}
    package require wcb
    package require snit
    package require tablelist_tile
    package require psmenu

    if {[catch {package require psballoon}]} {
        # Add a dummy if it does not exist.
        proc addBalloon {args} {}
    } else {
        namespace import -force psballoon::addBalloon
    }