Eskil

Check-in [c7652f29e5]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Handle accellerator with state
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: c7652f29e5836b243a55e1ddcfc0dbb3e932b22a46703358d0a4cd473a33d2b5
User & Date: peter 2024-09-08 02:23:23.354
Context
2024-09-08
02:23
Use psmenu with dirdiff window check-in: 2d052099ca user: peter tags: trunk
02:23
Handle accellerator with state check-in: c7652f29e5 user: peter tags: trunk
00:55
Added psmenu package. Use it for merge dialog. check-in: 88bd8ecfdb user: peter tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to eskil.vfs/lib/psmenu-1.0.tm.
︙︙
35
36
37
38
39
40
41

42
43
44
45
46
47
48

    # -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 --*








>








35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

    # -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
    # if/else commands can be included
    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 --*
︙︙
66
67
68
69
70
71
72



73
74
75
76
77
78
79

                    # 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.








>
>
>








67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

                    # 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
        }
    }
    # More calls with more cascades work
    psmenu::psmenu . {
        "&Debug" {
            "Reread &Source" -acc F1 -cmd _rs
        }
    }
}

# Main call for psmenu. Optional arguments are for internal use.
︙︙
97
98
99
100
101
102
103
104
105
106


107
108
109
110
111
112
113

    }
    # 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 ""]









|
|

>
>








101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

    }
    # It might exists for a second user call
    if { ! [winfo exists $m]} {
        # Create
        menu $m -tearoff 0
    }

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

    # Comments in definition block
    set def [regsub -all -line {^\s*#.*$} $def ""]
︙︙
251
252
253
254
255
256
257






258
259
260
261
262
263
264
265

            }
        }

        # 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








>
>
>
>
>
>
|








257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

            }
        }

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

        if {$doBind ne ""} {
            if {[regexp {^(.*)-(.*)$} $doBind -> pre post]} {
                set doBind $pre-Key-$post
            } else {
                set doBind Key-$doBind
            }
            #puts "Binding '$doBind' '$command'"
            bind $Toplevel <$doBind> $command
        }
    }

    return $m
}

# Extract one entry from definiton
︙︙