jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
329 Commits
1 Branch
1 Tag
240 MiB
 
 
 
 
 
 
Tree: 2f787109d8
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '2f787109d8'
${ noResults }
punkshell/src/modules/punk/args/tkcore-999999.0a1.0.tm

622 lines
38 KiB
Raw Blame History

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2025
#
# @@ Meta Begin
# Application punk::args::tkcore 999999.0a1.0
# Meta platform tcl
# Meta license MIT
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_punk::args::tkcore 0 999999.0a1.0]
#[copyright "2025"]
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}]
#[moddesc {-}] [comment {-- Description at end of page heading --}]
#[require punk::args::tkcore]
#[keywords module]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of punk::args::tkcore
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::args::tkcore
#[list_begin itemized]
package require Tcl 8.6-
package require punk::args
package require punk::ansi
package require textblock
#*** !doctools
#[item] [package {Tcl 8.6}]
#[item] [package {punk::args}]
#[item] [package {textblock}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
tcl::namespace::eval punk::args::tkcore {
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection {Namespace punk::args::tkcore}]
#[para] Core API functions for punk::args::tkcore
#[list_begin definitions]
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
set A_WARN \x1b\[7m
set A_RST \x1b\[0m
variable manbase
variable manbase_ext
set patch [info patchlevel]
lassign [split $patch .] major
if {$major < 9} {
set manbase "https://tcl.tk/man/tcl/TkCmd"
set manbase_ext .htm
} else {
set manbase "https://tcl.tk/man/tcl9.0/TkCmd"
set manbase_ext .html
}
proc manpage {cmd} {
variable manbase
variable manbase_ext
return ${manbase}/${cmd}${manbase_ext}
}
variable PUNKARGS
namespace eval argdoc {
tcl::namespace::import ::punk::ansi::a+
tcl::namespace::import ::punk::args::tkcore::manpage
# -- --- --- --- ---
#non colour SGR codes
# we can use these directly via ${$I} etc without marking a definition with @dynamic
#This is because they don't need to change when colour switched on and off.
set I [a+ italic]
set NI [a+ noitalic]
set B [a+ bold]
set N [a+ normal]
# -- --- --- --- ---
proc example {str} {
set str [string trimleft $str \n]
set block [punk::ansi::ansiwrap Web-gray [textblock::frame -ansibase [a+ Web-gray bold white] -ansiborder [a+ black White] -boxlimits {hl} -type block $str]]
set result [textblock::bookend_lines $block [a] "[a defaultbg] [a]"]
#puts $result
return $result
}
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id "(default)::punk::args::tkcore::common"
} "@doc -name Manpage: -url [manpage index]" ]
#list all tk_standardoptions
#use punk::args::resolved_spec
#{${[punk::args::resolved_def -types opts (default)::punk::args::tkcore::tk_standardoptions -disabledforeground -font ...]}}
::punk::args::define {
@id -id "(default)::punk::args::tkcore::tk_standardoptions"
-activebackground -type colour -help\
"Specifies background color to use when drawing active elements. An element (a widget or portion of a widget)
is active if the mouse cursor is positioned over the element and pressing a mouse button will cause some
action to occur. If strict Motif compliance has been requested by setting the tk_strictMotif variable, this
option will normally be ignored; the normal background color will be used instead. For some elements on
Windows and Macintosh systems, the active color will only be used while mouse button 1 is pressed over the
element."
-activeborderwidth -type tk_screen_units -help\
"Specifies a non-negative value indicating the width of the 3-D border drawn around active elements. See above
for definition of active elements. The value may have any of the forms acceptable to Tk_GetPixels. This option
is typically only available in widgets displaying more than one element at a time (e.g. menus but not buttons)."
-activeforeground -type colour -help\
"Specifies foreground color to use when drawing active elements. See above for definition of active elements."
-activerelief -type string -choicecolumns 6 -choices {raised sunken flat ridge solid groove} -help\
"Specifies the 3-D effect desired for the active item of the widget. See the -relief option for details."
-anchor -type string -choicecolumns 9 -choices {n ne e se s sw w nw center} -help\
"Specifies how the information in a widget (e.g. text or a bitmap) is to be displayed in the widget.
For example, ${$B}nw${$N} means display the information such that its top-left corner is at the top-left corner of the widget."
-background|-bg -type colour -help\
"Specifies the normal background color to use when displaying the widget."
-bitmap -type bmp -help\
"Specifies a bitmap to display in the widget, in any of the forms acceptable to Tk_GetBitmap. The exact
way in which the bitmap is displayed may be affected by other options such as -anchor or -justify.
Typically, if this option is specified then it overrides other options that specify a textual value to
display in the widget but this is controlled by the ${$B}-compound${$N} option; the -bitmap option may be reset to
an empty string to re-enable a text display. In widgets that support both -bitmap and -image options,
-image will usually override -bitmap."
-borderwidth|-bd -type tk_screen_units -help\
"Specifies a non-negative value indicating the width of the 3-D border to draw around the outside of the
widget (if such a border is being drawn; the -relief option typically determines this). The value may
also be used when drawing 3-D effects in the interior of the widget. The value may have any of the
forms acceptable to Tk_GetPixels."
#todo - something better for large -choices lists
#list of cursors is large, not obtainable dynamically, and has some that are platform specific.
-cursor -type string -help\
""
-compound -type string -choicecolumns 6 -choices {none bottom top left right center} -help\
"Specifies if the widget should display text and bitmaps/images at the same time, and if so, where the
bitmap/image should be placed relative to the text. Must be one of the values none, bottom, top, left,
right, or center. For example, the (default) value none specifies that the bitmap or image should
(if defined) be displayed instead of the text, the value ${$B}left${$N} specifies that the bitmap or image should
be displayed to the left of the text, and the value ${$B}center${$N} specifies that the bitmap or image should be
displayed on top of the text."
-disabledforeground -type colour|literal() -help\
"Specifies foreground color to use when drawing a disabled element. If the option is specified
as an empty string (which is typically the case on monochrome displays), disabled elements
are drawn with the normal foreground color but they are dimmed by drawing them with a
stippled fill pattern."
-exportselection -type boolean -help\
"Specifies whether or not a selection in the widget should also be the X selection. The value may have any of the
forms accepted by Tcl_GetBoolean, such as true, false, 0, 1, yes, or no. If the selection is exported, then
selecting in the widget deselects the current X selection, selecting outside the widget deselects any widget
selection, and the widget will respond to selection retrieval requests when it has a selection. The default is
usually for widgets to export selections."
-font -type tk_font -help\
"Specifies the font to use when drawing text inside the widget. The value may have any of the
forms described in the font manual page under FONT DESCRIPTION."
-foreground|-fg -type colour -help\
"Specifies the normal foreground color to use when displaying the widget."
-highlightbackground -type colour -help\
"Specifies the color to display in the traversal highlight region when the widget does not have the input focus."
-highlightcolor -type colour -help\
"Specifies the color to use for the traversal highlight rectangle that is drawn around the widget when it has the
input focus."
-highlightthicknes -type tk_screen_units -help\
"Specifies a non-negative value indicating the width of the highlight rectangle to draw around the outside of the
widget when it has the input focus. The value may have any of the forms acceptable to Tk_GetPixels. If the
value is zero, no focus highlight is drawn around the widget."
-image -type string -help\
"Specifies an image to display in the widget, which must have been created with the image create command.
Typically, if the -image option is specified then it overrides other options that specify a bitmap or textual
value to display in the widget, though this is controlled by the -compound option; the -image option may be
reset to an empty string to re-enable a bitmap or text display."
-insertbackground -type colour -help\
"Specifies the color to use as background in the area covered by the insertion cursor. This color will normally
override either the normal background for the widget (or the selection background if the insertion cursor
happens to fall in the selection)."
-insertborderwidth -type tk_screen_units -help\
"Specifies a non-negative value indicating the width of the 3-D border to draw around the insertion cursor.
The value may have any of the forms acceptable to Tk_GetPixels."
-insertofftime -type integer -typesynopsis {${$I}ms${$NI}} -range {0 ""} -help\
"Specifies a non-negative integer value indicating the number of milliseconds the insertion cursor should remain
“off” in each blink cycle. If this option is zero then the cursor does not blink: it is on all the time."
-insertontime -type integer -typesynopsis {${$I}ms${$NI}} -range {0 ""} -help\
"Specifies a non-negative integer value indicating the number of milliseconds the insertion cursor should remain
“on” in each blink cycle."
-insertwidth -type tk_screen_units -help\
"Specifies a non-negative value indicating the total width of the insertion cursor. The value may have any of the
forms acceptable to Tk_GetPixels. If a border has been specified for the insertion cursor (using the
-insertborderwidth option), the border will be drawn inside the width specified by the -insertwidth option."
-jump -type boolean -help\
"For widgets with a slider that can be dragged to adjust a value, such as scrollbars, this option determines when
notifications are made about changes in the value. The option's value must be a boolean of the form accepted by
Tcl_GetBoolean. If the value is false, updates are made continuously as the slider is dragged. If the value is
true, updates are delayed until the mouse button is released to end the drag; at that point a single
notification is made (the value “jumps” rather than changing smoothly)."
-justify -type string -choicecolumns 3 -choices {left center right} -help\
"When there are multiple lines of text displayed in a widget, this option determines how the lines line up with
each other. Must be one of left, center, or right. Left means that the lines' left edges all line up, center
means that the lines' centers are aligned, and right means that the lines' right edges line up."
-orient -type string -choiceprefix 1 -choicecolumns 2 -choices {horizontal vertical} -help\
"For widgets that can lay themselves out with either a horizontal or vertical orientation, such as scrollbars,
this option specifies which orientation should be used. Must be either horizontal or vertical or an
abbreviation of one of these."
-padx -type tk_screen_units -help\
"Specifies a non-negative value indicating how much extra space to request for the widget in the X-direction.
The value may have any of the forms acceptable to Tk_GetPixels. When computing how large a window it needs,
the widget will add this amount to the width it would normally need (as determined by the width of the things
displayed in the widget); if the geometry manager can satisfy this request, the widget will end up with extra
internal space to the left and/or right of what it displays inside. Most widgets only use this option for
padding text: if they are displaying a bitmap or image, then they usually ignore padding options."
-pady -type tk_screen_units -help\
"Specifies a non-negative value indicating how much extra space to request for the widget in the Y-direction.
The value may have any of the forms acceptable to Tk_GetPixels. When computing how large a window it needs,
the widget will add this amount to the height it would normally need (as determined by the height of the things
displayed in the widget); if the geometry manager can satisfy this request, the widget will end up with extra
internal space above and/or below what it displays inside. Most widgets only use this option for padding text:
if they are displaying a bitmap or image, then they usually ignore padding options."
-placeholder -type string -help\
"Specifies a help text string to display if no text is otherwise displayed, that is when the widget is empty.
The placeholder text is displayed using the values of the -font and -justify options."
-placeholderforeground -type colour -help\
"Specifies the foreground color to use when the placeholder text is displayed.
The default color is platform-specific."
-relief -type string -choicecolumns 6 -choices {raised sunken flat ridge solid groove} -help\
"Specifies the 3-D effect desired for the widget. Acceptable values are raised, sunken, flat, ridge, solid, and
groove. The value indicates how the interior of the widget should appear relative to its exterior; for example,
raised means the interior of the widget should appear to protrude from the screen, relative to the exterior of
the widget."
-repeatdelay -type integer -typesynopsis {${$I}ms${$NI}} -help\
"Specifies the number of milliseconds a button or key must be held down before it begins to auto-repeat. Used,
for example, on the up- and down-arrows in scrollbars."
-repeatinterval -type integer -typesynopsis {${$I}ms${$NI}} -help\
"Used in conjunction with -repeatdelay: once auto-repeat begins, this option determines the number of
milliseconds between auto-repeats."
-selectbackground -type colour -help\
"Specifies the background color to use when displaying selected items."
-selectborderwidth -type tk_screen_units -help\
"Specifies a non-negative value indicating the width of the 3-D border to draw around selected items.
The value may have any of the forms acceptable to Tk_GetPixels."
-selectforeground -type colour -help\
"Specifies the foreground color to use when displaying selected items."
-setgrid -type boolean -help\
"Specifies a boolean value that determines whether this widget controls the resizing grid for its top-level window.
This option is typically used in text widgets, where the information in the widget has a natural size (the size
of a character) and it makes sense for the window's dimensions to be integral numbers of these units. These
natural window sizes form a grid. If the -setgrid option is set to true then the widget will communicate with the
window manager so that when the user interactively resizes the top-level window that contains the widget, the
dimensions of the window will be displayed to the user in grid units and the window size will be constrained to
integral numbers of grid units. See the section GRIDDED GEOMETRY MANAGEMENT in the wm manual entry for more
details."
-takefocus -type literal(0)|literal(1)|literal() -help\
"Determines whether the window accepts the focus during keyboard traversal (e.g., Tab and Shift-Tab). Before
setting the focus to a window, the traversal scripts consult the value of the -takefocus option. A value of 0
means that the window should be skipped entirely during keyboard traversal. 1 means that the window should
receive the input focus as long as it is viewable (it and all of its ancestors are mapped). An empty value for
the option means that the traversal scripts make the decision about whether or not to focus on the window: the
current algorithm is to skip the window if it is disabled, if it has no key bindings, or if it is not viewable.
If the value has any other form, then the traversal scripts take the value, append the name of the window to it
(with a separator space), and evaluate the resulting string as a Tcl script. The script must return 0, 1, or an
empty string: a 0 or 1 value specifies whether the window will receive the input focus, and an empty string
results in the default decision described above. Note that this interpretation of the option is defined entirely
by the Tcl scripts that implement traversal: the widget implementations ignore the option entirely, so you can
change its meaning if you redefine the keyboard traversal scripts."
-text -type string -help\
"Specifies a string to be displayed inside the widget. The way in which the string is displayed depends on the
particular widget and may be determined by other options, such as -anchor or -justify."
-textvariable -type string -help\
"Specifies the name of a global variable. The value of the variable is a text string to be displayed inside the
widget; if the variable value changes then the widget will automatically update itself to reflect the new value.
The way in which the string is displayed in the widget depends on the particular widget and may be determined by
other options, such as -anchor or -justify."
-troughcolor -type colour -help\
"Specifies the color to use for the rectangular trough areas in widgets such as scrollbars and scales. This option
is ignored for scrollbars on Windows (native widget does not recognize this option)."
-underline -type indexexpression -help\
"Specifies the integer index of a character to underline in the widget. This option is used by the default
bindings to implement keyboard traversal for menu buttons and menu entries. 0 corresponds to the first character
of the text displayed in the widget, 1 to the next character, and so on. end corresponds to the last character,
end-1 to the before last character, and so on."
-wraplength -type tk_screen_units -help\
"For widgets that can perform word-wrapping, this option specifies the maximum line length. Lines that would
exceed this length are wrapped onto the next line, so that no line is longer than the specified length. The
value may be specified in any of the standard forms for screen distances. If this value is negative or zero
then no wrapping is done: lines will break only at newline characters in the text."
-xscrollcommand -type list -typesynopsis {${$I}cmdprefix${$NI}} -help\
"Specifies the prefix for a command used to communicate with horizontal scrollbars. When the view in the widget's
window changes (or whenever anything else occurs that could change the display in a scrollbar, such as a change
in the total size of the widget's contents), the widget will generate a Tcl command by concatenating the scroll
command and two numbers. Each of the numbers is a fraction between 0 and 1, which indicates a position in the
document. 0 indicates the beginning of the document, 1 indicates the end, .333 indicates a position one third
the way through the document, and so on. The first fraction indicates the first information in the document
that is visible in the window, and the second fraction indicates the information just after the last portion
that is visible. The command is then passed to the Tcl interpreter for execution. Typically the -xscrollcommand
option consists of the path name of a scrollbar widget followed by “set”, e.g. “.x.scrollbar set”: this will
cause the scrollbar to be updated whenever the view in the window changes. If this option is not specified,
then no command will be executed."
-yscrollcommand -type list -typesynopsis {${$I}cmdprefix${$NI}} -help\
"Specifies the prefix for a command used to communicate with vertical scrollbars. This option is treated in the
same way as the -xscrollcommand option, except that it is used for vertical scrollbars and is provided by
widgets that support vertical scrolling. See the description of -xscrollcommand for details on how this option
is used."
} "@doc -name Manpage: -url [manpage options]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS [list {
@id -id ::bell
@cmd -name "Tk Builtin: bell"\
-summary\
"Ring a display's bell."\
-help\
"This command rings the bell on the display for ${$I}window${$NI} and returns an empty string.
If the ${$B}-displayof${$N} option is omitted, the display of the application's main window
is used by default. The command uses the current bell-related settings for the
display, which may be modified with programs such as ${$B}xset${$N}.
If ${$B}-nice${$N} is not specified, this command also resets the screen saver for the screen.
Some screen savers will ignore this, but others will reset so that the screen
becomes visible again."
@opts
-displayof -type stringstartswith(.) -typesynopsis window
-nice -type none
@values -min 0 -max 0
} "@doc -name Manpage: -url [manpage bell]" ]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
lappend PUNKARGS_aliases {::button ::tk::button}
punk::args::define {
@id -id ::tk::button
@cmd -name "Tk Builtin: tk::button"\
-summary\
"Create and manipulate 'button' action widgets."\
-help\
"The ${$B}button${$N} command creates a new window (given by the ${$I}pathName${$NI} argument) and makes it into a button
widget. Additional options, described above, may be specified on the command line or in the option
database to configure aspects of the button such as its colors, font, text, and initial relief. The
${$B}button${$N} command returns its ${$I}pathName${$NI} argument. At the time this command is invoked, there must not
exist a window named ${$I}pathName${$NI}, but ${$I}pathName${$NI}'s parent must exist.
A button is a widget that displays a textual string, bitmap or image. If text is displayed, it must
all be in a single font, but it can occupy multiple lines on the screen (if it contains newlines or
if wrapping occurs because of the ${$B}-wraplength${$N} option) and one of the characters may optionally be
underlined using the ${$B}-underline${$N} option. It can display itself in either of three different ways,
according to the ${$B}-state${$N} option; it can be made to appear raised, sunken, or flat; and it can be made
to flash. When a user invokes the button (by pressing mouse button 1 with the cursor over the button),
then the Tcl command specified in the ${$B}-command${$N} option is invoked."
@leaders
pathName -type tk_path
@opts -type string -parsekey "" -group "STANDARD OPTIONS" -grouphelp\
""
}\
{${[punk::args::resolved_def -types opts (default)::punk::args::tkcore::tk_standardoptions\
-activebackground\
-activeforeground\
-anchor\
-background|-bg\
-bitmap\
-borderwidth|-bd\
-compound\
-cursor\
-disabledforeground\
-font\
-foreground|-fg\
-highlightbackground\
-highlightcolor\
-highlightthickness\
-image\
-justify\
-padx\
-pady\
-relief\
-takefocus\
-text\
-textvariable\
-underline\
-wraplength\
]}}\
{
@opts -type string -parsekey "" -group "WIDGET-SPECIFIC OPTIONS" -grouphelp\
""
-command -type script -help\
"Specifies a Tcl command to associate with the button. This command is typically invoked when mouse button 1
is released over the button window."
-default -type string -choices {normal active disabled} -help\
"Specifies one of three states for the default ring: normal, active, or disabled. In active state, the button
is drawn with the platform specific appearance for a default button. In normal state, the button is drawn
with the platform specific appearance for a non-default button, leaving enough space to draw the default
button appearance. The normal and active states will result in buttons of the same size. In disabled state,
the button is drawn with the non-default button appearance without leaving space for the default appearance.
The disabled state may result in a smaller button than the active state."
-height -type tk_screen_units -help\
"Specifies a desired height for the button. If an image or bitmap is being displayed in the button then the
value is in screen units (i.e. any of the forms acceptable to Tk_GetPixels); for text it is in lines of text.
If this option is not specified, the button's desired height is computed from the size of the image or bitmap
or text being displayed in it."
-overrelief -type string -default "" -choicecolumns 7 -choices {raised sunken flat ridge solid groove ""} -help\
"Specifies an alternative relief for the button, to be used when the mouse cursor is over the widget. This
option can be used to make toolbar buttons, by configuring -relief flat -overrelief raised. If the value of
this option is the empty string, then no alternative relief is used when the mouse cursor is over the button.
The empty string is the default value."
-state -type string -choices {normal active disabled} -help\
"Specifies one of three states for the button: normal, active, or disabled. In normal state the button is
displayed using the ${$B}-foreground${$N} and ${$B}-background${$N} options. The active state is typically used when the pointer
is over the button. In active state the button is displayed using the ${$B}-activeforeground${$N} and ${$B}-activebackground${$N}
options. Disabled state means that the button should be insensitive: the default bindings will refuse to
activate the widget and will ignore mouse button presses. In this state the ${$B}-disabledforeground${$N} and
${$B}-background${$N} options determine how the button is displayed."
-width -type tk_screen_units -help\
"Specifies a desired width for the button. If an image or bitmap is being displayed in the button then the
value is in screen units (i.e. any of the forms acceptable to Tk_GetPixels). For a text button (no image or
with -compound none) then the width specifies how much space in characters to allocate for the text label.
If the width is negative then this specifies a minimum width. If this option is not specified, the button's
desired width is computed from the size of the image or bitmap or text being displayed in it."
} "@doc -name Manpage: -url [manpage bell]"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::args::tkcore ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::args::tkcore::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace punk::args::tkcore::lib}]
#[para] Secondary functions that are part of the API
#[list_begin definitions]
#proc utility1 {p1 args} {
# #*** !doctools
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]]
# #[para]Description of utility1
# return 1
#}
#*** !doctools
#[list_end] [comment {--- end definitions namespace punk::args::tkcore::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
#tcl::namespace::eval punk::args::tkcore::system {
#*** !doctools
#[subsection {Namespace punk::args::tkcore::system}]
#[para] Internal functions that are not part of the API
#}
# == === === === === === === === === === === === === === ===
# Sample 'about' function with punk::args documentation
# == === === === === === === === === === === === === === ===
tcl::namespace::eval punk::args::tkcore {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
variable PUNKARGS
variable PUNKARGS_aliases
lappend PUNKARGS [list {
@id -id "(package)punk::args::tkcore"
@package -name "punk::args::tkcore" -help\
"Package
Description"
}]
namespace eval argdoc {
#namespace for custom argument documentation
proc package_name {} {
return punk::args::tkcore
}
proc about_topics {} {
#info commands results are returned in an arbitrary order (like array keys)
set topic_funs [info commands [namespace current]::get_topic_*]
set about_topics [list]
foreach f $topic_funs {
set tail [namespace tail $f]
lappend about_topics [string range $tail [string length get_topic_] end]
}
#Adjust this function or 'default_topics' if a different order is required
return [lsort $about_topics]
}
proc default_topics {} {return [list Description *]}
# -------------------------------------------------------------
# get_topic_ functions add more to auto-include in about topics
# -------------------------------------------------------------
proc get_topic_Description {} {
punk::args::lib::tstr [string trim {
package punk::args::tkcore
punk::args documentation for Tk
} \n]
}
proc get_topic_License {} {
return "MIT"
}
proc get_topic_Version {} {
return "$::punk::args::tkcore::version"
}
proc get_topic_Contributors {} {
set authors {{Julian Noble <julian@precisium.com.au}}
set contributors ""
foreach a $authors {
append contributors $a \n
}
if {[string index $contributors end] eq "\n"} {
set contributors [string range $contributors 0 end-1]
}
return $contributors
}
#proc get_topic_custom-topic {} {
# punk::args::lib::tstr -return string {
# ""
# }
#}
# -------------------------------------------------------------
}
# we re-use the argument definition from punk::args::standard_about and override some items
set overrides [dict create]
dict set overrides @id -id "::punk::args::tkcore::about"
dict set overrides @cmd -name "punk::args::tkcore::about"
dict set overrides @cmd -help [string trim [punk::args::lib::tstr {
About punk::args::tkcore
}] \n]
dict set overrides topic -choices [list {*}[punk::args::tkcore::argdoc::about_topics] *]
dict set overrides topic -choicerestricted 1
dict set overrides topic -default [punk::args::tkcore::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *]
lappend PUNKARGS [list $newdef]
proc about {args} {
package require punk::args
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on
set argd [punk::args::parse $args withid ::punk::args::tkcore::about]
lassign [dict values $argd] _leaders opts values _received
punk::args::package::standard_about -package_about_namespace ::punk::args::tkcore::argdoc {*}$opts {*}[dict get $values topic]
}
}
# end of sample 'about' function
# == === === === === === === === === === === === === === ===
# -----------------------------------------------------------------------------
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked
# -----------------------------------------------------------------------------
# variable PUNKARGS
# variable PUNKARGS_aliases
namespace eval ::punk::args::register {
#use fully qualified so 8.6 doesn't find existing var in global namespace
lappend ::punk::args::register::NAMESPACES ::punk::args::tkcore ::punk::args::tkcore::argdoc
}
# -----------------------------------------------------------------------------
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::args::tkcore [tcl::namespace::eval punk::args::tkcore {
variable pkg punk::args::tkcore
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]