home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / SEDCASE.SEQ < prev    next >
Encoding:
Text File  |  1989-07-03  |  5.0 KB  |  133 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. : l>lcase       ( --- )         \ convert the current line to lower case
  33.                 ?browse ?exit
  34.                 linebuf 1+ linelen bounds
  35.                 ?do     i c@ 'A' 'Z' between
  36.                         if      i c@ bl or i c!
  37.                         then
  38.                 loop    modified
  39.                 putline getline sdisplay ;
  40.  
  41. : l>ucase       ( --- )         \ convert the current line to lower case
  42.                 ?browse ?exit
  43.                 linebuf 1+ linelen bounds
  44.                 ?do     i c@ 'a' 'z' between
  45.                         if      i c@ 95 and i c!
  46.                         then
  47.                 loop    modified
  48.                 putline getline sdisplay ;
  49.  
  50. : w>lcase       ( --- )         \ convert the current word to lower case
  51.                 ?browse ?exit
  52.                 linebuf 1+ screenchar + linelen screenchar - 0MAX bounds
  53.                 ?do     i c@ 'A' 'Z' between
  54.                         if      i c@ bl or i c!
  55.                         then    i c@ bl = ?leave        \ leave at word end
  56.                 loop    modified
  57.                 putline getline sdisplay ;
  58.  
  59. : w>ucase       ( --- )         \ convert the current word to lower case
  60.                 ?browse ?exit
  61.                 linebuf 1+ screenchar + linelen screenchar - 0MAX bounds
  62.                 ?do     i c@ 'a' 'z' between
  63.                         if      i c@ 95 and i c!
  64.                         then    i c@ bl = ?leave        \ leave at word end
  65.                 loop    modified
  66.                 putline getline sdisplay ;
  67.  
  68. : c-alpha?      ( --- f1 )
  69.                 linebuf 1+ screenchar + c@
  70.                 dup  'A' 'Z' between            \ either A to Z
  71.                 swap 'a' 'z' between or ;       \   or   a to z
  72.  
  73. \ cursor MUST be sitting on a letter or NOTHING happens.
  74.  
  75. : wcasetgl      ( --- )         \ word case conversion toggle
  76.                 ?browse ?exit
  77.                 c-alpha?
  78.                 if      linebuf 1+ screenchar + c@ 'A' 'Z' between
  79.                         if      w>lcase
  80.                         else    w>ucase
  81.                         then
  82.                 then    modified
  83.                 putline getline sdisplay ;
  84.  
  85. : ccasetgl      ( --- )         \ word case conversion toggle
  86.                 ?browse ?exit
  87.                 c-alpha?
  88.                 if      linebuf 1+ screenchar +
  89.                         dup c@ dup 'A' 'Z' between
  90.                         if bl or else 95 and then swap c!
  91.                 then    modified
  92.                 putline getline sdisplay ;
  93.  
  94. : ALT-OPTION    ( --- )         \ Alt-O options
  95.                 savescr
  96.                 ['] noop save!> dobutton
  97.                 ?doingmac 0=    \ If we are doing a macro, don't display
  98.                                 \ command menu box.
  99.                 if      screenline 1+ dup 12 >
  100.                         if      13 -
  101.                         then    20 swap 60 over 11 + box&fill
  102.                         ."  Other commands.. Select an operation" bcr bcr
  103.                         ."    A - enter Any Character"       bcr
  104.                         ."    X - Expand all TABS to spaces" bcr
  105.                         ."    L - convert line to Lowercase" bcr
  106.                         ."    U - convert line to Uppercase" bcr
  107.                         ."    W - Word      case toggle" bcr
  108.                         ."    C - Character case toggle" bcr
  109.                         ."    P - Paste the Time and Date"   bcr
  110.                         ." \s10\r ESC \0 = cancel"
  111.                         showcur
  112.                 then
  113.                 key bl or >r
  114.                 restscr
  115.                 'a' r@ = if insany          then
  116.                 'x' r@ = if tabxp           then
  117.                 'p' r@ = if paste_datetime  then
  118.                 'l' r@ = if l>lcase         then
  119.                 'u' r@ = if l>ucase         then
  120.                 'c' r@ = if ccasetgl        then
  121.                 'w' r> = if wcasetgl        then
  122.                 restore> dobutton
  123.                 sdisplay showstat cursor-on ;
  124.  
  125. ' ALT-OPTION IS ALT-O
  126.  
  127.  
  128. headers
  129.  
  130. forth definitions
  131.  
  132.  
  133.