home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sedjust.seq < prev    next >
Text File  |  1989-07-03  |  3KB  |  76 lines
  1. \ LEFTJUST.SEQ  Words to manipulate a paragraphs left edge.
  2.  
  3. editor definitions
  4.  
  5. headerless
  6.  
  7. variable left#
  8.  
  9. : getleft#      ( --- )
  10.                 savescr
  11.                 ['] noop save!> dobutton
  12.                 screenline 7 - dup 1 <
  13.                 if      12 +
  14.                 then
  15.                 16 swap 64  over 5 + box&fill
  16.                 ."  Adjust paragraph left margin.. \r ESC \0 = cancel"
  17.                 bcr bcr
  18.                 ."  Press 1 to 9 for # of spaces to shift right" bcr
  19.                 ."  Press \1 - \0 to REMOVE leading spaces"
  20.                 showcur key
  21.                 restore> dobutton
  22.                 restscr
  23.                 '-' over =
  24.                 if      -1 left# !  drop exit then
  25.                 dup '0' '9' between
  26.                 if      48 - dup left# !
  27.                 else    0 left# !
  28.                 then    drop ;
  29.  
  30. : lzero         ( --- )
  31.                 ?browse ?exit
  32.                 off> lmrgn
  33.                 screenline curline
  34.                 begin   linelen 0> ?lastline 0= and
  35.                 while   chrptr c@ bl =
  36.                         if      delbl's
  37.                                 modified
  38.                         then    ( ?wrap ) sdln scrshow
  39.                 repeat  backto.line =: screenline
  40.                 emptykbd scrshow ;
  41.  
  42. : ljust         ( --- )         \ adjust left margin by 4 chars
  43.                 ?browse ?exit
  44.                 ?shiftkey
  45.                 if      lzero exit
  46.                 then
  47.                 ?full ?maxlines or
  48.                 if      sdln exit
  49.                 then
  50.                 getleft# left# @ 0= ?exit
  51.                 left# @ 0<
  52.                 if      lzero
  53.                 else    save> screenline         \ preserve SCREENLINE,
  54.                         true  save!> imode              \          IMODE,
  55.                         mxlln save!> rmargin            \       &  RMARGIN
  56.                         curline
  57.                         begin   linelen 0> ?lastline 0= and
  58.                         while   left# @ dup 0
  59.                                 do      bl schr
  60.                                 loop    negate  +!> screenchar
  61.                                 sdln scrshow
  62.                         repeat
  63.                         restore> rmargin
  64.                         restore> imode
  65.                         backto.line
  66.                         restore> screenline
  67.                         emptykbd scrshow
  68.                 then    ;
  69.  
  70. ' ljust is lftjust
  71.  
  72. headers
  73.  
  74. forth definitions
  75.  
  76.