Bwidget Source Code
Check-in [58357c462f]
Not logged in
Core Home Timeline Branches Tags Tickets Wiki Login
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:Allow case-sensitive accelerators in mainframe by new option -casesensitive [Patch 1977644]
Timelines: family | ancestors | descendants | both | bwidget
Files: files | file ages | folders
SHA1: 58357c462ff3a66788f9d78d253e5596c8a65ac3
User & Date: oehhar 2013-06-21 14:24:14
References
2013-06-26
08:08 • Closed ticket [83ce3e84e7]: Implement Shift, Cmd and ShiftCmd menu accelerators for MainFrame plus 6 other changes artifact: c8878a50b3 user: oehhar
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
Context
2013-06-21
15:54
Documentation typos check-in: 85844bb788 user: oehhar tags: bwidget
14:24
Allow case-sensitive accelerators in mainframe by new option -casesensitive [Patch 1977644] check-in: 58357c462f user: oehhar tags: bwidget
13:30
Methods from Tk entry were restored for LabelEntry [Bug 1002844] check-in: cc146bdf09 user: oehhar tags: bwidget
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to BWman/MainFrame.html. 

18
19
20
21
22
23
24

25
26
27
28
29
30


31

32
33
34
35

36
37
38
39
40
41
42
43
44
45
46
..
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93






















94
95
96
97
98
99
100
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133


134
135
136
137
138
139
140

</TR>
<TR>
<TD>&nbsp;&nbsp;-progressmax (see <B>-maximum</B>)</TD>
<TD>&nbsp;&nbsp;-progresstype (see <B>-type</B>)</TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;-progressvar (see <B>-variable</B>)</TD>

</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wso">WIDGET-SPECIFIC OPTIONS</A></I></DT>
<DD><TABLE CELLSPACING=0 CELLSPACING=0 BORDER=0>
<TR>


<TD>&nbsp;&nbsp;<A HREF="#-height">-height</A></TR>

<TD>&nbsp;&nbsp;<A HREF="#-menu">-menu</A></TR>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-separator">-separator</A></TR>

<TD>&nbsp;&nbsp;<A HREF="#-textvariable">-textvariable</A></TR>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-width">-width</A></TR>
<TD>&nbsp;&nbsp;<A HREF="#-sizegrip">-sizegrip</A></TR>
</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wc">WIDGET COMMAND</A></I></DT>
<DD><I>pathName</I> <A HREF="#addindicator"><B>addindicator</B></A>
 ?<I>arg...</I>?
................................................................................
<BR><HR WIDTH="100%"><BR>
<B><A NAME="descr"></A>DESCRIPTION</B><BR>
<P>

MainFrame manage toplevel to have:<BR>
<UL>
<LI>simple menu creation, with automatic accelerator bindings and
<A HREF="DynamicHelp.html">DynamicHelp</A> association,
<LI>one or more toolbars that user can hide,
<LI>a status bar, displaying a user message or a menu description, and optionally a 
<A HREF="ProgressBar.html">ProgressBar</A>.
</UL>
</P>
<BR><HR WIDTH="50%"><BR>
<B><A NAME="wso">WIDGET-SPECIFIC OPTIONS</A></B><BR>






















<DL><DT><A NAME="-height"><B>-height</B></A></DT>
<DD>

Specifies the desired height for the user frame in any of the forms acceptable to
Tk_GetPixels. If this option is less than or equal to zero (the default) then the window
will not request any size at all.
</DD>
................................................................................

This option describes the menu. This is a list whose each five elements describe
one cascade menu. It has the following form:
{<I>menuname</I> <I>tags</I> <I>menuId</I> <I>tearoff</I> <I>menuentries</I>...}
where <I>menuentries</I> is a list where each element describe one menu entry, which can be:
<UL>
<LI>for a separator:<BR>
  {<B>separator</B>}
<LI>for a command:<BR>
  {<B>command</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I>? ?<I>option</I> <I>value</I>? ...}
