bindings.tcl

来自「This Source-Navigator, an IDE for C/C++/」· TCL 代码 · 共 1,557 行 · 第 1/3 页

    for {set x [${w} index ${id} ${ind}]} {${x} > 0} {incr x -1} {
        if {([string first [string index ${string} ${x}] " \t"] < 0)\
          &&([string first [string index ${string} [expr ${x}-1]] " \t"] >=\
          0)} {

            break
        }
    }
    ${w} select from ${id} ${x}

    set len [string length ${string}]
    for {set x [${w} index ${id} ${ind}]} {${x} < ${len}} {incr x} {
        if {([string first [string index ${string} ${x}] " \t"] < 0)\
          &&([string first [string index ${string} [expr ${x}+1]] " \t"] >=\
          0)} {

            break
        }
    }
    ${w} select to ${id} [expr ${x}+1]
}

proc sn_canvas_entry_insert_column {w id a scale {check 0} {bell 1}} {

    set input_char\
      "01234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_$#@"
    if {${check} == 0} {
        append input_char "NULnul!=<>|"
    }
    if {[string first ${a} ${input_char}] == -1} {
        if {${a} != "" && ${bell}} {
            bell
        }
        return
    }

    set curs [${w} index insert]
    if {[catch {set first [${w} index ${id} sel.first]}]} {
        set first -1
    }
    if {[catch {set last [${w} index ${id} sel.last]}]} {
        set last -1
    }
    if {${first} >= 0 && ${last} >= 0 && ${first} <= ${curs} && ${curs} <=\
      [expr ${last} + 1]} {

        ${w} dchars ${id} ${first} ${last}
    }
    ${w} insert ${id} insert ${a}
}

# returns 1 if it could insert the digit otherwise 0.

proc sn_canvas_entry_insert_digit {w id a scale {check 0} {bell 1}} {

    set input_char "0123456789eE.-"
    if {${check} == 0} {
        append input_char "NULnul!=<>|"
    }
    if {${a} == ","} {
        set a "."
    }

    if {[string first ${a} ${input_char}] == -1} {
        if {${a} != "" && ${bell}} {
            bell
        }
        return 0
    }
    switch -- ${a} {
        "." {
                if {${scale} == "0" || [string first "." [lindex\
                  [${w} itemconfig ${id} -text] 4]] != -1} {
                    if {${a} != "" && ${bell}} {
                        bell
                    }
                    return 0
                }
            }
        "-" {
                if {[${w} index ${id} insert] != 0} {
                    if {${a} != "" && ${bell}} {
                        bell
                    }
                    return 0
                }
            }
        "E" -
        "e" {
                set fld [string tolower [lindex [${w} itemconfig ${id}\
                  -text] 4]]
                if {${scale} == "0" || [string first "." ${fld}] == -1 ||\
                  [string first "e" ${fld}] != -1} {

                    if {${a} != "" && ${bell}} {
                        bell
                    }
                    return 0
                }
            }
    }

    set curs [${w} index ${id} insert]
    if {[catch {set first [${w} index ${id} sel.first]}]} {
        set first -1
    }
    if {[catch {set last [${w} index ${id} sel.last]}]} {
        set last -1
    }
    if {${first} >= 0 && ${last} >= 0 && ${first} <= ${curs} && ${curs} <=\
      [expr ${last} + 1]} {

        ${w} dchars ${id} ${first} ${last}
    }
    ${w} insert ${id} insert ${a}

    return 1
}

proc sn_canvas_line_up {w id} {
    set sn_tmp_string [string range [lindex [${w} itemconfigure ${id}\
      -text] 4] 0 [expr [${w} index ${id} insert] -1]]

    set sn_tmp_off [string last "\n" ${sn_tmp_string}]

    if {${sn_tmp_off} != -1} {
        ${w} icursor ${id} ${sn_tmp_off}

        return 1
    }
    return 0
}

proc sn_canvas_line_down {w id} {
    set sn_tmp_ins [${w} index ${id} insert]
    set sn_tmp_string [string range [lindex [${w} itemconfigure ${id}\
      -text] 4] ${sn_tmp_ins} end]

    set sn_tmp_off [string first "\n" ${sn_tmp_string}]

    if {${sn_tmp_off} != -1} {
        ${w} icursor ${id} [expr ${sn_tmp_ins} + 1 + ${sn_tmp_off}]

        return 1
    }
    return 0
}

# syntax: %type_width_scale_height_linewidth_flags

proc sn_canvas_item_pars {c tid} {
    set tags [lindex [${c} itemconfigure ${tid} -tags] 4]
    set len [string last "%" ${tags}]

    set pars [string range ${tags} [expr ${len} +1] end]
    set off [string first " " ${pars}]
    if {${off} == -1} {
        set pars [split ${pars} "_"]
    } else {
        set pars [split [string range ${pars} 0 [expr ${off} - 1]] "_"]
    }
    return ${pars}
}

# This proc returns the id of the rectangle that belongs to the text.

