#!/usr/bin/tclsh
#------------------------------>  Tcl - script  <-----------------------------#
#- Copyright (C) 199x by International Computer Science Institute            -#
#- This file is part of the GNU Sather package. It is free software; you may -#
#- redistribute  and/or modify it under the terms of the  GNU General Public -#
#- License (GPL)  as  published  by the  Free  Software  Foundation;  either -#
#- version 2 of the license, or (at your option) any later version.          -#
#- This  program  is distributed  in the  hope that it will  be  useful, but -#
#- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY -#
#- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        -#
#- The license text is also available from:  Free Software Foundation, Inc., -#
#- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     -#
#------------->  Please email comments to <bug-sather@gnu.org>  <-------------#

# Called by gen_html
# generates lined-*-.gen files
# This has to be one of the slowest ways to do things, but
# it works... and is ok for html
# This script converts a Sather source file into a prettified
# HTML version. No hypertext links are generated.  
# For use with the pointer files genrated by the browser,
# the sather source file is given tags on each line number...

# Problems:
# Highlighting between "pre" conditions and "is"
# value classes (like FLT)
# after the routine "class_name" in test classes
# There is a problem with 2 ends in a row? see CHAR...

# To do:
# Make line numbers sparser (only needed if indent level < 2)
#
# Provide HTML highlinghting of sather text. 
# This consists of marking each line with a line number label

# Indent level
set gIndentLevel 0

# Whether the preliminary -- before comments shoudl be stripped or not
set gStripDashes 0


source "$env(SATHER_HOME)/Browser/Web/common_funcs"

set programName "gen_html_sa_files"

proc run { } {
    puts "HTMLifying all sather files in this directory"
    set fileList [ makeFileList ]
    processFiles ${fileList}
}

# Running consists of converting all sather files in the current directory
# into lined-<sather-file-name>.gen.html which has the html version of the file
proc processFiles { allFiles } {
    global gIndentLevel
    foreach fname ${allFiles} {
	set gIndentLevel 0
	debugPuts "gen_html_sa_files: Converting ${fname} to prettified html"
	set infile [open ${fname} r]
	set fileNameOnly [getFileName ${fname}]
	set outfilename "lined-${fileNameOnly}.gen.html"
	puts "Generating ${fileNameOnly}"
	set outfile [open $outfilename w]
	set txt [read $infile]
	close $infile
	markupSather $txt $outfile
	close $outfile
    }
}

proc makeFileList { } {
    # Return a list of files from the module
    global gClassDef
    
    set fileList ""
    set classes [array names gClassDef]
    puts "Making file list"
    foreach class ${classes} {
	set cdef $gClassDef(${class})
	set classFileName [lindex ${cdef} 0]
	if {[lsearch ${fileList} ${classFileName}] == -1} {
	    lappend fileList ${classFileName}
	    debugPuts "Adding file: ${classFileName}"
	}
    }
    return ${fileList}
}

# ######################## MAIN ROUTINE #################################
# Basic idea:
# Split up file into lines
# Split each line into a code and a comment part (to avoid hassles caused
# by getting confused by stuff in comments)
# Process code part -> htmlifyCode
# Process comment part -> htmlifyComment
# Glue the two together and add a tag for the line number
proc markupSather { txt outFile } {
    
    set txtl [ split $txt "\n" ]
    set txtlsize [ llength $txtl ] 
    # debugPuts "split text"
    puts $outFile  "Generated by gen_html_sa_files. Contact gomes@icsi.berkeley.edu"

    puts $outFile "<pre> <small>"
    set lineno 0
    # debugPuts "starting loop"
    while { $lineno < $txtlsize } {
	#	puts "Line: $lineno"
	set lineTag ""
	set thisline [ lindex $txtl $lineno ]
	# Find the location of the beginning of the comment (-1 if no comment
	# on this line)
	set comPt [string first "--"  ${thisline}]
	# Escape all > and < signs (problems with html otherwise)
	regsub -all ">" ${thisline} "\\&gt;" thisline
	regsub -all "<" ${thisline} "\\&lt;" thisline
	
	# debugPuts "Looking for comments"
	if {$comPt == -1 } {		
	    # IF there was no comment on this line, just deal with the code
	    set htmlCode [htmlifyCode ${thisline} ]
	    set htmlComment ""
	} else {
	    # Get the comment part of the line
	    set comPart [string range ${thisline} ${comPt} end]
	    # Determine the end of the code part and get it
	    if {$comPt == 0} {
		# Deal with the case where the comment begins the line
		# and there is no code i.e. comPt = 0 and [expr $comPt -1] = -1
		set codePart ""
	    } else {
		# Otherwise the code is the string upto the comment
		set codePart [string range ${thisline} 0 [expr $comPt - 1]]
	    }

	    # Prettify code and comment
	    set htmlCode [htmlifyCode ${codePart} ]
	    set htmlComment [htmlifyComment ${comPart}]
	}
	# Some futzing aroud to handle line numbers that start at 0 vs. 1
	set actualLine [expr $lineno + 1]
	set lineTag "<a Name=\"Line${actualLine}\"></a>"
	puts $outFile "${lineTag}${htmlCode}${htmlComment}" 
	incr lineno
    }
    puts $outFile "</pre></small>"
}

