home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / sedcase.seq < prev    next >
Text File  |  1991-02-27  |  5KB  |  140 lines
  1. \ SEDCASE       Case conversion, paste date/time, & tab expansion
  2.  
  3. editor definitions
  4.  
  5. headerless
  6.  
  7. : paste_datetime ( --- )
  8.                 ?browse ?exit
  9.                 true save!> imode
  10.                 bl schr getdate form-date count bounds
  11.                 ?do     i c@ schr       loop
  12.                 bl schr gettime form-time count bounds
  13.                 ?do     i c@ schr       loop
  14.                 bl schr
  15.                 restore> imode ;
  16.  
  17. : tabxp         ( --- )         \ tab expansion word
  18.                 ?browse ?exit
  19.                 save> slook.buf
  20.                 9 slook.buf 1+ c! 1 slook.buf c!
  21.                 mxlln save!> rmargin
  22.                 false save!> caps
  23.                 shom
  24.                 begin   incr> screenchar <slooker>
  25.                         looked
  26.                 while   fdel   stab lchr
  27.                 repeat  shom
  28.                 restore> caps
  29.                 restore> rmargin
  30.                 restore> slook.buf ;
  31.  
  32. : tab_to_space  ( -- )          \ show tabs as spaces
  33.                 ?exp_tabs 0= !> ?exp_tabs
  34.                 putline getline
  35.                 ?exp_type_set scrshow ;
  36.  
  37. : l>lcase       ( --- )         \ convert the current line to lower case
  38.                 ?browse ?exit
  39.                 linebuf 1+ linelen bounds
  40.                 ?do     i c@ 'A' 'Z' between
  41.                         if      i c@ bl or i c!
  42.                         then
  43.                 loop    modified
  44.                 putline getline sdisplay ;
  45.  
  46. : l>ucase       ( --- )         \ convert the current line to lower case
  47.                 ?browse ?exit
  48.                 linebuf 1+ linelen bounds
  49.                 ?do     i c@ 'a' 'z' between
  50.                         if      i c@ 95 and i c!
  51.                         then
  52.                 loop    modified
  53.                 putline getline sdisplay ;
  54.  
  55. : w>lcase       ( --- )         \ convert the current word to lower case
  56.                 ?browse ?exit
  57.                 linebuf 1+ screenchar + linelen screenchar - 0MAX bounds
  58.                 ?do     i c@ 'A' 'Z' between
  59.                         if      i c@ bl or i c!
  60.                         then    i c@ bl = ?leave        \ leave at word end
  61.                 loop    modified
  62.                 putline getline sdisplay ;
  63.  
  64. : w>ucase       ( --- )         \ convert the current word to lower case
  65.                 ?browse ?exit
  66.                 linebuf 1+ screenchar + linelen screenchar - 0MAX bounds
  67.                 ?do     i c@ 'a' 'z' between
  68.                         if      i c@ 95 and i c!
  69.                         then    i c@ bl = ?leave        \ leave at word end
  70.                 loop    modified
  71.                 putline getline sdisplay ;
  72.  
  73. : c-alpha?      ( --- f1 )
  74.                 linebuf 1+ screenchar + c@
  75.                 dup  'A' 'Z' between            \ either A to Z
  76.                 swap 'a' 'z' between or ;       \   or   a to z
  77.  
  78. \ cursor MUST be sitting on a letter or NOTHING happens.
  79.  
  80. : wcasetgl      ( --- )         \ word case conversion toggle
  81.                 ?browse ?exit
  82.                 c-alpha?
  83.                 if      linebuf 1+ screenchar + c@ 'A' 'Z' between
  84.                         if      w>lcase
  85.                         else    w>ucase
  86.                         then
  87.                 then    modified
  88.                 putline getline sdisplay ;
  89.  
  90. : ccasetgl      ( --- )         \ word case conversion toggle
  91.                 ?browse ?exit
  92.                 c-alpha?
  93.                 if      linebuf 1+ screenchar +
  94.                         dup c@ dup 'A' 'Z' between
  95.                         if bl or else 95 and then swap c!
  96.                 then    modified
  97.                 putline getline sdisplay ;
  98.  
  99. : ALT-OPTION    ( --- )         \ Alt-O options
  100.                 savescr
  101.                 ['] noop save!> dobutton
  102.                 ?doingmac 0=    \ If we are doing a macro, don't display
  103.                                 \ command menu box.
  104.                 if      screenline 1+ dup 11 >
  105.                         if      13 -
  106.                         then    20 swap 60 over 12 + box&fill
  107.                         ."  Other commands.. Select an operation" bcr bcr
  108.                         ."    A - enter Any Character"       bcr
  109.                         ."    X - Expand all TABS to spaces" bcr
  110.                         ."    S - Show   all TABS as spaces" bcr
  111.                         ."    L - convert line to Lowercase" bcr
  112.                         ."    U - convert line to Uppercase" bcr
  113.                         ."    W - Word      case toggle" bcr
  114.                         ."    C - Character case toggle" bcr
  115.                         ."    P - Paste the Time and Date"   bcr
  116.                         ." \s10\r ESC \0 = cancel"
  117.                         showcur
  118.                 then
  119.                 key bl or >r
  120.                 restscr
  121.                 'a' r@ = if insany          then
  122.                 'x' r@ = if tabxp           then
  123.                 's' r@ = if tab_to_space    then
  124.                 'p' r@ = if paste_datetime  then
  125.                 'l' r@ = if l>lcase         then
  126.                 'u' r@ = if l>ucase         then
  127.                 'c' r@ = if ccasetgl        then
  128.                 'w' r> = if wcasetgl        then
  129.                 restore> dobutton
  130.                 sdisplay showstat cursor-on ;
  131.  
  132. ' ALT-OPTION IS ALT-O
  133.  
  134.  
  135. headers
  136.  
  137. forth definitions
  138.  
  139.  
  140.