Picol  help.pcl at trunk

File help.pcl artifact 72e3ff3b24 on branch trunk

#! /usr/bin/env picolsh
# help.pcl: Extract usage messages from picol.h.
#
# The PICOL_ARITY2 macro in picol.h is called to ensure a command is being used
# correctly and display a usage message if it is not. This script extracts the
# commands and their usage messages from picol.h, adds any missing commands
# from [info commands], and prints the result. The code demonstrates text
# manipulation, basic parsing, and the use of optional features: arrays, I/O,
# and regular expressions. This might be the most complex program written in
# Picol.

set macro PICOL_ARITY2  ;# The macro we are going to look for.

# Find a matching closing bracket for an opening bracket in $s starting at
# $start. Brackets escaped with $escape don't count. Returns a list of
# {unmatched $n}, where $n is the number of unmatched opening brackets, or
# {matched $i}, where $i is the index of the match.
proc match-bracket {opening closing escape s start} {
    set n 0

    if {[string index $s $start] ne $opening} {
        error {start isn't a bracket}
    }

    set len [string length $s]
    for {set i $start} {$i < $len} {incr i} {
        set c [string index $s $i]

        if {[string equal $c $escape]} {
            incr i
            continue
        }

        if {[string equal $c $opening]} {
            incr n
        } elseif {[string equal $c $closing]} {
            incr n -1
        }

        if {$n == 0} break
    }

    if {$n > 0} {
        return [list unmatched $n]
    }

    return [list matched $i]
}

set file [if {$argc == 0} { lindex picol.h } else { lindex $argv 0 }]
set ch [open $file]
puts "Running $tcl_platform(engine) [info pa] with\
      [llength [info commands]] commands"

set count 0
while {![eof $ch]} {
    gets $ch statement
    # We don't want macro definitions.
    if {[string match #define* $statement]} continue

    set start [string first [set macro]( $statement]
    if {$start == -1} continue
    incr start [string length $macro]

    # Read up to five lines of the source code to get every argument to the
    # PICOL_ARITY2(...) macro.
    for {set lines 1} {$lines <= 5} {incr lines} {
        lassign [match-bracket ( ) \\ $statement $start] result
        if {$result eq {matched}} break

        gets $ch line
        append statement $line
    }

    # The usage message is one or more C strings in the last argument to the
    # macro.
    set last_arg_start [string last , $statement]
    set message_start [string first \" $statement $last_arg_start]
    set message_end [string last \" $statement]

    set message [string range $statement \
                              [+ $message_start 1] \
                              [- $message_end 1]]

    # Split the usage message into the command name and the possible
    # arguments.
    set cmd [lindex $message 0]
    if {[regexp ^\s*$ $cmd]} continue

    set usage [if {[info exists cmds($cmd)]} {
        set cmds($cmd)
    } else {
        lindex {}
    }]
    lappend usage [string trim [string range $message \
                                             [string length $cmd] \
                                             end]]
    set cmds($cmd) $usage
    incr count
}

close $ch

rename match-bracket {}

puts "$count usage notes\n"
foreach cmd [info commands] {
    if {[string match _* $cmd]} continue
    if {![info exists cmds($cmd)]} {
        set cmds($cmd) [list "\[no usage found\]"]
    }
}

foreach cmd [lsort -unique [array names cmds]] {
    foreach usage [set cmds($cmd)] {
        set msg "$cmd $usage"

        # Avoid printing the same usage muliple times. Some commands are
        # defined identically twice because of conditional compilation.
        if {[info exists printed($msg)]} continue

        puts $msg
        set printed($msg) 1
    }
}