home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / tledit.seq < prev    next >
Text File  |  1989-11-02  |  14KB  |  318 lines
  1. \ LEDIT.SEQ     Line Editor Utility                     by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.   Here is a relatively simple editor for editing one line strings.
  6.  
  7.   Support is provided for strings up to 126 characters in length, with
  8. full word and character operations using keypad or WordStar keys as follows:
  9.  
  10.         Ctrl-A                  Left word
  11.         Ctrl-S                  Left character
  12.         Ctrl-D                  Right character
  13.         Ctrl-F                  Right word
  14.         Ctrl-G                  Forward delete
  15.         Ctrl-T                  Word delete
  16.         Ctrl-Y                  Line delete or clear
  17.         Left arrow              Left character
  18.         Ctrl-Left arrow         Left word
  19.         Right arrow             Right character
  20.         Ctrl-Right arrow        Right word
  21.         Home                    Beginning of line
  22.         End                     End of line
  23.         ESC                     Discard changes and leave
  24.         Return/Enter            Save changes and leave
  25.  
  26.   The parameters needed by LINEEDIT are as follows:
  27.  
  28.         lineeditor    ( x y a1 n1 --- )
  29.  
  30.                 x = char pos on row,    zero = left edge
  31.                 y = row number,         zero = top line
  32.                 a1 = counted string
  33.                 n1 = edit limit length, maximum value = 80
  34.  
  35.   Here is an example of a command that would edit a line of text in
  36. SAMPLEBUFFER, with a maximum length of 12 characters, at location
  37. row 10 column 5 on the screen.
  38.  
  39.                 5 10 samplebuffer 12 lineedit
  40.  
  41.   Two auto resetting flags can be used to control the behavior of the
  42. line editor in special ways.
  43.  
  44.         The STRIPING_BL'S boolean "VALUE" determines whether the line
  45.         editor will strip trailing blanks from an edited string at
  46.         the completion of the edit. this VALUE defaults to TRUE, do
  47.         strip trailing blanks.
  48.  
  49.                 OFF> STRIPPING_BL'S     will prevent line edit from
  50.                                         stripping spaces.
  51.  
  52.         The AUTOCLEAR boolean "VALUE" determines whether the line
  53.         edit buffer will be automatically cleared if the first
  54.         character you enter on starting an edit is a normal text
  55.         char. This is used to ease the users life in the situation
  56.         where you want to give them the option of re-using a string
  57.         or easily entering a new one without having to delete the old
  58.         string first. This VALUE defaults to FALSE, no autoclear.
  59.  
  60.                 ON> AUTOCLEAR           will cause line edit to
  61.                                         automatically clear the edit
  62.                                         string if a letter if the
  63.                                         first thing entered.
  64.  
  65. comment;
  66.  
  67. FORTH DECIMAL TARGET >LIBRARY       \ A Library file
  68.  
  69. true     value stripping_bl's           \ are we stripping trailing blanks?
  70. false    value autoclear                \ automatically clear line if first
  71.                                         \ type entered is a letter;
  72.  
  73. HTARGET DEFINITIONS TARGET      \ hidden from target application
  74.  
  75.       variable saveflg                  \ are we saving the results
  76.  
  77.     0    value ?ldone                   \ is line edit done?
  78.     0    value lchar                    \ recent line edit character
  79.     0    value ex                       \ where we are editing X
  80.     0    value ey                       \ where we are editing Y
  81.     0    value ecursor                  \ edit cursor position
  82.     0    value lenlimit                 \ line edit length limit
  83.       variable insertmode               \ insert/overwrite mode flag
  84.  
  85. 132 constant maxedit
  86. [forth] maxedit 2+ [target] array editbuf       \ our edit buffer,
  87. \            editbuf off                        \ 132 characters max
  88.  
  89. : .ecursor      ( --- )                         \ show the cursor
  90.                 ex ecursor + COLS 1- min ey at ;
  91.  
  92. : .eline        ( --- )                         \ redisplay edit line
  93.                 ex ey at
  94.                 editbuf count type
  95.                 save> attrib >rev
  96.                 lenlimit editbuf c@ - 0MAX
  97.                 COLS 1- #out @ - 0MAX min spaces
  98.                 restore> attrib ;
  99.  
  100. : doldel        ( --- )                         \ Line delete
  101.                 0 editbuf c!
  102.                 off> ecursor ;
  103.  
  104. : ichar         ( c1 --- )
  105.                 autoclear               \ should we clear the line on the
  106.                 if      doldel          \ first character typed?
  107.                         off> autoclear
  108.                 then
  109.                 insertmode @
  110.                 if      editbuf 1+ ecursor + dup 1+
  111.                         maxedit ecursor - cmove>
  112.                         editbuf c@ 1+ lenlimit min editbuf c!
  113.                 then
  114.                 editbuf 1+ ecursor + c!
  115.                 ecursor 1+ lenlimit min COLS 1- min =: ecursor
  116.                 ecursor editbuf c@ max editbuf c! ;
  117.  
  118. : ?char         ( --- )                 \ handle normal keys, insert them
  119.                 lchar   bl '~' between
  120.                 if      lchar ichar
  121.                 then    ;
  122.  
  123. : dohome        ( --- )                         \ beginning of line
  124.                 off> ecursor ;
  125.  
  126. : doend         ( --- )                         \ End of line
  127.                 editbuf c@ =: ecursor ;
  128.  
  129. : doright       ( --- )                         \ right a character
  130.                 ecursor 1+ editbuf c@ min COLS 1- min =: ecursor ;
  131.  
  132. : doleft        ( --- )                         \ left a character
  133.                 ecursor 1- 0MAX =: ecursor ;
  134.  
  135. : edone         ( --- )      \ flag edit is finished, save changes
  136.                 on> ?ldone
  137.                 saveflg on ;
  138.  
  139. : equit         ( false --- true )      \ flag edit is finished, discard chngs
  140.                 on> ?ldone
  141.                 saveflg off ;
  142.  
  143. : dofdel        ( --- )                         \ Forward delete
  144.                 ecursor 1+ editbuf c@ max editbuf c!
  145.                 editbuf 1+ ecursor + dup 1+ swap maxedit ecursor - cmove
  146.                 -1 editbuf c+! ;
  147.  
  148. : >to=bl        ( --- )                         \ forward to a blank
  149.                 editbuf 1+ dup maxedit + swap ecursor +
  150.                 ?do     i c@ bl = ?leave
  151.                         1 +!> ecursor
  152.                 loop    editbuf c@ ecursor min =: ecursor ;
  153.  
  154. : >to<>bl       ( --- )                         \ forward to a non blank
  155.                 editbuf 1+ dup maxedit + swap ecursor +
  156.                 ?do     i c@ bl <> ?leave
  157.                         1 +!> ecursor
  158.                 loop    editbuf c@ ecursor min =: ecursor ;
  159.  
  160. : dorword       ( --- )                         \ Forward to next word
  161.                 >to=bl
  162.                 >to<>bl ;
  163.  
  164. : <to=bl+1      ( --- )                         \ back to char following BL
  165.                 ecursor 1- 0MAX =: ecursor
  166.                 editbuf 1+ dup ecursor + 1- editbuf 1+ max
  167.                 ?do     i c@ bl = ?leave
  168.                         -1 +!> ecursor
  169.             -1 +loop    ;
  170.  
  171. : <to<>bl       ( --- )                         \ Back to non blank
  172.                 ecursor 1- 0MAX =: ecursor
  173.                 editbuf 1+ dup ecursor + 1- editbuf 1+ max
  174.                 ?do     i c@ bl <> ?leave
  175.                         -1 +!> ecursor
  176.                 loop    ;
  177.  
  178. : dolword       ( --- )                         \ back a word
  179.                 <to<>bl
  180.                 <to=bl+1 ;
  181.  
  182. : dobdel        ( --- )                         \ back delete
  183.                 ecursor editbuf c@ max editbuf c!
  184.                 ecursor         ( --- f1 )
  185.                 doleft
  186.     ( --- f1 )  if      insertmode @            \ if we are in insertmode
  187.                         if      dofdel          \ then delete the character
  188.                         else    bl editbuf 1+ ecursor + c!
  189.                                                 \ else change char to blank
  190.                         then
  191.                 else    beep
  192.                 then    ;
  193.  
  194. : dowdel        ( --- )                         \ word delete
  195.                 begin   ecursor editbuf c@ <
  196.                         editbuf 1+ ecursor + c@ bl <> and
  197.                 while   dofdel
  198.                 repeat
  199.                 begin   ecursor editbuf c@ <
  200.                         editbuf 1+ ecursor + c@ bl = and
  201.                 while   dofdel
  202.                 repeat  ;
  203.  
  204. : strip_bl's    ( --- )                         \ strip blanks from editbuf
  205.                 ecursor >r
  206.                 doend
  207.                 begin   doleft
  208.                         editbuf 1+ ecursor + c@ bl =
  209.                         ecursor 0<> and
  210.                 while   dofdel
  211.                 repeat  editbuf c@ r> min 0MAX =: ecursor
  212.                 editbuf @               \ get count and first char
  213.                 $2001 =                 \ count=1 & char=blank
  214.                 if      0 editbuf c!    \ then reset buffer to empty
  215.                 then    ;
  216.  
  217. : doins         ( --- )                         \ toggle insert mode
  218.                 insertmode @ 0= dup insertmode !
  219.                 if      big-cursor
  220.                 else    norm-cursor
  221.                 then    ;
  222.  
  223. : ?control      ( --- )                         \ handle control characters
  224.                 lchar   bl >= ?exit
  225.                 off> autoclear          \ no auto clear now
  226.                 lchar exec:
  227. \               0 null  1 a     2 b     3 c     4 d     5 e     6 f
  228.                 noop    dolword noop    noop    doright noop    dorword
  229. \               7 g     8 h     9 i     LF      11 k    12 l    Enter
  230.                 dofdel  dobdel  noop    noop    noop    noop    edone
  231. \               14 n    15 o    16 p    17 q    18 r    19 s    20 t
  232.                 noop    noop    noop    noop    noop    doleft  dowdel
  233. \               21 u    22 v    23 w    24 x    25 y    26 z    Esc
  234.                 noop    doins   noop    noop    doldel  noop    equit
  235. \               28 \    29 ]    30 ^    31 _
  236.                 noop    noop    noop    noop ;
  237.  
  238. : ?func         ( --- )                         \ handle function keys
  239.                 lchar   199 < ?exit
  240.                 off> autoclear          \ no auto clear now
  241.                 lchar 199 - 0MAX 46 min exec:
  242. \       HOME
  243.         dohome
  244. \       UP      PgUp    202     LEFT    204     RIGHT   206     END
  245.         noop    noop    noop    doleft  noop    doright noop    doend
  246. \       DOWN    PgDn    INS     DEL     SF1     SF2     SF3     SF4
  247.         noop    noop    doins   dofdel  noop    noop    noop    noop
  248. \       SF5     SF6     SF7     SF8     SF9     SF10    CF1     CF2
  249.         noop    noop    noop    noop    noop    noop    noop    noop
  250. \       CF3     CF4     CF5     CF6     CF7     CF8     CF9     CF10
  251.         noop    noop    noop    noop    noop    noop    noop    noop
  252. \       AF1     AF2     AF3     AF4     AF5     AF6     AF7     AF8
  253.         noop    noop    noop    noop    noop    noop    noop    noop
  254. \       AF9     AF10    242     CLEFT   CRIGHT
  255.         noop    noop    noop    dolword dorword noop    noop ;
  256.  
  257.                                                 \ c1 = keyboard character
  258.                                                 \ f1 = true for done editing
  259. : dokey         ( c1 --- )                      \ process a key
  260.                 =: lchar
  261.                 ?char                           \ handle normal ascii
  262.                 ?func                           \ function characters
  263.                 ?control ;                      \ control chars
  264.  
  265. TARGET DEFINITIONS
  266.  
  267.                                                 \ x = char pos on row
  268.                                                 \ y = line number
  269.                                                 \ a1 = counted string
  270.                                                 \ n1 = edit limit length
  271. : <ledit>       ( x y a1 n1 --- )       \ Edit line currently in EDITBUF.
  272.                 save> lenlimit
  273.                 savecursor
  274.                 over c@ ecursor min =: ecursor
  275.                 maxedit min =: lenlimit         \ save max edit length
  276.                 dup >r                          \ save source address
  277.                 editbuf over c@ lenlimit min 1+ cmove
  278.                 editbuf c@ lenlimit min editbuf c!
  279.                 =: ey =: ex                     \ save origin
  280.                 doins   doins
  281.                 off> ?ldone
  282.                 begin   .eline
  283.                         .ecursor key dokey
  284.                         ?ldone
  285.                 until   saveflg @ dup           \ proper save exit
  286.                 if      stripping_bl's          \ do we want to strip blanks?
  287.                         if      strip_bl's
  288.                         then    on> stripping_bl's      \ force it next time
  289.                         editbuf r@ over c@ lenlimit min 1+ cmove
  290.                 then    r>drop
  291.                 restcursor              ( --- f1 )
  292.                 restore> lenlimit
  293.                 off> autoclear ;                \ no automatic line clear
  294.  
  295.                                         \ x = char pos on row
  296.                                         \ y = line number
  297.                                         \ a1 = counted string
  298.                                         \ n1 = edit limit length
  299.                                         \ f1 = true for saved changes
  300.                                         \ f1 = false for canceled with ESC
  301. : lineeditor    ( x y a1 n1 --- f1 )    \ Edit line in a1
  302.                 off> ecursor
  303.                 insertmode off
  304.                 <ledit> ;
  305.  
  306. FORTH TARGET >TARGET
  307.  
  308. \s
  309.  
  310. variable samplebuffer 128 allot
  311.  
  312. : sample        ( --- )
  313.                 " Zimmer, Harold" ">$
  314.                 samplebuffer over c@ 1+ cmove
  315.                 on> autoclear
  316.                 27 04 samplebuffer 24 lineeditor drop ;
  317.  
  318.