tools.tcl

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

        #choose font
        set fnt_btn ${fr}.fnt
        LabelEntryButton& ${fnt_btn} -text [get_indep String Font]\
          -labelwidth 14 -underline [get_indep Pos Font] -command " ${this}\
          choose_font ${fnt_btn} " -anchor e -state disabled

        # Since error handling is currently broken, disable typing.
#        ${fnt_btn}.txt configure -state disabled

        bind ${fnt_btn} <FocusOut> "${this} verify_font"
        pack ${fnt_btn} -side top -fill x

        #choose color
        set fg_btn ${fr}.fg
        #button $fg_btn -text [get_indep String FgColor]
        #pack $fg_btn -side top -padx 5 -pady 5 -fill x -expand y
        LabelEntryButton& ${fg_btn} -text [get_indep String FgColor]\
          -labelwidth 14 -underline [get_indep Pos FgColor] -command " ${this}\
          choose_fg ${fg_btn} " -anchor e -state disabled

        # Since error handling is currently broken, disable typing.
#        ${fg_btn}.txt configure -state disabled

        bind ${fg_btn} <FocusOut> "${this} verify_color fg"
        pack ${fg_btn} -side top -fill x

        #choose color
        set bg_btn ${fr}.bg
        #button $bg_btn -text [get_indep String BgColor]
        #pack $bg_btn -side top -padx 5 -pady 5 -fill x -expand y
        LabelEntryButton& ${bg_btn} -text [get_indep String BgColor]\
          -underline [get_indep Pos BgColor] -labelwidth 14 -command " ${this}\
          choose_bg ${bg_btn} " -anchor e -state disabled

        # Since error handling is currently broken, disable typing.
