help.tcl

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

# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# help.tcl - Online documentation and balloon help. 
# Copyright (C) 1998 Cygnus Solutions.

proc sn_help {{file ""} {busy 1}} {
    global sn_options tcl_platform sn_path

    if {${file} != "" && $tcl_platform(platform) == "windows"} {
        set file [file attribute ${file} -shortname]
    }

    if {${file} == ""} {
        set file "index.html"
        set dir $sn_path(htmldir)
        set file [file join ${dir} ${file}]
        if {$tcl_platform(platform) == "windows"} {
            set file [file attribute ${file} -shortname]
        }
        set file "file:${file}"
    }\
    elseif {![regexp -- {^(file:|http://)} ${file}]} {
        set file file:${file}
    }

    if {$tcl_platform(os) == "Windows NT"} {
        sn_log "cmd -c start ${file}"
        set ret [catch {exec cmd /c start ${file} &} errmsg]
    }\
    elseif {$tcl_platform(os) == "Windows 95"} {
        sn_log "command -c start ${file}"
        set ret [catch {exec command /c start ${file} &} errmsg]
    } else {
        global netscape_error netscape_exit_status
        global netscape_done

        set netscape_done 0
        set html_view $sn_options(def,html-viewer)
        if {${html_view} == ""} {
            set html_view "netscape -remote openURL(%s)"
        }
        if {[string first {%s} ${html_view}] != -1} {
            set cmd [format ${html_view} ${file}]
        } else {
            set cmd [list ${html_view} ${file}]
        }
        sn_log "${cmd}"
        set ret [catch {open "|${cmd}"} netscape_fd]
        if {${ret}} {
            set errmsg ${netscape_fd}
        } else {
            fconfigure ${netscape_fd} \
                -encoding $sn_options(def,system-encoding) \
                -blocking 0
            fileevent ${netscape_fd} readable [list netscape_reader\
              ${netscape_fd}]
            vwait netscape_done
            if {${netscape_exit_status}} {
                if {![string match {*not running on display*}\
                  ${netscape_error}]} {
                    set ret 1
                    set errmsg ${netscape_error}
                }\
                elseif {[regsub {([.]*)-remote openURL\(file:([^\)]*)\)([.]*)}\
                  ${cmd} {\1\2\3} cmd] != 0} {
                    sn_log "${cmd}"
                    eval exec ${cmd} &
                } else {
                    set ret 1
                    set errmsg ${netscape_error}
                }
            }
        }
    }

    if {${ret}} {
        sn_error_dialog ${errmsg}
        return
    }
    after 3000
}

proc netscape_reader {pipe} {
    global netscape_error
    global netscape_exit_status
    global netscape_done

    if {[eof ${pipe}]} {
        set netscape_exit_status [catch {close ${pipe}} netscape_error]
        incr netscape_done
        return
    }
    gets ${pipe} line
}

# display a small window on the button of a widget to
# view the binded help text
set balloon_bind_info(screen_width) [winfo screenwidth .]
set balloon_bind_info(screen_height) [winfo screenheight .]
set balloon_bind_info(shown) 0

#use class of bindings for balloon help
proc balloon_button_bind {} {
    global balloon_bind_info

    set w SN_Balloon

    bind ${w} <Enter> {+
		catch {
			set balloon_bind_info(id) [after $balloon_bind_info(%W,delay)\
      $balloon_bind_info(%W,proc) %W [list $balloon_bind_info(%W,text)] %X %Y]
		}
	}
    bind ${w} <Leave> {+balloon_destroy}
    bind ${w} <Any-ButtonPress> {+balloon_destroy}
    bind ${w} <KeyPress> {+balloon_destroy}
}

proc balloon_destroy {} {
    global balloon_bind_info

    if {[winfo exists .cb_balloon]} {
        destroy .cb_balloon
    }
    if {[info exists balloon_bind_info(id)]} {
        after cancel $balloon_bind_info(id)
    }
    if {[info exists balloon_bind_info(id,timeout)]} {
        after cancel $balloon_bind_info(id,timeout)
    }
    set balloon_bind_info(shown) 0
}

proc balloon_menu_bind {} {
    global balloon_bind_info

    set w Menu

    bind ${w} <<MenuSelect>> {+
		set tmpidx [%W index active]
		catch {
			if {$balloon_bind_info(%W,last_menu_index) == $tmpidx ||
				$tmpidx == "none"} {
				break
			}
		}
		balloon_destroy
		if {![info exists balloon_bind_info(%W,$tmpidx,text)]} {
			catch {unset balloon_bind_info(%W,last_menu_index)}
			break
		}
		set balloon_bind_info(%W,last_menu_index) $tmpidx
		set balloon_bind_info(id) [after $balloon_bind_info(%W,delay)\
      $balloon_bind_info(%W,proc) %W {""} %X %Y]
		unset tmpidx
	}

    bind Menu <Leave> {+
		balloon_destroy
		catch {unset balloon_bind_info(%W,last_menu_index)}
	}
}

#execute balloon bindings only once!
balloon_button_bind

proc balloon_bind_info {w text {delay -1} {procedure "balloon_display_info"}} {
    global sn_options
    global balloon_bind_info

    if {${delay} < 0} {
        set delay $sn_options(def,balloon-disp-delay)
    }
    set balloon_bind_info(${w},text) ${text}
    set balloon_bind_info(${w},delay) ${delay}
    set balloon_bind_info(${w},proc) ${procedure}

    sn_add_tags ${w} SN_Balloon 0
}

proc menu_balloon_bind_info {w idx text {delay -1} {procedure\
  "balloon_display_info"}} {
    global sn_options balloon_bind_info

    if {${delay} < 0} {
        set delay $sn_options(def,balloon-disp-delay)
    }
    set balloon_bind_info(${w},${idx},text) ${text}
    set balloon_bind_info(${w},delay) ${delay}
    set balloon_bind_info(${w},proc) ${procedure}
}

proc balloon_display_info {w text rx ry} {
    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
    }

    if {[winfo class ${w}] == "Menu"} {
        if {[catch {set act $balloon_bind_info(${w},last_menu_index)}] ||\
          [catch {set text $balloon_bind_info(${w},${act},text)}]} {
            return
        }

        if {[${w} cget -type] == "menubar"} {
            set y [expr [winfo rooty ${w}] + [winfo height ${w}]]
            set x [winfo rootx ${w}]
        }\
        elseif {${act} == [${w} index end]} {
            set y [expr [winfo rooty ${w}] + [winfo height ${w}]]
            set x [expr [winfo rootx ${w}] + [winfo width ${w}]]
        } else {
            set y [expr [winfo rooty ${w}] + [${w} yposition [expr ${act} +1]]]
            set x [expr [winfo rootx ${w}] + [winfo width ${w}]]
        }
    } else {
        set x ${rx}
        set y [expr [winfo rooty ${w}] + [winfo height ${w}]]
    }

    balloon_destroy

    set balloon_bind_info(shown) 1
    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)
    }
    pack [frame ${t}.f -bd 1 -background black]
    pack [label ${t}.f.l -text ${text} -wraplength 300 -justify left\
      -bg ${bg_color} -fg ${fg_color} -bd 0 -relief raised\
      -font $sn_options(def,balloon-font) -padx 4 -pady 4]
    wm overrideredirect ${t} 1

    if {${y} < 0} {
        set y 0
    }
    set w [expr [winfo reqwidth ${t}.f.l] + 2]
    set h [expr [winfo reqheight ${t}.f.l] + 2]

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