proc sn_find_assigned_rect {c id} {
    set tags [lindex [${c} itemconfigure ${id} -tags] 4]
    set off [lsearch -regexp ${tags} {rid_[0-9]+}]

    if {${off} == -1} {
        return ""
    }

    set rid [lindex [split [lindex ${tags} ${off}] "_"] 1]

    if {[${c} type ${rid}] != "rectangle"} {
        return ""
    }
    return ${rid}
}

proc sn_canv_goto_bindings {c} {

    #apply input to canvases
    bind ${c} <ButtonRelease-1> "focus %W"

    if {[string equal "unix" $::tcl_platform(platform)]} {
        bind ${c} <Button-4> {sn_canvas_scroll %W MultiUp}
        bind ${c} <Button-5> {sn_canvas_scroll %W MultiDown}
        bind ${c} <Shift-Button-4> {sn_canvas_scroll %W Up}
        bind ${c} <Shift-Button-5> {sn_canvas_scroll %W Down}
        bind ${c} <Control-Button-4> {sn_canvas_scroll %W MultiLeft}
        bind ${c} <Control-Button-5> {sn_canvas_scroll %W MultiRight}
    } else {
        # don't see a way to use sn_canvas_scroll with this single binding
        bind ${c} <MouseWheel> {
            %W yview scroll [expr {- (%D / 120) * 4}] units
        }
    }

    bind ${c} <Left> {sn_canvas_scroll %W Left}
    bind ${c} <Right> {sn_canvas_scroll %W Right}
    bind ${c} <Control-Left> {sn_canvas_scroll %W PgLeft}
    bind ${c} <Control-Right> {sn_canvas_scroll %W PgRight}
    bind ${c} <Up> {sn_canvas_scroll %W Up}
    bind ${c} <Down> {sn_canvas_scroll %W Down}
    bind ${c} <Home> {sn_canvas_scroll %W Home}
    bind ${c} <F27> [bind ${c} <Home>]
    # Sun Home
    bind ${c} <Control-Up> [bind ${c} <Home>]
    bind ${c} <Shift-Up> [bind ${c} <Home>]
    bind ${c} <End> {sn_canvas_scroll %W End}
    bind ${c} <Shift-Home> [bind ${c} <End>]
    bind ${c} <Control-Down> [bind ${c} <End>]
    bind ${c} <Shift-Down> [bind ${c} <End>]
    bind ${c} <R13> [bind ${c} <End>]
    # Sun End
    bind ${c} <Next> {sn_canvas_scroll %W PgDn}
    bind ${c} <R15> [bind ${c} <Next>]
    # Sun Next
    bind ${c} <Prior> {sn_canvas_scroll %W PgUp}
    bind ${c} <R9> [bind ${c} <Any-Prior>]
    # Sun Prior
}

proc sn_canvas_scroll {c which} {
    switch -- ${which} {
        Left {
                ${c} xview scroll -1 unit
            }
        Right {
                ${c} xview scroll 1 unit
            }
        PgLeft {
                ${c} xview scroll -1 page
            }
        PgRight {
                ${c} xview scroll 1 page
            }
        HomeLeft {
                ${c} xview scroll -1 unit
            }
        HomeRight {
                ${c} xview scroll 1 unit
            }
        Up {
                ${c} yview scroll -1 unit
            }
        Down {
                ${c} yview scroll 1 unit
            }
        PgUp {
                ${c} yview scroll -1 page
            }
        PgDn {
                ${c} yview scroll 1 page
            }
        Home {
                ${c} yview moveto 0
            }
        End {
                ${c} yview moveto 1
            }
        MultiUp {
                ${c} yview scroll -5 units
            }
        MultiDown {
                ${c} yview scroll 5 units
            }
        MultiLeft {
                ${c} xview scroll -5 units
            }
        MultiRight {
                ${c} xview scroll 5 units
            }
    }
}

proc sn_selection args {
    set sel ""
    catch {set sel [eval selection ${args}]}
    return ${sel}
}

proc sn_remove_tags {w tags} {
    set current [bindtags ${w}]
    foreach tag ${tags} {
        set idx [lsearch -exact ${current} ${tag}]
        if {${idx} != -1} {
            set current [lreplace ${current} ${idx} ${idx}]
        }
    }
    bindtags ${w} ${current}
    return ${current}
}

proc sn_add_tags {w tags {pos 1}} {
    set current [bindtags ${w}]
    set otags ${current}
    #first delete avail tags from the list
    foreach tag ${tags} {
        set idx [lsearch -exact ${current} ${tag}]
        if {${idx} != -1} {
            set current [lreplace ${current} ${idx} ${idx}]
        }
    }

    set current [eval linsert [list ${current}] ${pos} ${tags}]

    #bind older and newer tags to the widget.
    bindtags ${w} ${current}

    return ${current}
}

proc sn_execute_alt_accelerator {win key} {
    set key [string tolower ${key}]
    if {! [string match {[a-z0-9]} ${key}]} {
    }
    return [sn_recursive_alt_accelerator ${win} [winfo toplevel ${win}] ${key}]
}

