
# ===================

proc memchan {} {
    return [chan create {read write} [mystringchan %AUTO% {}]]
}

# ===================

snit::type mystringchan {
    
    constructor {data} {
   	# Initialize the buffer, current read location, and limit
   	set mydata $data
   	set myend [string length $mydata]
   	set mypos 0
    }
    
    # Setting up, shutting down.
    
    method initialize {chan mode} {
   	# Note: We can assume that mode is a list containing 'read'
   	# and/or 'write'. No checking required. We don't do anything
   	# with it in this example.
	
   	# A read-only type of channel can use it to verify that it was
   	# not opened for writing.
	
   	set mychan $chan
   	return
    }
    
    method finalize {chan} {
   	# We have nothing to finalize. Other channels may have to
   	# release external resources.
   	return
    }
    
    # Option handling. This channel has no options.
    
    method configure {chan option value} {
   	# No options, trying to write to any specific one is bogus.
   	return -code error "Invalid option '$option'"
    }
    
    method cget {chan option} {
   	# No options, trying to get any specific one is bogus.
   	return -code error "Invalid option '$option'"
    }
    
    method cgetall {chan} {
   	# No options, nothing to report.
   	return {}
    }
    
    # Basic I/O
    
    method read {chan n} {
   	# This is only called for a channel opened for reading. No
   	# need to check. Do checks in 'initialize'.
	
   	set endofrequest [expr ($mypos + $n - 1)]
   	if {$endofrequest < $myend} {
   	    # Get requested chunk, and move seek location behind it.
   	    set res [string range $mydata $mypos $endofrequest]
   	    set mypos $endofrequest
   	} else {
   	    # Cut short at end of buffer. Move to end of buffer.
   	    set res [string range $mydata $mypos end]
   	    set mypos $myend
   	}
	
   	return $res
    }
    
    method write {chan data} {
   	# This is only called for a channel opened for writing. No
   	# need to check. Do checks in 'initialize'.
	
   	set n [string length $data]
	
   	if {$mypos >= $myend} {
   	    # Append at end
   	    append mydata $data
   	    set myend [string length $mydata]
   	    set mypos $myend
   	    return $n
   	}
	
   	# Overwrite in the middle, may extend after the end
	
   	set endofrequest [expr ($mypos + $n - 1)]
   	if {$endofrequest >= $myend} {
   	    # Yes, extending beyond.
   	    set mydata [string replace $mydata $mypos end $data]
   	    set myend [string length $mydata]
   	    set mypos $myend
   	    return $n
   	}
	
   	# Replace in the middle.
	
   	set mydata [string replace $mydata $mypos $endofrequest $data]
   	set myend [string length $mydata]
   	set mypos $endofrequest
   	return $n
    }
    
    method seek {chan offset base} {
   	# Do a quick check for and bypass if this is a 'tell' request,
   	# i.e. do not seek, just report position.
	
   	if {!$offset && ($base eq "current")} {
   	    return $mypos
   	}
	
   	# Compute new location per the arguments.
	
   	switch -exact -- $base {
   	    start   { set newloc $offset}
   	    current { set newloc [expr {$mypos + $offset    }] }
   	    end     { set newloc [expr {$myend + $offset - 1}] }
   	}
	
   	# Check for new location getting out of range
	
   	if {$newloc < 0} {
   	    return -code error "Cannot seek before the start of the channel"
   	} elseif {$newloc > $myend} {
   	    # Here a different semantics is possible: Allow seeking
   	    # behind the end of the channel, auto-append \0. The
   	    # append may be defered until the data is actually needed,
   	    # or not happen at all, if the system is made complex
   	    # enough to handle disparate fragments instead of using a
   	    # single string as the buffer. That however is all beyond
   	    # the scope of this example.
	    
   	    return -code error "Cannot seek after the end of the channel"
   	}
	
   	# Commit to new location and report.
	
   	set mypos $newloc
   	return $newloc
    }
    
    # Event management.
    
    method blocking {chan mode} {
   	# We are like a file, not really blocking even in blocking
   	# mode.
   	return
    }
    
    method watch {chan eventstowatch} {
   	# Set up and/or shut down the timers used to generate events
   	# based on the set of events asked for.
	
   	# Note: A possible expansion is the export of one or more
   	# options through which a user can specify the time interval
   	# between events, either in general, or separately for
   	# read/write.
	
   	if {"read" in $eventstowatch} {
   	    set myreadtimer [after 5 [mymethod Readable]]
   	} else {
   	    after cancel $myreadtimer
   	}
	
   	if {"write" in $eventstowatch} {
   	    set mywritetimer [after 5 [mymethod Writable]]
   	} else {
   	    after cancel $mywritetimer
   	}
   	return
    }
    
    # Internals. State
    
    variable mydata       {} ; # The data delivered by the channel. Binary.
    variable mypos        0  ; # Current read location.
    variable myend        0  ; # First location after end of the buffer.
    variable mychan       {} ; # Handle of the channel we are at the Tcl level.
    variable myreadtimer  {} ; # Timer for generation of read events
    variable mywritetimer {} ; # Ditto for write events.
    
    # Internals. Methods. Event generation.
    
    method Readable {} {
   	set myreadtimer [after 5 [mymethod Readable]]
   	chan postevent $mychan read
   	return
    }
    
    method Writable {} {
   	set mywritetimer [after 5 [mymethod Writable]]
   	chan postevent $mychan write
   	return
    }
}
