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}