checkhtmlfiles.tcl

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

#!/usr/bin/tcl


proc processDirectory {path ignore} {
  foreach file [glob -nocomplain -directory $path -types f *] {
    processFile $file [string range $file $ignore end]
#    if {"[string range $file [expr [string length $file] - 5] end]" == ".html"} break
  }

  foreach file [glob -nocomplain -directory $path -types d *] {
    processDirectory $file $ignore
  }
}


proc processFile {file shown} {
  target $shown

#  if {"[string range $file [expr [string length $file] - 5] end]" == ".html"} 
#  if {"[string range $file [expr [string length $file] - 6] end]" == ".xhtml"}

  if {"[string range $file [expr [string length $file] - 5] end]" == ".html" || 
      "[string range $file [expr [string length $file] - 6] end]" == ".xhtml"} {
#    puts "Test: $file --- $shown"
#    puts -nonewline .
    checkfile $file $shown
  }
}




proc link uri {
 global fid_links
 global links

  puts $fid_links $uri
  lappend links $uri

  if {"$uri" == ""} {
    error "Empty URI!!!"
  }
}

proc target uri {
 global fid_targets
 global targets

  puts $fid_targets $uri
  lappend targets $uri

  if {"$uri" == ""} {
    error "Empty URI!!!"
  }
}


proc absoluteLink {relative source} {

  if {[regexp {://} $relative]} {
    return $relative
  }


  set reldepth [regexp -all {[.][.]/} $relative]
  regexp -all {^([.][.]/)*(.*)$} $relative dummyall dummyback purepath

#  set depth [regexp -all / $source]
#  incr depth "-$reldepth"



  set pathcomp [split $source /]
  set pathend [llength $pathcomp]
  incr pathend -2
  incr pathend "-$reldepth"

  set path {}
  if {$pathend >= 0} {
    set path [join [lrange $pathcomp 0 $pathend] /]/
  }

  
#  regexp -all {^(.*/)[^/]*$} $source dummyall sourcepath
#  set path $sourcepath
  
#  if {$reldepth > 0} {
#    set pattern [string repeat {[^/]*/} $reldepth]
#    append pattern {(.*)/[^/]*$}
#    regexp -all "^${pattern}" $source dummyall path
#    append path /
#  }

#puts "$relative relative to $source  ---->  $path - $purepath"

  if {"$path$purepath" == ""} {
    error "Empty URI!!! from $relative and $source"
  }

#  if {"$path$purepath" == "EAbortProgress/Type.html"} {
#    error "EAbortProgress/File.html from $relative and $source with $pathend ($reldepth)"
#  }


  return "$path$purepath"
}


proc checkfile {filename file} {
  set fileid [open $filename r] 
  set source [read $fileid]
  close $fileid

  foreach {tag value} [regexp -nocase -all -inline -- {\<a name="([^"]*)"} $source] {
#"
    target "$file#$value"
  }
  
  foreach {tag value} [regexp -nocase -all -inline -- {\<a href="([^"]*)"} $source] {
#"
    if [string match "#*" $value] {
      link $file$value
    } {
      link [absoluteLink $value $file]
    }
  }
  foreach {tag value} [regexp -nocase -all -inline -- {\<area [^>]*href="([^"]*)"} $source] {
#"
    if [string match "#*" $value] {
      link $file$value
    } {
      link [absoluteLink $value $file]
    }
  }


  foreach {tag value} [regexp -nocase -all -inline -- {\<img src="([^"]*)"} $source] {
#"
    link [absoluteLink $value $file]
  }
  
  foreach {tag value} [regexp -nocase -all -inline -- {\<link [^>]*href="([^"]*)"} $source] {
#"
    link [absoluteLink $value $file]
  }

}



proc splitLists {links targets} {
 global fid_links
 global fid_targets

  set llen [llength $links]
  set tlen [llength $targets]

  set link [lindex $links 0]
  set target [lindex $targets 0]

  set lind 1
  set tind 1

  while {$lind <= $llen && $tind <= $tlen} {
    if {"$link" == "$target"} {
      set link [lindex $links $lind]
      set target [lindex $targets $tind]
      incr lind
      incr tind
    } {
      if {"$link" < "$target"} {
        puts $fid_links $link
        set link [lindex $links $lind]
        incr lind
      } {
        puts $fid_targets $target
        set target [lindex $targets $tind]
        incr tind
      }
    }
  }

  if {$lind <= $llen} {
    puts $fid_links $link
    foreach uri [lrange $links $lind end] {
      puts $fid_links $uri
    }
  } elseif {$tind <= $tlen} {
    puts $fid_targets $target
    foreach uri [lrange $targets $tind end] {
      puts $fid_targets $uri
    }
  }
}










set path ../DelphiDoc/_doc

proc doIt {} {
 global path

  processDirectory $path [expr 1 + [string length $path]]
}






puts "Starting parsing files..."

set fid_links [open "links.list" w] 
set fid_targets [open "targets.list" w] 

set links {}
set targets {}


if { [catch doIt message] } {
  puts stderr "ERROR!"
  puts stderr "$message"
  puts stderr "$errorInfo"
  close $fid_links
  close $fid_targets
} {

  close $fid_links
  close $fid_targets



  puts "Starting sorting links..."
  set sortedlinks [lsort -unique $links]

  puts "Starting sorting targets..."
  set sortedtargets [lsort -unique $targets]


  puts "Writing sorted lists..."

  set fid_links [open "links.sort" w] 
  foreach entry $sortedlinks {
    puts $fid_links $entry
  }
  close $fid_links

  set fid_targets [open "targets.sort" w] 
  foreach entry $sortedtargets {
    puts $fid_targets $entry
  }
  close $fid_targets





  puts "Split lists..."

  set fid_links [open "links.unknown" w] 
  set fid_targets [open "targets.unused" w] 

  if { [catch {splitLists $sortedlinks $sortedtargets} message] } {
    puts stderr "ERROR!"
    puts stderr "$message"
    puts stderr "$errorInfo"
  }

  close $fid_links
  close $fid_targets

}



puts stdout "Take a look into the files links.* and targets.*"


set WaitOnFinish 1

if {$WaitOnFinish} {
  puts stdout "Press Enter to finish the Script..."
  gets stdin somevar
}