bindings.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

                    }
                    return 0
                }
            }
        "-" {
                if {[${w} index insert] != 0} {
                    if {${a} != "" && ${bell}} {
                        bell
                    }
                    return 0
                }
            }
        "E" -
        "e" {
                set fld [string tolower [${w} get]]
                if {${scale} == "0" || [string first "." ${fld}] == -1 ||\
                  [string first "e" ${fld}] != -1} {

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

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

        ${w} delete ${first} ${last}
    }
    ${w} insert insert ${a}

    return 1
}

proc sn_entry_insert_column {w 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 sel.first]}]} {
        set first -1
    }
    if {[catch {set last [${w} index sel.last]}]} {
        set last -1
    }
    if {${first} >= 0 && ${last} >= 0 && ${first} <= ${curs} && ${curs} <=\
      [expr ${last} + 1]} {

        ${w} delete ${first} ${last}
    }
    ${w} insert insert ${a}
}

proc sn_text_default_bindings {text} {
    bind ${text} <Control-d> [bind ${text} <Delete>]
    bind ${text} <Control-a> [bind ${text} <Home>]
    bind ${text} <Control-e> [bind ${text} <End>]

    if {[string equal "unix" $::tcl_platform(platform)]} {
        bind ${text} <Button-5> [list %W yview scroll 5 units]
        bind ${text} <Button-4> [list %W yview scroll -5 units]
        bind ${text} <Shift-Button-5> [list %W yview scroll 1 units]
        bind ${text} <Shift-Button-4> [list %W yview scroll -1 units]
        bind ${text} <Control-Button-5> [list %W xview scroll 10 units]
        bind ${text} <Control-Button-4> [list %W xview scroll -10 units]
    } else {
        bind ${text} <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units }
    }

    catch {
        bind ${text} <apLineDel> "[bind ${text} <Delete>]; break"
    }

    #add a hook for the french keyboard. "~" and "," work
    #bugy on windows, they are bound on AltGr-e' and AltGr-e`
    bind Text <Alt-Control-KeyPress> {+
				if {%k == 55} {
					tkTextInsertChar %W "`"
					break
				}
				if {%k == 50} {
					tkTextInsertChar %W "~"
					break
				}
			}

}

# tkTextClipboardKeysyms --
# This procedure is invoked to identify the keys that correspond to
# the "copy", "cut", and "paste" functions for the clipboard.
#
# Arguments:
# copy -        Name of the key (keysym name plus modifiers, if any,
#               such as "Meta-y") used for the copy operation.
# cut -         Name of the key used for the cut operation.
# paste -       Name of the key used for the paste operation.

catch {rename tkTextClipboardKeysyms {}}
# Don't use the original one.			
proc tkTextClipboardKeysyms {copy cut paste} {
    bind Text <${copy}> {
		if {[selection own -displayof %W] == "%W"} {
			clipboard clear -displayof %W
			catch {
				clipboard append -displayof %W [selection get -displayof %W]
			}
		}
	}
    bind Text <${cut}> {
		if {[selection own -displayof %W] == "%W"} {
			clipboard clear -displayof %W
			catch {
				clipboard append -displayof %W [selection get -displayof %W]
				%W delete sel.first sel.last
			}
		}
	}
    bind Text <${paste}> {
		catch {
			if {[%W compare sel.first <= insert] && [%W compare sel.last >= insert]} {
				%W delete sel.first sel.last
			}
		}
		catch {%W insert insert [selection get -displayof %W -selection CLIPBOARD]}
	}
}

# We do need this dummy function for bindings
proc sn_dummy_proc {k} {
    #	puts stdout "Keysym: \"$k\""
}

