Bwidget Source Code
Check-in [fdb38ca6f0]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Curing shift-lock interferences of Shift-Accelerators of Mainframe widget on the MAC. Ticket [83ce3e84e7], Patch [9f67a66609]
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: fdb38ca6f071202a5c7e74f8d73dad20285600ee
User & Date: oehhar 2013-06-28 07:45:06
Context
2013-09-02
09:39
notebook.tcl: cured error in _resize, that data($p,width) is not (jet) present. Ticket [a4cbba655d] check-in: 3e24e1b646 user: oehhar tags: bwidget
2013-08-14
17:46
notebook.tcl: cured error in _resize, that data($p,width) is not (jet) present. Ticket [a4cbba655d] Leaf check-in: cec2f0f4f8 user: oehhar tags: bug-a4cbba655d
2013-06-28
07:45
Curing shift-lock interferences of Shift-Accelerators of Mainframe widget on the MAC. Ticket [83ce3e84e7], Patch [9f67a66609] check-in: fdb38ca6f0 user: oehhar tags: bwidget
2013-06-26
08:03
mainframe.tcl: Reverted Patch [1977644] (checkin [58357c462f])(-casesensitive for accellerators). It has issues with shift-lock. check-in: 510027c421 user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2013-08-26 Harald Oehlmann <[email protected]>

	* mainframe.tcl: Reverted Patch [1977644]
	(-casesensitive for accellerators). It has
	issues with shift-lock.

2013-08-21 Harald Oehlmann <[email protected]>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2013-08-28 Harald Oehlmann <[email protected]>

	* mainframe.tcl: Included Patch [9f67a66609]
	curing issues of Shift-Accellerators with Shift-Lock
	on Mac. By Keith Nash, Ticket [83ce3e84e7].

2013-08-26 Harald Oehlmann <[email protected]>

	* mainframe.tcl: Reverted Patch [1977644]
	(-casesensitive for accellerators). It has
	issues with shift-lock.

2013-08-21 Harald Oehlmann <[email protected]>

Changes to mainframe.tcl.

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
624
625
626
627
628
629
630




631





632
633
634
635
636
637
638
...
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
...
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
    if { [Widget::hasChanged $path -textvariable newv] } {
        uplevel \#0 $path.status.label configure -textvariable [list $newv]
    }

    # The ttk frame has no -background
    if {![Widget::theme] && [Widget::hasChanged $path -background bg] } {
	if {$::tcl_platform(platform) == "unix"
	        && 0 != [string compare [tk windowingsystem] "aqua"]} {
	    set listmenu [$_widget($path,top) cget -menu]
	    while { [llength $listmenu] } {
		set newlist {}
		foreach menu $listmenu {
		    $menu configure -background $bg
		    set newlist [concat $newlist [winfo children $menu]]
		}
................................................................................
            DynamicHelp::register $menu menuentry $count $desc
        }

        # entry accelerator
        set accel [_parse_accelerator [lindex $entry 4]]
        if { [llength $accel] } {
            lappend opt -accelerator [lindex $accel 0]




            bind $_widget($path,top) [lindex $accel 1] [list $menu invoke $count]





        }

        # user options
        set useropt [lrange $entry 5 end]
        if { [string equal $type "command"] ||
             [string equal $type "radiobutton"] ||
             [string equal $type "checkbutton"] } {
................................................................................
    }
}


# MainFrame::_parse_accelerator --
#
#	Given a key combo description, construct an appropriate human readable
#	string (for display on as a menu accelerator) and the corresponding
#	bind event.








#
# Arguments:
#	desc	a list with the following format:
#			?sequence? key
#		sequence may be None, Ctrl, Alt, CtrlAlt, Shift, Cmd or
#			ShiftCmd
#		key may be any key
#
# Results:
#	{accel event}	a list containing the accelerator string and the event


proc MainFrame::_parse_accelerator { desc } {


    set fKey 0
    if { [llength $desc] == 1 } {
	set seq None
	set key [string tolower [lindex $desc 0]]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} {
	    set key [string toupper $key]
................................................................................
	    set fKey 1
	}
    } else {
	return {}
    }

    # Plain "Shift" can be used only with F keys, but "ShiftCmd" is allowed.
    if {[string equal $seq "Shift"] && !$fKey} {
        return -code error {Shift accelerator can be used only with F keys}
    }




    switch -- $seq {
	None {
	    set accel "[string toupper $key]"
	    set event "<Key-$key>"



	}
	Shift {
	    # Used only with Function keys.
	    set accel "Shift+[string toupper $key]"
	    set event "<Shift-Key-$key>"
	}
	Cmd {
	    set accel "Cmd+[string toupper $key]"





	    set event "<Command-Key-$key>"












	}

	ShiftCmd {
	    if {    [string equal [tk windowingsystem] "aqua"] &&
		    [string first AppKit [winfo server .]] == -1
	    } {
		# Carbon
		set accel "Shift+Cmd+[string toupper $key]"

		set event "<Shift-Command-Key-[string toupper $key]>"



	    } else {
		# Cocoa and anything else that uses Cmd
		set accel "Shift+Cmd+[string toupper $key]"





		set event "<Shift-Command-Key-$key>"

	    }
	}
	Ctrl {
	    set accel "Ctrl+[string toupper $key]"
	    set event "<Control-Key-$key>"
	}
	Alt {
	    set accel "Alt+[string toupper $key]"
	    set event "<Alt-Key-$key>"
	}
	CtrlAlt {
	    set accel "Ctrl+Alt+[string toupper $key]"
	    set event "<Control-Alt-Key-$key>"
	}
	default {
	    return -code error "invalid accelerator code $seq"
	}
    }

    return [list $accel $event]
}






