home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fscan.r < prev    next >
Text File  |  2000-07-29  |  3KB  |  150 lines
  1. /*
  2.  * File: fscan.r
  3.  *  Contents: move, pos, tab.
  4.  */
  5.  
  6. "move(i) - move &pos by i, return substring of &subject spanned."
  7. " Reverses effects if resumed."
  8.  
  9. function{0,1+} move(i)
  10.  
  11.    if !cnv:C_integer(i) then
  12.       runerr(101,i)
  13.  
  14.    abstract {
  15.       return string
  16.       }
  17.  
  18.    body {
  19.       register C_integer j;
  20.       C_integer oldpos;
  21.  
  22.       /*
  23.        * Save old &pos.  Local variable j holds &pos before the move.
  24.        */
  25.       oldpos = j = k_pos;
  26.  
  27.       /*
  28.        * If attempted move is past either end of the string, fail.
  29.        */
  30.       if (i + j <= 0 || i + j > StrLen(k_subject) + 1)
  31.          fail;
  32.  
  33.       /*
  34.        * Set new &pos.
  35.        */
  36.       k_pos += i;
  37.       EVVal(k_pos, E_Spos);
  38.  
  39.       /*
  40.        * Make sure i >= 0.
  41.        */
  42.       if (i < 0) {
  43.          j += i;
  44.          i = -i;
  45.          }
  46.  
  47.       /*
  48.        * Suspend substring of &subject that was moved over.
  49.        */
  50.       suspend string(i, StrLoc(k_subject) + j - 1);
  51.  
  52.       /*
  53.        * If move is resumed, restore the old position and fail.
  54.        */
  55.       if (oldpos > StrLen(k_subject) + 1)
  56.          runerr(205, kywd_pos);
  57.       else {
  58.          k_pos = oldpos;
  59.          EVVal(k_pos, E_Spos);
  60.          }
  61.  
  62.       fail;
  63.       }
  64. end
  65.  
  66.  
  67. "pos(i) - test if &pos is at position i in &subject."
  68.  
  69. function{0,1} pos(i)
  70.  
  71.    if !cnv:C_integer(i) then
  72.       runerr(101, i)
  73.  
  74.    abstract {
  75.       return integer
  76.       }
  77.    body {
  78.       /*
  79.        * Fail if &pos is not equivalent to i, return i otherwise.
  80.        */
  81.       if ((i = cvpos(i, StrLen(k_subject))) != k_pos)
  82.          fail;
  83.       return C_integer i;
  84.       }
  85. end
  86.  
  87.  
  88. "tab(i) - set &pos to i, return substring of &subject spanned."
  89. "Reverses effects if resumed."
  90.  
  91. function{0,1+} tab(i)
  92.  
  93.    if !cnv:C_integer(i) then
  94.       runerr(101, i);
  95.  
  96.    abstract {
  97.       return string
  98.       }
  99.  
  100.    body {
  101.       C_integer j, t, oldpos;
  102.  
  103.       /*
  104.        * Convert i to an absolute position.
  105.        */
  106.       i = cvpos(i, StrLen(k_subject));
  107.       if (i == CvtFail)
  108.          fail;
  109.  
  110.       /*
  111.        * Save old &pos.  Local variable j holds &pos before the tab.
  112.        */
  113.       oldpos = j = k_pos;
  114.  
  115.       /*
  116.        * Set new &pos.
  117.        */
  118.       k_pos = i;
  119.       EVVal(k_pos, E_Spos);
  120.  
  121.       /*
  122.        *  Make i the length of the substring &subject[i:j]
  123.        */
  124.       if (j > i) {
  125.          t = j;
  126.          j = i;
  127.          i = t - j;
  128.          }
  129.       else
  130.          i = i - j;
  131.  
  132.       /*
  133.        * Suspend the portion of &subject that was tabbed over.
  134.        */
  135.       suspend string(i, StrLoc(k_subject) + j - 1);
  136.  
  137.       /*
  138.        * If tab is resumed, restore the old position and fail.
  139.        */
  140.       if (oldpos > StrLen(k_subject) + 1)
  141.          runerr(205, kywd_pos);
  142.       else {
  143.          k_pos = oldpos;
  144.          EVVal(k_pos, E_Spos);
  145.          }
  146.  
  147.       fail;
  148.       }
  149. end
  150.