You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

330 lines
9.5 KiB

#JMN 2007
#public domain
#experimental
#VERY incomplete
package require pattern
package require patternlib
package require struct::set
package provide pattern::ms [namespace eval ::pattern::ms {
variable version
set version 1.0.12
}]
#--------------------------------------------------
namespace eval ::pattern::ms {
::>pattern .. Create >IEnumerable
>IEnumerable .. PatternVariable i ;#current index
>IEnumerable .. PatternProperty Current
>IEnumerable .. PatternPropertyRead Current {} {
var o_list i
return [lindex $o_list $i]
}
>IEnumerable .. PatternMethod MoveNext {} {
var i
incr i
}
>IEnumerable .. PatternMethod Reset {} {
var i
set i 0
}
}
#--------------------------------------------------
namespace eval ::pattern::ms {
::>pattern .. Create >Enumerator
>Enumerator .. PatternVariable o_enumerable
>Enumerator .. Constructor {IEnumerable_object} {
var o_enumerable
set o_enumerable $IEnumerable_object
}
>Enumerator .. PatternMethod atEnd {} {
var i o_list
return [expr {$i >= ([llength $o_list] -1)} ]
}
>Enumerator .. PatternMethod moveNext {} {
var i
incr i
}
>Enumerator .. PatternMethod moveFirst {} {
var i
set i 0
}
>Enumerator .. PatternMethod item {} {
var i o_list
return [lindex $o_list $i]
}
}
#--------------------------------------------------
namespace eval ::pattern::ms {
::>pattern .. Create >textstream
>textstream .. PatternVariable o_fd ;#file descriptor
>textstream .. Constructor {args} {
set opts [dict merge {
-mode r
} $args]
if {([dict get $opts -mode] eq "r") && ![file exists [dict get $opts -path]]} {
error "file [dict get $opts -path] not found"
}
set o_fd [open [dict get $opts -path] [dict get $opts -mode]]
return
}
>textstream .. PatternMethod Write {data} {
var o_fd
puts -nonewline $o_fd $data
}
>textstream .. PatternMethod WriteLine {{line ""}} {
var o_fd
puts $o_fd $line
}
>textstream .. PatternMethod WriteBlankLines {howmany} {
var o_fd
#!todo - work out proper line-ending and write in single call.
if {$howmany > 0} {
for {set i 0} {$i < $howmany} {incr i} {
puts $o_fd ""
}
}
}
>textstream .. PatternMethod Read {{numbytes ""}} {
var o_fd
if {[string length $numbytes]} {
return [read $o_fd $numbytes]
} else {
return [read $o_fd]
}
}
>textstream .. PatternMethod ReadLine {} {
var o_fd
return [gets $o_fd]
}
>textstream .. PatternMethod ReadAll {} {
var o_fd
return [read $o_fd] ;#don't use size argument - we can't be sure it hasn't changed since opening (?)
}
>textstream .. PatternMethod Skip {numchars} {
var o_fd
seek $o_fd $numchars current
}
>textstream .. PatternMethod SkipLine {} {
var o_fd
gets $o_fd
return
}
>textstream .. PatternMethod Close {} {
var o_fd
close $o_fd
}
}
#------------------------------------------------------------------------------
# https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/file-object
namespace eval ::pattern::ms {
::>pattern .. Create >fso_file
>fso_file .. PatternVariable o_path
>fso_file .. Constructor {args} {
var this o_path
set this @this@
set opts [dict merge {
} $args]
if {![file exists [dict get $opts -path]]} {
error "cannot find file '[dict get $opts -path]'"
}
if {![file isfile [dict get $opts -path]]} {
error "path '[dict get $opts -path]' does not appear to be a file"
}
set o_path [dict get $opts -path]
return
}
>fso_file .. PatternProperty Name
>fso_file .. PatternPropertyRead Name {} {
var o_path
return [file tail $o_path] ;#???
}
>fso_file .. PatternPropertyWrite Name {newname} {
var o_path
file rename $o_path [file dirname $o_path]/$newname
return
}
>fso_file .. PatternProperty Path
>fso_file .. PatternPropertyRead Path {} {
var o_path
return $o_path
}
}
#------------------------------------------------------------------------------
namespace eval ::pattern::ms {
::>pattern .. Create >fso_folder
>fso_folder .. PatternVariable o_path
>fso_folder .. PatternVariable o_files ;#collection
>fso_folder .. Constructor {args} {
var this ns o_path o_files
set this @this@
set ns [$this .. Namespace]
set opts [dict merge {
} $args]
if {![file exists [dict get $opts -path]]} {
error "cannot find folder '[dict get $opts -path]'"
}
if {![file isdirectory [dict get $opts -path]]} {
error "path '[dict get $opts -path]' does not appear to be a folder"
}
set o_path [dict get $opts -path]
set o_files [::patternlib::>collection .. Create ${ns}::>col_files]
return
}
#!todo - what happens to the object? destroy it?
>fso_folder .. PatternMethod Delete {{force 0}} {
var this o_path
if {$force} {
file delete -force $o_path
} else {
file delete $o_path
}
#??
# $this .. Destroy
return
}
>fso_folder .. PatternProperty DateCreated
>fso_folder .. PatternPropertyRead DateCreated {} {
var o_path
file stat $o_path info
return $info(ctime)
}
>fso_folder .. PatternProperty DateLastAccessed
>fso_folder .. PatternPropertyRead DateLastAccessed {} {
var o_path
return [file atime $o_path]
}
>fso_folder .. PatternProperty DateLastModified
>fso_folder .. PatternPropertyRead DateLastModified {} {
var o_path
return [file mtime $o_path]
}
>fso_folder .. PatternProperty Files
>fso_folder .. PatternPropertyRead Files {} {
var ns o_path objectcounter o_files
set filenames [glob -dir $o_path -type f -tail *]
lappend filenames {*}[glob -dir $o_path -types {f hidden} -tail *]
set NEW [::pattern::ms::>fso_file .. Create .]
set files [list]
set superfluous [struct::set difference [$o_files . names] $filenames]
foreach doomed $superfluous {
set f [$o_files . item $doomed]
$f .. Destroy
$o_files . del $doomed
}
set missing [struct::set difference $filenames [$o_files . names]]
foreach fname $missing {
if {[catch {
set fobj [$NEW ${ns}::>fl_[incr objectcounter] -path $o_path/$fname]
} errM]} {
#There can exist characterSpecial files such as 'nul' that aren't identified as file or directory by Tcl 'file isfile' or 'file isdirectory'
# yet were picked up by glob
#(these shouldn't really exist - but can be accidentally created)
#we don't want an error in creating an >fso_file for this to stop us accessing any other files in the folder
#but we should at least be loud about it by emitting the error to stderr
puts stder "
}
$o_files . add [$NEW ${ns}::>fl_[incr objectcounter] -path $o_path/$fname] $fname
}
return [$o_files . items]
}
}
#------------------------------------------------------------------------------
#vba and vb6 File System Object (used the same COM component - Microsoft Scripting Runtime library scrrun.dll)
namespace eval ::pattern::ms {
::>pattern .. Create >fso
>fso .. PatternVariable objectcounter ;#
>fso .. Constructor {args} {
var this ns objectcounter
set this @this@
set ns [$this .. Namespace]
set objectcounter 0
}
>fso .. PatternMethod CreateTextFile {path {bool 1}} {
var ns objectcounter
set ts [::pattern::ms::>textstream .. Create ${ns}::>ts_[incr objectcounter] -path $path -mode w]
return $ts
}
>fso .. PatternMethod OpenTextFile {path mode {bool 1}} {
var ns objectcounter
switch -- [string tolower $mode] {
1 -
forreading {
set md r
}
2 -
forwriting {
set md w
}
8 -
forappending {
set md a
}
default {
error "unknown file mode - $mode"
}
}
set ts [::pattern::ms::>textstream .. Create ${ns}::>ts_[incr objectcounter] -mode $md -path $path]
return $ts
}
>fso .. PatternMethod GetFolder {path} {
var ns objectcounter
set fld [::pattern::ms::>fso_folder .. Create ${ns}::>fld_[incr objectcounter] -path $path]
return $fld
}
>fso .. PatternProperty Drives
>fso .. PatternPropertyRead Drives {} {
var ns
error "unimplemented"
#todo >fso_drive object and collection
}
}