@ Pohon BBS
computer programme fun (5 replies)

■ 🕑 2.
│  WHERE'S THE SOURCE CODE, LEBOWSKI?
│   
└─■ 🕑 3.
  │  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 ]]]
  │  }
  │  
  │   
  └─■ 🕑 4.
      last line in tree got wrapped for some reason, tclreadline isn't actually
      needed (leftover from old interactive thing) and i forgot to remove it
       

Pohon BBS