Power-Programmierung

home *** CD-ROM | disk | FTP | other *** search

/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / ledit.seq < prev next >

Wrap

Text File | 1989-07-11 | 16.4 KB | 421 lines

\ LEDIT.SEQ Line Editor Utility by Tom Zimmer comment: Here is a relatively simple editor for editing one line strings. Support is provided for strings up to 126 characters in length, with full word and character operations using keypad or WordStar keys as follows: Ctrl-A Left word Ctrl-S Left character Ctrl-D Right character Ctrl-F Right word Ctrl-G Forward delete Ctrl-T Word delete Ctrl-Y Line delete or clear Left arrow Left character Ctrl-Left arrow Left word Right arrow Right character Ctrl-Right arrow Right word Home Beginning of line End End of line ESC Discard changes and leave Return/Enter Save changes and leave The parameters needed by LINEEDIT are as follows: lineeditor ( x y a1 n1 --- ) x = char pos on row, zero = left edge y = row number, zero = top line a1 = counted string n1 = edit limit length, maximum value = 80 Here is an example of a command that would edit a line of text in SAMPLEBUFFER, with a maximum length of 12 characters, at location row 10 column 5 on the screen. 5 10 samplebuffer 12 lineedit Two auto resetting flags can be used to control the behavior of the line editor in special ways. The STRIPING_BL'S boolean "VALUE" determines whether the line editor will strip trailing blanks from an edited string at the completion of the edit. this VALUE defaults to TRUE, do strip trailing blanks. OFF> STRIPPING_BL'S will prevent line edit from stripping spaces. The AUTOCLEAR boolean "VALUE" determines whether the line edit buffer will be automatically cleared if the first character you enter on starting an edit is a normal text char. This is used to ease the users life in the situation where you want to give them the option of re-using a string or easily entering a new one without having to delete the old string first. This VALUE defaults to FALSE, no autoclear. ON> AUTOCLEAR will cause line edit to automatically clear the edit string if a letter if the first thing entered. comment; only forth also hidden definitions also headerless variable saveflg \ are we saving the results headers 0 value ?ldone \ is line edit done? 0 value lchar \ recent line edit character 0 value ex \ where we are editing X 0 value ey \ where we are editing Y 0 value ecursor \ edit cursor position 0 value lenlimit \ line edit length limit variable insertmode \ insert/overwrite mode flag true value stripping_bl's \ are we stripping trailing blanks? false value autoclear \ automatically clear line if first \ type entered is a letter; defer ledbutton ' noop is ledbutton defer >edattrib ' >attrib3 is >edattrib \ trailing edit attribute is 3 132 constant maxedit variable editbuf maxedit 2+ allot \ our edit buffer, editbuf off \ 132 characters max : .ecursor ( --- ) \ show the cursor ex ecursor + COLS 1- min ey at ; : .eline ( --- ) \ redisplay edit line ex ey at editbuf count type save> attrib >edattrib lenlimit editbuf c@ - 0MAX COLS 1- #out @ - 0MAX min spaces restore> attrib ; headerless : <doldel> ( --- ) \ Line delete 0 editbuf c! off> ecursor ; : <ichar> ( c1 --- ) autoclear \ should we clear the line on the if <doldel> \ first character typed? off> autoclear then insertmode @ if editbuf 1+ ecursor + dup 1+ maxedit ecursor - cmove> editbuf c@ 1+ lenlimit min editbuf c! then editbuf 1+ ecursor + c! ecursor 1+ lenlimit min COLS 1- min =: ecursor ecursor editbuf c@ max editbuf c! ; : ?char ( --- ) \ handle normal keys, insert them lchar bl '~' between if lchar <ichar> then ; headers : dohome ( --- ) \ beginning of line off> ecursor ; : doend ( --- ) \ End of line editbuf c@ =: ecursor ; headerless : doright ( --- ) \ right a character ecursor 1+ editbuf c@ min COLS 1- min =: ecursor ; : doleft ( --- ) \ left a character ecursor 1- 0MAX =: ecursor ; headers : <edone> ( --- ) \ flag edit is finished, save changes on> ?ldone saveflg on ; : <equit> ( false --- true ) \ flag edit is finished, discard chngs on> ?ldone saveflg off ; defer doret ' <edone> is doret defer dotab ' <edone> is dotab defer edone ' <edone> is edone defer equit ' <equit> is equit defer dolf ' noop is dolf defer dopgup ' noop is dopgup defer dopgdn ' noop is dopgdn defer doup ' noop is doup defer dodown ' noop is dodown defer doldel ' <doldel> is doldel headerless : dofdel ( --- ) \ Forward delete ecursor 1+ editbuf c@ max editbuf c! editbuf 1+ ecursor + dup 1+ swap maxedit ecursor - cmove -1 editbuf c+! ; : >to=bl ( --- ) \ forward to a blank editbuf 1+ dup maxedit + swap ecursor + ?do i c@ bl = ?leave 1 +!> ecursor loop editbuf c@ ecursor min =: ecursor ; : >to<>bl ( --- ) \ forward to a non blank editbuf 1+ dup maxedit + swap ecursor + ?do i c@ bl <> ?leave 1 +!> ecursor loop editbuf c@ ecursor min =: ecursor ; : dorword ( --- ) \ Forward to next word >to=bl >to<>bl ; : <to=bl+1 ( --- ) \ back to char following BL ecursor 1- 0MAX =: ecursor editbuf 1+ dup ecursor + 1- editbuf 1+ max ?do i c@ bl = ?leave -1 +!> ecursor -1 +loop ; : <to<>bl ( --- ) \ Back to non blank ecursor 1- 0MAX =: ecursor editbuf 1+ dup ecursor + 1- editbuf 1+ max ?do i c@ bl <> ?leave -1 +!> ecursor loop ; : dolword ( --- ) \ back a word <to<>bl <to=bl+1 ; : dobdel ( --- ) \ back delete ecursor editbuf c@ max editbuf c! ecursor ( --- f1 ) doleft ( --- f1 ) if insertmode @ \ if we are in insertmode if dofdel \ then delete the character else bl editbuf 1+ ecursor + c! \ else change char to blank then else beep then ; : dowdel ( --- ) \ word delete begin ecursor editbuf c@ < editbuf 1+ ecursor + c@ bl <> and while dofdel repeat begin ecursor editbuf c@ < editbuf 1+ ecursor + c@ bl = and while dofdel repeat ; : strip_bl's ( --- ) \ strip blanks from editbuf ecursor >r doend begin doleft editbuf 1+ ecursor + c@ bl = ecursor 0<> and while dofdel repeat editbuf c@ r> min 0MAX =: ecursor editbuf @ \ get count and first char $2001 = \ count=1 & char=blank if 0 editbuf c! \ then reset buffer to empty then ; : doins ( --- ) \ toggle insert mode insertmode @ 0= dup insertmode ! if big-cursor else norm-cursor then ; : doany ( --- ) \ handle any character entry graphchar ( -- <c1> f1 ) if <ichar> then ; : ?control ( --- ) \ handle control characters lchar bl < if off> autoclear \ no auto clear now lchar exec: \ 0 null 1 a 2 b 3 c 4 d 5 e 6 f noop dolword noop dopgdn doright doup dorword \ 7 g 8 h 9 i LF 11 k 12 l Enter dofdel dobdel dotab dolf noop noop doret \ 14 n 15 o 16 p 17 q 18 r 19 s 20 t noop noop noop noop dopgup doleft dowdel \ 21 u 22 v 23 w 24 x 25 y 26 z Esc noop doins noop dodown doldel noop equit \ 28 \ 29 ] 30 ^ 31 _ noop noop noop noop then ; headers : funcarray ( n1 | <name> --- ) \ create an X array initialized to \ NOOP functions >r create xhere paragraph + dup xdpseg ! xseg @ - , xdp off r> 0 ?do ['] noop x, loop does> @ +XSEG swap 2* @L execute ; 128 funcarray keyfuncs1 128 funcarray keyfuncs2 ' keyfuncs1 value keysfuncptr \ default to table1 : >keys1 ( --- ) ['] keyfuncs1 is keysfuncptr ; : >keys2 ( --- ) ['] keyfuncs2 is keysfuncptr ; \ for keys in the range 128 to 255 : lkey! ( a1 n1 --- ) \ store key function CFA a1 into \ leuvalue n1 of the KEYFUNCS array 128 - dup 0< over 127 > or abort" keys must be in the range 128 to 255" 2* keysfuncptr >body @ +XSEG swap !L ; : lkey@ ( n1 --- a1 ) \ fetch the function CFA a1 of \ keyvalue n1 from the KEYFUNCS array 128 - dup 0< over 127 > or abort" keys must be in the range 128 to 255" 2* keysfuncptr >body @ +XSEG swap @L ; headerless : ?func ( --- ) \ handle function keys lchar 127 > if off> autoclear \ no auto clear now lchar 128 - 0MAX 127 min keysfuncptr execute then ; \ c1 = keyboard character \ f1 = true for done editing : dokey ( c1 --- ) \ process a key =: lchar ?char \ handle normal ascii ?func \ function characters ?control ; \ control chars headers \ x = char pos on row \ y = line number \ a1 = counted string \ n1 = edit limit length : <ledit> ( x y a1 n1 --- ) \ Edit line currently in EDITBUF. ['] ledbutton save!> dobutton save> lenlimit get-cursor >r over c@ ecursor min =: ecursor maxedit min =: lenlimit \ save max edit length dup >r \ save source address editbuf over c@ lenlimit min 1+ cmove editbuf c@ lenlimit min editbuf c! =: ey =: ex \ save origin doins doins off> ?ldone begin .eline .ecursor key dokey ?ldone until saveflg @ dup \ proper save exit if stripping_bl's \ do we want to strip blanks? if strip_bl's then on> stripping_bl's \ force it next time editbuf r@ over c@ lenlimit min 1+ cmove then r>drop r> set-cursor ( --- f1 ) restore> lenlimit restore> dobutton off> autoclear ; \ no automatic line clear forth definitions \ x = char pos on row \ y = line number \ a1 = counted string \ n1 = edit limit length \ f1 = true for saved changes \ f1 = false for canceled with ESC : lineeditor ( x y a1 n1 --- f1 ) \ Edit line in a1 ['] <equit> save!> equit off> ecursor insertmode off ['] noop save!> doLF save> keysfuncptr >keys2 <ledit> restore> keysfuncptr restore> doLF restore> equit ; \ *************************************************************************** \ Initialize the key arrays for the proper function keys >keys1 ' doany 158 lkey! \ Alt-A ' dohome 199 lkey! \ Home ' doup 200 lkey! \ Up arrow ' doPgUp 201 lkey! \ PgDn ' doleft 203 lkey! \ Left arrow ' doright 205 lkey! \ Right arrow ' doend 207 lkey! \ End ' dodown 208 lkey! \ Down arrow ' doPgDn 209 lkey! \ PgDn ' doins 210 lkey! \ Ins ' dofdel 211 lkey! \ Del ' dolword 243 lkey! \ Ctrl Left arrow ' dorword 244 lkey! \ Ctrl Right arrow >keys2 ' doany 158 lkey! \ Alt-A ' dohome 199 lkey! \ Home ' doup 200 lkey! \ Up arrow ' doPgUp 201 lkey! \ PgDn ' doleft 203 lkey! \ Left arrow ' doright 205 lkey! \ Right arrow ' doend 207 lkey! \ End ' dodown 208 lkey! \ Down arrow ' doPgDn 209 lkey! \ PgDn ' doins 210 lkey! \ Ins ' dofdel 211 lkey! \ Del ' dolword 243 lkey! \ Ctrl Left arrow ' dorword 244 lkey! \ Ctrl Right arrow behead only forth also definitions \s only forth also definitions hidden also variable samplebuffer 128 allot : sample ( --- ) " Zimmer, Harold" ">$ samplebuffer over c@ 1+ cmove on> autoclear 27 04 samplebuffer 24 lineeditor drop ;