proc sn_input_check_in_window {win check} {
    global sn_windows_to_check

    if {[catch {set topl [winfo toplevel ${win}]}]} {
        return
    }

    set off [lsearch ${sn_windows_to_check} ${topl}]

    if {${off} == -1} {
        if {${check}} {
            lappend sn_windows_to_check ${topl}
        }
    } else {
        #it is already in the list, if it is already checked, return
        if {${check}} {
            return
        }
        if {${off} > 0} {
            set new_list [lrange ${sn_windows_to_check} 0 [expr ${off} -1]]
        } else {
            set new_list ""
        }
        set new_list2 [lrange ${sn_windows_to_check} [expr ${off} +1] end]

        set sn_windows_to_check ${new_list}

        if {[llength ${new_list2}] > 0} {
            lappend sn_windows_to_check ${new_list2}
        }
    }
}

proc sn_canvas_input_bindings {c entry} {
    bind ${c} <Double-1> {sn_dummy_proc %K}
    bind ${c} <Triple-1> {sn_dummy_proc %K}
    #	bind $c <3> [bind $c <1>]

    sn_canvas_mark_bindings ${c} ${entry}

    ${c} bind ${entry} <1> {
		%W select clear
		%W focus current
		%W icursor current @[%W canvasx %x],[%W canvasy %y]
		%W select from current @[%W canvasx %x],[%W canvasy %y]
		break
	}

    #	$c bind $entry <3> [$c bind $entry <1>]

    ${c} bind ${entry} <KeyPress> {
		sn_canvas_entry_insert_input %W [%W focus] %A %K
		break
	}
    catch {${c} bind ${entry} <dead_tilde> {
		sn_canvas_entry_insert_input %W [%W focus] "~" %K
		break
	}}
    catch {${c} bind ${entry} <dead_circumflex> {
		sn_canvas_entry_insert_input %W [%W focus] "^" %K
		break
	}}
    catch {${c} bind ${entry} <dead_grave> {
		sn_canvas_entry_insert_input %W [%W focus] "`" %K
		break
	}}
    catch {${c} bind ${entry} <ssharp> {
		sn_canvas_entry_insert_input %W [%W focus] "?" %K
		break
	}}

    ${c} bind ${entry} <Return> {sn_dummy_proc %K}
    ${c} bind ${entry} <Any-Escape> {sn_dummy_proc %K}
    ${c} bind ${entry} <Any-Control-KeyPress> {sn_dummy_proc %K}

    ${c} bind ${entry} <BackSpace> {
		if {[%W index [%W focus] insert] > 0} {
			%W dchars [%W focus] [expr [%W index [%W focus] insert] - 1]
			set %W-changed 1
		}
		break
	}
    ${c} bind ${entry} <Any-BackSpace> [${c} bind ${entry} <BackSpace>]
    ${c} bind ${entry} <Home> {%W icursor [%W focus] 0}
    # Sun Home
    ${c} bind ${entry} <F27> [${c} bind ${entry} <Home>]
    ${c} bind ${entry} <Control-Left> [${c} bind ${entry} <Home>]
    ${c} bind ${entry} <End> {%W icursor [%W focus] end}
    ${c} bind ${entry} <Shift-Home> [${c} bind ${entry} <End>]
    # Sun End
    ${c} bind ${entry} <R13> [${c} bind ${entry} <End>]
    ${c} bind ${entry} <Control-Right> [${c} bind ${entry} <End>]
    ${c} bind ${entry} <Control-d> {
		if {[catch {%W dchars [%W focus] sel.first sel.last}]} {
			%W dchars [%W focus] insert
		}
		set %W-changed 1
		break
	}
    catch {
        ${c} bind ${entry} <apLineDel> [${c} bind ${entry} <Control-d>]
    }

    ${c} bind ${entry} <Delete> [${c} bind ${entry} <Control-d>]

    ${c} bind ${entry} <Control-h> [${c} bind ${entry} <Any-BackSpace>]
    ${c} bind ${entry} <Control-k> {
		%W dchars [%W focus] insert end
		set %W-changed 1
		break
	}
    ${c} bind ${entry} <Control-l> {
		%W dchars [%W focus] 0 end
		set %W-changed 1
		break
	}
    ${c} bind ${entry} <Control-u> {
		%W dchars [%W focus] 0 end
		set %W-changed 1
		break
	}
    ${c} bind ${entry} <Control-w> {
		sn_canvas_entry_mark_word %W [%W focus] [%W index [%W focus] insert]
		catch {%W dchars [%W focus] sel.first sel.last}
		break
	}
    ${c} bind ${entry} <Left> {
		%W select clear
		if {[%W index [%W focus] insert] > 0} {
			%W icursor [%W focus]  [expr [%W index [%W focus] insert] - 1]
		}
		break
	}
    ${c} bind ${entry} <Right> {
		%W select clear
		%W icursor [%W focus] [expr [%W index [%W focus] insert] + 1]
		break
	}
    ${c} bind ${entry} <Down> {
		sn_canvas_line_down %W [%W focus]
		break
	}

    ${c} bind ${entry} <Up> {
		sn_canvas_line_up %W [%W focus]
		break
	}

    ${c} bind ${entry} <Control-x> {
		if {[selection own] != "%W"} {
			return
		}
		if {[catch {set cut [sn_selection get]}]} {
			return
		}
		catch {%W dchars [%W focus] sel.first sel.last}
		if {[string compare $cut ""] != 0} {
			blt_cutbuffer set $cut 0
		}
		set %W-changed 1
		break
	}
    # Sun Cut
    ${c} bind ${entry} <Any-F20> [${c} bind ${entry} <Control-x>]

    ${c} bind ${entry} <3> [${c} bind ${entry} <1>]

    ${c} bind ${entry} <2> {
		%W focus current
		%W icursor current @[%W canvasx %x],[%W canvasy %y]
		if {[catch {set pst [string trim [sn_selection get]]}] == 0} {
			regsub -all "\t|\n" $pst "" pst
			sn_canvas_entry_insert_input %W current $pst
		}
		break
	}
    ${c} bind ${entry} <Control-v> {
		if {[catch {set pst [string trim [blt_cutbuffer get 0]]}] == 0} {
			regsub -all "\t|\n" $pst "" pst
			sn_canvas_entry_insert_input %W [%W focus] $pst
		}
		break
	}

    # Sun Paste
    ${c} bind ${entry} <Any-F18> [${c} bind ${entry} <Control-v>]
    ${c} bind ${entry} <Shift-2> [${c} bind ${entry} <Control-v>]
}