debugPuts "souring htmlifycode"
# Count number of occurences of "word" in the list of "wrds"    
proc numOccurs { wrds word } {
    set res 0
    foreach wrd ${wrds} {
	if {${wrd} == ${word}} {
	    incr res
	}
    }
    # puts "${word} ${res}"
    return $res
}

# First determine the indent level.
# If at the outer level, deal with htmlifying a class declaration
# At the next level, deal with routines, attributes and include clauses
# Deal with some words like "return" and "new" regardless of where they
# occur
proc htmlifyCode { codePart  } {
    set retVal ${codePart}
    global gIndentLevel


    # We actually use the *previous* indent level to determine
    # what to do with this line of code i.e. the level before 
    # encountering any of the if's, loop's etc. that occur in this line.
    set oldIndent ${gIndentLevel}
    # SPlit the sentence into words along space boundaries
    set wrds [split ${codePart} ]
    # Adjust the indent level, based on the keywords in this line
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "if"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "loop"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "parloop"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "is"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "typecase"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "protect"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "lock"]]
    set gIndentLevel [expr $gIndentLevel + [numOccurs ${wrds} "case"]]
    set gIndentLevel [expr $gIndentLevel - [numOccurs ${wrds} "end"]]
    set gIndentLevel [expr $gIndentLevel - [numOccurs ${wrds} "end;"]]

    # If at the topmost indent level, we have only classes
    if {${oldIndent} == 0} {
	# Class declarations
	regsub  {([ \t]*)(external class |value class |class |type )([A-Z$][A-Z_0-9]*)} ${retVal} \
  	   "<center><h3>\\3</h3></center>\n\\1<b><i>\\2</i></b><b>\\3</b>" \
	   retVal

    } elseif { ${oldIndent} == 1} {
	# At the next indent level, we have features: routines,attributes
	# and include clauses

	# Routine declarations
	# \\1 is the initial space, 
	# \\2 is the private keyword if it exists
	# \\3 is the routine name itself
	# \\4 is some delimiter (may not be necessary)
        regsub  {(^[ \t]*)(private |)([a-z][a-zA-Z_0-9!]*)(\(||;|:[^=]| pre| is|[ ]*$)} ${retVal} \
		"\\1<b><i>\\2</i></b><b>\\3</b>\\4" retVal

	# Attributes
	# \\1 is the initial space
	# \\2 is the attribute descriptor (private, shared etc.)
	# \\3 is the attribute name
	# followed by a colon (may not need this now that we know indent level)
	regsub  {(^[ \t]*)(readonly attr |attr |private attr |readonly shared |shared |private shared )([a-z][a-zA-Z_0-9]*):} ${retVal} \
		"\\1<b><i>\\2</i></b><b>\\3</b>:" retVal

	# Include clauses
	# Substitute all "include" classname in the current level
	# Could put this at the outermost level, but it is 
	# more efficient to do it here
	regsub  -all {(include )([A-Z][A-Z_0-9,\{\}]*)} ${retVal} \
		"<b><i>\\1</i></b><b>\\2</b>" retVal
    }
    
    # Stuff do do with * any * line
    # The following is nice, but generate a lot of bold text and is
    # probably not worth it
    # Creation expressions or plain class names or class declarations
    #    regsub -all {(:| :|#| )([A-Z$][A-Z_0-9,\{\}]*)} ${retVal} \
	    #	    "\\1<b>\\2</b>" retVal
    #    regsub -all { (is)} ${retVal} " <i>is</i>" retVal


    # Boldify :: calls and assign-declarations
    set retVal [bolden ${retVal} "::"]
    # Boldify "returns"
    set retVal [bolden ${retVal} "return"]
    set retVal [bolden ${retVal} "return;"]
    # Boldify "new"
    set retVal [bolden ${retVal} "new;"]
    return ${retVal}
}

debugPuts "souring bolden"
# Return the "bold" version of line, where each instance of 
# "word" is replaced by the html bold version
proc bolden { line word } {
    set retVal ""
    regsub -all $word $line "<b>${word}</b>" retVal
    return $retVal
}

debugPuts "sourcing htmlifycomments"
# Deal with comments. 
# Strip out the initial "--".
# Check for some standard strings and replace them with other text.
# Replace lines of dashes with horizontal rules
proc htmlifyComment { commentPart } {
    global gStripDashes

    set retVal "Error in converting comment"
    if {[string first "Please email comments" ${commentPart} ] != -1} {
	set retVal "<center><h5>Comments to bug-sather@gnu.org</h5></center>" 
	return $retVal
    }  else {
	regsub  {([ \t]*)--(.*)} ${commentPart} "\\1<i>\\0</i>" retVal
	# The -- is needed to mark end of options to regsub
	regsub  -- {^---[-]*} ${retVal} "<HR>" retVal
	regsub {(Author: .*)} ${retVal} "<H5>\\0</H5>" retVal
	return $retVal
    }

}

debugPuts "ready to run"



run



