/usr/bin/pt is in tcllib 1.18-dfsg-3.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | #!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
# activate commands below for execution from within the pt directory
set self [file normalize [info script]]
set selfdir [file dirname $self]
lappend auto_path $selfdir [file dirname $selfdir]
# When debugging package loading trouble, show the search paths
#puts [join $auto_path \n]
# # ## ### ##### ######## ############# #####################
package require pt::pgen 1.0.3
package require pt::util
package require fileutil
package require try
namespace eval ::pt::app {
namespace export generate help
namespace ensemble create
}
# # ## ### ##### ######## ############# #####################
proc main {} {
global argv argv0 errorInfo
if {![llength $argv]} { lappend argv help }
if {[catch {
set status [::pt::app {*}$argv]
} msg]} {
set elines [split $errorInfo \n]
if {[llength $elines] == 3} {
if {[string match *unknown* $msg]} {
#puts stderr "$argv0 $msg"
::pt::app help
exit 1
} elseif {[string match {*wrong # args*} $msg]} {
#puts $msg
# Extracting the command name from the error message,
# because there a prefix will have been expanded to
# the actual command. <lindex argv 0> OTOH would be a
# possible prefix, without a properly matching topic.
puts stderr Usage:
::pt::app help [lindex $msg 5 1]
exit 1
}
}
set prefix {INTERNAL ERROR :: }
puts ${prefix}[join $elines \n$prefix]
exit 1
}
exit $status
}
# # ## ### ##### ######## ############# #####################
proc ::pt::app::helpHelp {} {
return {
@ help ?TOPIC?
Provides general help, or specific to the given topic.
}
}
proc ::pt::app::help {{topic {}}} {
global argv0
if {[llength [info level 0]] == 1} {
puts stderr "Usage: $argv0 command ...\n\nKnown commands:\n"
foreach topic [Topics] {
::pt::app help $topic
}
} elseif {$topic ni [Topics]} {
puts stderr "$argv0: Unknown help topic '$topic'"
puts stderr "\tUse one of [linsert [join [Topics] {, }] end-1 or]"
puts stderr ""
} else {
puts stderr \t[join [split [string map [list @ $argv0] [string trim [::pt::app::${topic}Help]]] \n] \n\t]
puts stderr ""
}
return 0
}
proc ::pt::app::Topics {} {
namespace eval ::TEMP { namespace import ::pt::app::* }
set commands [info commands ::TEMP::*]
namespace delete ::TEMP
set res {}
foreach c $commands {
lappend res [regsub ^::TEMP:: $c {}]
}
proc ::pt::app::Topics {} [list return $res]
return $res
}
# # ## ### ##### ######## ############# #####################
proc ::pt::app::generateHelp {} {
return {
@ generate PFORMAT ?-option value...? PFILE INFORMAT GFILE
Generate data in format PFORMAT and write it to PFILE. Read
the grammar to be processed from GFILE (assuming the format
GFORMAT). Use any options to configure the generator. The are
dependent on PFORMAT.
}
}
proc ::pt::app::generate {args} {
# args = parserformat ?...? parserfile grammarformat grammarfile
if {[llength $args] < 4} {
# Just enough that the help code can extract the method name
return -code error "wrong # args, should be \"@ generate ...\""
}
set args [lassign $args parserformat]
lassign [lrange $args end-2 end] \
parserfile grammarformat grammarfile
set args [Template [lrange $args 0 end-3]]
lappend args -file $grammarfile
puts "Reading $grammarformat $grammarfile ..."
set grammar [fileutil::cat $grammarfile]
puts "Generating a $parserformat parser ..."
try {
set parser [::pt::pgen $grammarformat $grammar $parserformat {*}$args]
} trap {PT RDE SYNTAX} {e o} {
puts [pt::util error2readable $e $grammar]
return 1
}
puts "Saving to $parserfile ..."
fileutil::writeFile $parserfile $parser
puts OK
return 0
}
# Lift template specifications from file paths to the file's contents.
proc ::pt::app::Template {optiondict} {
set res {}
foreach {option value} $optiondict {
if {$option eq "-template"} {
set value [fileutil::cat $value]
}
lappend res $option $value
}
return $res
}
# # ## ### ##### ######## ############# #####################
main
exit
|