/usr/bin/pt is in tcllib 1.16-dfsg-2.
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 | #!/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
package require fileutil
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 {
::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 0
}
# # ## ### ##### ######## ############# #####################
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 ""
}
}
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
fileutil::writeFile $parserfile \
[::pt::pgen $grammarformat \
[fileutil::cat $grammarfile] \
$parserformat {*}$args]
return
}
# 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
|