proc sn_recursive_alt_accelerator {origw win key} {
    if {![winfo ismapped ${win}]} {
        return -1
    }

    set idx -1
    foreach w [winfo children ${win}] {

        set class [winfo class ${w}]

        if {${class} == "Menu"} {
            continue
        }
        if {[sn_recursive_alt_accelerator ${origw} ${w} ${key}] == 0} {
            return 0
        }

        #locate the underlined character
        set ret [catch {set idx [${w} cget -underline]}]
        if {${ret} || ${idx} == -1} {
            continue
        }
        #try -text or -label
        set ret [catch {set ch [${w} cget -text]}]
        if {${ret}} {
            set ret [catch {set ch [${w} cget -label]}]
        }
        if {${ret}} {
            continue
        }
        #underlined character
        set ch [string range ${ch} ${idx} ${idx}]

        if {[string tolower ${ch}] == ${key}} {
            #accelerator for text entries, focus the editor
            #after this widget or invoke a check/radiobutton
            if {${class} == "Label"} {
                set parents [winfo parent ${w}]
                #scans all sub trees of this scope
                while {1} {
                    set parent [lindex ${parents} 0]
                    if {${parent} == ""} {
                        break
                    }
                    set parents [lreplace ${parents} 0 0]
                    foreach ch [winfo children ${parent}] {
                        set chclass [winfo class ${ch}]
                        if {[lsearch -exact {Text Entry} ${chclass}] != -1} {
                            #go to the next entry, if availiable
                            if {[string compare ${ch} ${origw}] == 0} {
                                continue
                            }
                            if {[${ch} cget -state] == "normal"} {
                                focus ${ch}
                                return 0
                            }
                        }\
                        elseif {[lsearch -exact {Radiobutton Checkbutton}\
                          ${chclass}] != -1} {
                            if {[${ch} cget -state] == "normal"} {
                                focus ${ch}
                                ${ch} invoke
                                return 0
                            }
                        } else {
                            #add to stack to look for.
                            lappend parents ${ch}
                        }
                    }
                }
            }\
            elseif {${class} == "Button"} {
                if {[${w} cget -state] == "normal"} {
                    ${w} invoke
                    return 0
                }
            }\
            elseif {[lsearch -exact {Radiobutton Checkbutton} ${class}] != -1} {
                if {[${w} cget -state] == "normal"} {
                    focus ${w}
                    ${w} invoke
                    return 0
                }
            } else {
                if {[${w} cget -state] == "normal"} {
                    focus ${w}
                    return 0
                }
            }
        }
    }
    return 1
}

proc sn_init_keybindings {} {
    global sn_options

    #keybindings for new windows
    set all all

    #be sure that only F-key is pressed, not Shift/Contro/Alt-F-key
    bind ${all} <F4> {
							if {%s == 0} {
								MultiWindow&::windows_new_symbr
								break
							}
						}

    bind ${all} <F5> {
							if {%s == 0} {
								MultiWindow&::windows_new_window
								break
							}
						}

    bind ${all} <F6> {
							if {%s == 0} {
								MultiWindow&::windows_new_window {} ctree
								break
							}
						}

    bind ${all} <F7> {
							if {%s == 0} {
								MultiWindow&::windows_new_window {} classbr
								break
							}
						}

    bind ${all} <F8> {
							if {%s == 0} {
								MultiWindow&::windows_new_window {} xref
								break
							}
						}

    bind ${all} <F9> {
							if {%s == 0} {
								MultiWindow&::windows_new_window {} incbr
								break
							}
						}

    bind ${all} <F2> {
				if {%s == 0} {
					MultiWindow&::windows_new_window {} retr
					break
				}
			}

    #keybindings for adding views
    bind ${all} <Control-F4> "del_last_view; break"

    bind ${all} <Control-F5> "add_view edit; break"

    bind ${all} <Control-F6> "add_view ctree; break"

    bind ${all} <Control-F7> "add_view classbr; break"

    bind ${all} <Control-F8> "add_view xref; break"

    bind ${all} <Control-F9> "add_view incbr; break"

    bind ${all} <Control-F10> "add_view build; break"

    #save all binding
    bind ${all} <$sn_options(sys,alt-traverse)-a> "Editor&::SaveAll; break"
    bind ${all} <$sn_options(sys,alt-traverse)-A> [bind ${all}\
      <$sn_options(sys,alt-traverse)-a>]

    #print
    bind ${all} <Control-p> "main_print %W; break"

    #close window
    bind ${all} <Control-w> "close_main_window %W; break"

    #exit SN
    bind ${all} <Control-q> "sn_exit; break"

    #goto error
    bind ${all} <Shift-Control-E> "MultiWindow&::search_gotoerror; break"

    #toggle between views
    bind ${all} <Control-Tab> "switch_to_next_view %W; break"
    #bind ${all} <Shift-Control-Tab> "?"

    # Prior -> PgUp, Next -> PgDn
    bind ${all} <Control-Prior> "switch_tab %W prev; break"
    bind ${all} <Control-Next> "switch_tab %W next; break"

    bind ${all} <Control-F2> "dbg_start; break"
}