#!./wish

####!/usr/bin/wish

#  Users need to set correct path for "wish" (at least in UNIX)
#  Also, this file (nime.tk) must have executable permission


#                    Nifty Macro expander NIME 
#     source last modified: 18 December 2000  - WM Fawley, LBNL


  set frameBorder 8
  set itemBorder  3
  set cheight  20

  wm title . "NIME  ---  NIfty Macro Expander --- Version 1.2"
  wm geometry . -10+5


  frame .f

  button .f.hBtn -borderwidth $itemBorder -text "Help!" \
	    -background salmon  -foreground blue -command {help_proc}


  label .f.ilab -foreground blue -text "<< Filename:" 
  entry .f.infile  -width 24 -relief sunken -bd 2 -background moccasin  \
                    -textvariable ifile

  button .f.rBtn -borderwidth $itemBorder  -text "Read Input" \
	  -background yellow -command {read_proc}

  button .f.qBtn -borderwidth $itemBorder -text "Quit" \
	     -foreground white  -background red1  -command {exit}
  
  pack  .f.hBtn  .f.rBtn .f.ilab .f.infile .f.qBtn -side left -padx 2m -pady 1m


  frame .g

  button .g.sBtn  -borderwidth $itemBorder -text "Save Changes" \
	  -background thistle -command {save_proc}

  label .g.ilab -foreground Blue -text ">> Filename:" 
  entry .g.sfile  -width 24 -relief sunken -bd 2 -background moccasin \
                    -textvariable sfile

  button .g.pBtn -borderwidth $itemBorder -text "Expand Macros" \
	  -background lightgreen -command {go_proc}

  pack .g.pBtn .g.sBtn  .g.ilab .g.sfile  -side left -padx 1m -pady 1m


  text .t  -height 32 -relief raised -bd 2  -background honeydew2  \
           -yscrollcommand ".scroll set"

  scrollbar .scroll -background gold  -command ".t yview"
  pack .scroll -side right -fill y

  pack .f .g  .t -side top -anchor w

  set ifile test.nime

  set sfile std.out

  set outfile test.out

  set tmpfile nime.tmp


### variable definitions:
#   ndef :: integer :: number of macro definitions
#   nldef :: integer <= # lines of text contained in array defray

#   defname :: list of length ndef <= names of macro definitions
#   defray :: array of lists <= contains nldef lines of text
#   defbeg :: list of length ndef <= start index in defray of macro defs
#   defend :: list of length ndef <= end index in defray of macro defs 

#   percent_defs :: array  <= contains ndef lists, each of form
#                    (%varname1, DEFAULT value, %varname2, DEFAULT value, ...)


  proc help_proc {} {


     set hmsg [concat \
        "The Read button reads a text file into the edit window." \
        "The Expand Macros button expands all text (including modifications) " \
        "within the edit window into a new window, from which the " \
        "expanded output can be saved into a new text file." \
        "The edit window accepts a subset of standard  EMAC's key bindings, " \
        "mouse clicks, and arrow key movements from the keyboard."  \
        "Within the input text, the following characters must not be used: " \
        "brackets {} , single double quotes \", and solitary backslashes \\ ." \
        "Exclamation points (!) are used to begin comments and may appear " \
        "anywhere, including within macro definitions; upon expansion, " \
        "all text between the ! and the end-of-line is eliminated. " \
        "Note: if possible, percent symbols (%) should be used" \
        "only directly preceeding variable names and must themselves" \
        "be preceeded by spaces within macro definition bodies. " \
        "The default value, if any, for each variable in a macro must be "  \
        "contained within parentheses and immediately follow the " \
        "first use of the variable name in the macro definition." \
        "Neither macro names, variable names, nor variable default values" \
        "may contain spaces (underscores are OK). " \
        "All blank lines (save those in macro definitions) are eliminated."]



      if { [winfo exist .m] > 0 } {
         destroy .m
      }

     toplevel .m
     
     wm  title .m  "NIME Notes"
     wm geometry .m +5+5

     button .m.cBtn -borderwidth 3  -text "Close" \
     	  -background orange -command {destroy .m}
     
     message .m.msg -width 12c -justify left -bd 2 \
        -background lightyellow  -text $hmsg
     
     pack .m.cBtn .m.msg -side top -pady 4

  }


