hyper.tcl

很不错的tcl编程实例

#!htcl

# 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, RMCS Shrivenham, Cranfield University and AGOCG
# 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 


#
#  hyper.tcl
#
#    reads in hyper.tcl
#    process text stripping of all tex commands
#    binds appropriate text
#    possibly create dynamic tcl examples
#

proc getSections { w  } {
  global env
  set fh [open $env(PWD)/reftcl.tex]
	 while {![eof $fh]} {
      		set line [gets $fh]
		  if { [regexp {^\\section.*} $line]  == 1 } {
           regsub -all {\\section|\{|\}} $line "" sectionName
            $w insert end "\t $sectionName \n" {secn}
        }
	 }
  close $fh
}

#
# getSectionContents -- 
#
proc getSectionContents { w secname } {
  global env		
  set fh [open $env(PWD)/reftcl.tex] ;#open the latex file to read
	 while {![eof $fh]} {		;#while end of file is not reached
    set line [gets $fh]		;#read next line and assign it to variable line
    set pat [join [list "\\section{" $secname "}"] ""]  ;# set section head pattern 
	 if { [regexp $pat $line] == 1 } { ;#check if line has pattern
          					;# we got the section
         set pat2 "\\begin{enum}"
         set cline [gets $fh]
         while { [regexp $pat2 $cline match] != 1 && ![eof $fh] } {
           set cline [gets $fh]
           if { [regexp $pat2 $cline match] == 1 } {
   		while { [regexp {^\\end\{enum} $cline] != 1 } {
               		set cline [gets $fh]
             }
	        }
		 }
	}
   }   
}

# get section Lines
#  starting from \section to another \section
#

proc ShowSyntax { w secn } {
    global env
    set fh [open $env(PWD)/reftcl.tex]
    set pat [join [list "\\section{" $secn "}"] ""]
    while {![eof $fh]} {
    	set line [gets $fh] 
	if { [regexp $pat $line] == 1 } {
    			;# we got the section
      		set cline [gets $fh]
      		set pat2 {^\\section}
      		set n 1
		while { [regexp $pat2 $cline match] != 1 && ![eof $fh] } {
            		set cline [gets $fh]
            		set nline [removeLatex $cline]
	   		if {[regexp {\\(.*)} $nline ma subma] == 1} {
				continue
	 		} else {
				$w insert end "$nline \n" 
			       }
			incr n
                }
          
      return
     } 
    
   }  
	 
  close $fh
}

#  removeLatex  
#
proc removeLatex { line } {
	 regsub -all {\\kwd|\\Xi} $line "" temp
    regsub -all {\\quad} $temp "    " temp
    regsub -all {\|} $temp "" newLine
    return $newLine
}

#
#  to chnage font to all entries in the main text widget
#

proc tagContents { w } {
	 
	 scan [$w index end] %d nLines  ;# get number of lines
	 for {set i 1} {$i <= $nLines} {incr i} {
		  .t tag add secname $i.0 "$i.0 lineend"
	 }
	 set snfont "-adobe-helvetica-bold-r-normal--25-180-100-100-p-138-iso8859-1"
	 $w tag configure secname -font $snfont
}


proc ManGet {} {
global hyper pid

if { $pid == 0 } {
	PopM $Hyper(browser) $Hyper(html) pid
	
	} else {
		ClZ
		PopM $Hyper(browser) $Hyper(html) pid
		
		}
}

#
proc CreateSynWin {} {

global Hyper CONTENTS pid

# uncomment and set the two variables  Hyper(browser) & Hyper(html) to
# access Tcl/Tk html documents for your site

#Hyper(browser) should point to mosaic or netscape or other web browser
#Hyper(html) points to  ~tcl/html/tcltk-man-html/TclCmd/Tcl.n.html

#uncomment and set the next two lines


#set Hyper(browser) /usr/local/bin/mosaic
#set Hyper(html) ~tcl/html/tcltk-man-html/TclCmd/Tcl.n.html

set pid 0
source eb.tcl
if [winfo exists .syntax ] {
  .syntax.fr.txt delete 1.0 end
  raise .syntax
  } else {
	toplevel .syntax
	wm title .syntax "Quick Reference"
    
        frame .syntax.mbar 
        pack .syntax.mbar -fill x
	menubutton .syntax.mbar.ex -text {Examples for...} \
		-menu .syntax.mbar.ex.m
	pack .syntax.mbar.ex -side left

        button .syntax.mbar.man -text "Manual Pages" 
		
	if {[info exists Hyper(browser)] && [info exists Hyper(html)]} {
		.syntax.mbar.man configure -command \
		{ManGet}
		}  else {
		.syntax.mbar.man configure -state disabled
	   }
	pack .syntax.mbar.man  -side right
        set m [menu .syntax.mbar.ex.m]
	set f [frame .syntax.fr -width 10c -height 5c] ;#main window
	pack .syntax.fr
        
	#put a text widget with scroll bars
	set st [text .syntax.fr.txt -width 80 -height 20 \
		-wrap word -yscrollcommand "$f.ys set" \
		-font $Hyper(secfont) ]
	scrollbar  $f.ys -command "$st yview" 

	pack $st $f.ys -in $f -side left -fill y -expand 1
	button .syntax.b -text "Dismiss" -command {destroy .syntax}
	pack .syntax.b -side right
	}

set cur $Hyper(cstr)
.syntax.mbar.ex.m delete 1 last

 foreach i [lsort [set CONTENTS($cur) ]] {
         	.syntax.mbar.ex.m add command -label $i -command "InvokeEb $i"
       }
	

}


frame .base -bg red ;#create a frame
wm title . "Basics of Tcl V 0"
pack .base -padx 5 -pady 5 -ipadx 2 -ipady 2 ;#pack it
text .t -yscrollcommand ".sc set" 	;#text widget to show sectionheaders
scrollbar .sc -command ".t yview"	;#vertical scrollbar
pack .sc -in .base -side right -fill y  ;#make it visible
pack .t -in .base -side left	;#make text widget visible


frame .buttons -bg grey		;#create container for some buttons
pack .buttons -padx 4 -pady 4 -ipadx 4 -ipady 4 -fill x	;#make it visible

button .buttons.quit -text Quit -command { exit } ;#exit button

pack .buttons.quit -in .buttons -side right ;#make buttons visible
					;#pack them right to left


#
# some fonts
#
set Hyper(deffonts) "-*-courier-bold-r-*-*-*-160-*-*-*-*-*-*"
set Hyper(secfont) "-*-helvetica-bold-r-*-*-*-140-*-*-*-*-*-*"
source contents

#
# getSections -- picks section names 
#

getSections .t




tagContents .t

#
# tag bindings
#
set lastIndex ""
.t tag bind secn <Enter> {
	 set lastIndex [.t index {@%x,%y linestart}]
	 .t tag add hot "$lastIndex + 2 chars" "$lastIndex lineend"
}
.t tag bind secn <Leave> {
	 .t tag remove hot 1.0 end
}
.t tag bind secn <Motion> {
	 set newIndex [.t index {@%x,%y linestart}]
	 if {[string compare $newIndex $lastIndex] != 0} {
		  .t tag remove hot 1.0 end
		  set lastIndex $newIndex
		  .t tag add hot "$lastIndex + 2 chars" "$lastIndex lineend"
	 }
}

.t tag configure hot -relief raised -background yellow
.t tag configure syntax -relief ridge -background green -font $Hyper(deffonts)

.t tag bind secn <Button-1> {
     global Hyper
     set pos [.t index current]
     set lineText [.t get "$pos linestart" "$pos lineend"]
     set trmSecn [string trim $lineText]
     set Hyper(curSecn) $trmSecn
     regsub -all { } $trmSecn _  Hyper(cstr)
     CreateSynWin 
     ShowSyntax .syntax.fr.txt $trmSecn

}