# ACTIVESTATE TEAPOT-PKG BEGIN TM -*- tcl -*-
# -- Tcl Module

# @@ Meta Begin
# Package tcl::chan::string 1.0.1
# Meta as::build::date 2013-11-28
# Meta as::origin      http://sourceforge.net/projects/tcllib
# Meta category        Reflected/virtual channel support
# Meta description     Read-only in-memory channel
# Meta license         BSD
# Meta platform        tcl
# Meta require         {Tcl 8.5}
# Meta require         TclOO
# Meta require         tcl::chan::events
# Meta subject         {virtual channel} {tip 219} {in-memory channel}
# Meta subject         {reflected channel}
# Meta summary         tcl::chan::string
# @@ Meta End


# ACTIVESTATE TEAPOT-PKG BEGIN REQUIREMENTS

package require Tcl 8.5
package require TclOO
package require tcl::chan::events

# ACTIVESTATE TEAPOT-PKG END REQUIREMENTS

# ACTIVESTATE TEAPOT-PKG BEGIN DECLARE

package provide tcl::chan::string 1.0.1

# ACTIVESTATE TEAPOT-PKG END DECLARE
# ACTIVESTATE TEAPOT-PKG END TM
# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# @@ Meta Begin
# Package tcl::chan::string 1
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a channel representing
# Meta description an in-memory read-only random-access
# Meta description file. Based on using Tcl 8.5's channel
# Meta description reflection support. Exports a single
# Meta description command for the creation of new channels.
# Meta description One argument, the contents of the file.
# Meta description Result is the  handle of the new channel.
# Meta description Similar to -> tcl::chan::memchan, except
# Meta description that the content is read-only. Seekable
# Meta description only within the bounds of the content.
# Meta platform tcl
# Meta require TclOO
# Meta require tcl::chan::events
# Meta require {Tcl 8.5}
# @@ Meta End

# # ## ### ##### ######## #############

package require Tcl 8.5
package require TclOO
package require tcl::chan::events

# # ## ### ##### ######## #############

namespace eval ::tcl::chan {}

proc ::tcl::chan::string {content} {
    return [::chan create {read} [string::implementation new $content]]
}

oo::class create ::tcl::chan::string::implementation {
    superclass ::tcl::chan::events ; # -> initialize, finalize, watch

    constructor {thecontent} {
	set content $thecontent
	set at 0
	next
    }

    method initialize {args} {
	my Events
	next {*}$args
    }

    variable content at 

    method read {c n} {

	# First determine the location of the last byte to read,
	# relative to the current location, and limited by the maximum
	# location we are allowed to access per the size of the
	# content.

	set last [expr {min($at + $n,[string length $content])-1}]

	# Then extract the relevant range from the content, move the
	# seek location behind it, and return the extracted range. Not
	# to forget, switch readable events based on the seek
	# location.

	set res [string range $content $at $last]
	set at $last
	incr at

	my Events
	return $res
    }

    method seek {c offset base} {
	# offset == 0 && base == current
	# <=> Seek nothing relative to current
	# <=> Report current location.

	if {!$offset && ($base eq "current")} {
	    return $at
	}

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset    }] }
	    end     { set newloc [expr {$max + $offset - 1}] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc >= $max} {
	    return -code error "Cannot seek after the end of the channel"
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc

	my Events
	return $at
    }

    method Events {} {
	if {$at >= [string length $content]} {
	    my disallow read
	} else {
	    my allow read
	}
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::string 1.0.1
return