editorpane.tcl

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

	${m} add command \
	    -label [get_indep String EditPaste] \
	    -underline [get_indep Pos EditPaste] \
	    -accelerator "Ctrl+V" \
	    -command "${this} Paste" \
	    -state ${state}

	# Text sensitive commands, (Retriever, Views).
	${m} add separator

	AddRetrieveMenu ${m} ${this} $itk_component(editor) ${x} ${y}
    }

    # Take only valid identifier characters
    # to retrieve valid symbols.
    proc format_for_retriever {string} {
	# Don't delete spaces in the middle of the text.
	regexp \
	    -- "\[^\t\n\r^#%*{};',`\"\\\?()\]*" ${string} string

	return [string trim ${string}]
    }

    # Verify if we stay on a symbol declaration/implementaion
    # this procedure returns the key tagname pointing to,
    # when it's true.
    proc points_to_header {ed pos} {
	global sn_scopes
	set lasttag ""
	foreach tg [${ed} tag names ${pos}] {
	    if {[string first " " ${tg}] == -1} {
		# Tags like "scope".
		set lasttag ${tg}
	    }
	}
	if {[lsearch \
	    -exact ${sn_scopes} ${lasttag}] == -1} {
	    set lasttag ""
	}
	return ${lasttag}
    }

    # Adds the option menu for editor.
    proc AddRetrieveMenu {m cls ed x y} {
	global sn_options sn_scopes

	# Verify if the user has clicked on
	# 1. a selection       <==> retrieve selection
	# 2. outside of a selected region <==> retrieve current word
	# 3. word              <==> retrieve word
	# 4. nothing or unused <==> retrieve current symbol
	# 5. No scope active   <==> disabled
	set pos [${ed} index @${x},${y}]

	# Verify if we stay on a symbol declaration/implementaion
	set scopetag [points_to_header ${ed} ${pos}]
	if {${scopetag} != ""} {
	    set file [${cls} getvalidfilename]
	} else {
	    set file ""
	}

	set selrng [${ed} tag ranges sel]
	set current 1
	set string ""
	if {${selrng} != ""} {
	    set pos1 [split ${pos} "."]
	    set by [lindex ${pos1} 0]
	    set bx [lindex ${pos1} 1]

	    set rng1 [split [lindex ${selrng} 0] "."]
	    set rng2 [split [lindex ${selrng} 1] "."]

	    set sy1 [lindex ${rng1} 0]
	    set sx1 [lindex ${rng1} 1]
	    set sy2 [lindex ${rng2} 0]
	    set sx2 [lindex ${rng2} 1]
	    # Clicked in the selection region.
	    if {${by} == ${sy1} && ${bx} >= ${sx1} &&(${sx2} >= ${bx} || \
	      ${sy2} > ${by}) || ${by} == ${sy2} && ${bx} <= ${sx2} &&(${sx1} \
	      <= ${bx} || ${sy1} < ${by}) || ${by} > ${sy1} && ${by} < ${sy2}} {
		set string [format_for_retriever [lindex [${cls} Selection] 1]]
		set current 0
	    }
	}
	if {${current} || ${string} == ""} {
	    # Current word.
	    set string [format_for_retriever [${ed} get "${pos} wordstart" \
	      "${pos} wordend"]]

	    # Take current symbol.
	    if {${string} == ""} {
		set tg [${cls} find_tag ${pos}]
		if {${tg} != ""} {
		    split_symbol ${tg} class sym scope
		    if {${class} != ""} {
			set string "${class}\:\:${sym}"
		    } else {
			set string ${sym}
		    }
		    set string [format_for_retriever ${string}]
		}
	    }
	}
	if {${string} == ""} {
	    set findstate disabled
	    set lbl ""
	} else {
	    set findstate normal
	    set lbl " [get_indep String Of] '${string}'"
	}

	# Retrieve definition.
	${m} add command \
	    -accelerator "$sn_options(sys,alt-accelpref)+D" \
	    -label "[get_indep String SearchDefinition]${lbl}" \
	    -underline [get_indep Pos SearchDefinition] \
	    -command "Editor&::search_definition ${cls} [list ${string}]" \
	    -state ${findstate}

	# Retrieve implementation.
	${m} add command \
	    -accelerator "$sn_options(sys,alt-accelpref)+I" \
	    -label "[get_indep String SearchImplementation]${lbl}" \
	    -underline [get_indep Pos SearchImplementation] \
	    -command "Editor&::search_implementation ${cls} [list ${string}]" \
	    -state ${findstate}

	${m} add separator

	set vw ""
	set vlen [string length ${vw}]

	# View Hierarchy.
	${m} add command \
	    -accelerator "$sn_options(sys,alt-accelpref)+H" \
	    -label "${vw}[get_indep String MultiClassHierarchy] ${lbl}" \
	    -underline [expr [get_indep Pos MultiClassHierarchy] + ${vlen}] \
	    -command "sn_classtree [list ${string}]" \
	    -state ${findstate}

	# View Class.
	${m} add command \
	    -accelerator "$sn_options(sys,alt-accelpref)+C" \
	    -label "${vw}[get_indep String MultiClass] ${lbl}" \
	    -underline [get_indep Pos MultiClass] \
	    -command "sn_classbrowser [list ${string}]" \
	    -state ${findstate}

	if {${scopetag} != ""} {
	    set xstring "${string}(${scopetag})"
	} else {
	    set xstring ${string}
	}

	if {${findstate} == "normal" && ! [have_xref]} {
	    set xref_state disabled
	} else {
	    set xref_state normal
	}

	# View XRef.
	${m} add command \
	    -accelerator "$sn_options(sys,alt-accelpref)+X" \
	    -label "${vw}[get_indep String MultiXRef] ${lbl}" \
	    -underline [get_indep Pos MultiXRef] \
	    -command "sn_xref both [list ${xstring}] [list ""] [list ${file}]" \
	    -state ${xref_state}
    }

    method bind_right_mouse {t} {
	global sn_options
	if {$sn_options(def,edit-rightmouse-action) == "scroll"} {
	    bind ${t} <3> { }
	    bind ${t} <B3-Motion> { }
	} else {
	    bind ${t} <3> "${this} m3_post_menu %W %X %Y %x %y; break"
	    bind ${t} <B3-Motion> {break}
	}
    }

    # If tabsize is not specified, use default tab size.
    proc set_tabsize {t {tabsize ""} {refr ""}} {
	global sn_options

	if {${tabsize} == ""} {
	    # If $wd is empty or not a valid number, take 8 !
	    if {[catch {set sn_options(def,edit-tabstop) \
	      [expr $sn_options(def,edit-tabstop) + 0]}]} {
		set sn_options(def,edit-tabstop) 8
	    }
	    set tb $sn_options(def,edit-tabstop)
	} else {
	    set tb ${tabsize}
	}

	# Don't use "-tabs" to change the tab size, it does
	# have another behavior as normal tabulators.
	${t} config \
	    -tabsize ${tb}
    }

    # If tabsize is not specified, use default tab size.
    proc set_tab {t {tabsize ""} {refr ""}} {
	global sn_options

	set font [${t} cget -font]
	set text_avg_width [font measure ${font} "M"]

	if {${tabsize} == ""} {
	    # If $wd is empty or not a valid number, take 8 !
	    if {[catch {set sn_options(def,edit-tabstop) \
	      [expr $sn_options(def,edit-tabstop) + 0]}]} {
		set sn_options(def,edit-tabstop) 8
	    }
	    set tb $sn_options(def,edit-tabstop)
	} else {
	    set tb ${tabsize}
	}

	${t} config \
	    -tabs [expr {${text_avg_width} * ${tb}}]
    }

    proc set_wrap {w} {
	global sn_options
	${w} config \
	    -wrap $sn_options(def,edit-wrap)
    }

    # Toggle or set the insert/overwrite flag.
    proc set_overwrite {w {overwrite ""} {toggle "toggle"}} {
	global sn_options
	global tkText

	if {${overwrite} == ""} {
	    set overwrite $sn_options(def,edit-overwrite-mode)
	}
	
	if {${toggle} == "toggle" || ${toggle} == "yes"} {
	    if {${overwrite}} {
		set overwrite 0
	    } else {
		set overwrite 1
	    }
	}
	
	set tkText(${w},ovwrt) ${overwrite}

	if {$tkText(${w},ovwrt)} {
	    set wd 8
	} else {
	    set wd 2
	}

	${w} config \
	    -insertwidth ${wd}
    }

    # The basic insertion routine for a tab.
    proc InsertTab {w {pos ""}} {
	global sn_options

	# Insert Spaces instead of Tabs.
	if {$sn_options(def,edit-tab-inserts-spaces)} {
	    # At least we should insert one character.

	    if {$sn_options(def,edit-tabstop) == 0} {
	        set txt " "
	    } else {
	        set txt [string repeat " " $sn_options(def,edit-tabstop)]

	        set ts $sn_options(def,edit-tabstop)
	        set l [${w} index insert]
	        set col [lindex [split ${l} {.}] 1]
	        while {${col} >= $ts} {
	            incr col -$ts
	        }
	        set spaces [expr {$ts - $col}]
	        set txt [string repeat " " ${spaces}]
	    }

	    if {${pos} == ""} {
		tkTextInsertChar ${w} ${txt}
	    } else {
		tkTextInsert ${w} ${pos} ${txt}
	    }
	    return
	}

	if {${pos} == ""} {
	    tkTextInsertChar ${w} \t
	} else {
	    tkTextInsert ${w} ${pos} \t
	}
	# NOBODY asks us to translate previous blanks to tabs when
	# the user inserts a TAB.
	return
    }

    method Undo {} {
	tkTextUndo $itk_component(editor)
    }

    method Redo {} {
	global tkText
	set tkText($itk_component(editor),prevCmd) "Redo"
	tkTextUndo $itk_component(editor)
    }

    method Cut {} {
	# Only cut when there is a valid selection.
	if {![catch {$itk_component(editor) get sel.first}]} {
	    tkTextCut $itk_component(editor)
	}
    }

    method Copy {} {
	tkTextCopy $itk_component(editor)
    }

    method Paste {} {
	tkTextPaste $itk_component(editor)
    }

    method Delete {} {
	catch {tkTextDelete $itk_component(editor) insert [tkTextPlaceChar $itk_component(editor) +] 1 0}
    }

    method FindNext {{direction ""} {string ""}} {
	global sn_options

	if {![info exists edit_SearchString]} {
	    set edit_SearchString $sn_options(search,str)
	}

	if {${direction} != ""} {
	    set edit_SearchDirection ${direction}
	}
	if {[string compare ${string} ""] == 0} {
	    set string ${edit_SearchString}
	}
	SearchForNext ${string}

	find_and_mark_tag
    }

    # Get a search string from the user and search for it in the specified 
    # text widget.
    method FindText {} {
	global sn_options

	set s ${topw}.multiedit_search
	if {[winfo exists ${s}]} {
	    if {[${s} state] != "normal"} {
		${s} deiconify
	    } else {
		${s} raise
	    }
	    ${s} move_to_mouse

	    # Set text only and return.
	    catch {set edit_SearchString [string trim \
	      [selection get]]}
	    return
	}

	# See if there is a selection to look for.
	catch {
	    set edit_SearchString [string trim [selection get]]
	}

	set s [sourcenav::Window ${s}]
	set strchk ${s}.strchk
	set strs ${strchk}.string
	set chk ${strchk}.chk
	set but ${s}.but

	${s} title [sn_title [get_indep String EditSearchFor]]
	${s} on_close "${this} Delete_Trace_SearchString ${but}.start; itcl::delete object ${s}"

	frame ${strchk}

	frame ${strs}
	label ${strs}.label \
	    -text [get_indep String SearchPattern] \
	    -underline [get_indep Pos SearchPattern] \
	    -anchor w
	entry ${strs}.entry \
	    -width 30 \
	    -bd 3 \
	    -relief sunken \
	    -exportselection no \
	    -textvariable [itcl::scope edit_SearchString]
	${strs}.entry select to end
	bind ${strs}.entry <Return> "${but}.start invoke"
	pack ${strs}.label \
	    -side left \
	    -padx 5
	pack ${strs}.entry \
	    -side left \
	    -padx 5 \
	    -fill x \
	    -expand y

	frame ${but}
	if {${edit_SearchString} == ""} {
	    set state disabled
	} else {
	    set state normal
	}
	button ${but}.start \
	    -text [get_indep String UtilSearch] \
	    -underline [get_indep Pos UtilSearch] \
	    -state ${state} \
	    -command "${this} SearchForNext"
	# Trace the button to enable/disable it, when string is (not) empty.
	Trace_SearchString ${but}.start
	button ${but}.cancel \
	    -text [get_indep String Cancel] \
	    -underline [get_indep Pos Cancel] \
	    -command "
		${this} Delete_Trace_SearchString ${but}.start
		itcl::delete object ${s}"
	pack ${but}.start \
	    -side top \
	    -fill x \
	    -padx 10 \
	    -pady 5
	pack ${but}.cancel \
	    -side top \
	    -fill x \
	    -padx 10 \
	    -pady 5

	frame ${chk}
	checkbutton ${chk}.case \
	    -text [get_indep String IgnoreCase] \
	    -underline [get_indep Pos IgnoreCase] \
	    -variable [itcl::scope edit_SearchNoCase] \
	    -onvalue "-nocase" \
	    -offvalue ""
	checkbutton ${chk}.regexp \
	    -text [get_indep String RegExp] \
	    -underline [get_indep Pos RegExp] \
	    -variable [itcl::scope edit_SearchMethod] \
	    -onvalue "-regexp" \
	    -offvalue "-exact"
	checkbutton ${chk}.forward \
	    -text [get_indep String SQLFfor] \
	    -underline [get_indep Pos SQLFfor] \
	    -variable [itcl::scope edit_SearchDirection] \
	    -onvalue "-forwards" \
	    -offvalue "-backwards"
	pack ${chk}.case \
	    -side top \
	    -anchor nw \
	    -padx 35
	pack ${chk}.regexp \
	    -side top \
	    -anchor nw \
	    -padx 35
	pack ${chk}.forward \
	    -side top \
	    -anchor nw \
	    -padx 35

	# Bind_focus_enter $s "focus $strs.entry".

	pack ${strs} \
	    -side top \
	    -fill x \
	    -pady 5 \
	    -expand y
	pack ${chk} \
	    -side top \
	    -fill x \
	    -pady 5 \
	    -expand y
	pack ${strchk} \
	    -side left \
	    -fill x \
	    -pady 20 \
	    -fill x \
	    -expand y
	pack ${but} \
	    -anchor nw \
	    -side left \
	    -padx 20 \
	    -pady 5
	focus ${strs}.entry

	${s} move_to_mouse
	catch {${s} resizable yes no}

	update idletasks
	set geom [split [lindex [split [${s} geometry] "+"] 0] "x"]
	${s} minsize [lindex ${geom} 0] [lindex ${geom} 1]
    }

    # Search from the current insertion point to EOF for a given string and
    # highlight the first occurrence found; search will wrap-around.
    method SearchForNext {{string ""} {top ""}} {
	global sn_options
	global SearchFoundLength

# FIXME: What is this SearchFoundLength used for ??
	set SearchFoundLength 0

	if {[string compare ${string} ""] != 0} {