<LI>for a check button:<BR>
  {<B>checkbutton</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I>? ?<I>option</I> <I>value</I>? ...}
<LI>for a radio button:<BR>
  {<B>radiobutton</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I> ?<I>option</I> <I>value</I>? ...}
<LI>for a cascade menu:<BR>
  {<B>cascade</B> <I>menuname</I> <I>tags</I> <I>menuId</I> <I>tearoff</I> <I>menuentries</I>}
</UL>
where:
<UL>
<LI><I>menuname</I> is the name of the menu. If it contains a &amp;, the following character
is automatically converted to the corresponding <B>-underline</B> option of <B>menu add</B>
command.
<LI><I>tags</I> is the tags list for the entry, used for enabling or disabling menu
entries with <B>MainFrame::setmenustate</B>.
<LI><I>menuId</I> is an id for the menu, from which you can get menu pathname with
 <B>MainFrame::getmenu</B>.
<LI><I>tearoff</I> specifies if menu has tearoff entry.
<LI><I>description</I> specifies a string for <A HREF=\"DynamicHelp.html\">DynamicHelp</A>.
<LI><I>accelerator</I> specifies a key sequence. It is a list of two elements, where the first
is one of <B>Ctrl</B>, <B>Alt</B> or <B>CtrlAlt</B>, and the second as letter or a digit.


An accelerator string is build and corresponding binding set on the toplevel to invoke the
menu entry.
<LI><I>option value</I> specifies additionnal options for the entry (see <B>menu add</B>
command).
</UL>
Each value enclosed by ? are optional and defaulted to empty string, but must be
provided if one or more following options is not empty.







>






>
>
|
>
|


|
>
|


|







 







|
|
|
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|

|

|

|

|





|

|

|
|
|

|
>
>








18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

</TR>
<TR>
<TD>&nbsp;&nbsp;-progressmax (see <B>-maximum</B>)</TD>
<TD>&nbsp;&nbsp;-progresstype (see <B>-type</B>)</TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;-progressvar (see <B>-variable</B>)</TD>
</TR>
</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wso">WIDGET-SPECIFIC OPTIONS</A></I></DT>
<DD><TABLE CELLSPACING=0 CELLSPACING=0 BORDER=0>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-casesensitive">-casesensitive</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-height">-height</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-menu">-menu</A></TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-separator">-separator</A></TD></TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-textvariable">-textvariable</A></TD>
</TR>
<TR>
<TD>&nbsp;&nbsp;<A HREF="#-width">-width</A></TD></TR>
<TD>&nbsp;&nbsp;<A HREF="#-sizegrip">-sizegrip</A></TR>
</TABLE></DD>
</DL>
<DL>
<DT><I><A HREF="#wc">WIDGET COMMAND</A></I></DT>
<DD><I>pathName</I> <A HREF="#addindicator"><B>addindicator</B></A>
 ?<I>arg...</I>?
................................................................................
<BR><HR WIDTH="100%"><BR>
<B><A NAME="descr"></A>DESCRIPTION</B><BR>
<P>

MainFrame manage toplevel to have:<BR>
<UL>
<LI>simple menu creation, with automatic accelerator bindings and
<A HREF="DynamicHelp.html">DynamicHelp</A> association,</LI>
<LI>one or more toolbars that user can hide,</LI>
<LI>a status bar, displaying a user message or a menu description, and optionally a
<A HREF="ProgressBar.html">ProgressBar</A>.</LI>
</UL>
</P>
<BR><HR WIDTH="50%"><BR>
<B><A NAME="wso">WIDGET-SPECIFIC OPTIONS</A></B><BR>

