help.tcl

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

    }

    wm geometry ${t} +${x}+${y}
    wm deiconify ${t}

    # remove the balloon window after time-out:
    set balloon_bind_info(id,timeout) [after\
      [expr $sn_options(def,balloon-undisp-delay) + [string length ${text}] *\
      50] "catch \{destroy ${t}\}"]
}

proc canvas_rebind_info {w id text {delay -1} {procedure\
  "canvas_display_info"}} {
    global sn_options
    global balloon_bind_info

    if {${delay} < 0} {
        set delay $sn_options(def,balloon-disp-delay)
    }
    catch {
        ${w} bind ${id} <Enter> "
			set balloon_bind_info(id)  \[after ${delay} ${procedure} ${w} ${id} %X %Y\
          [list ${text}]\]
		"

        ${w} bind ${id} <Motion> "
			balloon_destroy
			set balloon_bind_info(id)  \[after ${delay} ${procedure} ${w} ${id} %X %Y\
          [list ${text}]\]
		"
    }
}

proc canvas_bind_info {w id text {delay -1} {procedure "canvas_display_info"}} {
    global sn_options
    global balloon_bind_info

    if {${delay} < 0} {
        set delay $sn_options(def,balloon-disp-delay)
    }
    #shown meens, that the info window is already displayed, don't
    #display it again
    set balloon_bind_info(shown) 0

    set balloon_bind_info(${w},${id},text) ${text}
    ${w} bind ${id} <Enter> "
		if \[info exists balloon_bind_info(${w},${id},text)\] {
		    set balloon_bind_info(id)  \[after ${delay} ${procedure}  ${w} ${id} %X\
      %Y [list ${text}]\]
		}
	"
    ${w} bind ${id} <Motion> "
		balloon_destroy
		if \[info exists balloon_bind_info(${w},${id},text)\] {
			set balloon_bind_info(id)  \[after ${delay} ${procedure}  ${w} ${id} %X %Y\
      [list ${text}]\]
		}
	"
    ${w} bind ${id} <Leave> {
		balloon_destroy
	}
    ${w} bind ${id} <Any-ButtonPress> [${w} bind ${id} <Leave>]
    ${w} bind ${id} <Any-Key> [${w} bind ${id} <Any-ButtonPress>]
}

proc canvas_display_info {w id rx ry args} {
    global sn_options
    global balloon_bind_info

    if {$balloon_bind_info(shown)} {
        return
    }
    if {[winfo containing [winfo pointerx .] [winfo pointery .]] != ${w}} {
        return
    }
    if {[catch {set bg_color $sn_options(def,balloon-bg)}]} {
        set bg_color lightyellow
    }
    if {[catch {set fg_color $sn_options(def,balloon-fg)}]} {
        set fg_color black
    }
    set balloon_bind_info(shown) 1

    catch {destroy [set t .cb_balloon]}
    toplevel ${t} -bg ${bg_color}
    wm withdraw ${t}

    if {$sn_options(def,desktop-font-size) > 14} {
        set fsize 14
    } else {
        set fsize $sn_options(def,desktop-font-size)
    }

    set text [join ${args}]
    label ${t}.l -text ${text} -wraplength 400 -justify left -bg ${bg_color}\
      -fg ${fg_color} -bd 1 -relief raised -font $sn_options(def,balloon-font)
    pack ${t}.l
    wm overrideredirect ${t} 1

    set x [winfo pointerx ${w}]
    set y [expr [winfo rooty ${w}] - [expr int([${w} canvasy 0])]]
    set bbox [${w} bbox ${id}]
    if {[catch {set y [expr ${y} + [expr [lindex ${bbox} 1] + [expr\
      [lindex ${bbox} 3] - [lindex ${bbox} 1]]]]}]} {
        set y 0
    }

    if {${y} < 0} {
        set y 0
    }
    set wdth [winfo reqwidth ${t}.l]
    set high [winfo reqheight ${t}.l]

    # make help window be completely visible
    if {${x} + ${wdth} > $balloon_bind_info(screen_width)} {
        set x [expr $balloon_bind_info(screen_width) - ${wdth}]
    }
    if {${y} + ${high} > $balloon_bind_info(screen_height)} {
        set y [expr $balloon_bind_info(screen_height) - ${high}]
    }

    wm geometry ${t} +${x}+${y}
    wm deiconify ${t}

    # remove the balloon window after 5 seconds:
    set balloon_bind_info(id,timeout) [after [expr 5000 + [string length\
      ${text}] * 50] "catch \{destroy ${t}\}"]
}