#******  SET_PERCENT_DEFAULT  *****************  SET_PERCENT_DEFAULT ******

  proc set_percent_default line {

    set p_ind [ string first \% $line ]

       if {$p_ind < 0} {
          return [concat %BOGUS "UNDEFINED"]
       } 

#..check to see if there is a default value enclosed in parentheses

       set p_item $line
       set par_s [ string first \( $p_item ]
       if {$par_s > -1} {
          set pb [expr $par_s - 1]
          set par_name [string range $p_item 0 $pb]
          set par_e [ string last \) $p_item ]
	  if {$par_e < $par_s } {
             puts [ concat "need closing parentheses in: " $p_item ]
             set def_out "UNDEFINED"
          } else {
            set pb [incr par_s]
            set pe [expr $par_e - 1]
            set def_out [ string range $p_item $pb $pe ]
  ###          puts [concat "pb pe p_out: " $pb $pe $p_out ]
          }
      } else {
          set def_out "UNDEFINED"
          set par_name $p_item
      }

     return [concat $par_name $def_out]
  }
#**** end PROC SET_PERCENT_DEFAULT

  proc update_percent_defs {perdef line}  {

     set temp $line

     set i_per [lsearch $temp \%*]
     while {$i_per > -1} {
        set per_var [lindex $temp $i_per] 
        set ieq [ string first "=" $per_var ]
	if {$ieq > 0} {
           set ii [ expr $ieq - 1 ]
	   set pname [string range $per_var 0 $ii]
	   set ind_per [lsearch $perdef $pname]

	   if {$ind_per > -1} {
	     set newval [string range $per_var [incr ieq] end ]
	     set ii [incr ind_per]
	     set perdef [lreplace $perdef $ii $ii $newval]
             ###  puts [concat "new value is:" $perdef]
	   } else {
             puts [concat "  could not expand variable" $per_var "in:" $line]
           }
	}
        set temp [lreplace $temp $i_per $i_per "*****" ]
        set i_per [lsearch $temp \%*]
     }

     return $perdef
 }
 
#  END PROC UPDATE_PERCENT_DEFS       



  proc expand_percent {perdef line} {

   ##   puts $perdef

     set temp $line

     set i_per [lsearch $temp \%*]
     while {$i_per > -1} {
        set per_var [lindex $temp $i_per] 
        set def_pos [lsearch $perdef $per_var]
        if {$def_pos < 0} {
           puts [concat "   could not find variable" $per_var "in:" $line]
           set rep_val ERROR
        } else { 
          set rep_val [lindex $perdef [incr def_pos] ]
        }
        set temp [lreplace $temp $i_per $i_per $rep_val]
        set i_per [lsearch $temp \%*]
     }

     return $temp

  }       
#**** end PROC EXPAND_PERCENT

  proc write_proc {} {

     global outfile

     set f [open $outfile w]   

     puts $f [.e.texp get 1.0 end]  

     close $f

  }

#*****  TAG_REGION_PROC  **************************  TAG_REGION_PROC  ********

  proc tag_region_proc {w tagname begtext endtext} {

     scan [$w index end] %d numlines

     set indef 0

     for {set i 1} {$i < $numlines} {incr i} {

	if {$indef > 0} {
	   set mend [ lsearch [ $w get $i.0 $i.end ] $endtext ]
	   if {$mend > -1} {
	      $w mark set final $i.end
	      set indef 0

	      $w tag add $tagname first final
	   }
	} else {
	   set mbeg [ lsearch [ $w get $i.0 $i.end ] $begtext ]

	    if {$mbeg > -1} {
	       $w mark set first $i.0
	       set indef 1
	    }
	} 
     }


 }


  proc tag_subline_proc  {w tagname pat} {

     scan [$w index end] %d numlines

     for {set i 1} {$i < $numlines} {incr i} {

        set pbeg [string first $pat  [ $w get $i.0 $i.end ] ]

	if {$pbeg > -1} {
	   $w mark set first $i.$pbeg
           $w mark set final $i.end
           $w tag add $tagname first final
        }
     }
  }