<DL><DT><A NAME="-casesensitive"><B>-casesensitive</B></A></DT>
<DD>
Controlls the interpretation of <I>accelerator</I> definition by the <B>-menu</B>
option. If this option is <B>false</B> or not given, the accelerator binding is done
for lowercase letters (no Shift Key pressed) and the accelerator text of the menu entry
is shown in uppercase letters. If it is set to <B>true</B> the accelerator binding
and the menu entry is done as given.
<P>
Example:<BR>
Both accelerators are identically if <B>-casesensitive</B> is specified as false. See
<A HREF="#-menu">-menu</A> for the syntax of the menu discription list.
</P>
<PRE>
...
{command "&Save" {} {Save the document} {<B>Ctrl s</B>} -command Menu::save}
{command "&Save As" {} {Save with different name} {<B>Ctrl S</B>} -command Menu::saveAs}
...
</PRE>
</DD>
</DL>

<DL><DT><A NAME="-height"><B>-height</B></A></DT>
<DD>

Specifies the desired height for the user frame in any of the forms acceptable to
Tk_GetPixels. If this option is less than or equal to zero (the default) then the window
will not request any size at all.
</DD>
................................................................................

This option describes the menu. This is a list whose each five elements describe
one cascade menu. It has the following form:
{<I>menuname</I> <I>tags</I> <I>menuId</I> <I>tearoff</I> <I>menuentries</I>...}
where <I>menuentries</I> is a list where each element describe one menu entry, which can be:
<UL>
<LI>for a separator:<BR>
  {<B>separator</B>}</LI>
<LI>for a command:<BR>
  {<B>command</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I>? ?<I>option</I> <I>value</I>? ...}</LI>
<LI>for a check button:<BR>
  {<B>checkbutton</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I>? ?<I>option</I> <I>value</I>? ...}</LI>
<LI>for a radio button:<BR>
  {<B>radiobutton</B> <I>menuname</I> ?<I>tags</I>? ?<I>description</I>? ?<I>accelerator</I> ?<I>option</I> <I>value</I>? ...}</LI>
<LI>for a cascade menu:<BR>
  {<B>cascade</B> <I>menuname</I> <I>tags</I> <I>menuId</I> <I>tearoff</I> <I>menuentries</I>}</LI>
</UL>
where:
<UL>
<LI><I>menuname</I> is the name of the menu. If it contains a &amp;, the following character
is automatically converted to the corresponding <B>-underline</B> option of <B>menu add</B>
command.</LI>
<LI><I>tags</I> is the tags list for the entry, used for enabling or disabling menu
entries with <B>MainFrame::setmenustate</B>.</LI>
<LI><I>menuId</I> is an id for the menu, from which you can get menu pathname with
 <B>MainFrame::getmenu</B>.</LI>
<LI><I>tearoff</I> specifies if menu has tearoff entry.</LI>
<LI><I>description</I> specifies a string for <A HREF=\"DynamicHelp.html\">DynamicHelp</A>.</LI>
<LI><I>accelerator</I> specifies a key sequence. It is a list of two elements, where the first
is one of <B>Ctrl</B>, <B>Alt</B> or <B>CtrlAlt</B>, and the second as letter
(see <A HREF="#-casesensitive">-casesensitive</A> option for interpretation),  digit or
a special key name.
An accelerator string is build and corresponding binding set on the toplevel to invoke the
menu entry.
<LI><I>option value</I> specifies additionnal options for the entry (see <B>menu add</B>
command).
</UL>
Each value enclosed by ? are optional and defaulted to empty string, but must be
provided if one or more following options is not empty.

Changes to ChangeLog. 

1
2
3
4




5
6
7
8
9
10
11

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

	* labelentry.tcl: Bug fixed:
	Methods from Tk entry widget restored [Bug 1002844].




	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.




>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

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

	* labelentry.tcl: Bug fixed:
	Methods from Tk entry widget restored [Bug 1002844].
	
	* mainframe.tcl: Allow case sensitive accelerators
	by new option -casesensitive.
	Patch by cmard [Patch 1977644]
	
2013-01-09 Harald Oehlmann <[email protected]>

	* widget.tcl: Bug fixed:
	Error 'invalid command name ".#BWidget.#ttk::entry"'
	arises in themed mode when an Entry widget should get
	focus by the tab key.

Changes to mainframe.tcl. 

