Picol  Check-in [fb19e567ce]

#! /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}
    }

            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 {

    }
}

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
    }
}