qmg_interactive_init.tcl

来自「算断裂的」· TCL 代码 · 共 75 行

# initialization for interactive work

# autoloader not working properly for object commands, so
# source all of our procedures.

proc gm_rehash {} {
    set olddir [pwd]
    global qmg_library
    cd $qmg_library
    set tclfiles [glob *.tcl]
    foreach file $tclfiles {
	if {[string range $file 0 3] != "qmg_" && [string range $file 0 1] != "tk"} {
	    uplevel [list source $file]
	}
    }
    cd $olddir
}


proc qmg_init_console1 {} {
    puts "Type gmhelp for help; type exit to exit"
    global TKCON
    set w $TKCON(menubar)
    $w.help add command -label "About QMG "  -command qmg_about
    $w.pop.help add command -label "About QMG "  -command qmg_about
    wm title .$TKCON(base) "QMG 2.0.1 --- TkCon $TKCON(version)"
}


proc qmg_about {} {
    global TKCON
    set w $TKCON(base).aboutqmg
    if {[winfo exists $w]} {
	wm deiconify $w
    } else {
	global tk_patchLevel tcl_patchLevel tcl_platform
	toplevel $w
	wm title $w "About QMG 2.0.1"
	button $w.b -text Dismiss -command [list wm withdraw $w]
	text $w.text -height 9 -bd 1 -width 60
	pack $w.b -fill x -side bottom
	pack $w.text -fill both -side left -expand 1
	$w.text tag config center -justify center
	if {[string compare unix $tcl_platform(platform)] \
		|| [info tclversion] >= 8} {
	    $w.text tag config title -justify center -font {Courier -18 bold}
	} else {
	    $w.text tag config title -justify center -font *Courier*Bold*18*
	}
	$w.text insert 1.0 "About QMG 2.0.1" title \
		"\n\n \251 1999 Cornell University\
		\nhttp://www.cs.cornell.edu/home/vavasis/qmg-home.html\
		\nType gmhelp for brief help.\
		\nUsing: Tcl v$tcl_patchLevel / Tk v$tk_patchLevel" center
	$w.text config -state disabled
    }
}



gm_rehash

gmviz_set_to_defaults
if {[info exists gm_no_windows] == 0} {
    qmg_start_tk
    wm withdraw .
    set argc 1
    set argv [list -rcfile $qmg_library/tkcon-init.tcl]
    source $qmg_library/tkcon.tcl
    tkwait window .
}