@ Pohon BBS

computer programme fun

Go back: thread mode | tree mode | sub tree

#3.
Published: 2024-09-02 [Mon] 21:20, by Anonymous
package require Tclx
package require tclreadline

proc rm { target } {
if {[ file exists $target ]} {
file delete -- $target
return
}
error "error removing \"$target\": no such file or directory"
}

proc rmr { path } {
xpt rm [ tree $path ]
}

proc mv { src dst } {
file rename -force -- $src $dst
}

proc cp { src dst } {
file copy -force -- $src $dst
}

proc mkdir { path } {
file mkdir $path
}

proc ls {{ path . }} {
if { ! [ catch { file link $path }]} {
error "open of directory \"${path}\" failed: not a directory"
}
vert [ readdir $path ]
}

proc lsn {{ path . }} {
vert [ enumerate [ ls $path ]] 2
}

proc cdn { n } {
cd [ sel $n ]
}

proc scroll { txt } {
set fd [ open "| less" w ]
puts $fd $txt
close $fd
}

proc vert { l { w 1 }} {
set out ""
set i 1
foreach item $l {
append out [ list $item ]
if { $i % $w == 0 } {
set sep_c "\n"
} else {
set sep_c " "
}
incr i
append out $sep_c
}
string trimright $out
}

proc prefix { prefix l } {
for { set i 0 } { $i < [ llength $l ]} { incr i } {
lset l $i "$prefix[ lindex $l $i ]"
}
return $l
}

proc enumerate { l } {
set out [ dict create ]
for { set i 0 } { $i < [ llength $l ]} { incr i } {
dict set out $i [ lindex $l $i ]
}
return $out
}

proc sel { n { path . }} {
dict get [ lsn $path ] $n
}

proc xp { cmd args_list { tail "" }} {
set out [ list ]
foreach item $args_list {
if { $tail eq "" } {
set retval [ uplevel 1 [ list {*}$cmd $item ]]
} else {
set retval [ uplevel 1 [ list {*}$cmd $item {*}$tail ]]
}
if { $retval ne "" } {
lappend out $retval
}
}
return $out
}

proc xpt { cmd tree { tail "" } { depth 1 }} {
set name [ lindex $tree 0 ]
set branches [ lindex $tree 1 ]

if {[ llength $branches ] == 0 } {
if { $tail eq "" } {
return [ uplevel $depth [ list {*}$cmd $name ]]
} else {
return [ uplevel $depth [ list {*}$cmd $name {*}$tail ]]
}
}

lappend branches [ list $name [ list ]]
set out [ list ]
foreach branch $branches {
set retval [ xpt $cmd $branch $tail [ expr { $depth + 1 }]]
if { $retval ne "" } {
lappend out $retval
}
}
return $out
}

proc tree {{ path . } { max_depth -1 } { depth 0 }} {
set path [ string trimright $path "/" ]
if {[ catch { ls $path } subdirs ]
|| ( $max_depth >= 0 && $depth > $max_depth )} {
set subdirs {}
}
incr depth
set ugly [ xp tree [ prefix "${path}/" $subdirs ] "$max_depth $depth" ]
list $path [ prefix "\n" [ vert [ prefix [ string repeat " " $depth ] $ugly ]]]
}
.

New Reply



(new)

You need to solve the captcha before you can post.

Parents

#2.
Published: 2024-09-02 [Mon] 17:51, by Anonymous
WHERE'S THE SOURCE CODE, LEBOWSKI?
.

#1. computer programme fun
Published: 2024-09-01 [Sun] 09:23, by Anonymous
the 'tree' command for my little tcl utilities collection now pretty
prints, but is still valid data. format is { path { subdirectories }}

example output:

mush {{
mush/people.tcl {}} {
mush/player.tcl {}} {
mush/input.tcl {}} {
mush/notions.tcl {}} {
mush/mush.tcl {}} {
mush/c {{
mush/c/raymath.h {}} {
mush/c/raylib.h {}} {
mush/c/raygui.h {}} {
mush/c/libraylib.a {}} {
mush/c/rl.c {}} {
mush/c/make.tcl {}} {
mush/c/rlgl.h {}} {
mush/c/rl.so {}}}} {
mush/graphics.tcl {}} {
mush/tool.tcl {}} {
mush/tools.txt {}} {
mush/proto.tcl {}} {
mush/event.tcl {}} {
mush/object.tcl {}}}
.
Pohon BBS