34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53
54
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
...
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
...
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
...
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
...
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
...
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
688
689
690
691
692
693
694







695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718

	-maximum    -progressmax
	-variable   -progressvar
	-type       -progresstype
	-foreground -progressfg
    }

    Widget::declare MainFrame {
	{-width        TkResource 0      0 frame}
	{-height       TkResource 0      0 frame}
	{-background   TkResource ""     0 frame}
	{-textvariable String     ""     0}

	{-menu         String     {}     1}
	{-separator    Enum       both   1 {none top bottom both}}
	{-bg           Synonym    -background}

	{-menubarfont   String     ""  0}
	{-menuentryfont String     ""  0}
	{-statusbarfont String     ""  0}
	{-sizegrip      Boolean    0   1}
    }

................................................................................

    set _widget($path,top)      $top
    set _widget($path,ntoolbar) 0
    set _widget($path,nindic)   0

    set menu [Widget::getoption $path -menu]
    if { [llength $menu] } {
        _create_menubar $path $menu
    }

    bind $path <Destroy> [list MainFrame::_destroy %W]

    return [Widget::create MainFrame $path]
}

................................................................................
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_menubar
# ----------------------------------------------------------------------------
proc MainFrame::_create_menubar { path descmenu } {
    variable _widget
    global    tcl_platform

    set top $_widget($path,top)

    foreach {v x} {mbfnt -menubarfont mefnt -menuentryfont} {
	if {[string length [Widget::getoption $path $x]]} {
................................................................................
	# [email protected]:  Add mapping from menu items to tags
	set _widget($path,menutags,[list $menubar $count]) $tags

        if { [string length $menuid] } {
            # menu has identifier
            set _widget($path,menuid,$menuid) $menu
        }
        _create_entries $path $menu $menuopts $entries
        incr count
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_entries
# ----------------------------------------------------------------------------
proc MainFrame::_create_entries { path menu menuopts entries } {
    variable _widget

    set count      [$menu cget -tearoff]
    set registered 0
    foreach entry $entries {
        set len  [llength $entry]
        set type [lindex $entry 0]
................................................................................
            set submenu $menu.menu$count
            eval [list $menu add cascade] $opt [list -menu $submenu]
            eval [list menu $submenu -tearoff $tearoff] $menuopts
            if { [string length $menuid] } {
                # menu has identifier
                set _widget($path,menuid,$menuid) $submenu
            }
            _create_entries $path $submenu $menuopts [lindex $entry 5]
            incr count
            continue
        }

        # entry help description
        set desc [lindex $entry 3]
        if { [string length $desc] } {
................................................................................
                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]
                set registered 1
            }
            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]
................................................................................
# 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, or CtrlAlt
#		key may be any key

#
# Results:
#	{accel event}	a list containing the accelerator string and the event

proc MainFrame::_parse_accelerator { desc } {
    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]
	}
    } elseif { [llength $desc] == 2 } {
        set seq [lindex $desc 0]
        set key [string tolower [lindex $desc 1]]
	# 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]
	}
    } else {
	return {}







    }
    switch -- $seq {
	None {
	    set accel "[string toupper $key]"
	    set event "<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]
}







|
|
|
|
>
|
|
|







 







|







 







|







 







|








|







 







|







 







|







 







|
|
|
|
>




|


|

|




|

|




>
>
>
>
>
>
>



|
|


|
|


|
|


|
|








34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
...
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
...
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
...
664
665
666
667
668
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
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727

	-maximum    -progressmax
	-variable   -progressvar
	-type       -progresstype
	-foreground -progressfg
    }

    Widget::declare MainFrame {
	{-width         TkResource 0      0 frame}
	{-height        TkResource 0      0 frame}
	{-background    TkResource ""     0 frame}
	{-textvariable  String     ""     0}
	{-casesensitive Boolean    0      0}
	{-menu          String     {}     1}
	{-separator     Enum       both   1 {none top bottom both}}
	{-bg            Synonym    -background}

	{-menubarfont   String     ""  0}
	{-menuentryfont String     ""  0}
	{-statusbarfont String     ""  0}
	{-sizegrip      Boolean    0   1}
    }

