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