Tcl Library Source Code

Check-in [3a80759025]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Reimplemented cluster::sleep to avoid vwait. (Nested vwaits go out into space under the wrong conditions) Added a new keyword "branchset" to the meta command. This allows you to input a dict, but tell the system that all of the elements are leaf points. (The option keyword does that now, this is a more general purpose tool.)
Timelines: family | ancestors | descendants | both | odie
Files: files | file ages | folders
SHA1: 3a80759025ba14ec76b2834f5a7aa0437775d010
User & Date: hypnotoad 2015-09-17 17:35:31
Context
2015-09-21
10:32
Added a TOOL style description for Tcllib check-in: 6e5e58d40c user: hypnotoad tags: odie
2015-09-17
17:35
Reimplemented cluster::sleep to avoid vwait. (Nested vwaits go out into space under the wrong conditions) Added a new keyword "branchset" to the meta command. This allows you to input a dict, but tell the system that all of the elements are leaf points. (The option keyword does that now, this is a more general purpose tool.) check-in: 3a80759025 user: hypnotoad tags: odie
2015-09-09
19:05
Removed a puts statement from oo::meta. Removed the line which caused dict::is_dict to wipe out ::errorInfo check-in: b25f267b8e user: hypnotoad tags: odie
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/nns/nns_cluster.tcl.

︙︙
346
347
348
349
350
351
352
353
354
355
356
357
358

359

360
361
362
363
364
365
366

  }
  if [catch {::comm::comm send -async $commid $command {*}$args} reply] {
    puts $stderr "ERR: SEND $service $reply"
  }
}

proc ::cluster::sleep ms {
  update
  set sid [incr ::_sleep_id]
  set ::_sleep_flag($sid) 0
  after $ms [list set ::_sleep_flag($sid) 1]
  vwait ::_sleep_flag($sid)
  unset -nocomplain ::_sleep_flag($sid)

  update

}

###
# topic: c8475e832c912e962f238c61580b669e
###
proc ::cluster::search pattern {
  set result {}  








<
|
<
<
<
<
>
|
>








346
347
348
349
350
351
352

353




354
355
356
357
358
359
360
361
362
363

  }
  if [catch {::comm::comm send -async $commid $command {*}$args} reply] {
    puts $stderr "ERR: SEND $service $reply"
  }
}

proc ::cluster::sleep ms {

  set start [clock milliseconds]




  while {([clock milliseconds]-$start) < $ms} {
    update
  }
}

###
# topic: c8475e832c912e962f238c61580b669e
###
proc ::cluster::search pattern {
  set result {}
︙︙
459
460
461
462
463
464
465
466

  # See: RFC3692 and http://www.iana.org
  variable discovery_group 224.0.0.200
  variable local_port {}
  variable local_macid [lindex [::nettool::mac_list] 0]
  variable local_pid   [::uuid::uuid generate]
}

package provide nameserv::cluster 0.2.2








|

456
457
458
459
460
461
462
463

  # See: RFC3692 and http://www.iana.org
  variable discovery_group 224.0.0.200
  variable local_port {}
  variable local_macid [lindex [::nettool::mac_list] 0]
  variable local_pid   [::uuid::uuid generate]
}

package provide nameserv::cluster 0.2.3

Changes to modules/nns/pkgIndex.tcl. 

1
2
3
4
5
6
7
8