................................................................................

    set _widget($path,top)      $top
    set _widget($path,ntoolbar) 0
    set _widget($path,nindic)   0

    set menu [Widget::getoption $path -menu]
    if { [llength $menu] } {
        _create_menubar $path $menu [Widget::getoption $path -casesensitive]
    }

    bind $path <Destroy> [list MainFrame::_destroy %W]

    return [Widget::create MainFrame $path]
}

................................................................................
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_menubar
# ----------------------------------------------------------------------------
proc MainFrame::_create_menubar { path descmenu casesensitive } {
    variable _widget
    global    tcl_platform

    set top $_widget($path,top)

    foreach {v x} {mbfnt -menubarfont mefnt -menuentryfont} {
	if {[string length [Widget::getoption $path $x]]} {
................................................................................
	# [email protected]:  Add mapping from menu items to tags
	set _widget($path,menutags,[list $menubar $count]) $tags

        if { [string length $menuid] } {
            # menu has identifier
            set _widget($path,menuid,$menuid) $menu
        }
        _create_entries $path $menu $menuopts $entries $casesensitive
        incr count
    }
}


# ----------------------------------------------------------------------------
#  Command MainFrame::_create_entries
# ----------------------------------------------------------------------------
proc MainFrame::_create_entries { path menu menuopts entries casesensitive } {
    variable _widget

    set count      [$menu cget -tearoff]
    set registered 0
    foreach entry $entries {
        set len  [llength $entry]
        set type [lindex $entry 0]
................................................................................
            set submenu $menu.menu$count
            eval [list $menu add cascade] $opt [list -menu $submenu]
            eval [list menu $submenu -tearoff $tearoff] $menuopts
            if { [string length $menuid] } {
                # menu has identifier
                set _widget($path,menuid,$menuid) $submenu
            }
            _create_entries $path $submenu $menuopts [lindex $entry 5] $casesensitive
            incr count
            continue
        }

        # entry help description
        set desc [lindex $entry 3]
        if { [string length $desc] } {
................................................................................
                DynamicHelp::register $menu menu [Widget::getoption $path -textvariable]
                set registered 1
            }
            DynamicHelp::register $menu menuentry $count $desc
        }

        # entry accelerator
        set accel [_parse_accelerator [lindex $entry 4] $casesensitive]
        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]
................................................................................
# 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, or CtrlAlt
#			key may be any key
#	casesensitive	Boolean if accelerator is case sensitive
#
# Results:
#	{accel event}	a list containing the accelerator string and the event

proc MainFrame::_parse_accelerator { desc casesensitive} {
    if { [llength $desc] == 1 } {
	set seq None
	set key [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]))$} [string tolower $key]]} {
	    set key [string toupper $key]
	}
    } elseif { [llength $desc] == 2 } {
        set seq [lindex $desc 0]
        set key [lindex $desc 1]
	# 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]))$} [string tolower $key]]} {
	    set key [string toupper $key]
	}
    } else {
	return {}
    }
    if {! $casesensitive} {
 	set akey [string toupper $key]
 	set ekey [string tolower $key]
    } else {
	set akey $key
	set ekey $key
    }
    switch -- $seq {
	None {
	    set accel $akey
	    set event "<Key-$ekey>"
	}
	Ctrl {
	    set accel "Ctrl+$akey"
	    set event "<Control-Key-$ekey>"
	}
	Alt {
	    set accel "Alt+$akey"
	    set event "<Alt-Key-$ekey>"
	}
	CtrlAlt {
	    set accel "Ctrl+Alt+$akey"
	    set event "<Control-Alt-Key-$ekey>"
	}
	default {
	    return -code error "invalid accelerator code $seq"
	}
    }
    return [list $accel $event]
}

This page was generated in about 0.014s by Fossil 2.9 [3a8abf492a] 2019-06-12 09:41:26