home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / jx4nt125 / utils / editor.utf (.txt) < prev    next >
Encoding:
Null Bytes Alternating  |  1995-05-19  |  20.0 KB  |  354 lines
  1. \ editor.F .. Unicode BLOCK file editor for Jax4th
  2. \ Copyright (c)1994 Jack J. Woehr
  3. \ P.O. Box 51, Golden, Colorado 80402-0051
  4. \ jax@well.sf.ca.us 72203.1320@compuserve.com
  5. \ SYSOP RCFB (303) 278-0364 2400/9600/14400
  6. \ All Rights Reserved
  7. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  8. \ This is free software and can be modified and redistributed under
  9. \ certain conditions described in the file COPYING.TXT. The
  10. \ Disclaimer of Warranty and License for this free software are also
  11. \ contained in the file COPYING.TXT.
  12. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  13.  
  14. \
  15. \ $Revision: 1.2 $
  16. \
  17.  
  18. MARKER editor.utf
  19.  
  20. \ ~~~~~~~~~~~~~~~~~~~~
  21. \ Conditional INCLUDED
  22. \ ~~~~~~~~~~~~~~~~~~~~
  23.  
  24. : PROVIDES ( c-addr u "ccc< >" --)
  25.     BL WORD FIND NIP 0=
  26.     IF INCLUDED ELSE 2DROP THEN ;
  27.  
  28. S" UTILS\UTILS.UTF" PROVIDES USEFUL
  29. S" UTILS\SYSCALLS.UTF" PROVIDES LIBRARY
  30.  
  31. CR .( Loading Editor) CR
  32.  
  33. USEFUL DECIMAL
  34.  
  35. \ ~~~~~~~~~~~~~~~~~~~~~~~
  36. \ Some classic keystrokes
  37. \ ~~~~~~~~~~~~~~~~~~~~~~~
  38. : N ( --) 1 SCR +! ;
  39. : B ( --) -1 SCR +! ;
  40. : L ( --) SCR @ LIST ;
  41.  
  42. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~
  43. \ Screen and shadow commands
  44. \ ~~~~~~~~~~~~~~~~~~~~~~~~~~
  45.  
  46. \ Number of BLOCKs in a file.
  47. : CAPACITY ( -- u)
  48.     BLOCK-FILE @ FILE-SIZE
  49.     0<> -37 AND THROW
  50.     1024 CHARS UM/MOD NIP ;
  51.  
  52. \ Switch to the Alternate (shadow) BLOCK
  53. : A ( --)
  54.     CAPACITY DUP 0 2 UM/MOD NIP
  55.     SCR @ + 0 ROT UM/MOD DROP SCR ! ;
  56.  
  57. \ Clean a screen.
  58. : WIPE ( --)
  59.     SCR @ BLOCK 1024 BL FILL ;
  60. \ This should have been in the Standard, really.
  61.  
  62. \ Copy one screen to another
  63. : COPY ( u1 u2 --)
  64.     SWAP BLOCK SWAP BLOCKNUM !
  65.     UPDATE SAVE-BUFFERS DROP ;
  66. \ This is kinda cheating based on our one-buffer system.
  67.  
  68. \ Close the file whose fid is in BLOCK-FILE
  69. : CLOSE ( --)
  70.     BLOCK-FILE @ CLOSE-FILE
  71.     0<> -37 AND THROW
  72.     0 BLOCK-FILE ! ;
  73.  
  74. \ Un-UPDATE a screen.
  75. : DISCARD ( --) FALSE UPDATED ! ;
  76.  
  77. INTERNALS-WORDLIST ALSO-WID DEFINITIONS
  78.  
  79. \ Opening a BLOCK file.
  80. : (OPEN) ( mode c-addr u  --)
  81.     ROT OPEN-FILE
  82.     0<> -37 AND THROW
  83.     BLOCK-FILE ! ;
  84.  
  85. PREVIOUS DEFINITIONS INTERNALS-WORDLIST ALSO-WID
  86.  
  87. \ A wrapper for the above.
  88. : OPEN ( mode "ccc< >" --)
  89.     BL WORD COUNT PAD PLACE PAD COUNT (OPEN) ;
  90.  
  91. \ Usable in compilation.
  92. : [OPEN] ( Compile: "ccc< >" -- Execution: mode --)
  93.     BL WORD COUNT
  94.     POSTPONE SLITERAL
  95.     POSTPONE (OPEN)
  96. ; IMMEDIATE
  97.  
  98. USEFUL
  99.  
  100. VOCABULARY EDITOR
  101. ALSO EDITOR DEFINITIONS
  102.  
  103. 1024 CONSTANT CHARS/BLOCK
  104.   64 CONSTANT CHARS/LINE
  105.  
  106. : S@B ( -- a-addr) SCR @ BLOCK ;
  107.  
  108. PREVIOUS DEFINITIONS
  109. DECIMAL
  110. USEFUL ALSO EDITOR DEFINITIONS
  111.  
  112. VARIABLE CURSOR
  113.  
  114. : !CURSOR ( n --) S>D 1024 FM/MOD DROP CURSOR ! ;
  115.  
  116. \ convert cursor value to data space address of that character
  117. : CURSORTOXY ( n -- x y)
  118.     CHARS/LINE /MOD 1+ ( header)
  119.     SWAP 3 + SWAP ( margin) ;
  120.  
  121. : CURSOR++ ( --) CURSOR @ 1+ !CURSOR ;
  122. : CURSOR-- ( --) CURSOR @ 1- !CURSOR ;
  123.  
  124. : ATCURSOR ( --) CURSOR @ CURSORTOXY AT-XY ;
  125.  
  126. : CURSORTODATA ( cursor - c-addr) S@B SWAP CHARS + ;
  127.  
  128. : GOODCURSOR ( n1 -- n2) S>D 1024 FM/MOD DROP ;
  129.  
  130. : DRAW-LONG-BLOCK ( cursor -- count)
  131.     GOODCURSOR 0
  132.     ?DO I CURSORTODATA C@ I CURSORTOXY AT-XY EMIT LOOP
  133.     ATCURSOR ;
  134.  
  135. : PROMPTLINE ( --) L 0 17 AT-XY ;
  136.  
  137. HEX
  138.  
  139. : MINIBUFF ( --)
  140.      PROMPTLINE ." Forth: " PAD 7F ACCEPT PAD SWAP EVALUATE
  141.      CR ." Press any key ..." KEY DROP ;
  142.  
  143. DECIMAL
  144.  
  145. \ Move a region of the editing screen
  146. \ slide a block from cursor pos 1 to cursor pos 2 of n size
  147. \ save current cursor
  148. \ move n aside and verify validty of two cursor arguments
  149. \ extra copy
  150. : SLIDE ( cursor1 cursor2 n --)
  151.     CURSOR @ >R                         \ c1 c2 nr: c-
  152.     >R GOODCURSOR SWAP GOODCURSOR SWAP  \ c1 c2 r: c n
  153.     2DUP                                \ c1 c2r: c n
  154.     SWAP CHARS S@B + OVER CHARS S@B +   \ c2 c1' c2' r: c n
  155.     ROT 1023 SWAP - R@ MIN CHARS MOVE   \ c1'   r: c n
  156.     R> DRAW-LONG-BLOCK                  \  r: c
  157.     R> CURSOR !                       \  r:
  158. ;
  159.  
  160. : NOESCPDEF ( char --) DROP ATCURSOR ;
  161.  
  162. : ESC-X ( char --) DROP MINIBUFF L ATCURSOR ;
  163.  
  164. HEX USEFUL ALSO EDITOR DEFINITIONS
  165. CREATE ESCAPEKEYS
  166.  
  167. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 00
  168. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  169. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  170. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  171. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 10
  172. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  173. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  174. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  175. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 20
  176. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  177. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  178. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  179. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 30
  180. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  181. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  182. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  183. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 40
  184. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  185. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  186. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  187. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 50
  188. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  189. '   ESC-X   , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  190. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  191. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 60
  192. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  193. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  194. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  195. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , \ 70
  196. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  197. '   ESC-X   , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  198. ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF , ' NOESCPDEF ,
  199.  
  200.  
  201. DECIMAL USEFUL ALSO EDITOR DEFINITIONS
  202.  
  203. : ESCPDEF ( 1bH -- char)
  204.     DROP ( passed-in char)
  205.     PROMPTLINE ." ESC-" KEY DUP EMIT ;
  206.  
  207. HEX USEFUL ALSO EDITOR DEFINITIONS
  208.  
  209. 80 CONSTANT #ESCAPEKEYS
  210.  
  211. : /ESCAPEKEY ( char -- a-addr)
  212.     #ESCAPEKEYS 1- AND CELLS ESCAPEKEYS + ;
  213.  
  214. : ESCAPEKEY ( char --)
  215.     DUP /ESCAPEKEY @ EXECUTE ;
  216.  
  217. DECIMAL USEFUL ALSO EDITOR DEFINITIONS
  218.  
  219. : EDITDEF ( char --)
  220.     DUP EMIT
  221.     S@B CURSOR @ S>D
  222.     CHARS/BLOCK FM/MOD DROP
  223.     CHARS + C!
  224.     CURSOR++ ATCURSOR UPDATE ;
  225.  
  226. : NOEDITDEF ( char --) DROP ATCURSOR ;
  227.  
  228. VARIABLE EDITING
  229.  
  230. : EDITEXIT ( char --) DROP FALSE EDITING ! ;
  231.  
  232. : EDITBS ( 8 --)
  233.     DROP CURSOR-- ATCURSOR
  234.     BL EDITDEF CURSOR-- ATCURSOR
  235.     UPDATE
  236. ;
  237.  
  238. CREATE TABSPACE 2 CELLS ALLOT
  239.  
  240. : EDITC-A ( 1 --)
  241.     DROP CURSOR @ 0 CHARS/LINE FM/MOD NIP CHARS/LINE * !CURSOR
  242.     S@B CURSOR @ CHARS + CHARS/LINE BL SKIP NIP
  243.     CHARS/LINE SWAP - 0 CHARS/LINE FM/MOD DROP CURSOR +!
  244.     CURSOR @ + !CURSOR ATCURSOR ;
  245.  
  246. : EDITC-B ( 2 --) DROP CURSOR-- ATCURSOR ;
  247.  
  248. : EDITC-D ( 4 --) DROP ATCURSOR ;
  249.  
  250. : EDITC-E ( 5 --)
  251.     DROP CURSOR @ 0 CHARS/LINE FM/MOD NIP CHARS/LINE *
  252.     CHARS/LINE 1- + S@B SWAP -TRAILING NIP
  253.     !CURSOR ATCURSOR ;
  254.  
  255. : EDITC-F ( 6 --)
  256.     DROP CURSOR++ ATCURSOR ;
  257.  
  258. : EDITC-L ( 12 --)
  259.     DROP PAGE L ATCURSOR ;
  260.  
  261. : EDITC-N ( 14 --)
  262.     DROP CURSOR @ CHARS/LINE + !CURSOR ATCURSOR ;
  263.  
  264. : EDITC-P ( 16 --)
  265.     DROP CURSOR @ CHARS/LINE - !CURSOR ATCURSOR ;
  266.  
  267. : EDITC-V ( 22 --) DROP ATCURSOR ;
  268.  
  269. : EDITC-[ ( 27 --) ESCPDEF ESCAPEKEY ;
  270.  
  271. HEX USEFUL ALSO EDITOR DEFINITIONS
  272. CREATE EDITKEYS
  273.  
  274. ' NOEDITDEF , '   EDITC-A , '   EDITC-B , ' NOEDITDEF , \ 00
  275. '   EDITC-D , '   EDITC-E , '   EDITC-F , ' NOEDITDEF ,
  276. '   EDITBS  , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF ,
  277. '   EDITC-L , '   EDITC-N , '   EDITC-N , ' NOEDITDEF ,
  278. '   EDITC-P , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF , \ 10
  279. ' NOEDITDEF , ' NOEDITDEF , '   EDITC-V , ' NOEDITDEF ,
  280. ' NOEDITDEF , ' NOEDITDEF , '  EDITEXIT , '   EDITC-[ ,
  281. ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF , ' NOEDITDEF ,
  282. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 20
  283. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  284. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  285. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  286. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 30
  287. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  288. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  289. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  290. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 40
  291. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  292. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  293. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  294. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 50
  295. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  296. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  297. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  298. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 60
  299. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  300. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  301. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  302. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF , \ 70
  303. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  304. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  305. '   EDITDEF , '   EDITDEF , '   EDITDEF , '   EDITDEF ,
  306.  
  307. HEX USEFUL ALSO EDITOR DEFINITIONS
  308.  
  309. 80 CONSTANT #EDITKEYS
  310.  
  311. : /EDITKEY ( char -- a-addr)
  312.     #EDITKEYS 1- AND CELLS EDITKEYS + ;
  313.  
  314. : EDITKEY ( char --) DUP /EDITKEY @ EXECUTE ;
  315.  
  316. DECIMAL USEFUL ALSO EDITOR DEFINITIONS
  317.  
  318. : ED.INIT ( --)
  319.     TRUE EDITING !
  320.     CURSOR @ !CURSOR
  321.     PAGE L ATCURSOR ;
  322.  
  323.  
  324. : EDITING ( --)
  325.     BEGIN
  326.         EDITING @
  327.     WHILE
  328.         KEY EDITKEY
  329.     REPEAT
  330.     0 17 AT-XY
  331.     UPDATED @
  332.     IF
  333.         ." UPDATEd"
  334.     ELSE
  335.         ." Not UPDATEd."
  336.     THEN CR
  337. ;
  338.  
  339. : ED ( --) ED.INIT EDITING ;
  340.  
  341. : EDIT ( u --) 1 ?ENOUGH SCR ! ED ;
  342.  
  343. USEFUL ALSO EDITOR
  344.  
  345. : ED ED ;
  346. : EDIT EDIT ;
  347.  
  348. USEFUL
  349.  
  350. \ ~~~~~~~~~~~~~~~
  351. \ End of editor.f
  352. \ ~~~~~~~~~~~~~~~
  353.  
  354.