proc sn_canvas_mark_bindings {c entry} {
    ${c} bind ${entry} <B1-Motion> {
		if {[%W index current insert] != [%W index current  @[%W canvasx %x],[%W\
      canvasy %y]]} {
			%W select to current @[%W canvasx %x],[%W canvasy %y]
		}
		break
	}
    ${c} bind ${entry} <Shift-Left> {
		if {[%W index [%W focus] insert] > 0} {
			if {[catch {set sn_mrk [%W index [%W focus] sel.first]}]} {
				set sn_mrk [%W index [%W focus] insert]
			}
			%W select adjust [%W focus] [expr $sn_mrk - 1]
		}
		break
	}
    ${c} bind ${entry} <Shift-R10> [${c} bind ${entry} <Shift-Left>]

    ${c} bind ${entry} <Shift-Right> {
		if {[%W index [%W focus] insert] >= 0} {
			if {[catch {set sn_mrk [%W index [%W focus] sel.last]}]} {
				set sn_mrk [%W index [%W focus] insert]
				%W select from [%W focus] $sn_mrk
				incr sn_mrk -1
			}
			%W select adjust [%W focus] [expr $sn_mrk + 1]
		}
		break
	}
    ${c} bind ${entry} <Shift-R12> [${c} bind ${entry} <Shift-Right>]

    ${c} bind ${entry} <Double-1> {
		sn_canvas_entry_mark_word %W current  @[%W canvasx %x],[%W canvasy %y]
		break
	}
    ${c} bind ${entry} <Triple-1> {
		%W select from current 0
		%W select to current end
		break
	}
    ${c} bind ${entry} <Control-c> {
		if {[catch {set cut [sn_selection get]}]} {
			return
		}
		blt_cutbuffer set $cut 0
		break
	}
    #$c bind $entry <Any-F4> [$c bind $entry <Any-F4>]

    # Sun Copy
    ${c} bind ${entry} <Any-F16> [${c} bind ${entry} <Control-c>]
}

