1#!/bin/sh 2# \ 3 exec itkwish "$0" ${1+"$@"} 4# 5# mkitclman "4 Dec 1995" 6# mkitclman - generate a man page from an itcl class 7# 8# SYNOPSIS 9# mkitclman classfile 10# 11# DESCRIPTION 12# Reads an [incr Tcl] or [incr Tk] class file as input, and outputs nroff. 13# mkitclman generates a standard format used for [incr Widget] classes. It 14# locates the class name, inheritance to one level, widget specific options, 15# and widget specific methods. Areas that the script cannot handle it 16# places and uppercased name delimited by leading and trailing '_' characters. 17# 18# [incr Tcl/Tk] 2.0 is the supported class format. 19# 20# CAVEATS 21# mkitlcman does not work with normal Tk or Tcl script files. 22# It expects only one class per file. In addition, it does not work on 23# namespace files. 24 25proc init { } { 26 global _className 27 global _inheritClass 28 global _publicMethod 29 global _publicVariable 30 global _protectedMethod 31 global _protectedVariable 32 global _privateMethod 33 global _privateVariable 34 global _options 35 36 set _className {} 37 set _inheritClass {} 38 39} 40proc namespace { args } { 41 global _className 42 43 set _className [lindex $args 0] 44 set classBody [lindex $args 1] 45 46 eval $classBody 47} 48proc class { args } { 49 global _className 50 51 set _className [lindex $args 0] 52 set classBody [lindex $args 1] 53 54 eval $classBody 55} 56proc itk_option { action switch args } { 57 global _options 58 59 if { $action == "define" } { 60 set _options($switch) $args 61 } 62} 63proc inherit { inheritClass } { 64 global _inheritClass 65 set _inheritClass $inheritClass 66} 67 68# default is public method 69proc method { name args } { 70 global _publicMethod 71 72 set _publicMethod($name) $args 73} 74 75# pick up arrays later... 76proc common { name args } { 77 global _commonVariable 78 79 # set to defaults 80 set _commonVariable($name) $args 81} 82 83proc public { type args } { 84 global _publicMethod 85 global _publicVariable 86 87 switch $type { 88 method { 89 set _publicMethod([lindex $args 0]) [lindex $args 1] 90 } 91 variable { 92 # _publicVariable(varName) = defaultValue 93 set _publicVariable([lindex $args 0]) [lindex $args 1] 94 } 95 } 96} 97 98proc protected { type args } { 99 global _protectedMethod 100 global _protectedVariable 101 102 switch $type { 103 method { 104 # _protectedMethod(methodName) = argList 105 set _protectedMethod([lindex $args 0]) [lrange $args 1 end] 106 } 107 variable { 108 # _protectedVariable(varName) = defaultValue 109 set _protectedVariable([lindex $args 0]) [lindex $args 1] 110 } 111 } 112} 113 114proc private { type args } { 115 global _privateMethod 116 global _privateVariable 117 118 switch $type { 119 method { 120 # _privateMethod(methodName) = argList 121 set _privateMethod([lindex $args 0]) [lrange $args 1 end] 122 } 123 variable { 124 # _privateVariable(varName) = defaultValue 125 set _privateVariable([lindex $args 0]) [lindex $args 1] 126 } 127 } 128} 129 130proc body { args } { 131} 132 133proc configbody { args } { 134} 135 136proc destructor { args } { 137} 138proc constructor { args } { 139} 140 141proc gen { } { 142 global _className 143 global _classBody 144 global _inheritClass 145 global _publicMethod 146 global _publicVariable 147 global _protectedMethod 148 global _protectedVariable 149 global _privateMethod 150 global _privateVariable 151 global _methodSection 152 global _optionSection 153 global _manpage 154 global _optionManFmt 155 global _methodManFmt 156 global _method 157 global _options 158 global _optionSwitch 159 global _optionName 160 global _optionClass 161 162 if { $_inheritClass != {} } { 163 set _inheritClass "$_inheritClass <-" 164 } 165 set _optionManFmt {} 166 set _methodManFmt {} 167 set _methodArgs {} 168 foreach pbv [lsort [array names _publicVariable]] { 169 set _optionSwitch "-$pbv" 170 set _optionName $pbv 171 set _optionClass "[string toupper [string index $pbv 0]][string range $pbv 1 end]" 172 lappend _optionManFmt [subst -nobackslash -nocommand $_optionSection] 173 } 174 175 foreach opt [lsort [array names _options]] { 176 set _optionSwitch $opt 177 set _optionName [lindex $_options($opt) 0] 178 set _optionClass [lindex $_options($opt) 1] 179 lappend _optionManFmt [subst -nobackslash -nocommand $_optionSection] 180 } 181 foreach pbm [lsort [array names _publicMethod]] { 182 set _method $pbm 183 eval set _methodArgs [list $_publicMethod($pbm)] 184 lappend _methodManFmt [subst -nobackslash -nocommand $_methodSection] 185 } 186 foreach ptm [lsort [array names _protectedMethod]] { 187 } 188 foreach ptv [lsort [array names _protectedVariable]] { 189 } 190 foreach pvm [lsort [array names _privateMethod]] { 191 } 192 foreach pvv [lsort [array names _privateVariable]] { 193 } 194 195 set _methodManFmt [join $_methodManFmt " "] 196 set _optionManFmt [join $_optionManFmt " "] 197 198 set _manpage [subst -nobackslash -nocommand $_manpage] 199 200 puts $_manpage 201} 202 203set _manpage { 204'\" 205'\" Copyright (c) _AUTHOR_ 206'\" 207'\" See the file "license.terms" for information on usage and redistribution 208'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. 209'\" 210'\" @(#) $_className.n 211'/" 212.so man.macros 213.HS $_className iwid 214.BS 215'\" Note: do not modify the .SH NAME line immediately below! 216'\" 217'\" 218.SH NAME 219$_className \- _NAME_DESCRIPTION_ 220.SH SYNOPSIS 221\fB$_className\fI \fIpathName\fR ?\fIoptions\fR? 222.SH "INHERITANCE" 223$_inheritClass $_className 224.SH "STANDARD OPTIONS" 225.LP 226.nf 227.ta 4c 8c 12c 228_STANDARD_OPTIONS_ 229.fi 230.LP 231See the "options" manual entry for details on the standard options. 232.SH "ASSOCIATED OPTIONS" 233.LP 234.nf 235.ta 4c 8c 12c 236_ASSOCIATED_OPTIONS_ 237.fi 238.LP 239See the "_ASSOCIATED_WIDGET_" widget manual entry for details on the above 240associated options. 241.SH "INHERITED OPTIONS" 242.LP 243.nf 244.ta 4c 8c 12c 245_INHERITED_OPTIONS_ 246.fi 247.LP 248See the "_INHERITED_WIDGET_" class manual entry for details on the inherited options. 249.SH "WIDGET-SPECIFIC OPTIONS" 250.LP 251$_optionManFmt 252.BE 253.SH DESCRIPTION 254.PP 255_DESCRIPTION_ 256.SH "METHODS" 257.PP 258The \fB$_className\fR command creates a new Tcl command whose 259name is \fIpathName\fR. This 260command may be used to invoke various 261operations on the widget. It has the following general form: 262.DS C 263\fIpathName option \fR?\fIarg arg ...\fR? 264.DE 265\fIOption\fR and the \fIarg\fRs 266determine the exact behavior of the command. The following 267commands are possible for $_className widgets: 268.SH "ASSOCIATED METHODS" 269.LP 270.nf 271.ta 4c 8c 12c 272_ASSOCIATED_METHODS_ 273.fi 274.LP 275See the "_ASSOCIATED_WIDGET_" manual entry for details on the standard methods. 276.SH "WIDGET-SPECIFIC METHODS" 277$_methodManFmt 278.SH "COMPONENTS" 279.LP 280.nf 281Name: \fB_COMPONENT_NAME_\fR 282Class: \fB_COMPONENT_CLASS_\fR 283.fi 284.IP 285_COMPONENT_DESCRIPTION_ 286See the "_COMPONENT_TYPE_" widget manual entry for details on the _COMPONENT_NAME_ component item. 287.fi 288.SH EXAMPLE 289.DS 290_EXAMPLE_CODE_ 291.DE 292.SH AUTHOR 293_AUTHOR_ 294.SH KEYWORDS 295_KEYWORDS_ 296} 297 298set _optionSection { 299.nf 300Name: \fB$_optionName\fR 301Class: \fB$_optionClass\fR 302Command-Line Switch: \fB$_optionSwitch\fR 303.fi 304.IP 305_OPTION_DESCRIPTION_ 306.LP 307} 308 309set _methodSection { 310.TP 311\fIpathName\fR \fB$_method\fR \fI$_methodArgs\fR 312_METHOD_DESCRIPTION_ 313} 314 315# Add these two lines up into the man page above to enable 316 317init 318source [lindex $argv 0] 319gen 320exit 321