|
|







 







>
>
>
>
|
>
>
>
>
>







 







|
|
>
>
>
>
>
>
>
>









|
>


>
>







 







|



>
>
>


|
|
>
>
>



|
|


|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>


|


|
>
|
>
>
>


|
>
>
>
>
>
|
>



|
|


|
|


|
|





>
|

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
...
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
...
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
    if { [Widget::hasChanged $path -textvariable newv] } {
        uplevel \#0 $path.status.label configure -textvariable [list $newv]
    }

    # The ttk frame has no -background
    if {![Widget::theme] && [Widget::hasChanged $path -background bg] } {
	if {($::tcl_platform(platform) == "unix")
	        && (0 != [string compare [tk windowingsystem] "aqua"])} {
	    set listmenu [$_widget($path,top) cget -menu]
	    while { [llength $listmenu] } {
		set newlist {}
		foreach menu $listmenu {
		    $menu configure -background $bg
		    set newlist [concat $newlist [winfo children $menu]]
		}
................................................................................
            DynamicHelp::register $menu menuentry $count $desc
        }

        # entry accelerator
        set accel [_parse_accelerator [lindex $entry 4]]
        if { [llength $accel] } {
            lappend opt -accelerator [lindex $accel 0]
            foreach event [lindex $accel 1] {
                bind $_widget($path,top) $event [list $menu invoke $count]
            }
            foreach event [lindex $accel 2] {
                if {[bind $_widget($path,top) $event] == {}} {
                    bind $_widget($path,top) $event { # do nothing }
                } else {
                    # The existing binding will intercept these events.
                }
            }
        }

        # user options
        set useropt [lrange $entry 5 end]
        if { [string equal $type "command"] ||
             [string equal $type "radiobutton"] ||
             [string equal $type "checkbutton"] } {
................................................................................
    }
}


# MainFrame::_parse_accelerator --
#
#	Given a key combo description, construct an appropriate human readable
#	string (for display on as a menu accelerator), a list of the
#	corresponding bind events, and a separate list of bind events that need
#	to be blocked.
#
# 	When argument $desc does not include "Shift", the bindings to $events
# 	will in some cases also intercept events that have the modifier "Shift",
# 	unless more specific bindings $blockEvents exist to the latter.  This
# 	situation occurs, for example, when a Cmd binding exists without a
# 	corresponding ShiftCmd binding.  The list of events that need to be
#       blocked is returned as the third element of the result.
#
# Arguments:
#	desc	a list with the following format:
#			?sequence? key
#		sequence may be None, Ctrl, Alt, CtrlAlt, Shift, Cmd or
#			ShiftCmd
#		key may be any key
#
# Results:
#	{accel events blockEvents}  a list containing the accelerator string and
#	                            two lists of events

proc MainFrame::_parse_accelerator { desc } {
    variable _widget

    set fKey 0
    if { [llength $desc] == 1 } {
	set seq None
	set key [string tolower [lindex $desc 0]]
	# If the key is an F key (ie, F1, F2, etc), it has to be capitalized
	if {[regexp {^f([1-9]|([12][0-9]|3[0-5]))$} $key]} {
	    set key [string toupper $key]
................................................................................
	    set fKey 1
	}
    } else {
	return {}
    }

    # Plain "Shift" can be used only with F keys, but "ShiftCmd" is allowed.
    if {[string equal $seq "Shift"] && (!$fKey)} {
        return -code error {Shift accelerator can be used only with F keys}
    }

    set blockEvents {}
    set upc [string toupper $key]

    switch -- $seq {
	None {
	    set accel "$upc"
	    set events [list "<Key-$key>"]
	    if {$fKey} {
		set blockEvents [list "<Shift-Key-$key>"]
	    }
	}
	Shift {
	    # Used only with Function keys.
	    set accel "Shift+$upc"
	    set events [list "<Shift-Key-$key>"]
	}
	Cmd {
	    set accel "Cmd+$upc"

	    if {    [string equal [tk windowingsystem] "aqua"] &&
		   ([string first AppKit [winfo server .]] == -1)
	    } {
		# Carbon
	        set events [list "<Command-Key-$key>" \
	                    "<Lock-Command-Key-$upc>" ]
		set blockEvents [list "<Lock-Shift-Command-Key-$upc>"]
		# Both bindings must be included in $events -  the first binding
		# does not fire if "Lock" is set, and this is as bind(n) states
		# because the second binding is NOT a more specialized form of
		# the first.
	    } else {
		# Cocoa and anything else that uses Cmd
	        set events [list "<Command-Key-$key>"]
	        # A binding to "<Lock-Command-Key-$upc>" must not be included
	        # here - both events fire if "Lock" is set.
		set blockEvents [list "<Shift-Command-Key-$key>"]
	    }
	}
	ShiftCmd {
	    if {    [string equal [tk windowingsystem] "aqua"] &&
		    ([string first AppKit [winfo server .]] == -1)
	    } {
		# Carbon
		set accel "Shift+Cmd+$upc"
		set events [list "<Shift-Command-Key-$upc>" \
			    "<Lock-Shift-Command-Key-$upc>"]
		# Both bindings must be included here -  the first binding does
		# not fire if "Lock" is set, even though the second binding
		# should be recognized as a more specialized form of the first.
	    } else {
		# Cocoa and anything else that uses Cmd
		set accel "Shift+Cmd+$upc"
		set events [list "<Shift-Command-Key-$key>"]
		# A binding to "<Lock-Shift-Command-Key-$key>" must not be
		# included here - both events fire if "Lock" is set.
		# Tk/Cocoa fails to recognize
		# <Lock-Shift-Command-Key-$key> as a "more specialized" binding
		# than <Shift-Command-Key-$key>.
		# Perversely, Tk/Carbon (above) makes the opposite error.
	    }
	}
	Ctrl {
	    set accel "Ctrl+$upc"
	    set events [list "<Control-Key-$key>"]
	}
	Alt {
	    set accel "Alt+$upc"
	    set events [list "<Alt-Key-$key>"]
	}
	CtrlAlt {
	    set accel "Ctrl+Alt+$upc"
	    set events [list "<Control-Alt-Key-$key>"]
	}
	default {
	    return -code error "invalid accelerator code $seq"
	}
    }

    return [list $accel $events $blockEvents]
}