proc sn_canvas_entry_insert_input {w id a {k ""} {forceinp 0} {bell 1}} {
    global sn_options
    global sn_windows_to_check
    global ${w}-changed

    if {[string compare ${a} ""] == 0} {
        sn_dummy_proc ${k}
        return
    }

    if {[lsearch ${sn_windows_to_check} [winfo toplevel ${w}]] == -1} {
        set check 0
    } else {
        set check 1
    }

    # syntax: %type_width_scale_font-width_font-height_flags

    set pars [sn_canvas_item_pars ${w} ${id}]
    set tags [lindex [${w} itemconfigure ${id} -tags] 4]
    if {[lsearch ${tags} "big"] == -1} {
        set big 0
    } else {
        set big 1
    }

    if {[llength ${pars}] < 2} {
        set type 4
        # SQL_CHA
        set width 0
        set scale 0
        set font_height 0
        set font_width 0
        set flags 0
    } else {
        set type [lindex ${pars} 0]
        set width [lindex ${pars} 1]
        set scale [lindex ${pars} 2]
        set font_height [lindex ${pars} 3]
        set font_width [lindex ${pars} 4]
        set flags [lindex ${pars} 5]
        # Support for older form versions.
        if {${font_height} == ""} {
            set font_height [expr $sn_options(def,desktop-font-size) + 2]
        }
    }
    if {${check} == 0} {
        set width 0
    }\
    elseif {${type} == 21 && ${forceinp} == 0} {
        # 	only lookup field
        if {${bell}} {
            bell
        }
        return
    }

    set ${w}-changed 1

    # Workaround SQLischar-Error !!!
    if {[SQLischar ${type}] && ${type} != 20} {
        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}
    } else {
        if {${type} == 20} {
            for {set len [string length ${a}]; set i 0} {${i} < ${len}}\
              {incr i} {
                sn_canvas_entry_insert_column ${w} ${id} [string index ${a}\
                  ${i}] ${scale} ${check} ${bell}
            }
        } else {
            for {set len [string length ${a}]; set i 0} {${i} < ${len}}\
              {incr i} {
                if {![sn_canvas_entry_insert_digit ${w} ${id} [string index\
                  ${a} ${i}] ${scale} ${check} ${bell}]} {

                    break
                }
            }
        }
        if {${width} > 0} {
            set fld [lindex [${w} itemconfigure ${id} -text] 4]
            if {[string index ${fld} 0] != "-"} {
                incr width -1
            }

            set len [string first "." ${fld}]
            if {${len} > [expr ${width} - ${scale} -1]} {
                set width [expr ${width} - ${scale} -1]
            }\
            elseif {${scale} > 0 && ${len} == -1} {
                set width [expr ${width} - ${scale} -1]
            }
        }
    }
    set rid [sn_find_assigned_rect ${w} ${id}]
    if {${rid} != ""} {
        set coords [${w} coords ${rid}]
        set x [lindex ${coords} 2]
        set y [expr [lindex ${coords} 3] - ${font_height}]
        set idx [${w} index ${id} @${x},${y}]
        if {${idx} > ${width} && ${width} != 0} {
            set idx ${width}
        }
        ${w} dchars ${id} ${idx} end
    }\
    elseif {${width} > 0} {
        ${w} dchars ${id} ${width} end
    }
}

proc sn_canvas_entry_mark_word {w id ind} {
    set string [lindex [${w} itemconfigure ${id} -text] 4]