Overview
| Comment: | Began work on new pure-Tcl metakit, which will replace readkit-converted mk4tcl |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
7bfc5cf0e25159c5f43a0786167eea2b |
| User & Date: | rkeene on 2010-09-26 04:41:04 |
| Other Links: | manifest | tags |
Context
|
2010-09-26
| ||
| 04:41 | Updated to not produce spurious newline check-in: 0aa038624e user: rkeene tags: trunk | |
| 04:41 | Began work on new pure-Tcl metakit, which will replace readkit-converted mk4tcl check-in: 7bfc5cf0e2 user: rkeene tags: trunk | |
| 04:41 | Updated to be less verbose on missing directories check-in: ea9a5ecf91 user: rkeene tags: trunk | |
Changes
Added kitsh/buildsrc/kitsh-0.0/mk4tcl-new.tcl version [737d3e66d5].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 |
#! /usr/bin/env tclsh
namespace eval ::mk {}
namespace eval ::mk::file {}
namespace eval ::mk::view {}
namespace eval ::mk::cursor {}
namespace eval ::mk::row {}
namespace eval ::mk::private {}
proc ::mk::file {cmd args} {
set args [lindex $args 0 ::mk::file::${cmd}]
return [eval $args]
}
proc ::mk::file::open {args} {
if {[llength $args] == 0} {
# Return open tags
set retval [list]
foreach tag [array names ::mk::private::tags] {
unset -nocomplain taginfo
array set taginfo $::mk::private::tags($tag)
lappend retval $tag $taginfo(file)
}
return
}
set tag [lindex $args 0]
if {[info exists ::mk::private::tags($tag)]} {
return -code error "tag is already open"
}
set taginfo(writable) 1
set taginfo(commit_on_close) 1
set taginfo(commit_on_set) 0
set taginfo(extend) 0
set taginfo(shared) 0
if {[llength $args] == 1} {
# Use in-memory file
set taginfo(file) ""
set taginfo(fd) ""
} else {
set filename [lindex $args 1]
foreach opt [lrange $args 2 end] {
switch -- $opt {
"-readonly" {
set taginfo(writable) 0
}
"-nocommit" {
set taginfo(commit_on_close) 0
}
"-extend" {
set taginfo(extend) 1
}
"-shared" {
set taginfo(shared) 1
}
}
}
if {$taginfo(writable)} {
set fd [open $filename a+]
seek $fd 0 start
} else {
set fd [open $filename r]
}
set taginfo(file) $filename
set taginfo(fd) $fd
}
set ::mk::private::changes($tag) [list]
set ::mk::private::tags($tag) [array get taginfo]
}
proc ::mk::file::close {tag} {
if {![info exists ::mk::private::tags($tag)]} {
return -code error "no storage with this name"
}
array set taginfo $::mk::private::tags($tag)
if {$taginfo(commit_on_close) && $taginfo(writable) && $taginfo(fd) != ""} {
mk::file commit $tag -full
}
if {$taginfo(fd) != ""} {
close $taginfo(fd)
}
unset ::mk::private::changes($tag)
unset ::mk::private::tags($tag)
}
proc ::mk::file::views {{tag ""}} {
return -code error "Not Implemented"
}
proc ::mk::file::commit {tag {fullOpt ""}} {
if {![info exists ::mk::private::tags($tag)]} {
return -code error "no storage with this name"
}
array set taginfo $::mk::private::tags($tag)
if {$fullOpt == "-full"} {
# Flush asides
# XXX: TODO
}
if {$taginfo(fd) == ""} {
# We can't commit if we weren't asked to write to stable
# storage
return
}
# XXX: TODO
return -code error "Not Implemented"
}
proc ::mk::file::rollback {tag {fullOpt ""}} {
if {![info exists ::mk::private::tags($tag)]} {
return -code error "no storage with this name"
}
if {$fullOpt == "-full"} {
# Clear asides ...
# XXX: TODO
}
set ::mk::private::changes($tag) ""
}
proc ::mk::file::load {{tag ""} {channel ""}} {
return -code error "Not Implemented"
}
proc ::mk::file::save {{tag ""} {channel ""}} {
return -code error "Not Implemented"
}
proc ::mk::file::aside {{tag1 ""} {tag2 ""}} {
return -code error "Not Implemented"
}
proc ::mk::file::autocommit {tag} {
if {![info exists ::mk::private::tags($tag)]} {
return -code error "no storage with this name"
}
array set taginfo $::mk::private::tags($tag)
set taginfo(commit_on_close) 1
set ::mk::private::tags($tag) [array get taginfo]
}
proc ::mk::view {cmd args} {
return -code error "Not Implemented"
}
proc ::mk::cursor {cmd args} {
return -code error "Not Implemented"
}
proc ::mk::row {cmd args} {
return -code error "Not Implemented"
}
proc ::mk::get {args} {
return -code error "Not Implemented"
}
proc ::mk::set {args} {
return -code error "Not Implemented"
}
proc ::mk::loop {args} {
return -code error "Not Implemented"
}
proc ::mk::select {args} {
return -code error "Not Implemented"
}
proc ::mk::channel {args} {
return -code error "Not Implemented"
}
package provide Mk4tcl 2.4.9.6
|