#        ${bg_btn}.txt configure -state disabled

        bind ${bg_btn} <FocusOut> "${this} verify_color bg"
        pack ${bg_btn} -side top -fill x

        #reset
        set rst ${fr}.rst
        button ${rst} -text [get_indep String Reset] -command " ${this} reset "
        pack ${rst} -side top -anchor ne

        eval itk_initialize $args

        display_schemes

        after idle "pack propagate ${tree} 0"
    }

    #add availiable scheme names to the combo box
    method display_schemes {} {
        set default_scheme ""
        set contents [list]
        foreach sm ${schemes} {
            set sname [lindex ${sm} 0]
            lappend contents ${sname}

            if {${default_scheme} == ""} {
                set default_scheme ${sname}
            }
        }
        ${combo} configure -contents $contents
        ${combo} selecttext ${default_scheme}
        display_scheme ${default_scheme}
    }

    #draw the tree of variable settings for the actual scheme
    method display_scheme {scheme} {
        foreach sm ${schemes} {
            set sname [lindex ${sm} 0]
            if {${sname} != ${scheme}} {
                continue
            }
            set sents [lindex ${sm} 1]

            #delete old values
            ${treew} delete 0 end
            #categories (editor, class, ..)
            foreach cat [join [lrange ${sm} 1 end]] {
                set cname [lindex ${cat} 0]
                set cents [lindex ${cat} 1]
                set idx [${treew} insert end -text ${cname}\
                  -bitmap @${unknown_bitmap}]
                #options (text, ..)
                foreach ent ${cents} {
                    set ename [lindex ${ent} 0]
                    set eents [lindex ${ent} 1]
                    if {${ename} == ""} {
                        continue
                    }
                    ${treew} insert end -text ${ename} -parent ${idx}\
                      -data ${eents} -bitmap @${unknown_bitmap}
                }
            }
        }
    }

    method display_item {{idx ""}} {
        if {${idx} == ""} {
            set idx [${treew} curselection]
        }
        if {${idx} == ""} {
            bell
            return
        }
        set data [${treew} data ${idx}]
        control_buttons ${data}
    }

    method display_value {x y} {
        #toggle the sub tree, if availiable
        set ret [${treew} identify ${x} ${y}]
        if {${ret} == "view" || ${ret} == "hide"} {
            ${treew} toggle @${x},${y}
            return
        }
        display_item
    }

    method reset {} {
        global sn_options
        if {${fnt} != ""} {
            set sn_options(${opt_fnt}) $sn_options(${fnt})
        }
        if {${fg} != ""} {
            set sn_options(${opt_fg}) $sn_options(${fg})
        }
        if {${bg} != ""} {
            set sn_options(${opt_bg}) $sn_options(${bg})
        }
    }

    method control_buttons {data} {
        global sn_options

        if {${data} == ""} {
            set state disabled
        } else {
            set state normal
        }
        if {${data} == ""} {
            set fnt ""
            set opt_fnt ""
            set fg ""
            set opt_fg ""
            set bg ""
            set opt_bg ""
        } else {
            set fnt [lindex ${data} 0]
            set opt_fnt [lindex ${data} 1]
            set fg [lindex ${data} 2]
            set opt_fg [lindex ${data} 3]
            set bg [lindex ${data} 4]
            set opt_bg [lindex ${data} 5]
        }

        if {${fnt} == ""} {
            ${fnt_btn} configure  -state disabled -variable "" -value ""

# FIXME: disabled, do we even need this?
            # Since error handling is currently broken, disable typing.
#            ${fnt_btn}.txt configure -state disabled

            ${sample} configure -font $sn_options(def,default-font)
        } else {
            ${fnt_btn} configure -state normal

# FIXME: disabled, do we even need this?
            # Since error handling is currently broken, disable typing.
#            ${fnt_btn}.txt configure -state disabled

            if {![::info exists sn_options(${opt_fnt})]} {
                set sn_options(${opt_fnt}) $sn_options(${fnt})
            }
            ${sample} configure -font $sn_options(${opt_fnt})
            ${fnt_btn} configure -variable sn_options(${opt_fnt})\
              -value $sn_options(${opt_fnt})
        }
        if {${fg} == ""} {
            ${fg_btn} configure -state disabled -variable "" -value ""

            # Since error handling is currently broken, disable typing.
#            ${fg_btn}.txt configure -state disabled

            ${sample} configure -fg black
        } else {
            ${fg_btn} configure -state normal

            # Since error handling is currently broken, disable typing.
#            ${fg_btn}.txt configure -state disabled

            if {![::info exists sn_options(${opt_fg})]} {
                set sn_options(${opt_fg}) $sn_options(${fg})
            }
            ${sample} configure -fg $sn_options(${opt_fg})
            ${fg_btn} configure -variable sn_options(${opt_fg})\
              -value $sn_options(${opt_fg})
        }
        if {${bg} == ""} {
            ${bg_btn} configure -state disabled -variable "" -value ""

            # Since error handling is currently broken, disable typing.
#            ${bg_btn}.txt configure -state disabled

            ${sample} configure -bg white
        } else {
            ${bg_btn} configure -state normal

            # Since error handling is currently broken, disable typing.
#            ${bg_btn}.txt configure -state disabled

            if {![::info exists sn_options(${opt_bg})]} {
                set sn_options(${opt_bg}) $sn_options(${bg})
            }
            ${sample} configure -bg $sn_options(${opt_bg})
            ${bg_btn} configure -variable sn_options(${opt_bg})\
              -value $sn_options(${opt_bg})
        }
    }

    #if we can't set the font the sample, the
    #it is a wrong font
    method verify_font {} {
        global sn_options
        if {${fnt} == ""} {
            return
        }
        if {$sn_options(${opt_fnt}) == "" || [catch {${sample} configure \
          -font $sn_options(${opt_fnt})}]} {
            bell
            set sn_options(${opt_fnt}) $sn_options(${fnt})

            if {[catch {${sample} configure -font $sn_options(${fnt})}]} {
                set sn_options(${opt_fnt}) "Courier"
            }
        }
    }

    #verify if it is a correct color
    method verify_color {fg_bg} {
        global sn_options
        if {${fg_bg} == "fg" && ${fg} == "" || ${fg_bg} == "bg" && ${bg} ==\
          ""} {
            return
        }
        if {${fg_bg} == "fg"} {
            if {[catch {${sample} configure -fg $sn_options(${opt_fg})}] ||\
              $sn_options(${opt_fg}) == ""} {
                bell
                set sn_options(${opt_fg}) $sn_options(${fg})
            }
        }
        if {${fg_bg} == "bg"} {
            if {[catch {${sample} configure -bg $sn_options(${opt_bg})}] ||\
              $sn_options(${opt_bg}) == ""} {
                bell
                set sn_options(${opt_bg}) $sn_options(${bg})
            }
        }
    }

    #called from choosing font to set the selected font
    #to the optional variable
    method setfont {cls fontname choosed_font} {
        global sn_options
        if {${choosed_font} != ""} {
	    set ret [catch {${sample} configure -font ${choosed_font}}]
            
                set ${fontname} ${choosed_font}
           
        }
    }

    #choose different font
    method choose_font {cls} {
        global sn_options tcl_platform

        if {$tcl_platform(platform) == "windows"} {
            # use native Windows common Dialog font selector
            set sn_options(${opt_fnt}) [ide_win_choose_font\
              -default $sn_options(${opt_fnt}) -parent ${cls}]
            sn_log "New font (for ${opt_fnt}) = $sn_options(${opt_fnt})"
        } else {
            set win ${this}-font

            if {[itcl::find object ${win}] == $win} {
                itcl::delete object ${win}
            }

            ChooseFont& ${win} -current $sn_options(${opt_fnt}) -command\
              [itcl::code $this setfont $cls sn_options($opt_fnt)]

            $win activate

            itcl::delete object $win
        }
    }

    #accept choosed color
    method setcolor {fg_bg cls clrname choosed_clr} {
        global sn_options
        global ${clrname}
        if {${choosed_clr} != ""} {
            if {${fg_bg} == "fg"} {
                set ret [catch {${sample} configure -fg ${choosed_clr}}]
            } else {
                set ret [catch {${sample} configure -bg ${choosed_clr}}]
            }
            if {! ${ret}} {
                set ${clrname} ${choosed_clr}
            }
        }
    }

    #choose fgcolor
    method choose_fg {cls} {
        global sn_options
        set win ${this}-choose_color
        if {[itcl::find object ${win}] == $win} {
            itcl::delete object ${win}
        }
        ChooseColor& ${win} -current $sn_options(${opt_fg}) -command " ${this}\
          setcolor fg ${cls} sn_options(${opt_fg}) "

	$win activate

	itcl::delete object $win
    }

    #choose bg color
    method choose_bg {cls} {
        global sn_options
        set win ${this}-choose_color
        if {[itcl::find object ${win}] == $win} {
            itcl::delete object ${win}
        }
        ChooseColor& ${win} -current $sn_options(${opt_bg}) -command " ${this}\
          setcolor bg ${cls} sn_options(${opt_bg}) "
	$win activate
	itcl::delete object $win
    }

    protected variable fnt ""
    protected variable opt_fnt ""
    protected variable fg ""
    protected variable opt_fg ""
    protected variable bg ""
    protected variable opt_bg ""

    protected variable combo
    protected variable treew
    protected variable tree
    protected variable sample
    protected variable fnt_btn
    protected variable fg_btn
    protected variable bg_btn

    protected variable unknown_bitmap ""
    protected variable plus_bitmap ""
    protected variable minus_bitmap ""

    public variable width 20
    public variable text "class"
    public variable color "color"
    public variable variable ""
    public variable schemes ""
}