#!/bin/sh 
# the next line restarts using wish \
exec wish "$0" -- "$@"
##my_tk_colorize.tcl
#09/07/2007


###############################################################################
#
#                             Class TextColorize
#
###############################################################################

namespace eval TextColorize {    
   variable _props  
   # _props(w,start)  indice début traitement 
   # _props(w,stop)   indice fin traitement
   # _props(w,time)   heure du dernier traitement 
   # _props(w,tags)   liste couleurs des tags   
   # _props(w,syntax) syntaxe

   #
   variable _ExpAll
   variable _ExpReg  

   # words(interpreter,color,offset_start,offset_end,priority)
   # words est une array initialisée sur une liste de mots clées

   # exp(interpreter,color,offset_start,offset_end,priority)
   # exp est une array initialisée sur une liste d'expressions réguliéres

   #---------------------------------------------------------------------------
   #                               sh syntax
   #---------------------------------------------------------------------------

   set words(sh,LightSteelBlue,0,0,0) [ list basename cat cd chmod chown cmp \
                col cut date dd df dirname echo find ln ls mkdir   \
                mount mv nice ps pwd read rename rm rmdir shift sleep sort su\
                tac touch tr umount ]
  
   set words(sh,cyan,0,0,0) [ list break case continue do done esac else eval exec exit\
                fi for function if in kill return then trap until wait while ] 

   # "texte entre guillemet"
   set exp(sh,LightSalmon,0,0,1)  [ list {"[\w\s\d$:\-\./\\#%'\[\]*_\(\)]*"} ] 

   # $variable
   set exp(sh,LightGoldenrod,0,0,0) [ list {\$[\w\d]*} ] 

   # variable=
   set exp(sh,LightGoldenrod,0,-1,0) [ list {[\w\d]*=} ] 

   # fonction ()  
   set exp(sh,LightSkyBlue,0,0,-1)  [ list {[\w\d]*\s*\(\s*\)} ]
   set exp(sh,White,0,0,1) [ list {\(\s*\)} ]

