1832 changed files with 647628 additions and 3803 deletions
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,358 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix 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) 2024 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::blockletter 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_punk::blockletter 0 999999.0a1.0] |
||||
#[copyright "2024"] |
||||
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||
#[require punk::blockletter] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of punk::blockletter |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by punk::blockletter |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
package require textblock |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package {textblock}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# oo::class namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#tcl::namespace::eval punk::blockletter::class { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::class}] |
||||
#[para] class definitions |
||||
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { |
||||
#*** !doctools |
||||
#[list_begin enumerated] |
||||
|
||||
# oo::class create interface_sample1 { |
||||
# #*** !doctools |
||||
# #[enum] CLASS [class interface_sample1] |
||||
# #[list_begin definitions] |
||||
|
||||
# method test {arg1} { |
||||
# #*** !doctools |
||||
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||
# #[para] test method |
||||
# puts "test: $arg1" |
||||
# } |
||||
|
||||
# #*** !doctools |
||||
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||
# } |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end class enumeration ---}] |
||||
#} |
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::blockletter { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
#variable xyz |
||||
|
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter}] |
||||
#[para] Core API functions for punk::blockletter |
||||
#[list_begin definitions] |
||||
|
||||
#A 3x4 block font |
||||
|
||||
variable default_frametype |
||||
set default_frametype {vl \u00a0 hl \u00a0 tlc \u00a0 trc \u00a0 blc \u00a0 brc \u00a0} |
||||
|
||||
# colours in order for T c l T k |
||||
set logo_letter_colours [list Web-red Web-green Web-royalblue Web-purple Web-orange] |
||||
set logo_letter_colours [list Red Green Blue Purple Yellow] |
||||
|
||||
|
||||
proc logo {args} { |
||||
variable logo_letter_colours |
||||
variable default_frametype |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-frametype -default {${$default_frametype}} |
||||
-outlinecolour -default "web-white" |
||||
-backgroundcolour -default {} -help "e.g Web-white |
||||
This argument is the name as accepted by punk::ansi::a+" |
||||
*values -min 0 -max 0 |
||||
}] $args] |
||||
set f [dict get $argd opts -frametype] |
||||
set bd [dict get $argd opts -outlinecolour] |
||||
set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary |
||||
|
||||
#standard red green blue purple yellow |
||||
lassign $logo_letter_colours c_0 c_1 c_2 c_3 c_4 |
||||
|
||||
set tc [merge_left_block [T -bg $c_0 -border $bd -frametype $f] [c -bg $c_1 -border $bd -frametype $f]] |
||||
set tk [merge_left_block [T -bg $c_3 -border $bd -frametype $f] [k_short -bg $c_4 -border $bd -frametype $f]] |
||||
set logo [textblock::join_basic -- $tc [l -bg $c_2 -border $bd -frametype $f] [textblock::block 2 8 " "] $tk] |
||||
if {$bgansi ne ""} { |
||||
lassign [textblock::size_as_list $logo] lwidth lheight |
||||
set w [expr {$lwidth + 2}] |
||||
set h [expr {$lheight + 2}] |
||||
if {![punk::ansi::ta::detect $bgansi]} { |
||||
set bgansi [punk::ansi::a+ $bgansi] |
||||
} |
||||
set logobg $bgansi[textblock::block $w $h " "][punk::ansi::a] |
||||
set topmargin [string repeat " " $w] |
||||
set lmargin [textblock::block 1 [expr {$h + 1}] " "] |
||||
set logo [overtype::left -transparent " " $logobg [textblock::join_basic -- $lmargin $topmargin\n$logo]] |
||||
} |
||||
return $logo |
||||
} |
||||
|
||||
#for characters where it makes sense - offset left by 4 (1 'block' width) |
||||
proc merge_left {charleft textright} { |
||||
if {[string length $charleft] != 1} { |
||||
error "merge_left requires a single character as the charleft argument" |
||||
} |
||||
if {[textblock::height $charleft$textright] > 1} { |
||||
error "merge_left only operates on a plain char and a plain string with no newlines" |
||||
} |
||||
set rhs [textblock::join_basic -- [textblock::block 8 8 " "] [text $textright]] |
||||
#important to explicitly use -transparent " " (ordinary space) rather than -transparent 1 (any space?) |
||||
#This is because our frames have NBSP as filler to be non-transparent |
||||
return [overtype::left -transparent " " -overflow 1 [text $charleft] $rhs] |
||||
} |
||||
proc merge_left_block {blockleft blockright} { |
||||
set rhs [textblock::join_basic -- [textblock::block 8 8 " "] $blockright] |
||||
return [overtype::left -transparent " " -overflow 1 $blockleft $rhs] |
||||
} |
||||
|
||||
proc T {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [lib::hbar {*}$args]\n |
||||
append out [textblock::join -- " " [lib::vbar {*}$args] " "] |
||||
} |
||||
proc c {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [textblock::block 12 2 " "]\n |
||||
append out [lib::hbar {*}$args]\n |
||||
append out [textblock::join -- [lib::block {*}$args] " "]\n |
||||
append out [lib::hbar {*}$args] |
||||
} |
||||
proc l {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [lib::vbar {*}[dict merge {-height 8} $args]] |
||||
} |
||||
|
||||
#full height lower k |
||||
proc k {args} { |
||||
set args [dict remove $args -width -height] |
||||
set left [lib::vbar {*}[dict merge {-height 8} $args]] |
||||
set centre [textblock::block 4 4 " "]\n |
||||
append centre [lib::block {*}$args]\n |
||||
append centre [textblock::block 4 2 " "] |
||||
set right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args]\n |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args] |
||||
append out [textblock::join_basic -- $left $centre $right] |
||||
} |
||||
proc k_short {args} { |
||||
set args [dict remove $args -width -height] |
||||
append left [textblock::block 4 2 " "]\n |
||||
append left [lib::vbar {*}[dict merge {-height 6} $args]] |
||||
append centre [textblock::block 4 4 " "]\n |
||||
append centre [lib::block {*}$args]\n |
||||
append centre [textblock::block 4 2 " "] |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args]\n |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args] |
||||
append out [textblock::join_basic -- $left $centre $right] |
||||
} |
||||
|
||||
proc text {args} { |
||||
variable default_frametype |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-bgcolour -default "Web-red" |
||||
-bordercolour -default "web-white" |
||||
-frametype -default {${$default_frametype}} |
||||
*values -min 1 -max 1 |
||||
str -help "Text to convert to blockletters |
||||
Requires terminal font to support relevant block characters" |
||||
" |
||||
}] $args] |
||||
set opts [dict get $argd opts] |
||||
set str [dict get $argd values str] |
||||
set str [string map {\r\n \n} $str] |
||||
set outblocks [list] |
||||
set literals [list \n] |
||||
foreach char [split $str ""] { |
||||
if {$char in $literals} { |
||||
lappend outblocks $char |
||||
continue |
||||
} |
||||
if {$char in [list \t \r]} { |
||||
lappend outblocks [textblock::block 1 8 $char] |
||||
continue |
||||
} |
||||
if {[info commands ::punk::blockletter::$char] ne ""} { |
||||
lappend outblocks [::punk::blockletter::$char {*}$opts] |
||||
} else { |
||||
lappend outblocks [textblock::block 12 8 $char] |
||||
} |
||||
} |
||||
return [textblock::join_basic -- {*}$outblocks] |
||||
} |
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::blockletter ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::blockletter::lib { |
||||
|
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
tcl::namespace::path [tcl::namespace::parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::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 |
||||
#} |
||||
|
||||
proc block {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-height -default 2 |
||||
-width -default 4 |
||||
-frametype -default {${$ft}} |
||||
-bgcolour -default "Web-red" |
||||
-bordercolour -default "web-white" |
||||
*values -min 0 -max 0 |
||||
}] $args] |
||||
set bg [dict get $argd opts -bgcolour] |
||||
set bd [dict get $argd opts -bordercolour] |
||||
set h [dict get $argd opts -height] |
||||
set w [dict get $argd opts -width] |
||||
set f [dict get $argd opts -frametype] |
||||
|
||||
#a frame will usually be filled with empty spaces if content not specified |
||||
#fill the frame with a non-space so we can do transparent overtypes using ordinary space as the transparency character |
||||
set w_in [expr {$w -2}] |
||||
set h_in [expr {$h -2}] |
||||
if {$w_in > 0 && $h_in > 0} { |
||||
set inner [textblock::block $w_in $h_in \u00a0] ;#NBSP |
||||
textblock::frame -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] $inner |
||||
} else { |
||||
#important to use no content arg - as empty string has 'height' of 1 in the textblock context (min height of any string is 1 row in the console) |
||||
textblock::frame -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] |
||||
} |
||||
|
||||
} |
||||
proc hbar {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
set defaults [dict create\ |
||||
-height 2\ |
||||
-width 12\ |
||||
-frametype $ft\ |
||||
] |
||||
set opts [dict merge $defaults $args] |
||||
block {*}$opts |
||||
} |
||||
proc vbar {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
#default height a multiple of default hbar/block height |
||||
set defaults [dict create\ |
||||
-height 6\ |
||||
-width 4\ |
||||
-frametype $ft\ |
||||
] |
||||
set opts [dict merge $defaults $args] |
||||
[namespace current]::block {*}$opts |
||||
} |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::blockletter::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval punk::blockletter::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::blockletter [tcl::namespace::eval punk::blockletter { |
||||
variable pkg punk::blockletter |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
@ -0,0 +1,3 @@
|
||||
0.1.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
@ -0,0 +1,74 @@
|
||||
# paths.tcl -- |
||||
# |
||||
# Manage lists of search paths. |
||||
# |
||||
# Copyright (c) 2009-2019 Andreas Kupries <andreas_kupries@sourceforge.net> |
||||
# |
||||
# See the file "license.terms" for information on usage and redistribution |
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
||||
|
||||
# Each object instance manages a list of paths. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Requisites |
||||
|
||||
package require Tcl 8.4 |
||||
package require snit |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## API |
||||
|
||||
snit::type ::fileutil::paths { |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Options :: None |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Creation, destruction |
||||
|
||||
# Default constructor. |
||||
# Default destructor. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Methods :: Querying and manipulating the list of paths. |
||||
|
||||
method paths {} { |
||||
return $mypaths |
||||
} |
||||
|
||||
method add {path} { |
||||
set pos [lsearch $mypaths $path] |
||||
if {$pos >= 0 } return |
||||
lappend mypaths $path |
||||
return |
||||
} |
||||
|
||||
method remove {path} { |
||||
set pos [lsearch $mypaths $path] |
||||
if {$pos < 0} return |
||||
set mypaths [lreplace $mypaths $pos $pos] |
||||
return |
||||
} |
||||
|
||||
method clear {} { |
||||
set mypaths {} |
||||
return |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Internal methods :: None |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## State :: List of paths. |
||||
|
||||
variable mypaths {} |
||||
|
||||
## |
||||
# ### ### ### ######### ######### ######### |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Ready |
||||
|
||||
package provide fileutil::paths 1 |
||||
return |
||||
@ -0,0 +1,504 @@
|
||||
# traverse.tcl -- |
||||
# |
||||
# Directory traversal. |
||||
# |
||||
# Copyright (c) 2006-2015 by Andreas Kupries <andreas_kupries@users.sourceforge.net> |
||||
# |
||||
# See the file "license.terms" for information on usage and redistribution |
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
||||
|
||||
package require Tcl 8.3 |
||||
|
||||
# OO core |
||||
if {[package vsatisfies [package present Tcl] 8.5]} { |
||||
# Use new Tcl 8.5a6+ features to specify the allowed packages. |
||||
# We can use anything above 1.3. This means v2 as well. |
||||
package require snit 1.3- |
||||
} else { |
||||
# For Tcl 8.{3,4} only snit1 of a suitable patchlevel is possible. |
||||
package require snit 1.3 |
||||
} |
||||
package require control ; # Helpers for control structures |
||||
package require fileutil ; # -> fullnormalize |
||||
|
||||
snit::type ::fileutil::traverse { |
||||
|
||||
# Incremental directory traversal. |
||||
|
||||
# API |
||||
# create %AUTO% basedirectory options... -> object |
||||
# next filevar -> boolean |
||||
# foreach filevar script |
||||
# files -> list (path ...) |
||||
|
||||
# Options |
||||
# -prefilter command-prefix |
||||
# -filter command-prefix |
||||
# -errorcmd command-prefix |
||||
|
||||
# Use cases |
||||
# |
||||
# (a) Basic incremental |
||||
# - Create and configure a traversal object. |
||||
# - Execute 'next' to retrieve one path at a time, |
||||
# until the command returns False, signaling that |
||||
# the iterator has exhausted the supply of paths. |
||||
# (The path is stored in the named variable). |
||||
# |
||||
# The execution of 'next' can be done in a loop, or via event |
||||
# processing. |
||||
|
||||
# (b) Basic loop |
||||
# - Create and configure a traversal object. |
||||
# - Run a script for each path, using 'foreach'. |
||||
# This is a convenient standard wrapper around 'next'. |
||||
# |
||||
# The loop properly handles all possible Tcl result codes. |
||||
|
||||
# (c) Non-incremental, non-looping. |
||||
# - Create and configure a traversal object. |
||||
# - Retrieve a list of all paths via 'files'. |
||||
|
||||
# The -prefilter callback is executed for directories. Its result |
||||
# determines if the traverser recurses into the directory or not. |
||||
# The default is to always recurse into all directories. The call- |
||||
# back is invoked with a single argument, the path of the |
||||
# directory. |
||||
# |
||||
# The -filter callback is executed for all paths. Its result |
||||
# determines if the current path is a valid result, and returned |
||||
# by 'next'. The default is to accept all paths as valid. The |
||||
# callback is invoked with a single argument, the path to check. |
||||
|
||||
# The -errorcmd callback is executed for all paths the traverser |
||||
# has trouble with. Like being unable to cd into them, get their |
||||
# status, etc. The default is to ignore any such problems. The |
||||
# callback is invoked with a two arguments, the path for which the |
||||
# error occured, and the error message. Errors thrown by the |
||||
# filter callbacks are handled through this callback too. Errors |
||||
# thrown by the error callback itself are not caught and ignored, |
||||
# but allowed to pass to the caller, usually of 'next'. |
||||
|
||||
# Note: Low-level functionality, version and platform dependent is |
||||
# implemented in procedures, and conditioally defined for optimal |
||||
# use of features, etc. ... |
||||
|
||||
# Note: Traversal is done in depth-first pre-order. |
||||
|
||||
# Note: The options are handled only during |
||||
# construction. Afterward they are read-only and attempts to |
||||
# modify them will cause the system to throw errors. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Implementation |
||||
|
||||
option -filter -default {} -readonly 1 |
||||
option -prefilter -default {} -readonly 1 |
||||
option -errorcmd -default {} -readonly 1 |
||||
|
||||
constructor {basedir args} { |
||||
set _base $basedir |
||||
$self configurelist $args |
||||
return |
||||
} |
||||
|
||||
method files {} { |
||||
set files {} |
||||
$self foreach f {lappend files $f} |
||||
return $files |
||||
} |
||||
|
||||
method foreach {fvar body} { |
||||
upvar 1 $fvar currentfile |
||||
|
||||
# (Re-)initialize the traversal state on every call. |
||||
$self Init |
||||
|
||||
while {[$self next currentfile]} { |
||||
set code [catch {uplevel 1 $body} result] |
||||
|
||||
# decide what to do upon the return code: |
||||
# |
||||
# 0 - the body executed successfully |
||||
# 1 - the body raised an error |
||||
# 2 - the body invoked [return] |
||||
# 3 - the body invoked [break] |
||||
# 4 - the body invoked [continue] |
||||
# everything else - return and pass on the results |
||||
# |
||||
switch -exact -- $code { |
||||
0 {} |
||||
1 { |
||||
return -errorinfo [::control::ErrorInfoAsCaller uplevel foreach] \ |
||||
-errorcode $::errorCode -code error $result |
||||
} |
||||
3 { |
||||
# FRINK: nocheck |
||||
return |
||||
} |
||||
4 {} |
||||
default { |
||||
return -code $code $result |
||||
} |
||||
} |
||||
} |
||||
return |
||||
} |
||||
|
||||
method next {fvar} { |
||||
upvar 1 $fvar currentfile |
||||
|
||||
# Initialize on first call. |
||||
if {!$_init} { |
||||
$self Init |
||||
} |
||||
|
||||
# We (still) have valid paths in the result stack, return the |
||||
# next one. |
||||
|
||||
if {[llength $_results]} { |
||||
set top [lindex $_results end] |
||||
set _results [lreplace $_results end end] |
||||
set currentfile $top |
||||
return 1 |
||||
} |
||||
|
||||
# Take the next directory waiting in the processing stack and |
||||
# fill the result stack with all valid files and sub- |
||||
# directories contained in it. Extend the processing queue |
||||
# with all sub-directories not yet seen already (!circular |
||||
# symlinks) and accepted by the prefilter. We stop iterating |
||||
# when we either have no directories to process anymore, or |
||||
# the result stack contains at least one path we can return. |
||||
|
||||
while {[llength $_pending]} { |
||||
set top [lindex $_pending end] |
||||
set _pending [lreplace $_pending end end] |
||||
|
||||
# Directory accessible? Skip if not. |
||||
if {![ACCESS $top]} { |
||||
Error $top "Inacessible directory" |
||||
continue |
||||
} |
||||
|
||||
# Expand the result stack with all files in the directory, |
||||
# modulo filtering. |
||||
|
||||
foreach f [GLOBF $top] { |
||||
if {![Valid $f]} continue |
||||
lappend _results $f |
||||
} |
||||
|
||||
# Expand the result stack with all sub-directories in the |
||||
# directory, modulo filtering. Further expand the |
||||
# processing stack with the same directories, if not seen |
||||
# yet and modulo pre-filtering. |
||||
|
||||
foreach f [GLOBD $top] { |
||||
if { |
||||
[string equal [file tail $f] "."] || |
||||
[string equal [file tail $f] ".."] |
||||
} continue |
||||
|
||||
if {[Valid $f]} { |
||||
lappend _results $f |
||||
} |
||||
|
||||
Enter $top $f |
||||
if {[Cycle $f]} continue |
||||
|
||||
if {[Recurse $f]} { |
||||
lappend _pending $f |
||||
} |
||||
} |
||||
|
||||
# Stop expanding if we have paths to return. |
||||
|
||||
if {[llength $_results]} { |
||||
set top [lindex $_results end] |
||||
set _results [lreplace $_results end end] |
||||
set currentfile $top |
||||
return 1 |
||||
} |
||||
} |
||||
|
||||
# Allow re-initialization with next call. |
||||
|
||||
set _init 0 |
||||
return 0 |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Traversal state |
||||
|
||||
# * Initialization flag. Checked in 'next', reset by next when no |
||||
# more files are available. Set in 'Init'. |
||||
# * Base directory (or file) to start the traversal from. |
||||
# * Stack of prefiltered unknown directories waiting for |
||||
# processing, i.e. expansion (TOP at end). |
||||
# * Stack of valid paths waiting to be returned as results. |
||||
# * Set of directories already visited (normalized paths), for |
||||
# detection of circular symbolic links. |
||||
|
||||
variable _init 0 ; # Initialization flag. |
||||
variable _base {} ; # Base directory. |
||||
variable _pending {} ; # Processing stack. |
||||
variable _results {} ; # Result stack. |
||||
|
||||
# sym link handling (to break cycles, while allowing the following of non-cycle links). |
||||
# Notes |
||||
# - path parent tracking is lexical. |
||||
# - path identity tracking is based on the normalized path, i.e. the path with all |
||||
# symlinks resolved. |
||||
# Maps |
||||
# - path -> parent (easier to follow the list than doing dirname's) |
||||
# - path -> normalized (cache to avoid redundant calls of fullnormalize) |
||||
# cycle <=> A parent's normalized form (NF) is identical to the current path's NF |
||||
|
||||
variable _parent -array {} |
||||
variable _norm -array {} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Internal helpers. |
||||
|
||||
proc Enter {parent path} { |
||||
#puts ___E|$path |
||||
upvar 1 _parent _parent _norm _norm |
||||
set _parent($path) $parent |
||||
set _norm($path) [fileutil::fullnormalize $path] |
||||
} |
||||
|
||||
proc Cycle {path} { |
||||
upvar 1 _parent _parent _norm _norm |
||||
set nform $_norm($path) |
||||
set paren $_parent($path) |
||||
while {$paren ne {}} { |
||||
if {$_norm($paren) eq $nform} { return yes } |
||||
set paren $_parent($paren) |
||||
} |
||||
return no |
||||
} |
||||
|
||||
method Init {} { |
||||
array unset _parent * |
||||
array unset _norm * |
||||
|
||||
# Path ok as result? |
||||
if {[Valid $_base]} { |
||||
lappend _results $_base |
||||
} |
||||
|
||||
# Expansion allowed by prefilter? |
||||
if {[file isdirectory $_base] && [Recurse $_base]} { |
||||
Enter {} $_base |
||||
lappend _pending $_base |
||||
} |
||||
|
||||
# System is set up now. |
||||
set _init 1 |
||||
return |
||||
} |
||||
|
||||
proc Valid {path} { |
||||
#puts ___V|$path |
||||
upvar 1 options options |
||||
if {![llength $options(-filter)]} {return 1} |
||||
set path [file normalize $path] |
||||
set code [catch {uplevel \#0 [linsert $options(-filter) end $path]} valid] |
||||
if {!$code} {return $valid} |
||||
Error $path $valid |
||||
return 0 |
||||
} |
||||
|
||||
proc Recurse {path} { |
||||
#puts ___X|$path |
||||
upvar 1 options options _norm _norm |
||||
if {![llength $options(-prefilter)]} {return 1} |
||||
set path [file normalize $path] |
||||
set code [catch {uplevel \#0 [linsert $options(-prefilter) end $path]} valid] |
||||
if {!$code} {return $valid} |
||||
Error $path $valid |
||||
return 0 |
||||
} |
||||
|
||||
proc Error {path msg} { |
||||
upvar 1 options options |
||||
if {![llength $options(-errorcmd)]} return |
||||
set path [file normalize $path] |
||||
uplevel \#0 [linsert $options(-errorcmd) end $path $msg] |
||||
return |
||||
} |
||||
|
||||
## |
||||
# ### ### ### ######### ######### ######### |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## |
||||
|
||||
# The next three helper commands for the traverser depend strongly on |
||||
# the version of Tcl, and partially on the platform. |
||||
|
||||
# 1. In Tcl 8.3 using -types f will return only true files, but not |
||||
# links to files. This changed in 8.4+ where links to files are |
||||
# returned as well. So for 8.3 we have to handle the links |
||||
# separately (-types l) and also filter on our own. |
||||
# Note that Windows file links are hard links which are reported by |
||||
# -types f, but not -types l, so we can optimize that for the two |
||||
# platforms. |
||||
# |
||||
# 2. In Tcl 8.3 we also have a crashing bug in glob (SIGABRT, "stat on |
||||
# a known file") when trying to perform 'glob -types {hidden f}' on |
||||
# a directory without e'x'ecute permissions. We code around by |
||||
# testing if we can cd into the directory (stat might return enough |
||||
# information too (mode), but possibly also not portable). |
||||
# |
||||
# For Tcl 8.2 and 8.4+ glob simply delivers an empty result |
||||
# (-nocomplain), without crashing. For them this command is defined |
||||
# so that the bytecode compiler removes it from the bytecode. |
||||
# |
||||
# This bug made the ACCESS helper necessary. |
||||
# We code around the problem by testing if we can cd into the |
||||
# directory (stat might return enough information too (mode), but |
||||
# possibly also not portable). |
||||
|
||||
if {[package vsatisfies [package present Tcl] 8.5]} { |
||||
# Tcl 8.5+. |
||||
# We have to check readability of "current" on our own, glob |
||||
# changed to error out instead of returning nothing. |
||||
|
||||
proc ::fileutil::traverse::ACCESS {args} {return 1} |
||||
|
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
if {![file readable $current] || |
||||
[BadLink $current]} { |
||||
return {} |
||||
} |
||||
|
||||
set res [lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]]] |
||||
|
||||
# Look for broken links (They are reported as neither file nor directory). |
||||
foreach l [lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]]] { |
||||
if {[file isfile $l]} continue |
||||
if {[file isdirectory $l]} continue |
||||
lappend res $l |
||||
} |
||||
return [lsort -unique $res] |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
if {![file readable $current] || |
||||
[BadLink $current]} { |
||||
return {} |
||||
} |
||||
|
||||
lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *]] |
||||
} |
||||
|
||||
proc ::fileutil::traverse::BadLink {current} { |
||||
if {[file type $current] ne "link"} { return no } |
||||
|
||||
set dst [file join [file dirname $current] [file readlink $current]] |
||||
|
||||
if {![file exists $dst] || |
||||
![file readable $dst]} { |
||||
return yes |
||||
} |
||||
|
||||
return no |
||||
} |
||||
|
||||
} elseif {[package vsatisfies [package present Tcl] 8.4]} { |
||||
# Tcl 8.4+. |
||||
# (Ad 1) We have -directory, and -types, |
||||
# (Ad 2) Links are returned for -types f/d if they refer to files/dirs. |
||||
# (Ad 3) No bug to code around |
||||
|
||||
proc ::fileutil::traverse::ACCESS {args} {return 1} |
||||
|
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
set res [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
|
||||
# Look for broken links (They are reported as neither file nor directory). |
||||
foreach l [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *] ] { |
||||
if {[file isfile $l]} continue |
||||
if {[file isdirectory $l]} continue |
||||
lappend res $l |
||||
} |
||||
return $res |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *] |
||||
} |
||||
|
||||
} else { |
||||
# 8.3. |
||||
# (Ad 1) We have -directory, and -types, |
||||
# (Ad 2) Links are NOT returned for -types f/d, collect separately. |
||||
# No symbolic file links on Windows. |
||||
# (Ad 3) Bug to code around. |
||||
|
||||
proc ::fileutil::traverse::ACCESS {current} { |
||||
if {[catch { |
||||
set h [pwd] ; cd $current ; cd $h |
||||
}]} {return 0} |
||||
return 1 |
||||
} |
||||
|
||||
if {[string equal $::tcl_platform(platform) windows]} { |
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
} |
||||
} else { |
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
set l [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
|
||||
foreach x [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]] { |
||||
if {[file isdirectory $x]} continue |
||||
# We have now accepted files, links to files, and broken links. |
||||
lappend l $x |
||||
} |
||||
|
||||
return $l |
||||
} |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
set l [concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *]] |
||||
|
||||
foreach x [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]] { |
||||
if {![file isdirectory $x]} continue |
||||
lappend l $x |
||||
} |
||||
|
||||
return $l |
||||
} |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Ready |
||||
|
||||
package provide fileutil::traverse 0.6 |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,74 @@
|
||||
# paths.tcl -- |
||||
# |
||||
# Manage lists of search paths. |
||||
# |
||||
# Copyright (c) 2009-2019 Andreas Kupries <andreas_kupries@sourceforge.net> |
||||
# |
||||
# See the file "license.terms" for information on usage and redistribution |
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
||||
|
||||
# Each object instance manages a list of paths. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Requisites |
||||
|
||||
package require Tcl 8.4 |
||||
package require snit |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## API |
||||
|
||||
snit::type ::fileutil::paths { |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Options :: None |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Creation, destruction |
||||
|
||||
# Default constructor. |
||||
# Default destructor. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Methods :: Querying and manipulating the list of paths. |
||||
|
||||
method paths {} { |
||||
return $mypaths |
||||
} |
||||
|
||||
method add {path} { |
||||
set pos [lsearch $mypaths $path] |
||||
if {$pos >= 0 } return |
||||
lappend mypaths $path |
||||
return |
||||
} |
||||
|
||||
method remove {path} { |
||||
set pos [lsearch $mypaths $path] |
||||
if {$pos < 0} return |
||||
set mypaths [lreplace $mypaths $pos $pos] |
||||
return |
||||
} |
||||
|
||||
method clear {} { |
||||
set mypaths {} |
||||
return |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Internal methods :: None |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## State :: List of paths. |
||||
|
||||
variable mypaths {} |
||||
|
||||
## |
||||
# ### ### ### ######### ######### ######### |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Ready |
||||
|
||||
package provide fileutil::paths 1 |
||||
return |
||||
@ -0,0 +1,504 @@
|
||||
# traverse.tcl -- |
||||
# |
||||
# Directory traversal. |
||||
# |
||||
# Copyright (c) 2006-2015 by Andreas Kupries <andreas_kupries@users.sourceforge.net> |
||||
# |
||||
# See the file "license.terms" for information on usage and redistribution |
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
||||
|
||||
package require Tcl 8.3 |
||||
|
||||
# OO core |
||||
if {[package vsatisfies [package present Tcl] 8.5]} { |
||||
# Use new Tcl 8.5a6+ features to specify the allowed packages. |
||||
# We can use anything above 1.3. This means v2 as well. |
||||
package require snit 1.3- |
||||
} else { |
||||
# For Tcl 8.{3,4} only snit1 of a suitable patchlevel is possible. |
||||
package require snit 1.3 |
||||
} |
||||
package require control ; # Helpers for control structures |
||||
package require fileutil ; # -> fullnormalize |
||||
|
||||
snit::type ::fileutil::traverse { |
||||
|
||||
# Incremental directory traversal. |
||||
|
||||
# API |
||||
# create %AUTO% basedirectory options... -> object |
||||
# next filevar -> boolean |
||||
# foreach filevar script |
||||
# files -> list (path ...) |
||||
|
||||
# Options |
||||
# -prefilter command-prefix |
||||
# -filter command-prefix |
||||
# -errorcmd command-prefix |
||||
|
||||
# Use cases |
||||
# |
||||
# (a) Basic incremental |
||||
# - Create and configure a traversal object. |
||||
# - Execute 'next' to retrieve one path at a time, |
||||
# until the command returns False, signaling that |
||||
# the iterator has exhausted the supply of paths. |
||||
# (The path is stored in the named variable). |
||||
# |
||||
# The execution of 'next' can be done in a loop, or via event |
||||
# processing. |
||||
|
||||
# (b) Basic loop |
||||
# - Create and configure a traversal object. |
||||
# - Run a script for each path, using 'foreach'. |
||||
# This is a convenient standard wrapper around 'next'. |
||||
# |
||||
# The loop properly handles all possible Tcl result codes. |
||||
|
||||
# (c) Non-incremental, non-looping. |
||||
# - Create and configure a traversal object. |
||||
# - Retrieve a list of all paths via 'files'. |
||||
|
||||
# The -prefilter callback is executed for directories. Its result |
||||
# determines if the traverser recurses into the directory or not. |
||||
# The default is to always recurse into all directories. The call- |
||||
# back is invoked with a single argument, the path of the |
||||
# directory. |
||||
# |
||||
# The -filter callback is executed for all paths. Its result |
||||
# determines if the current path is a valid result, and returned |
||||
# by 'next'. The default is to accept all paths as valid. The |
||||
# callback is invoked with a single argument, the path to check. |
||||
|
||||
# The -errorcmd callback is executed for all paths the traverser |
||||
# has trouble with. Like being unable to cd into them, get their |
||||
# status, etc. The default is to ignore any such problems. The |
||||
# callback is invoked with a two arguments, the path for which the |
||||
# error occured, and the error message. Errors thrown by the |
||||
# filter callbacks are handled through this callback too. Errors |
||||
# thrown by the error callback itself are not caught and ignored, |
||||
# but allowed to pass to the caller, usually of 'next'. |
||||
|
||||
# Note: Low-level functionality, version and platform dependent is |
||||
# implemented in procedures, and conditioally defined for optimal |
||||
# use of features, etc. ... |
||||
|
||||
# Note: Traversal is done in depth-first pre-order. |
||||
|
||||
# Note: The options are handled only during |
||||
# construction. Afterward they are read-only and attempts to |
||||
# modify them will cause the system to throw errors. |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Implementation |
||||
|
||||
option -filter -default {} -readonly 1 |
||||
option -prefilter -default {} -readonly 1 |
||||
option -errorcmd -default {} -readonly 1 |
||||
|
||||
constructor {basedir args} { |
||||
set _base $basedir |
||||
$self configurelist $args |
||||
return |
||||
} |
||||
|
||||
method files {} { |
||||
set files {} |
||||
$self foreach f {lappend files $f} |
||||
return $files |
||||
} |
||||
|
||||
method foreach {fvar body} { |
||||
upvar 1 $fvar currentfile |
||||
|
||||
# (Re-)initialize the traversal state on every call. |
||||
$self Init |
||||
|
||||
while {[$self next currentfile]} { |
||||
set code [catch {uplevel 1 $body} result] |
||||
|
||||
# decide what to do upon the return code: |
||||
# |
||||
# 0 - the body executed successfully |
||||
# 1 - the body raised an error |
||||
# 2 - the body invoked [return] |
||||
# 3 - the body invoked [break] |
||||
# 4 - the body invoked [continue] |
||||
# everything else - return and pass on the results |
||||
# |
||||
switch -exact -- $code { |
||||
0 {} |
||||
1 { |
||||
return -errorinfo [::control::ErrorInfoAsCaller uplevel foreach] \ |
||||
-errorcode $::errorCode -code error $result |
||||
} |
||||
3 { |
||||
# FRINK: nocheck |
||||
return |
||||
} |
||||
4 {} |
||||
default { |
||||
return -code $code $result |
||||
} |
||||
} |
||||
} |
||||
return |
||||
} |
||||
|
||||
method next {fvar} { |
||||
upvar 1 $fvar currentfile |
||||
|
||||
# Initialize on first call. |
||||
if {!$_init} { |
||||
$self Init |
||||
} |
||||
|
||||
# We (still) have valid paths in the result stack, return the |
||||
# next one. |
||||
|
||||
if {[llength $_results]} { |
||||
set top [lindex $_results end] |
||||
set _results [lreplace $_results end end] |
||||
set currentfile $top |
||||
return 1 |
||||
} |
||||
|
||||
# Take the next directory waiting in the processing stack and |
||||
# fill the result stack with all valid files and sub- |
||||
# directories contained in it. Extend the processing queue |
||||
# with all sub-directories not yet seen already (!circular |
||||
# symlinks) and accepted by the prefilter. We stop iterating |
||||
# when we either have no directories to process anymore, or |
||||
# the result stack contains at least one path we can return. |
||||
|
||||
while {[llength $_pending]} { |
||||
set top [lindex $_pending end] |
||||
set _pending [lreplace $_pending end end] |
||||
|
||||
# Directory accessible? Skip if not. |
||||
if {![ACCESS $top]} { |
||||
Error $top "Inacessible directory" |
||||
continue |
||||
} |
||||
|
||||
# Expand the result stack with all files in the directory, |
||||
# modulo filtering. |
||||
|
||||
foreach f [GLOBF $top] { |
||||
if {![Valid $f]} continue |
||||
lappend _results $f |
||||
} |
||||
|
||||
# Expand the result stack with all sub-directories in the |
||||
# directory, modulo filtering. Further expand the |
||||
# processing stack with the same directories, if not seen |
||||
# yet and modulo pre-filtering. |
||||
|
||||
foreach f [GLOBD $top] { |
||||
if { |
||||
[string equal [file tail $f] "."] || |
||||
[string equal [file tail $f] ".."] |
||||
} continue |
||||
|
||||
if {[Valid $f]} { |
||||
lappend _results $f |
||||
} |
||||
|
||||
Enter $top $f |
||||
if {[Cycle $f]} continue |
||||
|
||||
if {[Recurse $f]} { |
||||
lappend _pending $f |
||||
} |
||||
} |
||||
|
||||
# Stop expanding if we have paths to return. |
||||
|
||||
if {[llength $_results]} { |
||||
set top [lindex $_results end] |
||||
set _results [lreplace $_results end end] |
||||
set currentfile $top |
||||
return 1 |
||||
} |
||||
} |
||||
|
||||
# Allow re-initialization with next call. |
||||
|
||||
set _init 0 |
||||
return 0 |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Traversal state |
||||
|
||||
# * Initialization flag. Checked in 'next', reset by next when no |
||||
# more files are available. Set in 'Init'. |
||||
# * Base directory (or file) to start the traversal from. |
||||
# * Stack of prefiltered unknown directories waiting for |
||||
# processing, i.e. expansion (TOP at end). |
||||
# * Stack of valid paths waiting to be returned as results. |
||||
# * Set of directories already visited (normalized paths), for |
||||
# detection of circular symbolic links. |
||||
|
||||
variable _init 0 ; # Initialization flag. |
||||
variable _base {} ; # Base directory. |
||||
variable _pending {} ; # Processing stack. |
||||
variable _results {} ; # Result stack. |
||||
|
||||
# sym link handling (to break cycles, while allowing the following of non-cycle links). |
||||
# Notes |
||||
# - path parent tracking is lexical. |
||||
# - path identity tracking is based on the normalized path, i.e. the path with all |
||||
# symlinks resolved. |
||||
# Maps |
||||
# - path -> parent (easier to follow the list than doing dirname's) |
||||
# - path -> normalized (cache to avoid redundant calls of fullnormalize) |
||||
# cycle <=> A parent's normalized form (NF) is identical to the current path's NF |
||||
|
||||
variable _parent -array {} |
||||
variable _norm -array {} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Internal helpers. |
||||
|
||||
proc Enter {parent path} { |
||||
#puts ___E|$path |
||||
upvar 1 _parent _parent _norm _norm |
||||
set _parent($path) $parent |
||||
set _norm($path) [fileutil::fullnormalize $path] |
||||
} |
||||
|
||||
proc Cycle {path} { |
||||
upvar 1 _parent _parent _norm _norm |
||||
set nform $_norm($path) |
||||
set paren $_parent($path) |
||||
while {$paren ne {}} { |
||||
if {$_norm($paren) eq $nform} { return yes } |
||||
set paren $_parent($paren) |
||||
} |
||||
return no |
||||
} |
||||
|
||||
method Init {} { |
||||
array unset _parent * |
||||
array unset _norm * |
||||
|
||||
# Path ok as result? |
||||
if {[Valid $_base]} { |
||||
lappend _results $_base |
||||
} |
||||
|
||||
# Expansion allowed by prefilter? |
||||
if {[file isdirectory $_base] && [Recurse $_base]} { |
||||
Enter {} $_base |
||||
lappend _pending $_base |
||||
} |
||||
|
||||
# System is set up now. |
||||
set _init 1 |
||||
return |
||||
} |
||||
|
||||
proc Valid {path} { |
||||
#puts ___V|$path |
||||
upvar 1 options options |
||||
if {![llength $options(-filter)]} {return 1} |
||||
set path [file normalize $path] |
||||
set code [catch {uplevel \#0 [linsert $options(-filter) end $path]} valid] |
||||
if {!$code} {return $valid} |
||||
Error $path $valid |
||||
return 0 |
||||
} |
||||
|
||||
proc Recurse {path} { |
||||
#puts ___X|$path |
||||
upvar 1 options options _norm _norm |
||||
if {![llength $options(-prefilter)]} {return 1} |
||||
set path [file normalize $path] |
||||
set code [catch {uplevel \#0 [linsert $options(-prefilter) end $path]} valid] |
||||
if {!$code} {return $valid} |
||||
Error $path $valid |
||||
return 0 |
||||
} |
||||
|
||||
proc Error {path msg} { |
||||
upvar 1 options options |
||||
if {![llength $options(-errorcmd)]} return |
||||
set path [file normalize $path] |
||||
uplevel \#0 [linsert $options(-errorcmd) end $path $msg] |
||||
return |
||||
} |
||||
|
||||
## |
||||
# ### ### ### ######### ######### ######### |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## |
||||
|
||||
# The next three helper commands for the traverser depend strongly on |
||||
# the version of Tcl, and partially on the platform. |
||||
|
||||
# 1. In Tcl 8.3 using -types f will return only true files, but not |
||||
# links to files. This changed in 8.4+ where links to files are |
||||
# returned as well. So for 8.3 we have to handle the links |
||||
# separately (-types l) and also filter on our own. |
||||
# Note that Windows file links are hard links which are reported by |
||||
# -types f, but not -types l, so we can optimize that for the two |
||||
# platforms. |
||||
# |
||||
# 2. In Tcl 8.3 we also have a crashing bug in glob (SIGABRT, "stat on |
||||
# a known file") when trying to perform 'glob -types {hidden f}' on |
||||
# a directory without e'x'ecute permissions. We code around by |
||||
# testing if we can cd into the directory (stat might return enough |
||||
# information too (mode), but possibly also not portable). |
||||
# |
||||
# For Tcl 8.2 and 8.4+ glob simply delivers an empty result |
||||
# (-nocomplain), without crashing. For them this command is defined |
||||
# so that the bytecode compiler removes it from the bytecode. |
||||
# |
||||
# This bug made the ACCESS helper necessary. |
||||
# We code around the problem by testing if we can cd into the |
||||
# directory (stat might return enough information too (mode), but |
||||
# possibly also not portable). |
||||
|
||||
if {[package vsatisfies [package present Tcl] 8.5]} { |
||||
# Tcl 8.5+. |
||||
# We have to check readability of "current" on our own, glob |
||||
# changed to error out instead of returning nothing. |
||||
|
||||
proc ::fileutil::traverse::ACCESS {args} {return 1} |
||||
|
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
if {![file readable $current] || |
||||
[BadLink $current]} { |
||||
return {} |
||||
} |
||||
|
||||
set res [lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]]] |
||||
|
||||
# Look for broken links (They are reported as neither file nor directory). |
||||
foreach l [lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]]] { |
||||
if {[file isfile $l]} continue |
||||
if {[file isdirectory $l]} continue |
||||
lappend res $l |
||||
} |
||||
return [lsort -unique $res] |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
if {![file readable $current] || |
||||
[BadLink $current]} { |
||||
return {} |
||||
} |
||||
|
||||
lsort -unique [concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *]] |
||||
} |
||||
|
||||
proc ::fileutil::traverse::BadLink {current} { |
||||
if {[file type $current] ne "link"} { return no } |
||||
|
||||
set dst [file join [file dirname $current] [file readlink $current]] |
||||
|
||||
if {![file exists $dst] || |
||||
![file readable $dst]} { |
||||
return yes |
||||
} |
||||
|
||||
return no |
||||
} |
||||
|
||||
} elseif {[package vsatisfies [package present Tcl] 8.4]} { |
||||
# Tcl 8.4+. |
||||
# (Ad 1) We have -directory, and -types, |
||||
# (Ad 2) Links are returned for -types f/d if they refer to files/dirs. |
||||
# (Ad 3) No bug to code around |
||||
|
||||
proc ::fileutil::traverse::ACCESS {args} {return 1} |
||||
|
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
set res [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
|
||||
# Look for broken links (They are reported as neither file nor directory). |
||||
foreach l [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *] ] { |
||||
if {[file isfile $l]} continue |
||||
if {[file isdirectory $l]} continue |
||||
lappend res $l |
||||
} |
||||
return $res |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *] |
||||
} |
||||
|
||||
} else { |
||||
# 8.3. |
||||
# (Ad 1) We have -directory, and -types, |
||||
# (Ad 2) Links are NOT returned for -types f/d, collect separately. |
||||
# No symbolic file links on Windows. |
||||
# (Ad 3) Bug to code around. |
||||
|
||||
proc ::fileutil::traverse::ACCESS {current} { |
||||
if {[catch { |
||||
set h [pwd] ; cd $current ; cd $h |
||||
}]} {return 0} |
||||
return 1 |
||||
} |
||||
|
||||
if {[string equal $::tcl_platform(platform) windows]} { |
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
} |
||||
} else { |
||||
proc ::fileutil::traverse::GLOBF {current} { |
||||
set l [concat \ |
||||
[glob -nocomplain -directory $current -types f -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden f} -- *]] |
||||
|
||||
foreach x [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]] { |
||||
if {[file isdirectory $x]} continue |
||||
# We have now accepted files, links to files, and broken links. |
||||
lappend l $x |
||||
} |
||||
|
||||
return $l |
||||
} |
||||
} |
||||
|
||||
proc ::fileutil::traverse::GLOBD {current} { |
||||
set l [concat \ |
||||
[glob -nocomplain -directory $current -types d -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden d} -- *]] |
||||
|
||||
foreach x [concat \ |
||||
[glob -nocomplain -directory $current -types l -- *] \ |
||||
[glob -nocomplain -directory $current -types {hidden l} -- *]] { |
||||
if {![file isdirectory $x]} continue |
||||
lappend l $x |
||||
} |
||||
|
||||
return $l |
||||
} |
||||
} |
||||
|
||||
# ### ### ### ######### ######### ######### |
||||
## Ready |
||||
|
||||
package provide fileutil::traverse 0.6 |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,358 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix 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) 2024 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::blockletter 0.1.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_punk::blockletter 0 0.1.0] |
||||
#[copyright "2024"] |
||||
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||
#[require punk::blockletter] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of punk::blockletter |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by punk::blockletter |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
package require textblock |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package {textblock}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# oo::class namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#tcl::namespace::eval punk::blockletter::class { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::class}] |
||||
#[para] class definitions |
||||
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { |
||||
#*** !doctools |
||||
#[list_begin enumerated] |
||||
|
||||
# oo::class create interface_sample1 { |
||||
# #*** !doctools |
||||
# #[enum] CLASS [class interface_sample1] |
||||
# #[list_begin definitions] |
||||
|
||||
# method test {arg1} { |
||||
# #*** !doctools |
||||
# #[call class::interface_sample1 [method test] [arg arg1]] |
||||
# #[para] test method |
||||
# puts "test: $arg1" |
||||
# } |
||||
|
||||
# #*** !doctools |
||||
# #[list_end] [comment {-- end definitions interface_sample1}] |
||||
# } |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end class enumeration ---}] |
||||
#} |
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::blockletter { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
#variable xyz |
||||
|
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter}] |
||||
#[para] Core API functions for punk::blockletter |
||||
#[list_begin definitions] |
||||
|
||||
#A 3x4 block font |
||||
|
||||
variable default_frametype |
||||
set default_frametype {vl \u00a0 hl \u00a0 tlc \u00a0 trc \u00a0 blc \u00a0 brc \u00a0} |
||||
|
||||
# colours in order for T c l T k |
||||
set logo_letter_colours [list Web-red Web-green Web-royalblue Web-purple Web-orange] |
||||
set logo_letter_colours [list Red Green Blue Purple Yellow] |
||||
|
||||
|
||||
proc logo {args} { |
||||
variable logo_letter_colours |
||||
variable default_frametype |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-frametype -default {${$default_frametype}} |
||||
-outlinecolour -default "web-white" |
||||
-backgroundcolour -default {} -help "e.g Web-white |
||||
This argument is the name as accepted by punk::ansi::a+" |
||||
*values -min 0 -max 0 |
||||
}] $args] |
||||
set f [dict get $argd opts -frametype] |
||||
set bd [dict get $argd opts -outlinecolour] |
||||
set bgansi [dict get $argd opts -backgroundcolour] ;#we use ta::detect to see if already ansi and apply as necessary |
||||
|
||||
#standard red green blue purple yellow |
||||
lassign $logo_letter_colours c_0 c_1 c_2 c_3 c_4 |
||||
|
||||
set tc [merge_left_block [T -bg $c_0 -border $bd -frametype $f] [c -bg $c_1 -border $bd -frametype $f]] |
||||
set tk [merge_left_block [T -bg $c_3 -border $bd -frametype $f] [k_short -bg $c_4 -border $bd -frametype $f]] |
||||
set logo [textblock::join_basic -- $tc [l -bg $c_2 -border $bd -frametype $f] [textblock::block 2 8 " "] $tk] |
||||
if {$bgansi ne ""} { |
||||
lassign [textblock::size_as_list $logo] lwidth lheight |
||||
set w [expr {$lwidth + 2}] |
||||
set h [expr {$lheight + 2}] |
||||
if {![punk::ansi::ta::detect $bgansi]} { |
||||
set bgansi [punk::ansi::a+ $bgansi] |
||||
} |
||||
set logobg $bgansi[textblock::block $w $h " "][punk::ansi::a] |
||||
set topmargin [string repeat " " $w] |
||||
set lmargin [textblock::block 1 [expr {$h + 1}] " "] |
||||
set logo [overtype::left -transparent " " $logobg [textblock::join_basic -- $lmargin $topmargin\n$logo]] |
||||
} |
||||
return $logo |
||||
} |
||||
|
||||
#for characters where it makes sense - offset left by 4 (1 'block' width) |
||||
proc merge_left {charleft textright} { |
||||
if {[string length $charleft] != 1} { |
||||
error "merge_left requires a single character as the charleft argument" |
||||
} |
||||
if {[textblock::height $charleft$textright] > 1} { |
||||
error "merge_left only operates on a plain char and a plain string with no newlines" |
||||
} |
||||
set rhs [textblock::join_basic -- [textblock::block 8 8 " "] [text $textright]] |
||||
#important to explicitly use -transparent " " (ordinary space) rather than -transparent 1 (any space?) |
||||
#This is because our frames have NBSP as filler to be non-transparent |
||||
return [overtype::left -transparent " " -overflow 1 [text $charleft] $rhs] |
||||
} |
||||
proc merge_left_block {blockleft blockright} { |
||||
set rhs [textblock::join_basic -- [textblock::block 8 8 " "] $blockright] |
||||
return [overtype::left -transparent " " -overflow 1 $blockleft $rhs] |
||||
} |
||||
|
||||
proc T {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [lib::hbar {*}$args]\n |
||||
append out [textblock::join -- " " [lib::vbar {*}$args] " "] |
||||
} |
||||
proc c {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [textblock::block 12 2 " "]\n |
||||
append out [lib::hbar {*}$args]\n |
||||
append out [textblock::join -- [lib::block {*}$args] " "]\n |
||||
append out [lib::hbar {*}$args] |
||||
} |
||||
proc l {args} { |
||||
set args [dict remove $args -width -height] |
||||
append out [lib::vbar {*}[dict merge {-height 8} $args]] |
||||
} |
||||
|
||||
#full height lower k |
||||
proc k {args} { |
||||
set args [dict remove $args -width -height] |
||||
set left [lib::vbar {*}[dict merge {-height 8} $args]] |
||||
set centre [textblock::block 4 4 " "]\n |
||||
append centre [lib::block {*}$args]\n |
||||
append centre [textblock::block 4 2 " "] |
||||
set right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args]\n |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args] |
||||
append out [textblock::join_basic -- $left $centre $right] |
||||
} |
||||
proc k_short {args} { |
||||
set args [dict remove $args -width -height] |
||||
append left [textblock::block 4 2 " "]\n |
||||
append left [lib::vbar {*}[dict merge {-height 6} $args]] |
||||
append centre [textblock::block 4 4 " "]\n |
||||
append centre [lib::block {*}$args]\n |
||||
append centre [textblock::block 4 2 " "] |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args]\n |
||||
append right [textblock::block 4 2 " "]\n |
||||
append right [lib::block {*}$args] |
||||
append out [textblock::join_basic -- $left $centre $right] |
||||
} |
||||
|
||||
proc text {args} { |
||||
variable default_frametype |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-bgcolour -default "Web-red" |
||||
-bordercolour -default "web-white" |
||||
-frametype -default {${$default_frametype}} |
||||
*values -min 1 -max 1 |
||||
str -help "Text to convert to blockletters |
||||
Requires terminal font to support relevant block characters" |
||||
" |
||||
}] $args] |
||||
set opts [dict get $argd opts] |
||||
set str [dict get $argd values str] |
||||
set str [string map {\r\n \n} $str] |
||||
set outblocks [list] |
||||
set literals [list \n] |
||||
foreach char [split $str ""] { |
||||
if {$char in $literals} { |
||||
lappend outblocks $char |
||||
continue |
||||
} |
||||
if {$char in [list \t \r]} { |
||||
lappend outblocks [textblock::block 1 8 $char] |
||||
continue |
||||
} |
||||
if {[info commands ::punk::blockletter::$char] ne ""} { |
||||
lappend outblocks [::punk::blockletter::$char {*}$opts] |
||||
} else { |
||||
lappend outblocks [textblock::block 12 8 $char] |
||||
} |
||||
} |
||||
return [textblock::join_basic -- {*}$outblocks] |
||||
} |
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::blockletter ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::blockletter::lib { |
||||
|
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
tcl::namespace::path [tcl::namespace::parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::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 |
||||
#} |
||||
|
||||
proc block {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
set argd [punk::args::get_dict [tstr -return string { |
||||
-height -default 2 |
||||
-width -default 4 |
||||
-frametype -default {${$ft}} |
||||
-bgcolour -default "Web-red" |
||||
-bordercolour -default "web-white" |
||||
*values -min 0 -max 0 |
||||
}] $args] |
||||
set bg [dict get $argd opts -bgcolour] |
||||
set bd [dict get $argd opts -bordercolour] |
||||
set h [dict get $argd opts -height] |
||||
set w [dict get $argd opts -width] |
||||
set f [dict get $argd opts -frametype] |
||||
|
||||
#a frame will usually be filled with empty spaces if content not specified |
||||
#fill the frame with a non-space so we can do transparent overtypes using ordinary space as the transparency character |
||||
set w_in [expr {$w -2}] |
||||
set h_in [expr {$h -2}] |
||||
if {$w_in > 0 && $h_in > 0} { |
||||
set inner [textblock::block $w_in $h_in \u00a0] ;#NBSP |
||||
textblock::frame -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] $inner |
||||
} else { |
||||
#important to use no content arg - as empty string has 'height' of 1 in the textblock context (min height of any string is 1 row in the console) |
||||
textblock::frame -type $f -height $h -width $w -ansiborder [a+ $bd $bg] -ansibase [a+ $bg] |
||||
} |
||||
|
||||
} |
||||
proc hbar {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
set defaults [dict create\ |
||||
-height 2\ |
||||
-width 12\ |
||||
-frametype $ft\ |
||||
] |
||||
set opts [dict merge $defaults $args] |
||||
block {*}$opts |
||||
} |
||||
proc vbar {args} { |
||||
upvar ::punk::blockletter::default_frametype ft |
||||
#default height a multiple of default hbar/block height |
||||
set defaults [dict create\ |
||||
-height 6\ |
||||
-width 4\ |
||||
-frametype $ft\ |
||||
] |
||||
set opts [dict merge $defaults $args] |
||||
[namespace current]::block {*}$opts |
||||
} |
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::blockletter::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval punk::blockletter::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::blockletter::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::blockletter [tcl::namespace::eval punk::blockletter { |
||||
variable pkg punk::blockletter |
||||
variable version |
||||
set version 0.1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
Binary file not shown.
@ -0,0 +1,111 @@
|
||||
# Compiled Runtime In Tcl |
||||
|
||||
* Welcome to the C Runtime In Tcl, CriTcl for short, a system to |
||||
build C extension packages for Tcl on the fly, from C code |
||||
embedded within Tcl scripts, for all who wish to make their code |
||||
go faster. |
||||
|
||||
# Website |
||||
|
||||
* The main website of this project is http://andreas-kupries.github.io/critcl |
||||
|
||||
It provides access to pre-made binaries and archives for various |
||||
platforms, and the full documentation, especially the guides to |
||||
building and using Critcl. |
||||
|
||||
Because of the latter this document contains only the most basic |
||||
instructions on getting, building, and using Critcl. |
||||
|
||||
# Versions |
||||
|
||||
* Version 3 is the actively developed version of Critcl, with several |
||||
new features, listed in section **New Features**, below. This version |
||||
has changes to the public API which make it incompatible with packages |
||||
using Critcl version 2.x, or earlier. |
||||
|
||||
* The last of version 2 is 2.1, available at the same-named tag in the |
||||
repository. This version is not developed anymore. |
||||
|
||||
# Getting, Building, and Using Critcl |
||||
|
||||
* Retrieve the sources: |
||||
|
||||
```% git clone http://github.com/andreas-kupries/critcl``` |
||||
|
||||
Your working directory now contains a directory ```critcl```. |
||||
|
||||
* Build and install it: |
||||
|
||||
Install requisites: cmdline, md5; possibly one of tcllibc, Trf, md5c to accelerate md5. |
||||
|
||||
```% cd critcl``` |
||||
|
||||
```% tclsh ./build.tcl install``` |
||||
|
||||
The generated packages are placed into the **[info library]** directory |
||||
of the **tclsh** used to run build.tcl. The **critcl** application script |
||||
is put into the directory of the **tclsh** itself (and modified to |
||||
use this executable). This may require administrative (root) permissions, |
||||
depending on the system setup. |
||||
|
||||
* It is expected that a working C compiler is available. Installation and |
||||
setup of such a compiler is platform and vendor specific, and instructions |
||||
for doing so are very much outside of scope for this document. Please find |
||||
and read the documentation, how-tos, etc. for your platform or vendor. |
||||
|
||||
* With critcl installed try out one of the examples: |
||||
|
||||
```% cd examples/stack``` |
||||
|
||||
```% critcl -keep -cache B -pkg cstack.tcl``` |
||||
|
||||
```% critcl -keep -cache B -pkg stackc.tcl``` |
||||
|
||||
```% tclsh``` |
||||
|
||||
```> lappend auto_path [pwd]/lib``` |
||||
|
||||
```> package require stackc``` |
||||
|
||||
```> stackc create S``` |
||||
|
||||
```> S push FOO``` |
||||
|
||||
```> S size``` |
||||
|
||||
```> S destroy``` |
||||
|
||||
```> exit``` |
||||
|
||||
```%``` |
||||
|
||||
# New Features |
||||
|
||||
* Declaration, export and import of C-APIs through stubs tables. |
||||
|
||||
* Generation of source packages from critcl-based code containing a |
||||
TEA-based buildsystem wrapped around the raw critcl. |
||||
|
||||
* Declaration, initializaton and use of user-specified configuration |
||||
options. An important use is the declaration and use of custom |
||||
build configurations, like 'link a 3rd party library dynamically, |
||||
statically, build it from copy of its sources, etc.', etc. |
||||
|
||||
* This is of course not everything. For the details please read the |
||||
Changes sections of the documentation. |
||||
|
||||
# Documentation |
||||
|
||||
* Too much to cover here. Please go to http://andreas-kupries.github.io/critcl |
||||
for online reading, or the directories **embedded/www** and |
||||
**embedded/man** for local copies of the documentation in HTML |
||||
and nroff formats, respectively. |
||||
|
||||
# History |
||||
|
||||
* **2013-01-21** : Move code to from jcw to andreas-kupries. |
||||
|
||||
* **2011-08-18** : Move code to public repository on GitHub |
||||
|
||||
The Subversion repository at *svn://svn.equi4.com/critcl* is now obsolete. |
||||
GitHub has the new official repository for Critcl. |
||||
@ -0,0 +1,20 @@
|
||||
When releasing: |
||||
|
||||
- Run the test suite. |
||||
|
||||
- Run the examples. |
||||
|
||||
- Bump version in `doc/version.inc`. |
||||
|
||||
- If necessary, further bump: |
||||
- The versions of `package provide/ifneeded` in files: |
||||
- `lib/critcl-app/pkgindex.tcl` |
||||
- `lib/critcl/pkgindex.tcl` |
||||
- `lib/critcl/critcl.tcl` |
||||
- The version in `doc/pkg_version.inc`. |
||||
|
||||
- Regenerate the embedded documentation. |
||||
|
||||
- Commit |
||||
|
||||
- Push |
||||
@ -0,0 +1,73 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[include version.inc] |
||||
[manpage_begin critcl n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {Introduction To CriTcl}] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[include include/advert.inc] |
||||
[para] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {History & Motivation}] |
||||
|
||||
[para] [vset critcl] started life as an experiment by [vset jcw] and was a self-contained |
||||
Tcl package to build C code into a Tcl/Tk extension on the fly. It was somewhat inspired |
||||
by Brian Ingerson's [term Inline] for [term Perl], but is considerably more lightweight. |
||||
|
||||
[para] It is for the last 5% to 10% when pure Tcl, which does go a long way, is not |
||||
sufficient anymore. I.e. for |
||||
|
||||
[list_begin enumerated] |
||||
[enum] when the last bits of performance are needed, |
||||
[enum] access to 3rd party libraries, |
||||
[enum] hiding critical pieces of your library or application, and |
||||
[enum] simply needing features provided only by C. |
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Overview] |
||||
|
||||
To make the reader's topics of interest easy to find this documentation is roughly |
||||
organized by [vset quad], i.e. [include include/quad.inc] |
||||
|
||||
[strong Note]: At this point in time the documentation consists mainly of references, and |
||||
a few how-to guides. Tutorials and Explanations are in need of expansion, this is planned. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {Known Users}] |
||||
[include include/pkg_users.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {Tutorials - Practical Study - To Learn}] |
||||
|
||||
This section is currently empty. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {Explanations - Theoretical Knowledge - To Understand}] |
||||
|
||||
This section is currently empty. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {How-To Guides - Practical Work - To Solve Problems}] |
||||
|
||||
[list_begin enumerated] |
||||
[enum] [term {How To Get The CriTcl Sources}]. |
||||
[enum] [term {How To Install CriTcl}]. |
||||
[enum] [term {How To Use CriTcl}] - A light introduction through examples. |
||||
[enum] [strong NEW]: [term {How To Adapt Critcl Packages for Tcl 9}]. |
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {References - Theoretical Work - To Gain Knowlegde}] |
||||
|
||||
[list_begin enumerated] |
||||
[enum] [term {The CriTcl License}] |
||||
[enum] [term {CriTcl Releases & Changes}] |
||||
[include include/reference_docs.inc] |
||||
[enum] [term {Guide To The CriTcl Internals}] |
||||
[list_end] |
||||
|
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,45 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include pkg_version.inc] |
||||
[manpage_begin critcl_application n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {CriTcl Application Reference}] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the [cmd critcl] command. |
||||
Its intended audience are people having to build packages using |
||||
[package critcl] for deployment. Writers of packages with embedded C |
||||
code can ignore this document. |
||||
|
||||
[vset see_overview] |
||||
|
||||
[para] |
||||
|
||||
This application resides in the Application Layer of CriTcl. |
||||
[para][image arch_application][para]. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
|
||||
The application supports the following general command line: |
||||
|
||||
[list_begin definitions] |
||||
[call [cmd critcl] [opt [arg option]...] [opt [arg file]...]] |
||||
|
||||
The exact set of options supported, their meaning, and interaction is |
||||
detailed in section [sectref {Application Options}] below. |
||||
|
||||
For a larger set of examples please see section "Building CriTcl Packages" |
||||
in the document about [manpage {Using CriTcl}]. |
||||
|
||||
[list_end] |
||||
|
||||
|
||||
[section {Application Options}] [include include/aoptions.inc] |
||||
[section {Package Structure}] [include include/pstructure.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,62 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include pkg_version.inc] |
||||
[manpage_begin critcl_application_package n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {CriTcl Application Package Reference}] |
||||
[require Tcl 8.6] |
||||
[require critcl::app [opt [vset VERSION]]] |
||||
[require critcl [opt [vset VERSION]]] |
||||
[require platform [opt 1.0.2]] |
||||
[require cmdline] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the [package critcl::app] |
||||
package. Its intended audience are developers working on critcl's |
||||
internals. [vset not_needed_for_critcl_script] |
||||
|
||||
[vset see_overview] |
||||
|
||||
[para] |
||||
|
||||
This package resides in the Application Layer of CriTcl. |
||||
[para][image arch_application][para], |
||||
|
||||
implementing the functionality of the [manpage {CriTcl Application}], |
||||
and through this, the mode [sectref {Modes Of Operation/Use} {generate package}]. |
||||
|
||||
The actual application is (only) a shim wrapping around this |
||||
package. It itself is build on top of the core package |
||||
[package critcl]. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section API] |
||||
|
||||
The package exports a single command |
||||
|
||||
[list_begin definitions] |
||||
[call [cmd ::critcl::app::main] [arg commandline]] |
||||
|
||||
The [arg commandline] is a list of zero or more options followed by zero or |
||||
more [vset critcl_script] files. By default, the [vset critcl_script] files |
||||
are build and the results cached. This cuts down on the time needed to |
||||
load the package. The last occurrence of [option -pkg] and [option -tea], if |
||||
provided, selects the corresponding alternative mode of operations. |
||||
|
||||
For a larger set of examples please see section "Building CriTcl Packages" |
||||
in the document about [manpage {Using CriTcl}]. |
||||
|
||||
|
||||
[list_end] |
||||
|
||||
The options are: |
||||
[section {Options}] [include include/aoptions.inc] |
||||
[section {Modes Of Operation/Use}] [include include/modes.inc] |
||||
[section {Package Structure}] [include include/pstructure.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,161 @@
|
||||
[comment {-*- tcl -*- doctools manpage}] |
||||
[vset bitmap_version 1.1] |
||||
[manpage_begin critcl::bitmap n [vset bitmap_version]] |
||||
[include include/module2.inc] |
||||
[keywords singleton {Tcl Interp Association}] |
||||
[keywords bitmask bitset flags] |
||||
[titledesc {CriTcl - Wrap Support - Bitset en- and decoding}] |
||||
[require Tcl 8.6] |
||||
[require critcl [opt 3.2]] |
||||
[require critcl::bitmap [opt [vset bitmap_version]]] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the |
||||
[package critcl::bitmap] package. This package provides convenience |
||||
commands for advanced functionality built on top of both critcl core |
||||
and package [package critcl::iassoc]. |
||||
|
||||
[para] C level libraries often use bit-sets to encode many flags into a |
||||
single value. Tcl bindings to such libraries now have the task of |
||||
converting a Tcl representation of such flags (like a list of strings) |
||||
into such bit-sets, and back. |
||||
|
||||
[emph Note] here that the C-level information has to be something which |
||||
already exists. The package does [emph not] create these values. This is |
||||
in contrast to the package [package critcl::enum] which creates an |
||||
enumeration based on the specified symbolic names. |
||||
|
||||
[para] This package was written to make the declaration and management |
||||
of such bit-sets and their associated conversions functions easy, |
||||
hiding all attendant complexity from the user. |
||||
|
||||
[para] Its intended audience are mainly developers wishing to write |
||||
Tcl packages with embedded C code. |
||||
|
||||
[para] This package resides in the Core Package Layer of CriTcl. |
||||
[para][image arch_core][para] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
|
||||
[section API] |
||||
|
||||
[list_begin definitions] |
||||
[call [cmd ::critcl::bitmap::def] [arg name] [arg definition] [opt [arg exclusions]]] |
||||
|
||||
This command defines two C functions for the conversion of the |
||||
[arg name]d bit-set into Tcl lists, and vice versa. |
||||
|
||||
The underlying mapping tables are automatically initialized on first |
||||
access, and finalized on interpreter destruction. |
||||
|
||||
[para] The [arg definition] dictionary provides the mapping from the |
||||
Tcl-level symbolic names of the flags to their C expressions (often |
||||
the name of the macro specifying the actual value). |
||||
|
||||
[emph Note] here that the C-level information has to be something which |
||||
already exists. The package does [emph not] create these values. This is |
||||
in contrast to the package [package critcl::enum] which creates an |
||||
enumeration based on the specified symbolic names. |
||||
|
||||
[para] The optional [arg exlusion] list is for the flags/bit-sets for |
||||
which conversion from bit-set to flag, i.e. decoding makes no |
||||
sense. One case for such, for example, are flags representing a |
||||
combination of other flags. |
||||
|
||||
[para] The package generates multiple things (declarations and |
||||
definitions) with names derived from [arg name], which has to be a |
||||
proper C identifier. |
||||
|
||||
[list_begin definitions] |
||||
[def [arg name]_encode] |
||||
The function for encoding a Tcl list of strings into the equivalent |
||||
bit-set. |
||||
|
||||
Its signature is |
||||
[para][example_begin] |
||||
int [arg name]_encode (Tcl_Interp* interp, Tcl_Obj* flags, int* result); |
||||
[example_end] |
||||
|
||||
[para] The return value of the function is a Tcl error code, |
||||
i.e. [const TCL_OK], [const TCL_ERROR], etc. |
||||
|
||||
[def [arg name]_decode] |
||||
The function for decoding a bit-set into the equivalent Tcl list of |
||||
strings. |
||||
|
||||
Its signature is |
||||
[para][example_begin] |
||||
Tcl_Obj* [arg name]_decode (Tcl_Interp* interp, int flags); |
||||
[example_end] |
||||
|
||||
[def [arg name].h] |
||||
A header file containing the declarations for the two conversion |
||||
functions, for use by other parts of the system, if necessary. |
||||
|
||||
[para] The generated file is stored in a place where it will not |
||||
interfere with the overall system outside of the package, yet also be |
||||
available for easy inclusion by package files ([cmd csources]). |
||||
|
||||
[def [arg name]] |
||||
The name of a critcl argument type encapsulating the encoder function |
||||
for use by [cmd critcl::cproc]. |
||||
|
||||
[def [arg name]] |
||||
The name of a critcl result type encapsulating the decoder function |
||||
for use by [cmd critcl::cproc]. |
||||
|
||||
[list_end] |
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Example] |
||||
|
||||
The example shown below is the specification of the event flags pulled |
||||
from the draft work on a Tcl binding to Linux's inotify APIs. |
||||
|
||||
[example { |
||||
package require Tcl 8.6 |
||||
package require critcl 3.2 |
||||
|
||||
critcl::buildrequirement { |
||||
package require critcl::bitmap |
||||
} |
||||
|
||||
critcl::bitmap::def tcl_inotify_events { |
||||
accessed IN_ACCESS |
||||
all IN_ALL_EVENTS |
||||
attribute IN_ATTRIB |
||||
closed IN_CLOSE |
||||
closed-nowrite IN_CLOSE_NOWRITE |
||||
closed-write IN_CLOSE_WRITE |
||||
created IN_CREATE |
||||
deleted IN_DELETE |
||||
deleted-self IN_DELETE_SELF |
||||
dir-only IN_ONLYDIR |
||||
dont-follow IN_DONT_FOLLOW |
||||
modified IN_MODIFY |
||||
move IN_MOVE |
||||
moved-from IN_MOVED_FROM |
||||
moved-self IN_MOVE_SELF |
||||
moved-to IN_MOVED_TO |
||||
oneshot IN_ONESHOT |
||||
open IN_OPEN |
||||
overflow IN_Q_OVERFLOW |
||||
unmount IN_UNMOUNT |
||||
} { |
||||
all closed move oneshot |
||||
} |
||||
|
||||
# Declarations: tcl_inotify_events.h |
||||
# Encoder: int tcl_inotify_events_encode (Tcl_Interp* interp, Tcl_Obj* flags, int* result); |
||||
# Decoder: Tcl_Obj* tcl_inotify_events_decode (Tcl_Interp* interp, int flags); |
||||
# crit arg-type tcl_inotify_events |
||||
# crit res-type tcl_inotify_events |
||||
}] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback2.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,17 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include version.inc] |
||||
[manpage_begin critcl_build_tool n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {CriTcl build.tcl Tool Reference}] |
||||
[description] |
||||
[include include/welcome.inc] |
||||
|
||||
The script [file build.tcl] found in the top directory of the [vset critcl] sources is the |
||||
main tool of use to a developer or maintainer of [vset critcl] itself. |
||||
|
||||
[para] Invoking it a via [example {./build.tcl help}] provides the online help for this |
||||
tool, explaining the operations available, and their arguments. |
||||
|
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,196 @@
|
||||
[vset VERSION 1.1] |
||||
[comment {-*- tcl -*- doctools manpage}] |
||||
[manpage_begin critcl::callback n [vset VERSION]] |
||||
[include include/module2.inc] |
||||
[titledesc {CriTcl - C-level Callback Utilities}] |
||||
[require Tcl 8.6] |
||||
[require critcl [opt 3.2]] |
||||
[require critcl::callback [opt [vset VERSION]]] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the |
||||
[package critcl::callback] package. |
||||
|
||||
This package provides, via a stubs API table, data structures and |
||||
functions to manage callbacks from C to Tcl. The package has no |
||||
Tcl-level facilities. |
||||
|
||||
Its intended audience are mainly developers wishing to write Tcl |
||||
packages with embedded C code who have to invoke user-specified |
||||
command (prefixes) in Tcl. |
||||
|
||||
[para] |
||||
This package resides in the Support Package Layer of CriTcl. |
||||
|
||||
[para][image arch_support][para] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section API] |
||||
|
||||
The package API consist of one opaque data structure |
||||
([type critcl_callback_p]) and four functions operating on the same. |
||||
|
||||
These functions are |
||||
|
||||
[list_begin definitions] |
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [type critcl_callback_p] [fun critcl_callback_new] \ |
||||
[arg interp] [arg objc] [arg objv] [arg nargs]] |
||||
|
||||
This function creates a new callback (manager) and returns it as its result. |
||||
|
||||
[para] |
||||
The callback is initialized with the Tcl_Interp* [arg interp] |
||||
specifying where to run the callback, the fixed part of the command to |
||||
run in standard [arg objc]/[arg objv] notation, plus the number of |
||||
free arguments to expect after the fixed part. |
||||
|
||||
[para] |
||||
The fixed part is the essentially the command prefix of the callback. |
||||
|
||||
[para] |
||||
All [type Tcl_Obj*] elements of [arg objv] are protected against early |
||||
release by incrementing their reference counts. The callback |
||||
effectively takes ownership of these objects. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [type void] [fun critcl_callback_extend] \ |
||||
[arg callback] [arg argument]] |
||||
|
||||
This function takes a [arg callback] of type [type critcl_callback_p] |
||||
and extends its fixed part with the [arg argument], taking the first |
||||
free slot for arguments to do so. |
||||
|
||||
This means that after the application of this function the specified |
||||
callback has one free argument less. |
||||
|
||||
[para] |
||||
With assertions active attempting to extend beyond the number of free |
||||
arguments will cause a panic. Without assertions active expect a crash |
||||
at some point. |
||||
|
||||
[para] |
||||
This allows the user to extend the fixed part of the callback with |
||||
semi-fixed elements, like method names (See [sectref {Multiple methods}]). |
||||
|
||||
[para] |
||||
The [arg argument] is protected against early release by incrementing |
||||
its reference count. The callback effectively takes ownership of this |
||||
object. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [type void] [fun critcl_callback_destroy] \ |
||||
[arg callback]] |
||||
|
||||
This function takes a [arg callback] of type [type critcl_callback_p] |
||||
and releases all memory associated with it. |
||||
|
||||
After application of this function the callback cannot be used anymore. |
||||
|
||||
[para] |
||||
All fixed elements of the callback (owned by it) are released by |
||||
decrementing their reference counts. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [type int] [fun critcl_callback_invoke] \ |
||||
[arg callback] [arg objc] [arg objv]] |
||||
|
||||
This function invokes the callback in the Tcl interpreter specified at |
||||
the time of construction, in the global level and namespace, with the |
||||
free arguments filled by the [type Tcl_Obj*] objects specified via |
||||
[arg objc]/[arg objv]. |
||||
|
||||
[para] |
||||
It returns the Tcl status of the invoked command as its result. |
||||
|
||||
Any further results or error messages will be found in the result area |
||||
of the Tcl interpreter in question. The exact nature of such is |
||||
dependent on the callback itself. |
||||
|
||||
[para] |
||||
With assertions active attempting to use more arguments than available |
||||
will cause a panic. Without assertions active expect a crash at some |
||||
point. |
||||
|
||||
[para] |
||||
While the callback is running all [type Tcl_Obj*] elements of the |
||||
command, fixed and arguments, are protected against early release by |
||||
temporarily incrementing their reference counts. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Examples] |
||||
|
||||
[subsection {Simple callback}] |
||||
|
||||
The example here shows the important parts of using the functions of |
||||
this package for a simple callback which is invoked with a single |
||||
argument, some kind of data to hand to the Tcl level. |
||||
|
||||
[example { |
||||
// Create the callback with interpreter and command prefix in |
||||
// oc/ov, plus space for the argument |
||||
critcl_callback_p cb = critcl_callback_new (interp, oc, ov, 1); |
||||
|
||||
// Invoke the callback somewhere in the C package using this one, |
||||
// with Tcl_Obj* data holding the information to pass up. |
||||
critcl_callback_invoke (cb, 1, &data); |
||||
|
||||
// At the end of the lifetime, release the callback. |
||||
critcl_callback_destroy (cb); |
||||
}] |
||||
|
||||
Note that the functions of this package are designed for the case |
||||
where the created callback ([const cb] above) is kept around for a |
||||
long time, and many different invokations. |
||||
|
||||
[para] |
||||
Using the sequence above as is, creating and destroying the callback |
||||
each time it is invoked will yield very poor performance and lots of |
||||
undesirable memory churn. |
||||
|
||||
|
||||
[subsection {Multiple methods}] |
||||
|
||||
While we can use the methodology of the previous section when a single |
||||
(Tcl-level) callback is invoked from different places in C, with |
||||
different methods, simply having another argument slot and filling it |
||||
an invokation time with the method object, a second methodology is |
||||
open to us due to [fun critcl_callback_extend]. |
||||
|
||||
[example { |
||||
|
||||
// Create one callback manager per different method the callback |
||||
// will be used with. Fill the first of the two declared arguments |
||||
// with the different methods. |
||||
critcl_callback_p cb_a = critcl_callback_new (interp, oc, ov, 2); |
||||
critcl_callback_p cb_b = critcl_callback_new (interp, oc, ov, 2); |
||||
|
||||
critcl_callback_extend (cb_a, Tcl_NewStringObj ("method1", -1)); |
||||
critcl_callback_extend (cb_b, Tcl_NewStringObj ("method2", -1)); |
||||
|
||||
// After the extension we have one free argument left, for use in |
||||
// the invokations. |
||||
|
||||
critcl_callback_invoke (cb_a, 1, &dataX); |
||||
|
||||
critcl_callback_invoke (cb_b, 1, &dataY); |
||||
|
||||
|
||||
// At the end release both managers again |
||||
critcl_callback_destroy (cb_a); |
||||
critcl_callback_destroy (cb_b); |
||||
}] |
||||
|
||||
The nice thing here is that the method objects are allocated only once |
||||
and automatically shared by all the calls. No memory churn to |
||||
repeatedly allocate the same string objects over and over again. |
||||
|
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback2.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,16 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include version.inc] |
||||
[manpage_begin critcl_changes n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {CriTcl Releases & Changes}] |
||||
[description] |
||||
[include include/welcome.inc] |
||||
[include include/advert.inc] |
||||
|
||||
See the changes done in each release of [vset critcl], from the latest at the top to the |
||||
beginning of the project. |
||||
|
||||
[include include/changes.inc] |
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,57 @@
|
||||
[comment {-*- tcl -*- doctools manpage}] |
||||
[vset VERSION 1.1] |
||||
[manpage_begin critcl::class n [vset VERSION]] |
||||
[include include/module2.inc] |
||||
[keywords {C class} {C object} {C instance}] |
||||
[titledesc {CriTcl - Code Gen - C Classes}] |
||||
[require Tcl 8.6] |
||||
[require critcl [opt 3.2]] |
||||
[require critcl::class [opt [vset VERSION]]] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the [package critcl::class] |
||||
package. This package provides convenience commands for advanced |
||||
functionality built on top of the core. |
||||
|
||||
[para] With it a user wishing to create a C level object with class |
||||
and instance commands can concentrate on specifying the class- and |
||||
instance-variables and -methods in a manner similar to a TclOO class, |
||||
while all the necessary boilerplate around it is managed by this |
||||
package. |
||||
|
||||
[para] Its intended audience are mainly developers wishing to write |
||||
Tcl packages with embedded C code. |
||||
|
||||
[para] This package resides in the Core Package Layer of CriTcl. |
||||
[para][image arch_core][para] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
|
||||
[section API] |
||||
|
||||
[list_begin definitions] |
||||
[call [cmd ::critcl::class::define] [arg name] [arg script]] |
||||
|
||||
This is the main command to define a new class [arg name], where |
||||
[arg name] is the name of the Tcl command representing the class, |
||||
i.e. the [term {class command}]. The [arg script] provides the |
||||
specification of the class, i.e. information about included headers, |
||||
class- and instance variables, class- and instance-methods, etc. |
||||
|
||||
See the section [sectref {Class Specification API}] below for the |
||||
detailed list of the available commands and their semantics. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section {Class Specification API}][include include/class_spec.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Example][include include/class_example.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback2.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,40 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include pkg_version.inc] |
||||
[manpage_begin critcl_cproc_types n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {CriTcl cproc Type Reference}] |
||||
[require Tcl 8.6] |
||||
[require critcl [opt [vset VERSION]]] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is a breakout of the descriptions for the predefined argument- and result-types usable |
||||
with the [cmd critcl::cproc] command, as detailed in the reference manpage for the [package critcl] |
||||
package, plus the information on how to extend the predefined set with custom types. The breakout |
||||
was made to make this information easier to find (toplevel document vs. having to search the large |
||||
main reference). |
||||
|
||||
[para] Its intended audience are developers wishing to write Tcl packages with embedded C code. |
||||
|
||||
[section {Standard argument types}] [include include/cproc/api_stdat_cproc.inc] |
||||
[section {Standard result types}] [include include/cproc/api_stdrt_cproc.inc] |
||||
[section {Advanced: Adding types}] [include include/cproc/api_extcproc2.inc] |
||||
|
||||
[section Examples] |
||||
|
||||
The examples shown here have been drawn from the section "Embedding C" in the document about |
||||
[manpage {Using CriTcl}]. Please see that document for many more examples. |
||||
|
||||
[include include/cproc/using_eproc.inc] [comment {%% cproc}] |
||||
[include include/cproc/using_eprocstr.inc] [comment {%% cproc, strings}] |
||||
[include include/cproc/using_eproctypes.inc] [comment {%% cproc types, intro & trivial}] |
||||
[include include/cproc/using_eproctypes2.inc] [comment {%% cproc types, semi-trivial}] |
||||
[include include/cproc/using_eproctypes3.inc] [comment {%% cproc types, support (incl alloc'd)}] |
||||
[include include/cproc/using_eproctypes4.inc] [comment {%% cproc types, results}] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,413 @@
|
||||
[vset VERSION 0.3] |
||||
[comment {-*- tcl -*- doctools manpage}] |
||||
[manpage_begin critcl::cutil n [vset VERSION]] |
||||
[include include/module2.inc] |
||||
[titledesc {CriTcl - C-level Utilities}] |
||||
[require Tcl 8.6] |
||||
[require critcl [opt 3.2]] |
||||
[require critcl::cutil [opt [vset VERSION]]] |
||||
[description] |
||||
[para] |
||||
[include include/welcome.inc] |
||||
[para] |
||||
|
||||
This document is the reference manpage for the [package critcl::cutil] |
||||
package. This package encapsulates a number of C-level utilites for |
||||
easier writing of memory allocations, assertions, and narrative tracing |
||||
and provides convenience commands to make these utilities accessible |
||||
to critcl projects. |
||||
|
||||
Its intended audience are mainly developers wishing to write Tcl |
||||
packages with embedded C code. |
||||
[para] |
||||
|
||||
This package resides in the Core Package Layer of CriTcl. |
||||
[para][image arch_core][para] |
||||
|
||||
The reason for this is that the main [package critcl] package makes |
||||
use of the facilities for narrative tracing when |
||||
[cmd {critcl::config trace}] is set, to instrument commands and |
||||
procedures. |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section API] |
||||
|
||||
[list_begin definitions] |
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd ::critcl::cutil::alloc]] |
||||
|
||||
This command provides a number C-preprocessor macros which make the |
||||
writing of memory allocations for structures and arrays of structures |
||||
easier. |
||||
|
||||
[para] When run the header file [file critcl_alloc.h] is directly made |
||||
available to the [file .critcl] file containing the command, and |
||||
becomes available for use in [cmd {#include}] directives of companion |
||||
C code declared via [cmd critcl::csources]. |
||||
|
||||
[para] The macros definitions and their signatures are: |
||||
|
||||
[example { |
||||
type* ALLOC (type) |
||||
type* ALLOC_PLUS (type, int n) |
||||
type* NALLOC (type, int n) |
||||
type* REALLOC (type* var, type, int n) |
||||
void FREE (type* var) |
||||
|
||||
void STREP (Tcl_Obj* o, char* s, int len); |
||||
void STREP_DS (Tcl_Obj* o, Tcl_DString* ds); |
||||
void STRDUP (varname, char* str); |
||||
}] |
||||
|
||||
[para] The details of the semantics are explained in section |
||||
[sectref Allocation]. |
||||
|
||||
[para] The result of the command is an empty string. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd ::critcl::cutil::assertions] [opt [arg enable]]] |
||||
|
||||
This command provides a number C-preprocessor macros for the writing |
||||
of assertions in C code. |
||||
|
||||
[para] When invoked the header file [file critcl_assert.h] is directly |
||||
made available to the [file .critcl] file containing the command, and |
||||
becomes available for use in [cmd {#include}] directives of companion |
||||
C code declared via [cmd critcl::csources]. |
||||
|
||||
[para] The macro definitions and their signatures are |
||||
|
||||
[example { |
||||
void ASSERT (expression, char* message); |
||||
void ASSERT_BOUNDS (int index, int size); |
||||
|
||||
void STOPAFTER (int n); |
||||
}] |
||||
|
||||
[para] Note that these definitions are conditional on the existence of |
||||
the macro [const CRITCL_ASSERT]. |
||||
|
||||
Without a [cmd {critcl::cflags -DCRITCL_ASSERT}] all assertions in the |
||||
C code are quiescent and not compiled into the object file. In other |
||||
words, assertions can be (de)activated at will during build time, as |
||||
needed by the user. |
||||
|
||||
[para] For convenience this is controlled by [arg enable]. By default |
||||
([const false]) the facility available, but not active. |
||||
|
||||
Using [const true] not only makes it available, but activates it as |
||||
well. |
||||
|
||||
[para] The details of the semantics are explained in section |
||||
[sectref Assertions]. |
||||
|
||||
[para] The result of the command is an empty string. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd ::critcl::cutil::tracer] [opt [arg enable]]] |
||||
|
||||
This command provides a number C-preprocessor macros for tracing |
||||
C-level internals. |
||||
|
||||
[para] When invoked the header file [file critcl_trace.h] is directly |
||||
made available to the [file .critcl] file containing the command, and |
||||
becomes available for use in [cmd {#include}] directives of companion |
||||
C code declared via [cmd critcl::csources]. Furthermore the [file .c] |
||||
file containing the runtime support is added to the set of C companion |
||||
files |
||||
|
||||
[para] The macro definitions and their signatures are |
||||
|
||||
[example { |
||||
/* (de)activation of named logical streams. |
||||
* These are declarators, not statements. |
||||
*/ |
||||
|
||||
TRACE_ON; |
||||
TRACE_OFF; |
||||
TRACE_TAG_ON (tag_identifier); |
||||
TRACE_TAG_OFF (tag_identifier); |
||||
|
||||
/* |
||||
* Higher level trace statements (convenience commands) |
||||
*/ |
||||
|
||||
void TRACE_FUNC (const char* format, ...); |
||||
void TRACE_FUNC_VOID; |
||||
any TRACE_RETURN (const char* format, any x); |
||||
void TRACE_RETURN_VOID; |
||||
void TRACE (const char* format, ...); |
||||
|
||||
/* |
||||
* Low-level trace statements the higher level ones above |
||||
* are composed from. Scope management and output management. |
||||
*/ |
||||
|
||||
void TRACE_PUSH_SCOPE (const char* scope); |
||||
void TRACE_PUSH_FUNC; |
||||
void TRACE_POP; |
||||
|
||||
void TRACE_HEADER (int indent); |
||||
void TRACE_ADD (const char* format, ...); |
||||
void TRACE_CLOSER; |
||||
|
||||
/* |
||||
* Convert tag to the underlying status variable. |
||||
*/ |
||||
|
||||
TRACE_TAG_VAR (tag) |
||||
|
||||
/* |
||||
* Conditional use of arbitrary code. |
||||
*/ |
||||
|
||||
TRACE_RUN (code); |
||||
TRACE_DO (code); |
||||
TRACE_TAG_DO (code); |
||||
}] |
||||
|
||||
[para] Note that these definitions are conditional on the existence of |
||||
the macro [const CRITCL_TRACER]. |
||||
|
||||
Without a [cmd {critcl::cflags -DCRITCL_TRACER}] all trace |
||||
functionality in the C code is quiescent and not compiled into the |
||||
object file. In other words, tracing can be (de)activated at will |
||||
during build time, as needed by the user. |
||||
|
||||
[para] For convenience this is controlled by [arg enable]. By default |
||||
([const false]) the facility available, but not active. |
||||
|
||||
Using [const true] not only makes it available, but activates it as |
||||
well. |
||||
|
||||
Further note that the command [cmd critcl::config] now accepts a |
||||
boolean option [const trace]. Setting it activates enter/exit tracing |
||||
in all commands based on [cmd critcl::cproc], with proper printing of |
||||
arguments and results. This implicitly activates the tracing facility |
||||
in general. |
||||
|
||||
[para] The details of the semantics are explained in section |
||||
[sectref Tracing] |
||||
|
||||
[para] The result of the command is an empty string. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Allocation] |
||||
|
||||
[list_begin definitions] |
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {type* ALLOC (type)}]] |
||||
|
||||
This macro allocates a single element of the given [arg type] and |
||||
returns a pointer to that memory. |
||||
|
||||
[call [cmd {type* ALLOC_PLUS (type, int n)}]] |
||||
|
||||
This macro allocates a single element of the given [arg type], plus an |
||||
additional [arg n] bytes after the structure and returns a pointer to |
||||
that memory. |
||||
|
||||
[para] This is for variable-sized structures of. An example of such |
||||
could be a generic list element structure which stores management |
||||
information in the structure itself, and the value/payload immediately |
||||
after, in the same memory block. |
||||
|
||||
[call [cmd {type* NALLOC (type, int n)}]] |
||||
|
||||
This macro allocates [arg n] elements of the given [arg type] and |
||||
returns a pointer to that memory. |
||||
|
||||
[call [cmd {type* REALLOC (type* var, type, int n)}]] |
||||
|
||||
This macro expands or shrinks the memory associated with the C |
||||
variable [arg var] of type [arg type] to hold [arg n] elements of the |
||||
type. It returns a pointer to that memory. |
||||
|
||||
Remember, a reallocation may move the data to a new location in memory |
||||
to satisfy the request. Returning a pointer instead of immediately |
||||
assigning it to the [arg var] allows the user to validate the new |
||||
pointer before trying to use it. |
||||
|
||||
[call [cmd {void FREE (type* var)}]] |
||||
|
||||
This macro releases the memory referenced by the pointer variable |
||||
[arg var]. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void STREP (Tcl_Obj* o, char* s, int len)}]] |
||||
|
||||
This macro properly sets the string representation of the Tcl object |
||||
[arg o] to a copy of the string [arg s], expected to be of length |
||||
[arg len]. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void STREP_DS (Tcl_Obj* o, Tcl_DString* ds)}]] |
||||
|
||||
This macro properly sets the string representation of the Tcl object |
||||
[arg o] to a copy of the string held by the [type DString] [arg ds]. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void STRDUP (varname, char* str)}]] |
||||
|
||||
This macro duplicates the string [arg str] into the heap and stores |
||||
the result into the named [type char*] variable [arg var]. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Assertions] |
||||
|
||||
[list_begin definitions] |
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void ASSERT (expression, char* message}]] |
||||
|
||||
This macro tests the [arg expression] and panics if it does not hold. |
||||
The specified [arg message] is used as part of the panic. |
||||
The [arg message] has to be a static string, it cannot be a variable. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void ASSERT_BOUNDS (int index, int size)}]] |
||||
|
||||
This macro ensures that the [arg index] is in the |
||||
range [const 0] to [const {size-1}]. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void STOPAFTER(n)}]] |
||||
|
||||
This macro throws a panic after it is called [arg n] times. |
||||
Note, each separate instance of the macro has its own counter. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Tracing] |
||||
|
||||
All output is printed to [const stdout]. |
||||
|
||||
[list_begin definitions] |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd TRACE_ON]] |
||||
[call [cmd TRACE_OFF]] |
||||
[call [cmd {TRACE_TAG_ON (identifier)}]] |
||||
[call [cmd {TRACE_TAG_OFF (identifier)}]] |
||||
|
||||
These "commands" are actually declarators, for use outside of |
||||
functions. They (de)activate specific logical streams, named either |
||||
explicitly by the user, or implicitly, refering to the current file. |
||||
|
||||
[para] For example: |
||||
[para][example { |
||||
TRACE_TAG_ON (lexer_in); |
||||
}] |
||||
|
||||
[para] All high- and low-level trace commands producing output have |
||||
the controlling tag as an implicit argument. The scope management |
||||
commands do not take tags. |
||||
|
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_FUNC}]] |
||||
[call [cmd {void TRACE_TAG_FUNC (tag)}]] |
||||
[call [cmd {void TRACE_FUNC_VOID}]] |
||||
[call [cmd {void TRACE_TAG_FUNC_VOID (tag)}]] |
||||
|
||||
Use these macros at the beginning of a C function to record entry into |
||||
it. The name of the entered function is an implicit argument |
||||
([var __func__]), forcing users to have a C99 compiler.. |
||||
|
||||
[para] The tracer's runtime maintains a stack of active functions and |
||||
expects that function return is signaled by either [fun TRACE_RETURN], |
||||
[fun TRACE_RETURN_VOID], or the equivalent forms taking a tag. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_RETURN_VOID}]] |
||||
[call [cmd {void TRACE_TAG_RETURN_VOID (tag)}]] |
||||
|
||||
Use these macros instead of [example {return}] to return from a void |
||||
function. Beyond returning from the function this also signals the |
||||
same to the tracer's runtime, popping the last entered function from |
||||
its stack of active functions. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {any TRACE_RETURN ( char* format, any x)}]] |
||||
[call [cmd {any TRACE_TAG_RETURN (tag, char* format, any x)}]] |
||||
|
||||
Use this macro instead of [example {return x}] to return from a |
||||
non-void function. |
||||
|
||||
Beyond returning from the function with value [arg x] this also |
||||
signals the same to the tracer's runtime, popping the last entered |
||||
function from its stack of active functions. |
||||
|
||||
The [arg format] is expected to be a proper formatting string for |
||||
[fun printf] and analogues, able to stringify [arg x]. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE ( char* format, ...)}]] |
||||
[call [cmd {void TRACE_TAG (tag, char* format, ...)}]] |
||||
|
||||
This macro is the trace facilities' equivalent of [fun printf], |
||||
printing arbitrary data under the control of the [arg format]. |
||||
|
||||
[para] The printed text is closed with a newline, and indented as per |
||||
the stack of active functions. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_HEADER (int indent)}]] |
||||
[call [cmd {void TRACE_TAG_HEADER (tag, int indent)}]] |
||||
|
||||
This is the low-level macro which prints the beginning of a trace |
||||
line. This prefix consists of physical location (file name and line |
||||
number), if available, indentation as per the stack of active scopes |
||||
(if activated), and the name of the active scope. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_CLOSER}]] |
||||
[call [cmd {void TRACE_TAG_CLOSER (tag)}]] |
||||
|
||||
This is the low-level macro which prints the end of a trace |
||||
line. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_ADD (const char* format, ...)}]] |
||||
[call [cmd {void TRACE_TAG_ADD (tag, const char* format, ...)}]] |
||||
|
||||
This is the low-level macro which adds formatted data to the line. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {void TRACE_PUSH_SCOPE (const char* name)}]] |
||||
[call [cmd {void TRACE_PUSH_FUNC}]] |
||||
[call [cmd {void TRACE_PUSH_POP}]] |
||||
|
||||
These are the low-level macros for scope management. The first two |
||||
forms push a new scope on the stack of active scopes, and the last |
||||
forms pops the last scope pushed. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {TRACE_TAG_VAR (tag)}]] |
||||
|
||||
Helper macro converting from a tag identifier to the name of the |
||||
underlying status variable. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {TRACE_RUN (code);}]] |
||||
|
||||
Conditionally insert the [arg code] at compile time when the tracing |
||||
facility is activated. |
||||
|
||||
[comment {* * ** *** ***** ******** ************* *********************}] |
||||
[call [cmd {TRACE_DO (code);}]] |
||||
[call [cmd {TRACE_TAG_DO (tag, code);}]] |
||||
|
||||
Insert the [arg code] at compile time when the tracing facility is |
||||
activated, and execute the same when either the implicit tag for the |
||||
file or the user-specified tag is active. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[include include/feedback2.inc] |
||||
[manpage_end] |
||||
@ -0,0 +1,228 @@
|
||||
[comment {-*- mode: tcl ; fill-column: 90 -*- doctools manpage}] |
||||
[comment {quadrant: reference}] |
||||
[include version.inc] |
||||
[manpage_begin critcl_devguide n [vset VERSION]] |
||||
[include include/module.inc] |
||||
[titledesc {Guide To The CriTcl Internals}] |
||||
[description] |
||||
[include include/welcome.inc] |
||||
|
||||
[comment {= = == === ===== ======== ============= =====================}] |
||||
[section Audience] |
||||
|
||||
[para] This document is a guide for developers working on CriTcl, i.e. maintainers fixing |
||||
bugs, extending the package's functionality, etc. |
||||
|
||||
[para] Please read |
||||
|
||||
[list_begin enum] |
||||
[enum] [term {CriTcl - License}], |
||||
[enum] [term {CriTcl - How To Get The Sources}], and |
||||
[enum] [term {CriTcl - The Installer's Guide}] |
||||
[list_end] |
||||
|
||||
first, if that was not done already. |
||||
|
||||
[para] Here we assume that the sources are already available in a directory of the readers |
||||
choice, and that the reader not only know how to build and install them, but also has all |
||||
the necessary requisites to actually do so. The guide to the sources in particular also |
||||
explains which source code management system is used, where to find it, how to set it up, |
||||
etc. |
||||
|
||||
[section {Playing with CriTcl}] |
||||
[include include/largeexampleref.inc] |
||||
[include include/smallexampleref.inc] |
||||
|
||||
|
||||
[section {Developing for CriTcl}] |
||||
|
||||
[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@] |
||||
[subsection {Architecture & Concepts}] |
||||
[include include/architecture.inc] |
||||
|
||||
[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@] |
||||
[subsection Requirements] |
||||
|
||||
To develop for critcl the following packages and applications must be available in the |
||||
environment. These are all used by the [cmd build.tcl] helper application. |
||||
|
||||
[list_begin definitions] |
||||
[def [syscmd dtplite]] |
||||
|
||||
A Tcl application provided by Tcllib, for the validation and conversion of |
||||
[term doctools]-formatted text. |
||||
|
||||
[def [syscmd dia]] |
||||
|
||||
A Tcl application provided by Tklib, for the validation and conversion |
||||
of [package diagram]-formatted figures into raster images. |
||||
|
||||
[para] Do not confuse this with the Gnome [syscmd dia] application, which is a graphical |
||||
editor for figures and diagrams, and completely unrelated. |
||||
|
||||
[def [package fileutil]] |
||||
A Tcl package provided by Tcllib, providing file system utilities. |
||||
|
||||
[def "[package vfs::mk4], [package vfs]"] |
||||
Tcl packages written in C providing access to Tcl's VFS facilities, required for the |
||||
generation of critcl starkits and starpacks. |
||||
|
||||
[list_end] |
||||
|
||||
[comment @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@] |
||||
[subsection {Directory structure}] |
||||
|
||||
[list_begin definitions][comment {___1___}] |
||||
|
||||
[comment {= = == === ===== ======== ============= =======================}] |
||||
[def Helpers] |
||||
[list_begin definitions] |
||||
[def [file build.tcl]] |
||||
|
||||
This helper application provides various operations needed by a developer for critcl, like |
||||
regenerating the documentation, the figures, building and installing critcl, etc. |
||||
|
||||
[para] Running the command like |
||||
|
||||
[example { |
||||
./build.tcl help |
||||
}] |
||||
|
||||
will provide more details about the available operations and their arguments. |
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =======================}] |
||||
[def Documentation] |
||||
[list_begin definitions] |
||||
[def [file doc/]] |
||||
|
||||
This directory contains the documentation sources, for both the text, and the figures. |
||||
The texts are written in [term doctools] format, whereas the figures are written for |
||||
tklib's [package dia](gram) package and application. |
||||
|
||||
[def [file embedded/]] |
||||
|
||||
This directory contains the documentation converted to regular manpages (nroff) and HTML. |
||||
|
||||
It is called embedded because these files, while derived, are part of the git repository, |
||||
i.e. embedded into it. This enables us to place these files where they are visible when |
||||
serving the prject's web interface. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =======================}] |
||||
[def Testsuite] |
||||
[list_begin definitions] |
||||
[def [file test/all.tcl]] |
||||
[def [file test/testutilities.tcl]] |
||||
[def [file test/*.test]] |
||||
|
||||
These files are a standard testsuite based on Tcl's [package tcltest] package, with some |
||||
utility code snarfed from [package Tcllib]. |
||||
|
||||
[para] This currently tests only some of the [package stubs::*] packages. |
||||
|
||||
[def [file test/*.tcl]] |
||||
|
||||
These files (except for [file all.tcl] and [file testutilities.tcl]) are example files |
||||
(Tcl with embedded C) which can be run through critcl for testing. |
||||
|
||||
[para] [strong TODO] for a maintainers: These should be converted into a proper test suite. |
||||
|
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =======================}] |
||||
[def {Package Code, General structure}] |
||||
|
||||
[list_begin definitions] |
||||
[list_end] |
||||
|
||||
[comment {= = == === ===== ======== ============= =======================}] |
||||
[def {Package Code, Per Package}] |
||||
[list_begin definitions][comment ----------------------PCPP] |
||||
|
||||
[def [package critcl]] |
||||
[list_begin definitions][comment ---------------critcl] |
||||
[def [file lib/critcl/critcl.tcl]] |
||||
The Tcl code implementing the package. |
||||
|
||||
[def [file lib/critcl/Config]] |
||||
The configuration file for the standard targets and their settings. |
||||
|
||||
[def [file lib/critcl/critcl_c/]] |
||||
Various C code snippets used by the package. |
||||
|
||||
This directory also contains the copies of the Tcl header files used to compile the |
||||
assembled C code, for the major brnaches of Tcl, i.e. 8.4, 8.5, and 8.6. |
||||
|
||||
[list_end][comment -----------------------------critcl] |
||||
|
||||
[def [package critcl::util]] |
||||
[list_begin definitions][comment ---------------critcl::util] |
||||
[def [file lib/critcl-util/util.tcl]] |
||||
The Tcl code implementing the package. |
||||
[list_end][comment -----------------------------critcl::util] |
||||
|
||||
[def [package critcl::app]] |
||||
[list_begin definitions][comment ---------------critcl::app] |
||||
[def [file lib/app-critcl/critcl.tcl]] |
||||
The Tcl code implementing the package. |
||||
[list_end][comment -----------------------------critcl::app] |
||||
|
||||
[def [package critcl::iassoc]] |
||||
[list_begin definitions][comment ---------------critcl::iassoc] |
||||
[def [file lib/critcl-iassoc/iassoc.tcl]] |
||||
The Tcl code implementing the package. |
||||
[def [file lib/critcl-iassoc/iassoc.h]] |
||||
C code template used by the package. |
||||
[list_end][comment -----------------------------critcl::iassoc] |
||||
|
||||
[def [package critcl::class]] |
||||
[list_begin definitions][comment ---------------critcl::class] |
||||
[def [file lib/critcl-class/class.tcl]] |
||||
The Tcl code implementing the package. |
||||
[def [file lib/critcl-class/class.h]] |
||||
C code template used by the package. |
||||
[list_end][comment -----------------------------critcl::class] |
||||
|
||||
|
||||
[def [package stubs::*]] |
||||
[list_begin definitions][comment ---------------stubs] |
||||
[def [file lib/stubs/*]] |
||||
|
||||
A set of non-public (still) packages which provide read and write access to and represent |
||||
Tcl stubs tables. These were created by taking the [file genStubs.tcl] helper application |
||||
coming with the Tcl core sources apart along its internal logical lines. |
||||
|
||||
[list_end][comment -----------------------------stubs] |
||||
|
||||
[def [package critclf]] |
||||
[list_begin definitions][comment ---------------critclf] |
||||
[def [file lib/critclf/]] |
||||
|
||||
Arjen Markus' work on a critcl/Fortran. The code is outdated and has not been adapted to |
||||
the changes in critcl version 3 yet. |
||||
|
||||
[list_end][comment -----------------------------critclf] |
||||
|
||||
[def [package md5]] |
||||
[def [package md5c]] |
||||
[def [package platform]] |
||||
|
||||
These are all external packages whose code has been inlined in the repository for easier |
||||
development (less dependencies to pull), and quicker deployment from the repository |
||||
(generation of starkit and -pack). |
||||
|
||||
[para] [strong TODO] for maintainers: These should all be checked against their origin for |
||||
updates and changes since they were inlined. |
||||
|
||||
[list_end][comment ------------------------------------PCPP] |
||||
|
||||
[list_end][comment {___1___}] |
||||
|
||||
[comment {TODO **** Package dependency diagram ****}] |
||||
[comment {TODO **** Diagram of the internal call graph ? ****}] |
||||
[comment {TODO **** Add test/ ****}] |
||||
|
||||
[include include/feedback.inc] |
||||
[manpage_end] |
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in new issue