#*****  READ_/SAVE_PROC  *************************  READ_/SAVE_PROC  *********#

  proc read_proc {} {

     global sfile ifile outfile

     set f [open $ifile]

    .t delete 1.0 end

     while {[gets $f line] >= 0} {
	   .t insert end $line
	   .t insert end \n
     }

     close $f

     set sfile $ifile

     append sfile ".new"

     set outfile $ifile

     append outfile ".out"

     tag_subline_proc .t slashtag \\
     .t tag configure slashtag -background lightyellow

     tag_region_proc .t mactag \def \enddef
     .t  tag configure mactag -foreground red -background white

     tag_subline_proc .t extag !
     .t  tag configure extag -foreground blue -background white


  }

  proc save_proc {} {

     global sfile

     set f [open $sfile w]   

     puts $f [.t get 1.0 end]  

     close $f

  }

#*****  GO_PROC  ***********************************  GO_PROC  ***********#

  proc go_proc {} {

  global ifile tmpfile outfile

  set f [open $tmpfile w]   

  puts $f [.t get 1.0 end]  

  close $f

  set f [open $tmpfile]

  puts ""

  puts  [concat "    scanning macro definitions in file:" $ifile]

  set m 0
  set ndef 0
  set nldef 0
  set indef 0

  while {[gets $f line] >= 0} {

     incr m

      if { [string first \{  $line] > -1 } {
	 puts [concat "--> ERROR: left bracket appears on line" $m ]
         puts [concat ".......offending text: " $line ]
         set line "!"
     } 

     ### puts $line

     set tdef [ lsearch $line \def ]

     if {$indef > 0} {
                        #..we are in the middle of a definition
        set fdef  [ lsearch $line \enddef ]
        if {$fdef > -1} {
          set indef 0
          lappend defend $nldef
          set percent_defs($curdef_name) $perval
          if {$fdef > 0} {
             puts [concat "....ERROR on line" $m ":" $line ]
             puts "....        \\enddef must be first item! "
          }
        } else {
          set ex [string first ! $line]
          if {$ex > 0 } {
             set ll [expr $ex - 1]
             set outl [string range $line 0 $ll]
          } elseif {$ex == -1} {
            set outl $line
	  }
          if {$ex != 0} {
            incr nldef
            set temp $outl
            set perl [ lsearch $temp %* ]

	    while {$perl != -1} {
               set p_str [lindex $temp $perl]
#..check to see if percent variable already defined
               if {$n_percent > 0} {
                  set dfname [array names percent_defs]
                  set per_ind [lsearch $dfname $p_str]
               } else {
                  set per_ind -1
               }
               if {$per_ind == -1} {
                  incr n_percent

#..get_percent_default returns a two element list: { %varname , DEFAULT value }
                  set p_ret [ set_percent_default $p_str ]
             ##     puts [concat "set_percent_default returned: " $p_ret ]
                  set perval [concat $perval $p_ret]
                  set outl [lreplace $outl $perl $perl [lindex $p_ret 0] ]
                  set temp [lreplace $temp $perl $perl "REP" ]
               }

              set perl [ lsearch $temp %* ]
            }
            set defray($nldef) $outl
            ### puts [concat $defname "perval = " $perval]
          }
        }
     } elseif {$tdef > -1} {
	if {$tdef > -1} {
           incr ndef
           set ii [expr $tdef + 1]
	   set curdef_name  [lindex $line $ii] 
	   lappend defname $curdef_name
	   lappend defbeg [expr $nldef + 1]
	   incr indef
	   set n_percent 0
	   set perval {}
           if {$tdef > 0} {
              puts [concat "....ERROR in line" $m ":" $line ]
              puts "....    \\def must be first item!" 
           }
        }
    }

 #|# next brace closes while {$f} statement
  }

  close $f

  ###   puts [concat "   the following macros are defined:" $defname ]


#..set up text window to contain expanded output:

  if { [winfo exist .e] > 0} {
     destroy .e
  }

  toplevel .e -class Dialog
  wm geometry .e +5-10

  set tw "Expanded macros from input file: "

  append tw $ifile

  wm title .e $tw

  frame .e.f

  button .e.f.wBtn -borderwidth 3 -text "Save Output File" \
	  -background lightgreen  -command {write_proc}

  label .e.f.olab -text ">> Filename:" 
  entry .e.f.outfile  -width 24 -relief sunken -bd 2 -background lightcyan \
                    -textvariable outfile

  button .e.f.dBtn -borderwidth 3 -text "Close" \
	  -background red  -foreground white -command "destroy .e"

  pack .e.f.wBtn .e.f.olab .e.f.outfile .e.f.dBtn   -side left -padx 2m -pady 1m

  text .e.texp  -height 30 -relief raised -bd 2  -background honeydew2  \
              -yscrollcommand ".e.scroll set"

  scrollbar .e.scroll -background gold -command ".e.texp yview"
  pack .e.scroll -side right -fill y

  pack .e.f .e.texp -side top


#..now reopen file and parse through once again to expand macros:

  set f [open $tmpfile]

  set m 0
  set indef 0

  puts [concat "   now expanding macro definitions in input file:" $ifile ]

  while {[gets $f line] >= 0} {

#....select case construct:
#.... if \def, parse until \enddef found, not outputting lines
#.... if exclamation point (!) found, ignore it and all following text
#.... if backslash (\) found, find relevant macro def, then check 
#....     if  "%variable=VALUE" included on line, then expand macro

     incr m

     set no_write 0

     if { [string first \{  $line] > -1 } {
       set line [concat "line " $m " ERROR => left bracket"]
     } else {
       set $line [string trim $line]
     }

     set tdef [ lsearch $line \def ]

     if {[string length $line] < 1} {
        set outl " "
     } elseif {$indef > 0} {
        set fdef  [ lsearch $line \enddef ]
        if {$fdef > -1} {
           set indef 0
        }
    } elseif  {$tdef > -1} {
      incr indef
    } else {
      set ex [string first ! $line]
      if {$ex > 0 } {
          set ll [expr $ex - 1]
          set outl [string range $line 0 $ll]
          set ll [string trim $outl]
          if { [string length $ll] < 1} {
             set no_write 1
          }
      } elseif {$ex == -1} {
          set outl $line
      } else {
        set outl " "
        set no_write 1
      }

      if { $ndef == 0} {
         set edef -1
      } else {       
         set edef [string first \\ $outl]
      }

      if {$edef == -1}  {
	  if {$no_write < 1} {
            .e.texp insert end $outl
            .e.texp insert end \n
          }
      } else {
        incr edef
        set ww [string range $outl $edef end]
        set vv [lindex $ww 0]

        set idef [lsearch $defname $vv]

	if {$idef == -1} {
           puts [concat "--> ERROR: line #"  $m ]
           puts [concat ".......could not find macro definition: " $vv ]
	} else {
          set ii [lindex $defbeg $idef]
          set iend [lindex $defend $idef]
          set dname [lindex $defname $idef]
          set perdef $percent_defs($dname)

          set perdef [update_percent_defs $perdef $ww]

	  while {$ii <= $iend} {
            set outl $defray($ii)
	    if { [ lsearch $outl \%* ] > -1} {
               set outl [expand_percent $perdef $outl]
            }
            .e.texp insert end $outl
            .e.texp insert end \n
            incr ii
          }
	}
      }  
  #..end of if $edef == -1

    }
  #..end of check on indef

  }
#..end of while on gets $f line

  close $f

  puts "  "

 }