   # Commentaire
   #set exp(sh,Chocolate1,0,0,1) [ list {[^\\]\#.*$|^\#.*$} ] 
   set exp(sh,Chocolate1,0,0,1) [ list {\#.*$} ]   

   #---------------------------------------------------------------------------
   #                               tcl syntax
   #---------------------------------------------------------------------------

   set words(tcl,cyan,0,0,0) [ list body break class constructor continue else \
                               elseif eval foreach if method proc  return while ] 

   set words(tcl,PaleGreen1,0,0,0) [ list common global inherit public variable ]  

   # "texte entre guillemet"
   set exp(tcl,LightSalmon,0,0,1) $exp(sh,LightSalmon,0,0,1)
   #set exp(tcl,LightSalmon,0,0,1) [ list {"[\w\s\d$:\-\./\\#%'\[\]*]*"} ] 
 
   # Commentaire
   set exp(tcl,chocolate1,0,0,1)  $exp(sh,Chocolate1,0,0,1)

   # proc Name::fonction   
   set exp(tcl,LightSkyBlue,0,0,0)  [ list {proc\s+[\w:]+ }        \
                                           {body\s+[\w:]+ }        \
                                           {method\s+[\w:]+ }      \
                                           {constructor\s+[\w:]+ } ]  

   #---------------------------------------------------------------------------
   #                               povray syntax
   #---------------------------------------------------------------------------
   
   # commentaire /* ... */
   set _ExpAll(pov,chocolate) [ list {/\*.*?\*/} ]
   set exp(pov,chocolate1,0,0,1) [ list {//.*$} ]

   # Words list
   set words(pov,red,0,0,0) [ list difference union ] 

    set words(pov,LightGoldenrod,0,0,0) [ list background blob box camera cone cylinder object \
                                              plane sphere torus ] 

   # <>*=
   set exp(pov,green,0,0,0) [ list {<} {>} {\*} {=}  ] 

   # #prepeocesseur
   set exp(pov,palegreen,0,0,0) [ list {#[\w]+}  ] 

   # Nombre
   set exp(pov,yellow3,0,0,0) [ list {\d}  ] 


   #---------------------------------------------------------------------------

   # Construit l'array _ExpReg(...) à partir de words(...) et exp(...)

   foreach { key values} [ array get words ] {
      set _ExpReg($key) {}
      foreach val $values {
	  lappend _ExpReg($key) "\\s$val\\s|^$val\$|\\s$val\$|^$val\\s" 
      }
   }

   foreach { key values } [ array get exp ] {
      set _ExpReg($key) $values
   }  
} 

#----------------------------------------------------------------

proc TextColorize::AddTag { w a } {
   variable _props
   variable _ExpReg
   variable _ExpAll

   foreach  key [ array names _Exp$a ] {
      set color [ lindex [ split $key "," ] 1 ]        
      if { [ array get _props($w,tags$a) $color ] == {} } {
          lappend _props($w,tags$a) $color
          $w tag configure $color -foreground $color
       }       
   } 
}

proc TextColorize::Destroy { w } {
    variable _props

    bind $w <KeyRelease>    ""
    bind $w <ButtonRelease> ""  
    array unset _props $w,* 
}

#----------------------------------------------------------------

# w argument: text widget

proc TextColorize::New { w { syntax sh } } {   
   variable _props
   variable _ExpReg    
   variable _ExpAll

   # Default syntax sh

   if { [ array names _ExpReg "$syntax,*" ] == "" } { 
      set _props($w,syntax) "sh,*" 
   } else { 
      set _props($w,syntax) "$syntax,*"
   }   
   
   bind $w <KeyRelease>    "+TextColorize::CallBack $w"
   bind $w <ButtonRelease> "+TextColorize::CallBack $w"

   TextColorize::AddTag $w "Reg"
   TextColorize::AddTag $w "All"  

   set _props($w,start) 1.0
   set _props($w,stop)  [ $w index "end" ]

   TextColorize::All    $w
   TextColorize::Region $w   
}

#-----------------------------------------------------------------

proc TextColorize::CallBack { w } {
   variable _props
   #puts "TextColorize::CallBack $w"

   if { [ $w index "insert linestart" ] < $_props($w,start) } {
      set _props($w,start) [ $w index "insert linestart" ] 
   }
   if { [ $w index "insert lineend" ] > $_props($w,stop) } {
      set _props($w,stop) [ $w index "insert lineend" ] 
   }
   
   # une tempo de 1 seconde 
   if { [ expr [clock seconds] - $_props($w,time)] < 1 } { return }


   after idle TextColorize::All    $w
   after idle TextColorize::Region $w   
}  

#-----------------------------------------------------------------

proc TextColorize::All { w } {
   variable _props
   variable _ExpAll

   #puts "TextColorize::All $w" 

   if { [array names _props "*,tagsAll"] == "" } { return }
    
   foreach t $_props($w,tagsAll) { $w tag remove $t "1.0" "end" }  

   foreach { key values }  [ array get _ExpAll $_props($w,syntax) ] {
      puts $key
      set color [ lindex [ split $key "," ] 1 ]
      $w tag raise $color 

      foreach val $values {   
 
         set lines [ $w get 1.0 end ]
         set start "1.0"
  
         while { $lines != "" } {
            if { [ regexp -indices $val $lines i ] } {    
               set i0 [lindex $i 0]
               set i1 [lindex $i 1] 

               set lines [ string range $lines $i1 end ]
      
               set i0 [ $w index "$start + $i0 chars" ]
               set i1 [ $w index "$start + $i1 chars" ]  

               set start $i1
               $w tag add $color $i0 "$i1+1 chars"
            } else { 
               return 
            }
         }
      } 
  }      
}

#------------------------------------------------------------------

proc TextColorize::Region { w } {
   variable _ExpReg
   variable _props
   
   #puts "TextColorize::Page $w"  

   set START $_props($w,start)
   set STOP  $_props($w,stop)

   #puts "$START $STOP"

   if { [array names _props "*,tagsReg"] == "" } { return } 
  
   foreach t $_props($w,tagsReg) { $w tag remove $t "$START" "$STOP" }  
  
   foreach { key values }  [ array get  _ExpReg $_props($w,syntax) ] {     

      set color     [ lindex [ split $key "," ] 1 ]
      set off_start [ lindex [ split $key "," ] 2 ] 
      set off_end   [ lindex [ split $key "," ] 3 ] 
      set priority  [ lindex [ split $key "," ] 4 ] 

      if { "$priority" == "-1" } { $w tag lower $color }
      if { "$priority" == "1"  } { $w tag raise $color }        

      foreach val $values {          
       
         set debut $START         
       
         while { "$debut" != "$STOP" } {
	    
	    set indice [ $w search -count n -regexp $val "$debut" "$STOP" ]   

            if { "$indice" != "" } {                

               ## Debug
               #puts "====================================================="
               #puts [ $w get "$debut" "$STOP" ]
               #puts "$indice $n"
               #puts $val
               ####

	       set _off_end [ expr $n + $off_end ]             
               $w tag add $color "$indice + $off_start char" "$indice + \
                                                              $_off_end char"  
	       set debut [ $w index "$indice +$n char" ]  
                        
            } else {
               set debut $STOP
            }            
	 }       
      }    
   } 
   set _props($w,start) [ $w index "end" ]
   set _props($w,stop)  1.0        
   set _props($w,time) [ clock seconds ]  
}



#------------------------------------------------------------------
#                                 MAIN
# For test only
#------------------------------------------------------------------

if { "$argv0" != [ info script ] } {
   return 0
}

catch { console show }

#set fd [ open "my_tk_colorize.tcl" ]
set fd [ open "balcony.pov" ]
set lines [ read $fd ]
close $fd

text .t -bg black -fg white -font "courier" -insertbackground magenta3
.t insert end $lines
TextColorize::New .t "pov"

pack .t

TextColorize::Destroy .t

TextColorize::New .t "pov"