proc sn_show_abbrav {} {
    global sn_options
    global sn_scopes

    set win .sn_abbr
    set t ${win}

    if {[winfo exists ${t}]} {
        ${t} raise
        return
    }
    sourcenav::Window ${t}
    ${t} configure -title [list [get_indep String Abrav]]

    sn_motif_buttons ${t} bottom 0 [get_indep String ok]

    ${t}.button_0 config -command "itcl::delete object ${t}"

    text ${t}.a -width 50 -wrap none -spacing1 2
    set bw 0
    set max 0
    set sc_str ""

    foreach sc "${sn_scopes} lv ud" {
        set desc [convert_scope_to_plain_str ${sc}]

        set f ${t}.a.${sc}
        frame ${f}
        button ${f}.${sc} -image type_${sc}_image -bd ${bw}
        pack ${f}.${sc}
        pack ${f}

        ${t}.a window create end -window ${f}
        ${t}.a insert end " ${sc}:\t${desc}\n"
    }

    ${t}.a insert end ${sc_str}

    ${t}.a insert end "\n\t[get_indep String CrossReference]\n\n"
    ${t}.a insert end "r\t[get_indep String Read]\t\t"
    ${t}.a insert end "w\t[get_indep String Written]\n"
    ${t}.a insert end "p\t[get_indep String Passed]\t\t"
    ${t}.a insert end "u\t[get_indep String Unused]\n"

    ${t}.a insert end "\n\t[get_indep String ClassNoKey]\n\n"

    ${t}.a tag configure protected -font $sn_options(def,protected-font)
    ${t}.a tag configure public -font $sn_options(def,public-font)

    ${t}.a insert end "\t[get_indep String Private]\n"

    set idx [${t}.a index "insert linestart"]
    frame ${t}.a.p
    button ${t}.a.p.b -image cls_br_p_image -bd ${bw}
    pack ${t}.a.p.b
    pack ${t}.a.p

    ${t}.a window create end -window ${t}.a.p
    ${t}.a insert end "\t[get_indep String Protected]\n"

    ${t}.a tag add protected ${idx} insert

    set idx [${t}.a index "insert linestart"]
    frame ${t}.a.pub
    button ${t}.a.pub.b -image cls_br__image -bd ${bw}
    pack ${t}.a.pub.b
    pack ${t}.a.pub

    ${t}.a window create end -window ${t}.a.pub
    ${t}.a insert end "\t[get_indep String Public]\n"

    ${t}.a tag add public ${idx} insert

    frame ${t}.a.v
    button ${t}.a.v.v -image cls_br_v_image -bd ${bw}
    pack ${t}.a.v.v
    pack ${t}.a.v

    ${t}.a window create end -window ${t}.a.v
    ${t}.a insert end " v\t[get_indep String Virtual]\n"

    frame ${t}.a.s
    button ${t}.a.s.s -image cls_br_s_image -bd ${bw}
    pack ${t}.a.s.s
    pack ${t}.a.s

    ${t}.a window create end -window ${t}.a.s
    ${t}.a insert end " s\t[get_indep String Static]\n"

    frame ${t}.a.pl
    button ${t}.a.pl.pl -image cls_br_+_image -bd ${bw}
    pack ${t}.a.pl.pl
    pack ${t}.a.pl

    ${t}.a window create end -window ${t}.a.pl
    ${t}.a insert end " +\t[get_indep String PafAbrOverride]\n"

    frame ${t}.a.min
    button ${t}.a.min.mi -image cls_br_-_image -bd ${bw}
    pack ${t}.a.min.mi
    pack ${t}.a.min

    ${t}.a window create end -window ${t}.a.min
    ${t}.a insert end " -\t[get_indep String PafAbrOverridden]\n"

    set height [expr int([${t}.a index "end -1c"]) + 1]

    ${t}.a config -state disabled -height ${height}

    pack ${t}.a -anchor w -fill x

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

    tkwait visibility ${win}

    set idx [lindex [split [${t}.a index end] "."] 0]
    update idletasks

    # This is a nasty hack, dude.
    after idle [list abbr_correction ${t}.a]
}

proc abbr_correction {ed} {
    update idletasks

    if {![winfo exists ${ed}] || [${ed} yview] == "0 0"} {
        return
    }

    set steps 0
    while {[winfo exists ${ed}] && [${ed} yview] != "0 1"} {
        set height [${ed} cget -height]
        incr height +2
        ${ed} config -height ${height}
        update idletasks

        #what happens if the screen height is lesser that
        #the should be window hight. Break the loop here
        #after enough steps.
        if {${steps} > 20} {
            break
        }
        incr steps
    }
}