if {![package vsatisfies [package provide Tcl] 8]} {return}
package ifneeded nameserv::common 0.1 [list source [file join $dir common.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded nameserv         0.4.2 [list source [file join $dir nns.tcl]]
package ifneeded nameserv::server 0.3.2 [list source [file join $dir server.tcl]]
package ifneeded nameserv::auto   0.3   [list source [file join $dir nns_auto.tcl]]
package ifneeded nameserv::cluster 0.2.2   [list source [file join $dir nns_cluster.tcl]]








|

1
2
3
4
5
6
7
8

if {![package vsatisfies [package provide Tcl] 8]} {return}
package ifneeded nameserv::common 0.1 [list source [file join $dir common.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded nameserv         0.4.2 [list source [file join $dir nns.tcl]]
package ifneeded nameserv::server 0.3.2 [list source [file join $dir server.tcl]]
package ifneeded nameserv::auto   0.3   [list source [file join $dir nns_auto.tcl]]
package ifneeded nameserv::cluster 0.2.3   [list source [file join $dir nns_cluster.tcl]]

Changes to modules/ooutil/oometa.tcl.

︙︙
130
131
132
133
134
135
136








137
138
139
140
141
142
143

      set info [properties $class]
      return [uplevel 1 [list ::dict $submethod [lindex $args 0] [dict get $info {*}[lrange $args 1 end-1]] [lindex $args end]]]
    }
    with {
      upvar 1 TEMPVAR info
      set info [properties $class]
      return [uplevel 1 [list ::dict with TEMPVAR {*}$args]]








    }
    append -
    incr -
    lappend -
    set -
    unset -
    update {








>
>
>
>
>
>
>
>








130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

      set info [properties $class]
      return [uplevel 1 [list ::dict $submethod [lindex $args 0] [dict get $info {*}[lrange $args 1 end-1]] [lindex $args end]]]
    }
    with {
      upvar 1 TEMPVAR info
      set info [properties $class]
      return [uplevel 1 [list ::dict with TEMPVAR {*}$args]]
    }
    branchset {
      if {$class ni $::oo::meta::dirty_classes} {
        lappend ::oo::meta::dirty_classes $class
      }
      foreach {field value} [lindex $args end] {
        ::dict set ::oo::meta::local_property($class) {*}[lrange $args 0 end-1] [string trimright $field :] $value
      }
    }
    append -
    incr -
    lappend -
    set -
    unset -
    update {
︙︙
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339

    ::oo::meta::info $class set option $field [string trim $prop :]: $value
  }
}

oo::define oo::class {

  method meta {submethod args} {
    set class [self]
    switch $submethod {
      is {
        set info [::oo::meta::properties $class]
        return [string is [lindex $args 0] -strict [dict getnull $info {*}[lrange $args 1 end]]]
      }
      for -
      map {
        set info [::oo::meta::properties $class]
        return [uplevel 1 [list dict $submethod [lindex $args 0] [dict get $info {*}[lrange $args 1 end-1]] [lindex $args end]]]
      }
      with {
        upvar 1 TEMPVAR info
        set info [::oo::meta::properties $class]
        return [uplevel 1 [list dict with TEMPVAR {*}$args]]
      }
      dump {
        return [::oo::meta::properties $class]
      }
      append -
      incr -
      lappend -
      set -
      unset -
      update {
        ::oo::meta::info $class rebuild
        return [dict $submethod config {*}$args]
      }
      merge {
        ::oo::meta::info $class rebuild
        return [dict $submethod config {*}$args]
      }
      default {
        set info [::oo::meta::properties $class]
        return [dict $submethod $info {*}$args] 
      }
    }
  }
  
}

oo::define oo::object {
    
  method meta {submethod args} {








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








297
298
299
300
301
302
303

















304



















305
306
307
308
309
310
311

    ::oo::meta::info $class set option $field [string trim $prop :]: $value
  }
}

oo::define oo::class {

  method meta {submethod args} {

















    return [::oo::meta::info [self] $submethod {*}$args]



















  }
  
}

oo::define oo::object {
    
  method meta {submethod args} {
︙︙
391
392
393
394
395
396
397





398
399
400
401
402
403
404

      append -
      incr -
      lappend -
      set -
      unset -
      update {
        return [dict $submethod config {*}$args]





      }
      rmerge -
      merge {
        set config [dict rmerge $config {*}$args]
        return $config
      }
      getnull {








>
>
>
>
>








363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381

      append -
      incr -
      lappend -
      set -
      unset -
      update {
        return [dict $submethod config {*}$args]
      }
      branchset {
        foreach {field value} [lindex $args end] {
          dict set config {*}[lrange $args 0 end-1] [string trimright $field :] $value
        }
      }
      rmerge -
      merge {
        set config [dict rmerge $config {*}$args]
        return $config
      }
      getnull {
︙︙
426
427
428
429
430
431
432
433

        set info [dict rmerge $class_properties $config]
        return [dict $submethod $info {*}$args] 
      }
    }
  }
}

package provide oo::meta 0.2








|

403
404
405
406
407
408
409
410

        set info [dict rmerge $class_properties $config]
        return [dict $submethod $info {*}$args] 
      }
    }
  }
}

package provide oo::meta 0.3

Changes to modules/ooutil/pkgIndex.tcl. 

1
2
3
4
5
6
7
8
9

#checker -scope global exclude warnUndefinedVar
# var in question is 'dir'.
if {![package vsatisfies [package provide Tcl] 8.5]} {
    # PRAGMA: returnok
    return
}
package ifneeded oo::util 1.2.2 [list source [file join $dir ooutil.tcl]]
package ifneeded oo::meta 0.2 [list source [file join $dir oometa.tcl]]
package ifneeded oo::option 0.2 [list source [file join $dir oooption.tcl]]








|


1
2
3
4
5
6
7
8
9

#checker -scope global exclude warnUndefinedVar
# var in question is 'dir'.
if {![package vsatisfies [package provide Tcl] 8.5]} {
    # PRAGMA: returnok
    return
}
package ifneeded oo::util 1.2.2 [list source [file join $dir ooutil.tcl]]
package ifneeded oo::meta 0.3 [list source [file join $dir oometa.tcl]]
package ifneeded oo::option 0.2 [list source [file join $dir oooption.tcl]]

This page was generated in about 0.015s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19