editorpane.tcl

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

	${this} SetFondPos [set $itk_option(-linenumber_var)] 1 0
    }

    #
    # The basic insertion routine for brackets
    # If requested, does bracket matching
    #
    # w: 	  Editor widget
    # sb: 	  start bracket
    # eb:	  end bracket
    # insert: marks if a bracket is inserted or the region
    #		  has to selected
    proc Insert_Mark_Bracket {args} {
	after idle "Editor&::x_Insert_Mark_Bracket ${args}"
    }
    proc x_Insert_Mark_Bracket {w sb {bracket 1}} {
	global sn_options

	#by insertion, do a bracket selection
	#by double-click on a bracket, do a real selection
	if {${bracket}} {
	    set tag bracket
	} else {
	    set tag sel
	}

	#delay is invalid
	if {$sn_options(def,edit-bracket-delay) <= 0} {
	    return
	}

	set ebees "\"\'\>\]\)\}"
	set sbees "\"\'\<\[\(\{"
	set i [string first ${sb} ${ebees}]
	if {${i} != -1} {
	    set eb [string index ${sbees} ${i}]
	} else {
	    set i [string first ${sb} ${sbees}]
	    if {${i} == -1} {
		return
	    }
	    set eb [string index ${ebees} ${i}]
	}

	set str_range ""

	switch -- ${sb} {
	\" -
	\' {
		#if string tag is availiable, mark the whole reagon
		#of the string
		set tags [${w} tag names insert]
		if {[lsearch \
		    -exact ${tags} str] != -1} {
		    set str_range [${w} tag prevrange str insert+1c]
		    if {${str_range} != ""} {
			set idx [lindex ${str_range} 0]
			set end [lindex ${str_range} end]

			#somebody tries to select a region in text area
			#can he do it?
			if {[${w} compare ${idx} < insert] && [${w} compare \
			  ${end}-1c > insert]} {
			    return
			}
		    }
		}

		#do normal selection (locate a matching \"
		if {${str_range} == ""} {
		    set ob ""
		    set cb ${eb}
		    set beg_off [${w} index "insert-200c"]
		    set cont [${w} get ${beg_off} "insert-1c"]
		    set forw 0
		}
	    }
	\> -
	\] -
	\) -
	\} {
		set ob ${sb}
		set cb ${eb}
		set beg_off 0.0
		set cont [${w} get ${beg_off} insert]
		set forw 0
	    }
	\< -
	\[ -
	\( -
	\{ {
		set ob ${sb}
		set cb ${eb}
		set beg_off "insert-1c"
		set cont [${w} get ${beg_off} end]
		set forw 1
	    }
	default {
		return
	    }
	}

	if {${str_range} == ""} {
	    # brace_balance is written in C. If it does not exist just return.
	    if {[::info commands brace_balance] != ""} {
		set off [brace_balance ${cont} ${forw} ${ob} ${cb}]
	    } else {
		return
	    }
	    if {${off} == -1} {
		return
	    }
	    set idx [${w} index "${beg_off} + ${off} chars"]
	    set end [${w} index insert]
	}

	${w} tag remove ${tag} 0.0 end
	${w} see ${idx}

	if {${str_range} == ""} {
	    if {[${w} compare ${idx} > "insert"]} {
		set end ${idx}
		set idx "insert-1c"
	    } else {
		set end "insert"
	    }
	}

	after idle "${w} tag add ${tag} ${idx} ${end}"
	if {${bracket}} {
	    # If we just insert remove the selection.
	    set cmd "; ${w} tag remove ${tag} 0.0 end"
	} else {
	    set cmd ""
	}
	update idletasks
	after $sn_options(def,edit-bracket-delay) "${w} see insert ${cmd}"
    }

    #
    # The basic insertion routine for adding a new line
    #
    proc Newline {w} {
	global sn_options
	if {$sn_options(def,edit-indentwidth) <= 0} {
	    tkTextInsertChar ${w} \n
	} else {
	    set l [${w} get "insert linestart" "insert lineend"]
	    set indentStr ""
	    if {[regexp \
	            -indices "^\[ \t\]*" ${l} ind_off]} {
	        set end [lindex ${ind_off} 1]
	        set indentStr [string range ${l} 0 ${end}]
	        # Unexpand the spaces to TABS.
	        set spaces [string repeat " " $sn_options(def,edit-tabstop)]

	        regsub \
	                -all ${spaces} ${indentStr} "\t" indentStr
	        regsub \
	                -all "\[ \]+\t" ${indentStr} "\t" indentStr

	        if {$sn_options(def,edit-tab-inserts-spaces)} {
	            # we have to translate \t to the current size number of tabs
	            if {$sn_options(def,edit-tabstop) == 0} {
	                set spaces " "
	            } else {
	                set spaces [string repeat " " \
	                        $sn_options(def,edit-tabstop)]
	            }
	            regsub \
	                -all \t ${indentStr} ${spaces} indentStr
	        }
	    }
	    
	    tkTextInsertChar ${w} \n${indentStr}
	}
    }

    # The function tries to get an identifier from the text widget.
    # 1. from the selection (if that exists)
    # 2. from the cursor position
    proc get_current_word {{cls ""}} {
	global sn_all_scopes
	set w [${cls} editor]
	set name ""

	if {[catch {set name [selection get]}]} {
	    set name ""
	    foreach nm [${w} tag names insert] {
		if {[lsearch \
		    -exact ${sn_all_scopes} ${nm}] != -1} {
		    set rng [${w} tag prevrange ${nm} "insert +1c"]
		    set name [format_for_retriever [eval ${w} get ${rng}]]
		}
	    }
	    if {${name} == ""} {
		set name [format_for_retriever [${w} get "insert wordstart" \
		  "insert wordend"]]
	    }
	}

	return ${name}
    }

    proc Get_XSelection {{cls ""}} {
	if {![catch {set string [selection get]}]} {
	    set off [string first "\n" ${string}]
	    if {${off} != -1} {
		set string [string trim [string range ${string} 0 \
		  [expr ${off} - 1]]]
	    }
	} else {
	    set string ""
	}

	#look for the current symbol in the editor
	if {${string} == "" && ${cls} != ""} {
	    set sel [${cls} Selection]
	    if {${sel} != ""} {
		set string [lindex ${sel} 1]
		if {[lindex ${sel} 2] != ""} {
		    set string "[lindex ${sel} 2] ${string}"
		}
	    }
	}

	#look for the current word in the editor
	if {${string} == "" && ${cls} != ""} {
	    set string [Editor&::get_current_word ${cls}]
	}

	return ${string}
    }

    proc search_definition {cls {string ""} {file ""}} {
	search_implementation ${cls} ${string} ${file} "def"
    }
    proc search_implementation {cls {string ""} {file ""} {imp_def "imp"}} {
	global sn_scopes
	set cls [namespace tail $cls]

        if {$cls != "" && [[$cls cget -parent] isakeep] == 1} {
	    set cmd "${cls} gotofile_cb"
	} else {
	    set cmd ""
	}

	#see if cursor stays on a symbol header
	if {${cls} != ""} {
	    set editor [${cls} editor]
	    set pos [$editor index {insert wordstart}]
	}
	if {${cls} != "" && [points_to_header [${cls} editor] ${pos}] != ""} {
	    set sel [${cls} Selection]
	    set scope [lindex ${sel} 0]
	    set sym [lindex ${sel} 1]
	    set cls [lindex ${sel} 2]
	    set file [lindex ${sel} 3]
	    set type [lindex ${sel} 5]
	    set prm [lindex ${sel} 6]

	    set string [string trim "${cls}\:\:${sym}" "\:\:"]

	    set have_declaration 1
	} else {
	    if {${string} == ""} {
		set string [Get_XSelection ${cls}]
	    }
	    if {${string} == ""} {
		bell
		return
	    }
	    set from ""
	    set type ""
	    set prm ""
	    set to ""

	    set have_declaration 0
	}

	#look using the following table
	#pattern file param type
	#pattern file param ""
	#pattern ""   param type
	#pattern ""   param ""
	#pattern ""   ""    ""
	#don't look for declarations, if we already have declarations
	if {${imp_def} == "imp"} {
	    lappend scopes {fu mi}
	    if {! ${have_declaration}} {
		lappend scopes {fd md fr}
	    }
	} else {
	    lappend scopes {fd md fr}
	    #exclude implementations as like the scopes "fd md fr"
	    set rest ""
	    foreach s ${sn_scopes} {
		if {[lsearch \
		    -exact {fu mi fd md fr} ${s}] == -1} {
		    lappend rest ${s}
		}
	    }
	    if {${rest} != ""} {
		lappend scopes ${rest}
	    }
	}
	foreach scopegrp ${scopes} {
	    lappend looking_list [list ${file} ${scopegrp} ${prm} ${type}]
	    lappend looking_list [list ${file} ${scopegrp} ${prm} ""]
	    lappend looking_list [list "" ${scopegrp} ${prm} ${type}]
	    lappend looking_list [list "" ${scopegrp} ${prm} ""]
	    lappend looking_list [list "" ${scopegrp} "" ""]
	}

	#find first "mi fu", if nothing is found try to find declaration
	#look first in the same file, when nothing is found, try to find
	#in all files
	foreach l ${looking_list} {
	    set file [lindex ${l} 0]
	    set scopes [lindex ${l} 1]
	    set prm [lindex ${l} 2]
	    set type [lindex ${l} 3]

	    #make sure that a fetch hasn't been done twice
	    if {[info exists looking_arr(${file},${scopes},${prm},${type})]} {
		continue
	    }
	    set looking_arr(${file},${scopes},${prm},${type}) 1

	    #1. find implementation by accepting types and parameters
	    set ret [sn_retrieve_symbol ${string} ${scopes} ${file} \
	        -exact 1 0 ${cmd} "" ${type} ${prm}]

	    #if something found, break the selection
	    if {${ret}} {
		break
	    }
	}
	catch {unset looking_list}
	catch {unset looking_arr}
    }

    method RetrieveObject {} {
	global sn_options Parser_Info
	set case -1
	set file $itk_option(-filename)
	if {${file} != $sn_options(noname_file)} {
	    set type [sn_get_file_type ${file}]
	    set case $Parser_Info(${type},CASE)
	}
	if {[catch {set name [selection get]}]} {
	    set name ""
	}
	set name [string trim ${name}]
	if {${name} == ""} {
	    sn_error_dialog [get_indep String NoSelection] [get_indep String \
	      MultiRetriever]
	    return
	}

	if {!${case}} {
	    set name [string toupper ${name}]
	}
	sn_retrieve_symbol [list ${name}] all "" \
	    -exact 1 1
    }

    #this function set the color for the different symbols
    #displayed in the editor
    proc init_tags {t} {
	global sn_options
	global combobox_editor_scopes

	if {$sn_options(iscolor)} {
	    # Create highlight tags for text widget
	    set sc [::lunique [lsort [eval concat [array get \
	      combobox_editor_scopes]]]]
	    foreach tg [concat key rem str ${sc} lv] {
		catch {${t} tag configure ${tg} \
		        -foreground $sn_options(def,color_${tg})}
	    }
	    if {$sn_options(def,edit-xref-highlight)} {
		catch {${t} tag configure "xref_g" \
		        -foreground orange}
		catch {${t} tag configure "xref_u" \
		        -foreground green}
		catch {${t} tag configure "xref_l" \
		        -foreground "cornflower blue"}
	    }

	    ${t} tag configure bracket \
	        -background $sn_options(def,bracketmatch-bg) \
	        -foreground white

	    catch {${t} tag raise mi md}
	} else {
	    ${t} tag configure bracket \
	        -background black \
	        -foreground white
	}
	${t} tag configure grep \
	    -foreground white \
	    -background black
    }

    method color_file {{run_parse 1}} {
	if {${highlight}} {
	    UpdateHighlights ${run_parse}

	    #read symbols from DB
	    set file_syms [get_file_symbols $itk_option(-filename)]

	    #create tags for the found symbols in the editor
	    sn_db_create_symbol_tags $itk_component(editor) ${file_syms} "in iu"

	    #mark actual tag and display found tags into
	    #the combobox
	    GetFileTags 0 ${file_syms}
	}
    }

    # This proc is used to clear the editor then load and hight a file.
    # It can also be called if a file has changed and we need to revert.

    method load_n_colour {{run_parse 0}} {
        global sn_options

	if {[catch {set lastpos [$itk_component(editor) index insert]}]} {
	    set lastpos 1.0
	}
	if {[catch {set markpos [$itk_component(editor) index markpos]}]} {
	    set markpos 1.0
	}

        # Load the file from disk.
	if {[catch {set f [open $itk_option(-filename) r]} msg]} {
             sn_error_dialog "$msg $itk_option(-filename)"
             return
        }

        fconfigure ${f} \
            -encoding $sn_options(def,encoding) \
            -blocking 0
    
        $itk_component(editor) delete 1.0 end
        $itk_component(editor) insert 1.0 [read -nonewline $f]
    
        close ${f}
        $this configure -file_changed 0

 	# Revert undo list.
	tkTextUndoSetup $itk_component(editor)
   
        # Save modification time.
        set file_mtime [file mtime $itk_option(-filename)]
    
        # Color tags.
        color_file $run_parse
    
	# Mark last position.
	$itk_component(editor) mark set lastpos ${lastpos}
	$itk_component(editor) mark set markpos ${markpos}
	$itk_component(editor) mark set insert 0.0
	$itk_component(editor) tag remove sel 0.0 end
    }

    # This file is called, when ever a file must be edited.
    method editfile {f {line ""} {revert ""} {run_parse 1}} {
	global sn_options
	global SyncEditors_Disabled

	# Check we haven't been called before creation.
        if {![info exists itk_component(editor)] \
             || ![winfo exists $itk_component(editor)]} {
	     return
        }

 	if {${f} == ""} {
	    return 0
	}

	# Verify if the momentan file is modified.
	if {${revert} != "revert" && [Ask_For_Modified revert] == 0} {
	    return 0
	}

	# We should never be asked to edit a directory.
	if {[file isdirectory ${f}]} {
	    error "editfile method called for a directory \"${f}\""
	}

	# Test if file exists and readable, returns if
	# file doesn't exist.
	if {${f} != $sn_options(noname_file) &&(! [file exists ${f}] || ! \
	  [file readable ${f}])} {
	    return 0
	}

	# Parse file to see if we could add it into the project.
	if {[file exists ${f}]} {
	    # Make sure that we want to refresh a file before
	    # editing it. This could be a slow mechanism, when somebody
	    # wants to work only with "Fast Save" (without refreshing).
	    if {$sn_options(def,auto-reparse)} {
		if {! [sn_parse_uptodate [list ${f}] 0]} {
		    return 0
		}
	    }
	}