home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / SEDIT2.SEQ < prev    next >
Encoding:
Text File  |  1989-08-15  |  7.5 KB  |  182 lines
  1. \ SEDIT2.SEQ    The second part of the main body of the sequential editor
  2.  
  3. editor definitions
  4.  
  5. : notavail      ( --- )
  6.              window.left statusline at cursor-off
  7.              ." \2 You MUST Load an expanded function set for that operation."
  8.              edeeol beep 2 seconds cursor-on ;
  9.  
  10. defer sedesc    ' sesc     is sedesc
  11. defer jstfy     ' notavail is jstfy
  12. defer shelp     ' notavail is shelp
  13. defer exportx   ' notavail is exportx
  14. defer excutx    ' notavail is excutx
  15. defer importx   ' notavail is importx
  16. defer pmenux    ' notavail is pmenux
  17. defer kerr      ' beep is kerr
  18. defer sedset    ' notavail is sedset
  19. defer sortlin   ' notavail is sortlin
  20. defer drawlin   ' notavail is drawlin
  21. defer lftjust   ' notavail is lftjust
  22. defer appendx   ' notavail is appendx
  23. defer alt-g     ' notavail is alt-g
  24. defer adjwind   ' notavail is adjwind
  25. defer alt-o     ' notavail is alt-o
  26. defer insany    ' ^cc      is insany
  27. defer zoomwind  ' notavail is zoomwind
  28. defer Ctrl-J    ' beep is Ctrl-J
  29.  
  30.                 \ control key functiontable
  31. : s^tbl         ( n1 --- )
  32.                 exec:
  33. \ @     A       B       C       D       E       F       G
  34. kerr    lwrd    jstfy   pdn     rchr    upln    rwrd    fdel
  35. \ H     I       J       K       L       M       N       O
  36. bdel    stab    Ctrl-J  kerr    lmset   nln     spltln  kerr
  37. \ P     Q       R       S       T       U       V       W
  38. kerr    kerr    pup     lchr    wdel    updt    itgl    sclup
  39. \ X     Y       Z       ESC
  40. dnln    ldel    scldn   sedesc  kerr    kerr    kerr    kerr  ;
  41.  
  42.  
  43.                 \ function key table
  44. : sfuntbl       ( n1 --- )
  45.                 exec:
  46. \ CBS Control Backspace
  47. fdel
  48. \ A-9   A-0     A -     A =     CPGUP   133     134     135
  49. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  50. \ 136   137     138     139     140     141     142     BACKSPACE
  51. kerr    kerr    kerr    kerr    kerr    kerr    kerr    sbtab
  52. \ A-Q   A-W     A-E     A-R     A-T     A-Y     A-U     A-I
  53. kerr    wr->fl  kerr    NOOP    tabset  lundel  wudel   kerr
  54. \ A-O   A-P     154     155     156     157     A-A     A-S
  55. Alt-O   pmenux  kerr    kerr    kerr    kerr    appendx sedset
  56. \ A-D   A-F     A-G     A-H     A-J     A-K     A-L     167
  57. kerr    kerr    alt-g   kerr    joinln  kerr    lftjust kerr
  58. \ 168   169     170     171     A-Z     A-X     A-C     A-V
  59. kerr    kerr    kerr    kerr    send    excutx  exportx importx
  60. \ A-B   A-N     A-M     179     180     181     182     183
  61. kerr    kerr    NOOP    kerr    kerr    kerr    kerr    kerr
  62. \ 184   185     186     F1      F2      F3      F4      F5
  63. kerr    kerr    kerr    shelp   tscrn   smrk    bscrn   sgetl
  64. \ F6    F7      F8      F9      F10     197     198     199
  65. sloon   sortlin srepn   drawlin sesc    kerr    kerr    kerr
  66. \ 200   201     202     203     204     205     206     END
  67. kerr    kerr    kerr    kerr    kerr    kerr    kerr    sendl
  68. \ 208   209     210     Del     SF1     SF2     SF3     SF4
  69. kerr    kerr    kerr    fdel    kerr    kerr    kerr    kerr
  70. \ SF5   SF6     SF7     SF8     SF9     SF10    CF1     CF2
  71. kerr    sloob   sortlin repall  kerr    kerr    kerr    kerr
  72. \ CF3   CF4     CF5     CF6     CF7     CF8     CF9     CF10
  73. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr
  74. \ AF1   AF2     AF3     AF4     AF5     AF6     AF7     AF8
  75. kerr    kerr    kerr    kerr    kerr    slooa   kerr    srepa
  76. \ AF9   AF10    242     CLEFT   CRIGHT  CEND    CPGDN   CHOME
  77. kerr    squt    kerr    lwrd    rwrd    send    kerr    shom
  78. \ A-1   A-2     A-3     A-4     A-5     A-6     A-7     A-8
  79. kerr    kerr    kerr    kerr    kerr    kerr    kerr    kerr ;
  80.  
  81. \ ***************************************************************************
  82. \ The following two words allow changing the functions installed in
  83. \ two previous tables
  84.  
  85. : ctlset        ( n1 | function --- )
  86.                 defined
  87.                 if      swap                    \ get address of functon
  88.                         0MAX 31 min 2*          \ clip n1 to valid CTRL char
  89.                         2+                      \ step past EXEC:
  90.                         ['] s^tbl >body @       \ relative segment of S^TBL
  91.                         +XSEG swap !L   \ convert to absolute segment & store
  92.                 else    nip cr count type
  93.                         ."  <- Not defined, and not installed "
  94.                 then    ;
  95.  
  96. : fnset         ( n1 | function --- )   \ same comments as ABOVE
  97.                 defined
  98.                 if      swap
  99.                         127 max 255 min 127 - 2*
  100.                         2+                      \ skip two bytes for EXEC:
  101.                         ['] sfuntbl >body @     \ relative segment of SFUNTBL
  102.                         +XSEG swap !L
  103.                 else    nip cr count type
  104.                         ."  <- Not defined, and not installed "
  105.                 then    ;
  106.  
  107. headerless
  108.  
  109. : ?controls     ( c1 --- c1 )   \ handle control characters
  110.                 keychar 32 <
  111.                 if      keychar s^tbl
  112.                         off> keychar
  113.                 then    ;
  114.  
  115. : ?functions    ( c1 --- c2 )   \ handle function characters
  116.                 keychar 126 >       \ they have values >126
  117.                 if      keychar 127 - sfuntbl
  118.                         off> keychar
  119.                 then    ;
  120.  
  121. : ?schr         ( c1 --- )      \ insert character if not a func
  122.                 keychar ?dup if schr then    ;
  123.  
  124. : doachar       ( c1 --- )
  125.                 =: keychar
  126.                 ?controls ?functions ?schr ;
  127.  
  128. : find.line     ( --- )         \ Assumes we are starting on first line.
  129.                 loadline @ 1- 0MAX maxlines min to.line ;
  130.  
  131. : deferset      ( --- )         \ save current deferred words, and reset them
  132.                 @> keyfilter    is normfilter  ['] skeyfilter  is keyfilter
  133.                 @> key          is normkey     ['] statkey     is key
  134.                 @> bgstuff      is normbgstuff ['] ?showstatus is bgstuff
  135.                 @> dobutton     is normbutton   @> sbutton     is dobutton ;
  136.  
  137. : deferreset    ( --- )         \ restore the deferred words old function.
  138.                 @> normbutton   is dobutton
  139.                 @> normbgstuff  is bgstuff
  140.                 @> normkey      is key
  141.                 @> normfilter   is keyfilter ;
  142.  
  143. ' deferreset is reset_defered   \ reset the defered words even if there
  144.                                 \ is a serious error condition
  145.  
  146. headers
  147.  
  148. : <reedit>      ( --- )         \ reenter edit of file
  149.                 get-cursor >r
  150.                 restore_vectors ?diskfull drop
  151.                 time-reset savestate
  152.                 decimal
  153.                 edscroll                \ enable sub screen scrolling
  154.                 off> updated
  155.                 etabsize tabsize !
  156. \                0 lmargin !
  157.                 rmset?
  158.                 if      rmmax 70 max
  159.                 else    ermargin
  160.                 then    rmargin !
  161.                 edready 0= abort" No file to re-edit."
  162.                 ?showfull drop
  163.                 find.line
  164.                 scrline curline first.textline + min
  165.                 last.textline min =: screenline
  166.                 showscreen
  167.                 on> ?border
  168.                 off> ?eddone
  169.                 begin   on> vstaton
  170.                         showcur
  171.                         key doachar
  172.                         ?eddone
  173.                 until   restorestate
  174.                 set_vectors
  175.                 r> set-cursor ;
  176.  
  177. : reedit        ( --- )
  178.                 deferset <reedit> deferreset ;
  179.  
  180. forth definitions
  181.  
  182.