eb.tcl

很不错的tcl编程实例

# Copyright 1996


# Authors

# Lakshmi Sastry
# Computing and Information Systems Department
# Rutherford Appleton Laboratory, Chilton, Didcot. OX11 0QX
# [e-mail]

#                         and

# Venkat VSS Sastry
# Department of Applied Mathematics and Operational Research
# Cranfield University, RMCS Shrivenham, Swindon, SN6 8LA
# [e-mail]

# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies.
  
# The authors, RAL and RMCS Shrivenham, Cranfield University
# make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without
# express or implied warranty. Likewise they accept no responsibility
# whatsoever for any public domain software modules used (which are
# hereby acknowledged) in this software 


proc getFiles { key } {
global fileNames EB
.eb.info config -text "Searching for ... $key"

set fileNames($key) {}
	 		  
set fileNames($key) [eval exec /usr/bin/grep -l $key [glob $EB(dir)/*.tcl]]

.eb.mb.ex.m delete 1 last
foreach val [set fileNames($key)] {
	set x  [scan $val  "$EB(dir)/%s" val1]
	.eb.mb.ex.m add command -label $val1 -command [list viewSource $val]
	 }

if {[string length [set x [lindex $fileNames($key) 0]]] > 0} {
	viewSource $x
	} else {
	 .eb.f.t insert end "Sorry. There is no example for this at present\n"}

	
}

proc applySource { file } {
# source Tcl commands in file
if { [winfo exists .results] } {
	raise .results
   } else {
	toplevel .results
	wm title .results "Results"
	set r .results
	frame $r.dum
	text $r.dum.t -setgrid true -width 80 -height 25 \
		-yscrollcommand {.results.dum.s set}
	scrollbar $r.dum.s -command {.results.dum.t yview} -orient vertical
	pack $r.dum.s -side right -fill y
	pack $r.dum.t -side left -fill both -expand true
	pack $r.dum
	button $r.dis -text Dismiss -command cleanUp
	$r.dum.t delete 1.0 end
	pack $r.dis
   }
wm title .results "Output from sourcing $file"
#
# open temp file
#
set tout [open temp.out w]    ;# all the tutorial examples write on tout
set temp [open temp.tcl w]
puts $temp [.eb.f.t get 1.0 end]
close $temp
catch {source temp.tcl} msg
flush $tout                  ;# make sure that stuff is written
set tin [open temp.out r]
	;# don't delete earlier text
while { [gets $tin line ] > -1 } {
	.results.dum.t insert end " $line \n"
     }



}

proc viewSource { f } {
   global filesVisited EB
   set EB(curFile) $f
   lappend filesVisited $f

   # change window title to show the current file
   set wt [wm title .eb]
   if { [string first : $wt] != -1 } {
	set idx [string first : $wt]
	set base [string range $wt 0 $idx]
	set wtn [concat $base $f]
	 } else {
		  set wtn [concat ${wt}: $f]
	 }
    wm title .eb $wtn 
    .eb.f.t config -state normal
    .eb.f.t delete 1.0 end
    if [catch {open $f} in] {
	.eb.f.t insert end $in
     } else {
	.eb.f.t insert end [read $in]
	close $in
     }
    .eb.f.t config -state normal
    .eb.buttons.apply config -command [list applySource $f]
}

proc cleanUp { } {
	 # remove temp.tcl and destroy .results
	 catch {exec /bin/rm temp.tcl} msg
	 destroy .results
}

proc saveNotes { w f } {
	 ;# saves the contents of the text widget w
	 ;# in the file fn with extension .nts (e.g, for_ex1.nts)
    	 set fh [open $f w 0600]
	 puts $fh [$w get 1.0 end]
	 close $fh
	 puts stdout "Notes file saved ...\n"
}


proc createNotes { f } {

if [winfo exists .notes ] {
  .notes.f.t delete 1.0 end
  raise .notes
  if {[file exists $f]} {
  	set fid [open $f r]
  	while {![eof $fid]} {		
		.notes.f.t insert 1.0  \
		   "This is the notes file for [file rootname $f].tcl \n"
		.notes.f.t insert end [read $fid 1000]
	}
	close $fid
  } else {
	.notes.f.t insert 1.0  \
		   "This is the notes file for [file rootname $f].tcl \n"
	}
.notes.f.t mark set insert end

  } else {
	toplevel .notes
	wm title .notes "Notes"
	frame    .notes.f
    	set nf .notes.f
	text $nf.t -setgrid true -width 60 -height 15 \
				-yscrollcommand "$nf.s set"
    	scrollbar $nf.s -command "$nf.t yview" -orient vertical
	pack $nf.s -side right -fill y
	pack $nf.t -side left -fill both -expand true
	pack $nf
              ;# supply the first line of text indicating filename
	$nf.t insert end "This is the notes file for [file rootname $f].tcl \n"
	set nb [frame .notes.bs]
	button $nb.quit -text Dismiss -command {destroy .notes}
	button $nb.save -text Save    -command "saveNotes .notes.f.t $f"
        button $nb.print -text Print  -command {exec pr $f}
	pack $nb.quit $nb.save $nb.print  -side right
	pack $nb -fill x
	}
}


proc viewNotes { } {
    global EB
    set f $EB(curFile)
    set fr [file rootname $f]
    set fn ${fr}.nts
    createNotes $fn

}
proc InvokeEb {key} {
# Keywords: foreach proc menubutton
# example program browser eb.tcl
#
global EB Hyper CONTENTS
set EB(dir)  Examples
set filesVisited {}           ;# keep track of files

 if [winfo exists .eb ] {
  .eb.fr.txt delete 1.0 end
  raise .eb
  } else {
	toplevel .eb
	wm minsize . 35 10
	wm title .eb "Example Browser V 0"
        frame .eb.mb
	pack .eb.mb -fill x
        menubutton .eb.mb.ex -text "See Also" -menu .eb.mb.ex.m
	pack .eb.mb.ex -side left
        set m [menu .eb.mb.ex.m] ;# create menu widget

	# text widget to display the source file
	frame .eb.f
	text .eb.f.t -setgrid true -width 75 -height 25 \
		  -yscrollcommand {.eb.f.s set}
	scrollbar .eb.f.s -command {.eb.f.t yview} -orient vertical
	pack .eb.f.s -side right -fill y
	pack .eb.f.t -side left -fill both -expand true
	pack .eb.f -side top -fill both -expand true
	label .eb.info -text "Help Line here"
	pack .eb.info
	frame .eb.buttons -relief groove -bg yellow
	button .eb.buttons.quit -text Dismiss -command {destroy .eb }
	button .eb.buttons.apply -text Apply 
	button .eb.buttons.notes -text Notes -command viewNotes
	pack .eb.buttons.quit .eb.buttons.notes  -side right
	pack .eb.buttons.apply -side left
	pack .eb.buttons -fill x -expand true -padx 3 -pady 3 -ipadx 3 -ipady 3
	}
getFiles $key

}