cursors.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
immutable class CURSOR_ERRORS < $ENUMS{CURSOR_ERRORS}
immutable class CURSOR_ERRORS < $ENUMS{CURSOR_ERRORS} is
-- This is an enumeration class which describes the different
-- units of measurement which may be used for import/export of data values.
-- Note that it provides an ordered domain.
--
-- The strings to be read into the Names array are expected to be
-- culturally appropriate strings having the following meanings --
--
-- The item found was expected to be a digit but is not.
--
-- An attempt has been made to go beyond the end of the buffer.
--
-- An attempt has been made to go before the start of the buffer.
--
-- During an attempt to convert buffer contents to a value of some
-- class the conversion could not be carried out because of
-- implementation limitations (eg cardinal number out of implemented
-- range).
--
-- During a buffer search the element being sought was not found.
--
-- During an attempt to convert from buffer contents to a value of
-- some class an item not conforming to the expected syntax for
-- such a value was encountered.
--
-- During an attempt to skip past some item in the buffer the end of
-- buffer was encountered.
--
-- An attempt to advance by an item has occurred when the end had
-- already been reached.
-- Version 1.0 Jan 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 11 Jan 97 kh Original
include ENUM{CURSOR_ERRORS} ;
private const val_count : CARD := 8 ;
-- The next routines provide the enumeration itself.
Not_Digit : SAME is return enum(1) end ;
Past_End : SAME is return enum(2) end ;
Past_Beginning : SAME is return enum(3) end ;
Conversion_Error : SAME is return enum(4) end ;
Element_Not_Found : SAME is return enum(5) end ;
Format_Error : SAME is return enum(6) end ;
Bad_Block : SAME is return enum(7) end ;
Already_at_End : SAME is return enum(8) end ;
end ; -- CURSOR_ERRORS
partial class CURSOR{ELT < $IS_EQ, STP < $STRING{ELT}}
partial class CURSOR{ELT < $IS_EQ, STP < $STRING{ELT}} is
-- This partial class implements those common portions of cursor
-- functionality which are independent of the string element class.
--
-- The purpose of the cursor class is to extract sections of strings and,
-- where appropriate, perform conversions to program attributes in the
-- process of 'scanning'. This permits perfectly general scanning which
-- depends only on the correct interpretation of the string contents and
-- structure.
--
-- Since the string is not consumed by scanning, it is possible also to
-- perform test on contents/structure in order to 'synchronise' the program
-- with the data involved.
-- Version 1.0 Jan 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 12 Jan 97 kh Original developed from STR_CURSOR
readonly attr error : CURSOR_ERRORS ;
readonly attr index : CARD ;
readonly attr buffer : STP ;
readonly attr skip_val : ELT ;
readonly attr is_done : BOOL ;
reassign(str : STP)
pre ~void(self)
post (buffer = str)
and (index = 0)
and error.is_nil
and (skip_val = initial(skip_val))
and (is_done = (buffer.size = 0))
is
-- This routine changes the string to which this cursor is pointing,
-- so that the current element is the first. Any error condition is
-- cleared.
buffer := str ;
index := 0 ;
is_done := (buffer.size = 0) ;
clear_error
end ;
create(str : STP) : SAME
pre ~void(str)
post (result.buffer = str) and (result.is_done=(result.buffer.size=0))
is
-- This routine is the sole creation one for this class. It produces
-- a new cursor for use with the given string argument.
-- if str.size = 0 then return void; end ;
me : SAME := new ;
me.error := CURSOR_ERRORS::nil ;
me.skip_val := void ;
me.reassign(str) ;
--#OUT+"cursors.sa create: size="+me.buffer.size.str+", index="+me.index.str+",is_done="+me.is_done.str+"\n";
return me
end ;
advance
pre ~void(self)
post (initial(is_done) and ~error.is_nil)
or ((initial(index) + 1) = index)
is
-- This routine advances the cursor to the next string element. It is
-- an error if the end of the string was reached before this routine is
-- called.
if (is_done) then
error := CURSOR_ERRORS::Past_End
else
index := index + 1 ;
is_done := index >= buffer.size
end
end ;
advance : SAME
pre ~void(self)
post (initial(is_done) and ~error.is_nil)
or ((initial(index) + 1) = index)
is
-- This routine advances the cursor to the next string element as above
-- and returns the updated value of self.
advance ;
return self
end ;
retract
pre ~void(self)
post ((initial(index) = 0) and ~error.is_nil)
or ((initial(index) - 1) = index)
is
-- This routine retracts the cursor to point to the previous string
-- element. It is an error if the current value of the cursor indicated the
-- beginning of the string before this routine was called.
if index = 0 then
error := CURSOR_ERRORS::Past_Beginning
else
index := index - 1 ;
is_done := false
end
end ;
retract : SAME
pre ~void(self)
post ((initial(index) = 0) and ~error.is_nil)
or ((initial(index) - 1) = index)
is
-- This routine retracts the cursor to point to the previous string
-- element. It is an error if the current value of the cursor indicated the
-- beginning of the string before this routine was called. It then returns
-- the updated value of the cursor.
retract ;
return self
end ;
item : ELT
pre ~void(self) and (buffer.size > 0)
post ((is_done
or ~error.is_nil)
and void(result))
or (result = buffer[index])
is
-- This routine returns the string element indicated by the current
-- value of the cursor -- or void if an error condition exists. It does
-- NOT advance the cursor.
if (is_done)
or ~error.is_nil then
return void
else
return buffer[index]
end
end ;
set_index( new_posn : CARD)
pre (new_posn < buffer.size)
post (new_posn = index)
is
-- This routine resets the index position to new_posn, provided that
-- that is a valid index for the buffer and clears any end of buffer condition
-- which may have existed.
res : CARD := index ;
index := new_posn ;
is_done := false ;
if ~error.is_nil -- just in case no error at all!
and (error = CURSOR_ERRORS::Past_End) then
clear_error
end
end ;
clear
pre ~void(self)
post void(buffer)
and is_done
and (index = 0)
and error.is_nil
is
-- This routine resets the cursor to be indicating an empty string
-- and clears any error condition.
index := 0 ;
buffer := void ;
is_done := true ;
clear_error
end ;
set_skip(val : ELT)
pre ~void(self)
post skip_val = val
is
-- This routine sets the value of the element used in all skipping
-- operations - until this is next set.
skip_val := val
end ;
set_skip(val : ELT) : SAME
pre ~void(self)
post skip_val = val
is
-- This routine sets the value of the element used in all skipping
-- operations - until this is next set. It then returns self.
set_skip(val) ;
return self
end ;
-- The following operations all skip various parts of the string.
-- It is not an error if such skipping reaches the end of the
-- string.
skip_over
pre ~void(self) and (buffer.size > 0)
post is_done or (item /= skip_val)
is
-- This routine advances the cursor until the current element is
-- different from the currently set skip element.
loop
while!(~is_done) ;
if item = skip_val then
advance
else
break!
end
end
end ;
skip_over : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item /= skip_val)
is
-- This routine advances the cursor until the current element is
-- different from the currently set skip element value. It then returns self.
skip_over ;
return self
end ;
skip_to
pre ~void(self) and (buffer.size > 0)
post is_done or (item = skip_val)
is
-- This routine advances the cursor until the current element is equal
-- to the currently set skip element value.
loop
until!(is_done or (item = skip_val)) ;
advance
end
end ;
skip_to : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item = skip_val)
is
-- This routine advances the cursor until the current element is equal
-- to the currently set skip element value. It then returns self.
skip_to ;
return self
end ;
skip_to(elem : ELT)
pre ~void(self) and (buffer.size > 0)
post is_done or (item = elem)
is
-- This routine advances the cursor until the current element is equal
-- to the element value given.
loop
until!(is_done
or (item = elem)) ;
advance
end
end ;
skip_to( elem : ELT) : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item = elem)
is
-- This routine advances the cursor until the current element is equal
-- to the given element value. It then returns self.
skip_to(elem) ;
return self
end ;
skip_over( val : ELT)
pre ~void(self) and (buffer.size > 0)
post is_done or (index > initial(index))
is
-- This routine advances the cursor until the current element is
-- one after the first occurrence of the given element.
skip_to(val) ;
if ~is_done then
advance
end
end ;
skip_over( val : ELT) : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (index > initial(index))
is
-- This routine advances the cursor until the current element is one
-- element after the first occurrence of the skip value after the current
-- cursor position. It then returns self.
skip_over(val) ;
return self
end ;
skip_block(start_delimiter, finish_delimiter : ELT)
pre ~void(self)
and (buffer.size > 0)
and (buffer[index] = start_delimiter)
post (initial(index) = index) -- no finish delimiter!
or ((initial(index) < index)
and (buffer[index - 1] = finish_delimiter))
is
-- Providing that the current string element is start_delimiter, this
-- routine skips further string elements up to and including the matching
-- occurrence of finish_delimiter. It IS AN ERROR if the start delimiter
-- is found but not the finishing one.
start_index : CARD := index ;
if (item = start_delimiter) then
advance ;
loop
if item = finish_delimiter then
advance ; -- past the end!
return
elsif item = start_delimiter then -- recursive call needed!
skip_block(start_delimiter,finish_delimiter)
elsif is_done then
error := CURSOR_ERRORS::Bad_Block ;
set_index(start_index) ;
return
else
advance
end
end
else
error := CURSOR_ERRORS::Element_Not_Found
end
end ;
remaining : CARD is
-- This routine returns the number of items yet to be scanned in
-- the buffer.
if buffer.size = 0 then
return 0
else
return buffer.size - index
end
end ;
-- The following group of predicates indicate whether the remaining
-- string from the currently indicated element is correctly formed
-- to produce an item of the indicated class if the elements were
-- to be retrieved.
is_value( val : ELT) : BOOL is
-- This predicate returns true if and only if the current string element
-- has the value val, otherwise false.
return item = val
end ;
get_item : ELT
pre ~void(self)
and ~void(buffer)
post is_done
or ((initial(index) + 1) = index)
is
-- This routine returns the currently indicated item and advances
-- the cursor value by one. Note that it is not an error condition if
-- the cursor cannot be advanced as the current cursor value indicates
-- the last element in the string.
res : ELT := item ;
advance ;
return res
end ;
get_upto( elem : ELT) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (item = elem))
is
-- This routine returns the string starting at the current element
-- until either the element with the value elem is reached or the end of
-- the string, whichever occurs first. It is an error if elem is not
-- detected before the end of the string.
res : STP := STP::create ;
loop
if (is_done
or (item = elem)) then
break!
else
res := res + get_item
end
end ;
return res
end ;
get_upto : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (item = skip_val))
is
-- This routine scans the string from the current element, skipping
-- until a value which is not the current value of skip_val is found, then
-- up to the next occurrence of the current value of the skip_val,
-- returning the string scanned NOT including the skip element found.
-- It is NOT an error if the skip element is not detected before the end of
-- the string.
loop
if is_done or (item /= skip_val) then
break!
else
advance
end
end ;
res : STP := STP::create ;
loop
if (is_done or (item = skip_val)) then
break!
else
res := res + get_item
end
end ;
return res
end ;
get_upto(count : CARD) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (result.size = initial(count)))
is
-- This routine returns the string starting at the current element
-- until either the given count is reached or the end of the string,
-- whichever occurs first.
res : STP := STP::create ;
loop
if (is_done or (count = 0)) then
break!
else
res := res + get_item ;
count := count - 1
end
end ;
return res
end ;
get_rest_upto( elem : ELT) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (self.item = elem))
is
-- This routine returns the string starting at the current element
-- until either the element with the value elem is reached or the end of
-- the string, whichever occurs first. It is NOT an error if elem is not
-- detected before the end of the string.
start : CARD := index ;
loop -- to scan for elem (or end!)
if is_done then
break!
end ;
while!(elem /= item) ;
advance
end ;
return buffer.substring(start,index - start)
end ;
get_block( begin_delimiter, finish_delimiter : ELT ) : STP
pre ~void(self) and (buffer.size > 0)
post (void(error)
and (result[0] = begin_delimiter)
and (result[result.size - 1] = finish_delimiter))
or (void(result)
and (initial(index) = index))
is
-- This routine returns the string up to and including the next
-- occurrence of the finish_delimiter provided that the current character
-- is begin_delimiter. Searching is done recursively to permit nested
-- blocks. It is an error if the finish delimiter is not found, in which
-- case the cursor is unchanged, the error has been set and void is returned.
start_index : CARD := index ; -- in case need to restore!
res : STP := STP::create ;
if (item = begin_delimiter) then
res := res + get_item ;
loop
if item = finish_delimiter then
res := res + get_item ;
return res
elsif item = begin_delimiter then
loc_block : STP := get_block(begin_delimiter,finish_delimiter) ;
if void(loc_block) then
set_index(start_index) ; -- error already set!
return void
else
res := res + loc_block
end
elsif is_done then
set_index(start_index) ;
error := CURSOR_ERRORS::Bad_Block ;
return void
else
res := res + get_item
end
end
else
error := CURSOR_ERRORS::Element_Not_Found ; -- posn still at start!
return void
end ;
return res
end ;
get_remainder : STP
pre ~void(self) and (buffer.size > 0)
post is_done
and (result.size = (buffer.size - initial(index)))
is
-- This routine returns the remainder of the string from the cursor
-- current position.
is_done := true ;
res : STP := buffer.tail(remaining) ;
index := buffer.size ;
return res
end ;
clear_error
pre ~void(self)
post error.is_nil
is
-- This routine resets the error value to 'No Error'.
error := error.nil
end ;
has_error : BOOL is
-- This predicate returns true if and only if the cursor has encountered
-- an error which has not been cleared. Note - this implementation is a hack
-- because of compiler 'confusion' between zero and void for immutable types.
return ~error.is_nil
end ;
end ; -- CURSOR{ELT}
partial class TEXT_CURSOR{ELT < $IS_EQ, STP < $TEXT_STRING{ELT}}
partial class TEXT_CURSOR{ELT < $IS_EQ, STP < $TEXT_STRING{ELT}} is
-- This partial class implements those common portions of text cursor
-- functionality which are independent of the form of the string element.
-- Version 1.0 Apr 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 12 Apr 99 kh Original for Version 8 of text classes.
include CURSOR{ELT,STP}
reassign -> ;
readonly attr line_no : CARD ;
readonly attr comment_start : STP ;
readonly attr comment_end : STP ;
reassign( str : STP)
pre ~void(self)
and ~void(str)
post (buffer = str)
and (index = 0)
and error.is_nil
-- and ~is_done
is
-- This routine changes the string to which this cursor is pointing,
-- so that the current element is the first. Any error condition is
-- cleared.
buffer := str ;
index := 0 ;
line_no := 0 ;
comment_start := STP::create(buffer.index_lib.Space) ;
is_done := index >= buffer.size ;
clear_error
end ;
reset_line(val : CARD)
pre ~void(self)
post line_no = val
is
-- This is provided for use when it has been necessary to change to
-- different positions in the string, using set_index. If track needs to be
-- kept of the line number then this routine enables restoration.
line_no := val
end ;
set_comment_start(char : ELT)
pre ~void(self)
post (comment_start[0] = char)
is
-- This routine sets the first comment character and clears the second to null.
comment_start := STP::create(char)
end ;
set_comment_start(str : STP)
pre ~void(self)
post (comment_start = str)
is
-- This routine sets both comment characters.
comment_start := str
end ;
set_comment_end(char : ELT)
pre ~void(self)
post (comment_start[0] = char)
is
-- This routine sets the first comment character and clears the second to null.
comment_end := STP::create(char)
end ;
set_comment_end(str : STP)
pre ~void(self)
post (comment_end = str)
is
-- This routine sets both comment characters.
comment_start := str
end ;
advance
pre ~void(self)
post (initial(is_done) and ~error.is_nil)
or ((initial(index) + 1) = index)
is
-- This routine advances the cursor to the next string element. It is
-- an error if the end of the string was reached before this routine is called.
if (is_done) then
error := CURSOR_ERRORS::Past_End
else
index := index + 1 ;
is_done := index >= buffer.size ;
if is_line_mark then
line_no := line_no + 1
end
end
end ;
retract
pre ~void(self)
post ((initial(index) = 0) and ~error.is_nil)
or ((initial(index) - 1) = index)
is
-- This routine retracts the cursor to point to the previous string element.
-- It is an error if the current value of the cursor indicated the
-- beginning of the string before this routine was called.
if index = 0 then
error := CURSOR_ERRORS::Past_Beginning
else
index := index - 1 ;
if is_line_mark then
line_no := line_no - 1
end ;
is_done := index >= buffer.size
end
end ;
private is_same(str : STP) : BOOL is
-- This predicate returns true if and only if the string starting at
-- the current positiion is identical to str. If true is returned then the
-- current index position is at the character next after str.
if remaining < str.size then
return false
else
start_index : CARD := index ;
loop
if item = str.elt! then
advance
else
index := start_index ;
return false
end
end ;
return true
end
end ;
skip_to(elem : ELT)
pre ~void(self)
and (buffer.size > 0)
post is_done
or (item = elem)
is
-- This routine advances the cursor until the current element is equal
-- to the element value given.
loop
until!(is_done or (item = elem)) ;
advance
end
end ;
skip_to(elem : ELT) : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item = elem)
is
-- This routine advances the cursor until the current element is equal
-- to the given element value. It then returns self.
skip_to(elem) ;
return self
end ;
skip_block(start_delimiter, finish_delimiter : ELT)
pre ~void(self)
and ~is_done
and (buffer.size > 0)
and (buffer[index] = start_delimiter)
post (initial(index) = index) -- no finish delimiter!
or ((initial(index) < index)
and (buffer[index - 1] = finish_delimiter))
is
-- Providing that the current string element is start_delimiter, this
-- routine skips further string elements up to and including the matching
-- occurrence of finish_delimiter. It IS AN ERROR if the start delimiter
-- is found but not the finishing one.
start_index : CARD := index ;
if (item = start_delimiter) then
advance ;
loop
if item = finish_delimiter then
advance ; -- past the end!
return
elsif item = start_delimiter then -- recursive call needed!
skip_block(start_delimiter,finish_delimiter)
elsif is_done then
error := CURSOR_ERRORS::Bad_Block ;
set_index(start_index) ;
return
else
advance
end
end
else
error := CURSOR_ERRORS::Element_Not_Found
end
end ;
skip_block(start : STP, stop : STP) : BOOL
pre ~void(self)
and ~is_done
and (buffer.size > 0)
post (initial(index) = index) -- no finish delimiter!
or (initial(index) < index)
is
-- Providing that the current string element is start_delimiter, this
-- routine skips further string elements up to and including the matching
-- occurrence of finish_delimiter. It IS AN ERROR if the start delimiter
-- is found but not the finishing one. True is returned if and only if
-- properly nesting blocks have been found.
start_index : CARD := index ;
skip_over(start) ;
if (index - start_index) = start.size then
loop
if is_done then
break!
end ;
loc_index : CARD := index ;
if item = stop[0] then
skip_over(stop) ;
if (index - loc_index) = stop.size then
return true
else
advance
end
elsif item = start[0] then
skip_over(start) ;
if (index - loc_index) = start.size then
index := loc_index ; -- a nested pair?!
return skip_block(start,stop)
else
advance
end
elsif is_done then
error := CURSOR_ERRORS::Bad_Block ;
set_index(start_index) ;
return false
else
advance
end
end
else
error := CURSOR_ERRORS::Element_Not_Found
end ;
return false
end ;
remaining : CARD is
-- This routine returns the number of items yet to be scanned in
-- the buffer.
return buffer.size - index
end ;
-- The following group of predicates indicate whether the remaining
-- string from the currently indicated element is correctly formed
-- to produce an item of the indicated class if the elements were
-- to be retrieved.
is_value(val : ELT) : BOOL is
-- This predicate returns true if and only if the current string element
-- has the value val, otherwise false.
return item = val
end ;
get_item : ELT
pre ~void(self) and ~void(buffer)
post is_done or ((initial(index) + 1) = index)
is
-- This routine returns the currently indicated item and advances
-- the cursor value by one. Note that it is not an error condition if
-- the cursor cannot be advanced as the current cursor value indicates
-- the last element in the string.
res : ELT := item ;
advance ;
return res
end ;
get_upto(elem : ELT) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (item = elem))
is
-- This routine returns the string starting at the current element
-- until either the element with the value elem is reached or the end of
-- the string, whichever occurs first. It is an error if elem is not
-- detected before the end of the string.
res : STP := STP::create ;
loop
if (is_done or (item = elem)) then
break!
else
res := res + get_item
end
end ;
return res
end ;
get_upto : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (item = skip_val))
is
-- This routine scans the string from the current element, skipping
-- until a value which is not the current value of skip_val is found, then
-- up to the next occurrence of the current value of the skip_val,
-- returning the string scanned NOT including the skip element found.
-- It is NOT an error if the skip element is not detected before the end of
-- the string.
skip_to ;
res : STP := STP::create ;
loop
if (is_done or (item = skip_val)) then
break!
else
res := res + get_item
end
end ;
return res
end ;
get_upto(count : CARD) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (result.size = count))
is
-- This routine returns the string starting at the current element
-- until either the given count is reached or the end of the string,
-- whichever occurs first.
res : STP := STP::create ;
loop
if (is_done or (count = 0)) then
break!
else
res := res + get_item ;
count := count - 1
end
end ;
return res
end ;
get_rest_upto(elem : ELT) : STP
pre ~void(self)
post (is_done and (result.size = initial(remaining)))
or (~is_done and (self.item = elem))
is
-- This routine returns the string starting at the current element
-- until either the element with the value elem is reached or the end of
-- the string, whichever occurs first. It is NOT an error if elem is not
-- detected before the end of the string.
start : CARD := index ;
loop -- to scan for elem (or end!)
if is_done then
break!
end ;
while!(elem /= item) ;
advance
end ;
return buffer.substring(start,index - start)
end ;
is_line_mark : BOOL is
-- This predicate returns true if and only if the cursor is positioned at
-- a line mark. The cursor is not moved.
return buffer.line_mark.contains(item)
end ;
skip_over_line
is
-- This routine skips items in the buffer up to and beyond the next line
-- mark in the string.
loop -- up to the next line mark
if is_line_mark then
dummy : STP := get_line_mark ;
return
elsif is_done then
return
else
advance
end
end
end ;
private try_skip_comment : BOOL
pre ~void(self) and (buffer.size > 0)
post ((initial(item) = comment_start[0]) and result)
or ~result
is
-- This routine returns true if and only if it has been possible to skip
-- over a comment starting at the present position.
if (comment_start.size = 1)
or buffer[index + 1] = comment_start[1] then
if void(comment_end) then
skip_over_line ;
return true
else
return skip_block(comment_start,comment_end)
end
else
return false
end
end ;
skip_comment : BOOL
pre ~void(self) and (buffer.size > 0)
post result or (index = initial(index))
is
-- This routine returns true if and only if a comment starts at
-- the current index position and has been skipped.
if void(comment_start) or is_done then
return false
elsif comment_start[0] = item then
return try_skip_comment
else
return false
end
end ;
skip_space
pre ~void(self) -- and (buffer.size > 0)
post is_done or ~item.is_space(buffer.index_lib)
is
-- This routine skips space elements and treats comments as single space elements.
loop
while!(~is_done) ;
if (item.is_space(buffer.index_lib)) then
advance
elsif ~skip_comment then
break!
end
end
end ;
skip_space : SAME
pre ~void(self) --and (buffer.size > 0)
post is_done or ~item.is_space(buffer.index_lib)
is
-- This routine skips over space and then returns self.
skip_space ;
return self
end ;
skip_word
pre ~void(self) and (buffer.size > 0)
post is_done or item.is_space(buffer.index_lib)
is
-- This routine skips up to the first space character.
loc_skip : ELT := skip_val ;
typecase loc_skip
when CHAR then
set_skip(buffer.index_lib.Space.char) ;
when RUNE then
set_skip(buffer.index_lib.Space.rune) ;
end ;
skip_to ;
set_skip(loc_skip)
end ;
skip_word : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or item.is_space(buffer.index_lib)
is
-- This routine skips over a word and then returns self.
skip_word ;
return self
end ;
skip_to(str : STP)
pre ~void(self) and (buffer.size > 0)
post is_done or (item = str[0])
is
-- This routine advances the cursor to find the string str. It
-- positions the cursor to indicate the first element of str.
if str.size = 0 then -- Nothing to do!
return
end ;
loop
loc_index : CARD := index.upto!(buffer.size - str.size) ;
match : BOOL := true ;
loop
if buffer.elt!(loc_index) /= str.elt! then
match := false ;
break!
end
end ;
if match then
index := loc_index ;
return
end
end ;
is_done := true ;
return
end ;
skip_to(str : STP) : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item = str[0])
is
-- This routine advances the cursor to find the string str.
-- It positions the cursor to indicate the first element of str.
-- It then returns self.
skip_to(str) ;
return self
end ;
skip_over(str : STP)
pre ~void(self) and (buffer.size > 0)
post is_done or (buffer[index - 1] = str[str.size - 1])
is
-- This routine advances the cursor to find the string str. It
-- positions the cursor to indicate the string element beyond the last
-- element of str. This is done by first skipping to str and then
-- incrementing the cursor by the length of str.
skip_to(str) ;
if ~is_done then
index := index + str.size
end ;
is_done := index >= buffer.size
end ;
skip_over(str : STP) : SAME
pre ~void(self) and (buffer.size > 0)
post is_done or (item = str[0])
is
-- This routine advances the cursor to find the string str.
-- It positions the cursor to indicate the first element of beyond the given string.
-- It then returns self.
skip_over(str) ;
return self
end ;
get_char : ELT
pre ~void(self)
and (buffer.size > 0)
and ~is_done
post (result = initial(item))
and ((initial(index) + 1) = index)
is
-- This routine returns the simple character at the current index
-- position and then advances the index by one character.
res : ELT := item ;
advance ;
return res
end ;
get_line_mark : STP
pre ~void(self) and is_line_mark
post true
is
-- This routine takes items from the buffer up to the end of the current
-- line mark in the string, returning the canonical contents of a line mark!.
-- NOTE This routine has to implement variable line mark codings - since
-- some OSs permit one or two control codes to indicate line end.
loc_mark : STP := STP::line_mark ;
first_ch : ELT := get_item ;
if loc_mark.contains(item) then -- a valid part of a line mark
if item /= first_ch then -- and it is different from first
advance
end
end ;
return loc_mark
end ;
get_word : STP
pre ~void(self) and (buffer.size > 0) and ~is_done
post (is_done or item.is_space(buffer.index_lib)) and ~void(result) -- it could, however, be empty
is
-- This routine skips space up to the next non-space character and then
-- retrieves the remaining string up to the end of the string or white space
-- whichever is detected first.
--if (~void(self) and (buffer.size > 0) and ~is_done).not then
--#OUT+"void(self):"+void(self).str+", buffer.size:"+buffer.size.str+",is_done:"+is_done.str+"\n";
--end;
res : STP := STP::create(buffer.index_lib) ; -- an empty string!
skip_space ;
loop
until!(is_done or item.is_space(buffer.index_lib)) ;
res := res + get_item
end ;
return res
end ;
get_word(max_size : CARD) : STP
pre ~void(self)
and (buffer.size > 0)
and ~is_done
post (is_done or item.is_space(buffer.index_lib))
and (result.size <= max_size)
is
-- This routine skips any leading space and then retrieves a word up to
-- max_size long or until the end of the string has been reached or a space
-- is detected.
res : STP := STP::create(buffer.index_lib) ;
loc_count : CARD := max_size ;
skip_space ;
loop
until!(is_done
or (loc_count = 0)
or item.is_space(buffer.index_lib)) ;
res := res + get_item ;
loc_count := loc_count - 1 -- the loop variant!
end ;
return res
end ;
get_upto_char(ch : ELT) : STP
pre ~void(self)
and (buffer.size > 0)
and ~is_done
post (is_done or (item = ch))
and (result.size >= 0)
is
-- This routine retrieves the string up to the next occurrence of ch
-- or until the string is finished.
res : STP := STP::create ;
loop
until!(is_done or (item = ch)) ;
res := res + get_char
end ;
return res
end ;
get_pred(predicate : ROUT{ELT} : BOOL) : STP
pre ~void(self)
and (buffer.size > 0)
and ~void(predicate)
post true
is
-- This routine retrieves the string up to the next character for which
-- the given predicate returns false or until the string is finished.
-- NOTE The predicate may have a bound library argument, in which case that
-- library may be used when testing, not the cursor one!
res : STP := STP::create(buffer.index_lib) ;
loop
if is_done then
break!
elsif predicate.call(item) then
res := res + get_item
else
break!
end
end ;
return res
end ;
get_upto_cut(cut_set : STP ) : STP
pre ~void(self)
and (buffer.size > 0)
and ~void(cut_set)
post ~result.contains(cut_set)
is
-- This routine considers the cut_set string to be a set of elements,
-- the first occurrence of any one of which will terminate the retrieval of
-- the string. The element of cut-set found is NOT included in the string returned.
res : STP := STP::create ;
skip_space ;
loop
until!(is_done) ;
loc_ch : ELT := get_item ;
if cut_set.contains(loc_ch) then
retract ;
return res
end ;
res := res + loc_ch
end ;
error := CURSOR_ERRORS::Format_Error ;
return res
end ;
get_over_cut(cut_set : STP) : STP
pre ~void(self) and (buffer.size > 0)
post (is_done
and (result.size = (buffer.size - initial(index))))
or ((result.size = (index - initial(index)))
and cut_set.contains(result[result.size - 1]))
is
-- This routine considers cut_set to be effectively a set of
-- characters. Starting at the first non-space position, the string is
-- retrieved until the first occurrence of any character in cut_set (which is
-- therefore the last character in the string returned).
res : STP := STP::create ;
skip_space ;
loop
until!(is_done) ;
loc_ch : ELT := get_item ;
res := res + loc_ch ;
if (cut_set.search(loc_ch) /= CARD::nil) then
return res
end
end ;
error := CURSOR_ERRORS::Format_Error ;
return res
end ;
private skip_back_to_line_start
pre ~void(self)
and (buffer.size > 0)
and ~is_done
post true
is
-- This is a private auxiliary routine which returns the index of the
-- start of the current text line, working backward from the present index.
res : CARD := index ;
loop
if is_line_mark then
skip_over_line ;
break!
elsif index = 0 then
break!
else
index := index - 1
end
end ;
is_done := index >= buffer.size
end ;
get_str : STP
pre ~void(self) and (buffer.size > 0)
post (result.size > 0) or is_done
is
-- This routine returns the string in the buffer up to and including
-- the first end of line mark (if any).
res : STP := STP::create(buffer.index_lib) ;
loop
until!(is_done) ;
if is_line_mark then
res := res + get_line_mark ;
break!
else
res := res + get_item
end
end ;
return res
end ;
current_line : STP
pre ~void(buffer) and (buffer.size > 0)
post true
is
-- This routine returns the string which is the current line in
-- the source string.
skip_back_to_line_start ;
return get_str
end ;
line!(once escape : ELT, out line_num : CARD) : SAME -- "escape" may be void!
pre ~void(self)
and (buffer.size > 0)
and ~is_done
post result.buffer.size <= (index - initial(index))
is
-- This iter assembles one or more source lines into a logical
-- line, omitting comment lines and stripping unwanted line marks at the end
-- as necessary. The iter then returns a new string cursor for the line or
-- quits!
text : STP := STP::create ;
strip_count : CARD ;
escaped : BOOL := false ;
loop
if is_done then -- 'text' normally empty!
if text.size > 0 then -- but an escape was at the end!
yield text.cursor
end ;
quit
end ;
if ~escaped then
line_num := line_no
end ;
loc_str : STP := get_str.strip ;
loc_index : CARD := 0 ;
loop -- find the first non-space!
while!(loc_index < loc_str.size) ;
if (loc_str[loc_index].is_space(buffer.index_lib)) then
loc_index := loc_index + 1
else
break!
end
end ;
if (loc_index < loc_str.size) then -- something there?
if ~skip_comment or is_line_mark then
escaped := void(escape) or (loc_str[(loc_str.size - 1)] = escape) ;
if escaped then
text := text + loc_str.head(loc_str.size - 1)
else
res : SAME := (text + loc_str).cursor ;
res.set_comment_start(comment_start) ;
res.set_comment_end(comment_end) ;
yield res ;
text := STP::create
end
end
end
end
end ;
end ; -- TEXT_CURSOR{ELT}