home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / PARSORT.SEQ < prev    next >
Encoding:
Text File  |  1988-11-03  |  2.6 KB  |  81 lines
  1. \ SEDSORT.SEQ   Sort the lines of a paragraph           by Tom Zimmer
  2.  
  3. only forth also editor definitions also
  4.  
  5. \ headerless
  6.  
  7. : nextpar       ( --- )
  8.                 begin   linelen  0> ?lastline 0= and while <sdln> repeat
  9.                 begin   linelen  0= ?lastline 0= and while <sdln> repeat ;
  10.  
  11. : prevpar       ( --- )
  12.                 <suln>
  13.                 begin   linelen  0= ?lastline 0= and while <suln> repeat
  14.                 begin   linelen  0> ?lastline 0= and while <suln> repeat
  15.                 nextpar ;
  16.  
  17. : delpar        ( --- n1 )
  18.                 ?lastline if 0 exit then
  19.                 0
  20.                 begin   linelen
  21.                         ?lastline 0= and
  22.                 while   1+ <ldel>
  23.                 repeat                  \ return count of deleted lines
  24.                 begin   linelen 0=
  25.                         ?lastline 0= and
  26.                 while   1+ <ldel>
  27.                 repeat  ;
  28.  
  29. : undelpar      ( n1 --- )
  30.                 0
  31.                 ?do  <lundel> loop ;         \ un-delete the deleted lines
  32.  
  33. : save1lin      ( --- )
  34.                 linebuf 1+ sort1.buf 1+ 10 cmove
  35.                 44 7 at sort1.buf 1+ 8 type ;
  36.  
  37. : #linelen      ( n1 --- n2 )   \ return line length n2 of line n1.
  38.                 #lineseginfo nip nip 2- ;
  39.  
  40. : sortpar       ( --- )
  41.                 curline >r              \ save where we are
  42.                 save1lin delpar >r
  43.                 @> sortto backto.line
  44.                 begin   linebuf 1+ sort1.buf 1+ 8 compare 0> 0=
  45.                         ?lastline 0= and
  46.                         curline 2r@ drop < and
  47.                 while   nextpar
  48.                 repeat  r> undelpar
  49.                 r> to.line nextpar ;
  50.  
  51. : parsort       ( --- )         \ sort lines of a paragraph
  52.                 linelen 0= ?lastline or if sdln exit then
  53.                 20 06 60 08 box&fill ."  Paragraph sorting ... "
  54.                 cursor-off
  55.                 screenchar =: colsave
  56.                 ?shiftkey save!> caps
  57.                      true save!> imode
  58.                            save> screenline
  59.                         0 save!> screenchar
  60.                 curline =: sortto
  61.                 nextpar
  62.                 begin   ?lastline 0=
  63.                         key? 0= and
  64.                 while   sortpar
  65.                         showstat
  66.                 repeat  sortto @ backto.line
  67.                 key? if key drop then
  68.                 restore> screenchar
  69.                 restore> screenline
  70.                 restore> imode
  71.                 restore> caps
  72.                 cursor-on
  73.                 scrshow ;
  74.  
  75. ' parsort is sortlin
  76.  
  77. \ headers
  78.  
  79. only forth also definitions
  80.  
  81.