tool/spellsift.tcl

   1 #!/usr/bin/tclsh
   2
   3 set usage {
   4   Usage: spellsift.tcl <source_filenames>
   5   The named .c and .h source files comment blocks are spell-checked.
   6 }
   7
   8 if {[llength $argv] == 0} {
   9   puts stderr $usage
  10   exit 0
  11 }
  12
  13 # Want a Tcl version with 3-argument close.
  14 package require Tcl 8.6
  15
  16 set ::spellchk "aspell --extra-dicts ./custom.rws list"
  17
  18 # Run text through aspell with custom dictionary, return finds.
  19 proc misspelled {text} {
  20   set spellerr [open "|$::spellchk" r+]
  21   puts $spellerr $text
  22   flush $spellerr
  23   close $spellerr write
  24   set huhq [regsub {\s*$} [read $spellerr] {}]
  25   close $spellerr read
  26   return [split $huhq "\n"]
  27 }
  28
  29 # Eliminate some common patterns that need not be well spelled.
  30 proc decruft {text} {
  31   set nopp [regsub -all "\n *#\[^\n\]*\n" $text "\n\n" ]
  32   set noticket [regsub -all {Ticket \[?[0-9a-f]+\]?} $nopp "" ]
  33   return $noticket
  34 }
  35
  36 # Sift out common variable spellings not in normal dictionaries.
  37 proc varsift {words} {
  38   set rv [list]
  39   foreach w $words {
  40     set n [string length $w]
  41     set cr [string range $w 1 end]
  42     if {[string tolower $cr] ne $cr} continue
  43     lappend rv $w;
  44   }
  45   return $rv
  46 }
  47
  48 foreach fname $argv {
  49   set ich [open $fname r]
  50   set dtext [decruft [read $ich]]
  51   close $ich
  52   set cbounds [regexp -indices -inline -all {(/\*)|(\*/)} $dtext]
  53   set ccb -1
  54   set cblocks [list]
  55   foreach {ap cb ce} $cbounds {
  56     set cib [lindex $cb 1]
  57     set cie [lindex $ce 0]
  58     if {$cie != -1} {
  59       if {$ccb != -1} {
  60         set cce [expr $cie - 1]
  61         set destar [string map [list * " "] [string range $dtext $ccb $cce]]
  62         lappend cblocks $destar
  63         set ccb -1
  64       } else continue
  65     } elseif {$cib != -1} {
  66       set ccb [expr $cib + 1]
  67     }
  68   }
  69   set oddspells [varsift [misspelled [join $cblocks "\n"]]]
  70   if {[llength $oddspells] > 0} {
  71     puts "!? Misspellings from $fname:"
  72     puts [join [lsort -nocase -unique $oddspells] "\n"]
  73   }
  74 }