@ -7,7 +7,7 @@
# (C) 2024
#
# @@ Meta Begin
# Application fauxlink 0.1. 2
# Application fauxlink 0.2.0
# Meta platform tcl
# Meta license MIT
# @@ Meta End
@ -17,7 +17,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin fauxlink_module_fauxlink 0 0.1. 2]
#[manpage_begin fauxlink_module_fauxlink 0 0.2.0 ]
#[copyright "2024"]
#[titledesc {faux link application shortcuts}] [comment {-- Name section and table of contents description --}]
#[moddesc {.fauxlink .fxlnk}] [comment {-- Description at end of page heading --}]
@ -628,28 +628,126 @@ namespace eval fauxlink {
}
return $out
}
#encode one #-delimited section (or one + delimited target segment)
#round-trip property: literal % is encoded as %25 so that pre-existing %XX / %UXXXX
#lookalike sequences in the input survive resolve's decoding untouched.
proc Segment_encode {str} {
variable encode_map
if {[tcl::string::first \x00 $str] >= 0} {
error "fauxlink::link_as NUL character cannot be represented in a fauxlink name"
}
set out [tcl::string::map {% %25} $str]
return [tcl::string::map $encode_map $out]
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::fauxlink::link_as
@cmd -name fauxlink::link_as\
-summary\
"NOT YET IMPLEMENTED - encode a name and target as a fauxlink filename."\
"Encode a name and target as a fauxlink filename (counterpart of resolve) ."\
-help\
"Reserved API - not yet implemented; currently raises an error.
Intended to perform the encoding counterpart of fauxlink::resolve:
produce the fauxlink filename for a given nominal name and target
path, applying the required %XX encodings and + path separators."
@values -min 2 -max 2
"Return the fauxlink filename encoding the given nominal name and target
path, applying the required %XX encodings and + path separators, such
that fauxlink::resolve on the result returns the inputs unchanged
(resolve reports the decoded target tail as name when name is empty).
target is a forward-slash separated path; each segment is encoded
separately (a literal + # % etc within a segment is escaped). A leading
// (e.g //server/share) is preserved via leading ++.
Literal % characters anywhere in the inputs are encoded as %25 so that
%XX or %UXXXX lookalike sequences in names/targets round-trip literally.
Unicode characters are left unencoded (modern filesystems accept utf-8).
Only the filename is returned - no file is created; creating the
(normally zero-byte) link file is the caller's responsibility.
Not representable (raises an error): NUL characters anywhere; a literal
forward slash within the name, a tag, a comment or a target segment
(fauxlink deliberately provides no %XX decoding for the slash - path
structure must be expressed via the + separators); an empty comment
(resolve drops empty comments, so it cannot round-trip)."
@leaders -min 2 -max 2
name -type string -help\
"Nominal name for the link (may be empty to default to the target tail)"
"Nominal name for the link. May be empty: the encoded form then starts
with # and resolve reports the target tail as the effective name.
NOTE: some punkcheck-based punkshell tooling treats leading-# filenames
as hidden/aside - prefer a non-empty name in punkshell project trees."
target -type string -help\
"Target path the link should resolve to"
"Target path the link should resolve to (forward-slash separated)"
@opts
-tags -type list -default {} -help\
"List of tags for the tagset section. A literal @ within a tag is
encoded as %40 (the tagset uses @ as its separator)."
-comments -type list -default {} -help\
"List of non-empty comments (each becomes one #-delimited section)"
-extension -type string -default "fauxlink" -choices {fauxlink fxlnk} -help\
"File extension for the link filename"
}]
}
proc link_as {name target} {
#todo - implement the encoder counterpart of resolve
error "fauxlink::link_as not yet implemented"
proc link_as {name target args} {
#manual args parsing - punk::args PUNKARGS definition above is documentation-only
#(keep behaviour synchronized with the definition)
set opts [dict create -tags {} -comments {} -extension fauxlink]
foreach {k v} $args {
switch -- $k {
-tags - -comments - -extension {
dict set opts $k $v
}
default {
error "fauxlink::link_as unknown option '$k'. Known options: -tags -comments -extension"
}
}
}
set extension [dict get $opts -extension]
if {$extension ni [list fauxlink fxlnk]} {
error "fauxlink::link_as -extension must be fauxlink or fxlnk"
}
if {[tcl::string::first / $name] >= 0} {
error "fauxlink::link_as name cannot contain a forward slash (no %XX decoding exists for it - see fauxlink::resolve)"
}
set encname [Segment_encode $name]
set enctarget_parts [list]
foreach segment [split $target /] {
lappend enctarget_parts [Segment_encode $segment]
}
set enctarget [join $enctarget_parts +]
set enctags [list]
foreach tag [dict get $opts -tags] {
if {[tcl::string::first / $tag] >= 0} {
error "fauxlink::link_as tag cannot contain a forward slash"
}
#encode literal @ within a tag - @ is the tagset separator
lappend enctags [tcl::string::map {@ %40} [Segment_encode $tag]]
}
set enccomments [list]
foreach comment [dict get $opts -comments] {
if {$comment eq ""} {
error "fauxlink::link_as empty comment is not representable (resolve drops empty comments)"
}
if {[tcl::string::first / $comment] >= 0} {
error "fauxlink::link_as comment cannot contain a forward slash"
}
lappend enccomments [Segment_encode $comment]
}
set parts [list $encname $enctarget]
if {[llength $enctags]} {
lappend parts "@[join $enctags @]"
if {![llength $enccomments]} {
#force a 4th (empty comment) section so the tagset is not read as a comment
lappend parts ""
} else {
lappend parts {*}$enccomments
}
} elseif {[llength $enccomments]} {
#explicit empty tagset section keeps comments unambiguous
lappend parts "" {*}$enccomments
}
return "[join $parts #].$extension"
}
#proc sample1 {p1 args} {
@ -717,7 +815,7 @@ namespace eval ::punk::args::register {
package provide fauxlink [namespace eval fauxlink {
variable pkg fauxlink
variable version
set version 0.1. 2
set version 0.2.0
}]
return
