Menu
▾
▴
[Win32forth-cvs] win32forth/src Extend.f, 1.13, 1.14 Keysave.f, 1.4, 1.5 editor_io.f, 1.3, 1.4
|
From: Dirk B. <db...@us...> - 2007-05-13 07:52:34
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27480/src Modified Files: Extend.f Keysave.f editor_io.f Log Message: - Removed the Forth-Instance-Counting from then Editor-IO. Index: editor_io.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/editor_io.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** editor_io.f 12 May 2007 07:51:19 -0000 1.3 --- editor_io.f 13 May 2007 07:52:26 -0000 1.4 *************** *** 7,22 **** anew -Editor_io.F ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ primitive utilities to support view, browse and edit of words and files ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ INTERNAL EXTERNAL ! in-application 0 value ed-hndl 0 value ed-ptr - FALSE value second-forth? \ am I the second or more copy of forth to load INTERNAL --- 7,21 ---- anew -Editor_io.F ! \ ---------------------------------------------------------------------------------------- ! \ Communication beetween the Editor (e.g. the Win32ForthIDE) and the Console window. ! \ ---------------------------------------------------------------------------------------- INTERNAL EXTERNAL ! IN-APPLICATION 0 value ed-hndl 0 value ed-ptr INTERNAL *************** *** 30,34 **** 0 cell ed-field+ ed-window \ the handle of the MainWindow of the Editor - cell ed-field+ ed-forth-count \ count of forths running cell ed-field+ ed-response \ response from the editor cell ed-field+ ed-line \ line number to edit --- 29,32 ---- *************** *** 44,64 **** 4096 + 4096 / 4096 * constant ed-size \ multiples of 4k bytes ! \ Messages To Forth FROM the Editor ! newproc WM_SETBP ! newproc WM_STEPBP ! newproc WM_NESTBP ! newproc WM_UNESTBP ! newproc WM_CONTBP ! newproc WM_JUMPBP ! newproc WM_BEGNBP ! newproc WM_HEREBP ! newproc WM_RSTKBP ! newproc WM_DONEBP ! newproc WM_INQUIRE ! ! \ tell Forth to get text from the clipboard and compile it ! newproc WM_PASTELOAD ! \ Messages TO the Editor FROM the Editor newproc ED_OPEN_EDIT newproc ED_OPEN_BROWSE --- 42,63 ---- 4096 + 4096 / 4096 * constant ed-size \ multiples of 4k bytes ! \ Messages FROM the Editor TO Forth for Console window ! newproc WM_KEY \ give Forth a key ! newproc WM_SETBP \ tell the forth console to set a breakpoint on a word (only used in WinEd) ! newproc WM_STEPBP \ single step ! newproc WM_NESTBP \ nest into this definition ! newproc WM_UNESTBP \ unnest to definition above ! newproc WM_CONTBP \ continuous step till key ! newproc WM_JUMPBP \ Jump over next Word ! newproc WM_BEGNBP \ proceed to def again ! newproc WM_HEREBP \ proceed to this point again ! newproc WM_RSTKBP \ show Return stack ! newproc WM_DONEBP \ done, run the program ! newproc WM_INQUIRE \ what it is good for? (only used in WinEd) ! newproc WM_PASTELOAD \ tell Forth to get text from the clipboard and compile it (only used in WinEd) ! \ Messages FROM the Forth for Console window TO the Editor ! newproc ED_ALIVE \ notify editor that the Forth console window is ready to accept characters ! newproc ED_SHUTDOWN \ notify editor that the Forth console window was closed newproc ED_OPEN_EDIT newproc ED_OPEN_BROWSE *************** *** 67,86 **** newproc ED_STACK newproc ED_DEBUG - newproc ED_NOTINBP - - \ Messages FROM Editor TO Forth for Console - newproc WM_KEY \ give Forth a key - - \ Messages TO Editor FROM Forth for Console - newproc ED_READY \ notify editor Forth is alive (not used) - newproc ED_ALIVE \ notify editor Forth is ready to accept characters - newproc ED_SHUTDOWN \ tell editor to shut down the Forth console window : editor-present? ( -- f1 ) ed-ptr -IF drop ed-window @ call IsWindow 0<> THEN ; ! : editor-message ( lParam wParam -- ) \ send a Message to the Editor editor-present? if WM_WIN32FORTH ed-window @ Call SendMessage drop --- 66,78 ---- newproc ED_STACK newproc ED_DEBUG : editor-present? ( -- f1 ) + \ *G check if the Editor (e.g. the Win32ForthIDE) is present. ed-ptr -IF drop ed-window @ call IsWindow 0<> THEN ; ! : editor-message ( lParam wParam -- ) ! \ *G Send a Message to the Editor. editor-present? if WM_WIN32FORTH ed-window @ Call SendMessage drop *************** *** 93,102 **** INTERNAL - : init-shared-forth ( -- ) - 1 ed-forth-count +! ; \ bump count of Forths currently running - - ' init-shared-forth is init-shared-type - : init-shared-memory ( -- ) 0 to ed-ptr \ initialize to not present 0 to ed-hndl --- 85,90 ---- INTERNAL : init-shared-memory ( -- ) + \ *G Init the shared memory for commuication. 0 to ed-ptr \ initialize to not present 0 to ed-hndl *************** *** 108,127 **** THEN ; - init-shared-memory \ init it now per smb March 6th, 1996 - - initialization-chain chain-add init-shared-memory - - : uninit-shared-forth ( -- ) - second-forth? 0= \ and I'm the editors copy of Forth - IF 0 ed-result ! \ then tell console to close the console - 0 ED_SHUTDOWN editor-message - THEN - -1 ed-forth-count +! ; \ bump count of Forths currently running - - ' uninit-shared-forth is uninit-shared-type - - EXTERNAL - : uninit-shared-memory ( -- ) ed-ptr 0<> \ if shared memory was inited ed-hndl 0<> and --- 96,101 ---- THEN ; : uninit-shared-memory ( -- ) + \ *G Deinit the shared memory for commuication. ed-ptr 0<> \ if shared memory was inited ed-hndl 0<> and *************** *** 132,138 **** THEN ; ! unload-chain chain-add-before uninit-shared-memory ! INTERNAL LOADED? debug.f [IF] --- 106,115 ---- THEN ; ! initialization-chain chain-add init-shared-memory ! unload-chain chain-add-before uninit-shared-memory ! \ ---------------------------------------------------------------------------------------- ! \ Debug support ! \ ---------------------------------------------------------------------------------------- LOADED? debug.f [IF] *************** *** 140,144 **** IN-SYSTEM ! : do-inquire ( -- ) \ respond to an inquiry from the editor on a data item [ also bug ] ed-result off --- 117,122 ---- IN-SYSTEM ! : do-inquire ( -- ) ! \ *G Respond to an inquiry from the editor on a data item [ also bug ] ed-result off *************** *** 163,222 **** : db-pushkey ( c1 -- ) in-breakpoint? ! if pushkey ! else drop ! 0 ED_NOTINBP editor-message ! then ; ! ! : (win-set-break) { wParam lParam \ bp$ -- wParam lParam } ! wParam lParam ! \ This forth instance counting doesn't work well, and I don't understand ! \ what it's realy good for. So I removed the SECOND-FORTH? check to ! \ fix this nasty Win32ForthIDE F12 bug. (Samstag, Mai 12 2007 dbu) ! \ second-forth? ?EXIT \ ignore messages if second copy MAXSTRING LocalAlloc: bp$ ! ed-ptr 0= ?EXIT \ exit if no shared memory ! sys-free 0= ?EXIT \ exit if no heads are present ! over WM_SETBP = \ if we are being told to set a breakpoint ! if context @ >r \ save context vocabulary ! ed-name count bl skip 2dup bl scan ?dup ! if 2dup 2>r nip - bp$ place bp$ anyfind ! if execute ! 2r> bl skip bp$ place ! bp$ anyfind ! else 2r> 2drop ! FALSE ! then ! else ed-name anyfind then ! if unbug \ remove any previous BP ! remote-debug \ set the breakpoint ! dup ed-response ! \ non zero=success ! if with-source \ enable source viewing ! then ! else drop \ couldn't find it ! 0 ed-response ! \ 0=failure then ! r> context ! \ restore the context vocabulary ! EXIT ! then over CASE \ --- Debugger support ! WM_STEPBP OF 0x0D db-pushkey ENDOF ! WM_NESTBP OF 'N' db-pushkey ENDOF ! WM_UNESTBP OF 'U' db-pushkey ENDOF ! WM_CONTBP OF 'C' db-pushkey ENDOF ! WM_JUMPBP OF 'J' db-pushkey ENDOF ! WM_BEGNBP OF 'P' db-pushkey ENDOF ! WM_HEREBP OF 'P' +k_control db-pushkey ENDOF ! WM_RSTKBP OF 'R' db-pushkey ENDOF ! WM_DONEBP OF 'D' db-pushkey ENDOF ! WM_INQUIRE OF do-inquire ENDOF \ --- Support for console interface ! WM_KEY OF dup pushkey ENDOF ENDCASE ; --- 141,200 ---- : db-pushkey ( c1 -- ) + \ *G Push a key to the console window during debuging. in-breakpoint? ! if pushkey ! else drop beep ! then ; ! : do-set-breakpoint { \ bp$ -- } ! \ *G Set breakpoint to a word. MAXSTRING LocalAlloc: bp$ ! ! context @ >r \ save context vocabulary ! ed-name count bl skip 2dup bl scan ?dup ! if 2dup 2>r nip - bp$ place ! bp$ anyfind ! if execute ! 2r> bl skip bp$ place bp$ anyfind ! else 2r> 2drop ! FALSE then ! else ed-name anyfind ! then ! if unbug \ remove any previous BP ! remote-debug \ set the breakpoint ! dup ed-response ! \ non zero=success ! if with-source \ enable source viewing then ! else drop \ couldn't find it ! 0 ed-response ! \ 0=failure ! then ! r> context ! \ restore the context vocabulary ! ; ! ! : (win-set-breakpoint) { wParam lParam \ bp$ -- wParam lParam } ! wParam lParam ! ! ed-ptr 0= ?EXIT \ exit if no shared memory ! ! over CASE \ --- Debugger support ! WM_SETBP OF do-set-breakpoint ENDOF ! WM_STEPBP OF 0x0D db-pushkey ENDOF ! WM_NESTBP OF 'N' db-pushkey ENDOF ! WM_UNESTBP OF 'U' db-pushkey ENDOF ! WM_CONTBP OF 'C' db-pushkey ENDOF ! WM_JUMPBP OF 'J' db-pushkey ENDOF ! WM_BEGNBP OF 'P' db-pushkey ENDOF ! WM_HEREBP OF 'P' +k_control db-pushkey ENDOF ! WM_RSTKBP OF 'R' db-pushkey ENDOF ! WM_DONEBP OF 'D' db-pushkey ENDOF ! WM_INQUIRE OF do-inquire ENDOF \ --- Support for console interface ! WM_KEY OF dup pushkey ENDOF ENDCASE ; *************** *** 224,230 **** : win-set-breakpoint ( -- ) ! TURNKEYED? ?EXIT ! \IN-SYSTEM-OK (win-set-break) ! ; forth-msg-chain chain-add win-set-breakpoint --- 202,208 ---- : win-set-breakpoint ( -- ) ! \ *G Handle debug-messages from the Editor ! TURNKEYED? ?EXIT \ exit if no heads are present ! \IN-SYSTEM-OK (win-set-breakpoint) ; forth-msg-chain chain-add win-set-breakpoint *************** *** 232,234 **** --- 210,238 ---- [ENDIF] + \ ---------------------------------------------------------------------------------------- + \ Copy text from the clipboard to the console window and compile it. + \ ---------------------------------------------------------------------------------------- + + EXTERNAL + + defer paste-load ' noop is paste-load + + INTERNAL + + IN-SYSTEM + + : (win-paste-load) ( wParam lParam -- wParam lParam ) + ed-ptr 0= ?EXIT \ exit if no shared memory + over WM_PASTELOAD = + if paste-load \ tell Forth to PASTE and LOAD + then ; + + IN-APPLICATION + + : win-paste-load ( wParam lParam -- wParam lParam ) + TURNKEYED? ?EXIT \ exit if no heads are present + \IN-SYSTEM-OK (win-paste-load) ; + + forth-msg-chain chain-add win-paste-load + MODULE Index: Keysave.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Keysave.f,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -d -r1.4 -r1.5 *** Keysave.f 29 Apr 2006 19:47:17 -0000 1.4 --- Keysave.f 13 May 2007 07:52:26 -0000 1.5 *************** *** 29,33 **** :M GetLogName: ( -- a1 n1 ) ! logfilename count ;M --- 29,33 ---- :M GetLogName: ( -- a1 n1 ) ! logfilename count ;M *************** *** 118,122 **** logfilebuf place logfilebuf to logfilename ! logfilename count r/w create-file dup s" Error Creating LOG file" ?MessageBox if drop --- 118,122 ---- logfilebuf place logfilebuf to logfilename ! logfilename count r/w create-file dup s" Error Creating LOG file" ?MessageBox if drop *************** *** 147,151 **** 2dup r/o open-file dup s" Key LOG file doesn't exist!" ?MessageBox ! if 3drop else to playhndl logfilebuf place --- 147,151 ---- 2dup r/o open-file dup s" Key LOG file doesn't exist!" ?MessageBox ! if 3drop else to playhndl logfilebuf place *************** *** 327,331 **** : new-log ( -- ) ! NewLog: key-log-file logging-on ; --- 327,331 ---- : new-log ( -- ) ! NewLog: key-log-file logging-on ; *************** *** 362,366 **** PlayLog: key-log-file ['] play1key is auto_key ! ['] play1key? is auto_key? play1key ; --- 362,366 ---- PlayLog: key-log-file ['] play1key is auto_key ! ['] play1key? is auto_key? play1key ; *************** *** 373,377 **** : replay-macro ( -- ) ! Playing: key-log-file 0= \ replay only if not already \ playing some keys if GetLogName: key-log-file "playkeys --- 373,377 ---- : replay-macro ( -- ) ! Playing: key-log-file 0= \ replay only if not already \ playing some keys if GetLogName: key-log-file "playkeys *************** *** 419,423 **** else drop 0 then to #repeating-macro ! then #repeating-macro if GetLogName: key-log-file PlayLog: key-log-file --- 419,423 ---- else drop 0 then to #repeating-macro ! then #repeating-macro if GetLogName: key-log-file PlayLog: key-log-file *************** *** 472,484 **** then ; ! defer paste-load ! : _paste-load ( -- ) ! ( _conHndl) null call OpenClipboard 0= if beep else CF_TEXT call GetClipboardData ?dup ! if dup to paste-hdl call GlobalLock dup to paste-ptr \ lock memory ! 0= if call CloseClipboard drop exit then ! paste-ptr zcount nip dup to paste-len \ get len if 0 to paste-off 0 to play0cnt --- 472,484 ---- then ; ! : _paste-load ( -- ) ! \ *G Copy text from the clipboard to the console window and compile it. ! conhndl call OpenClipboard 0= if beep else CF_TEXT call GetClipboardData ?dup ! if dup to paste-hdl call GlobalLock dup to paste-ptr \ lock memory ! 0= if call CloseClipboard drop exit then ! paste-ptr zcount nip dup to paste-len \ get len if 0 to paste-off 0 to play0cnt *************** *** 498,517 **** then then ; - ' _paste-load is paste-load - - : win-paste-load ( wParam lParam -- wParam lParam ) - ed-ptr 0= ?EXIT \ exit if no shared memory - sys-free 0= ?EXIT \ exit if no heads are present - over WM_PASTELOAD = \ tell Forth to PASTE and LOAD - if paste-load - then ; ! forth-msg-chain chain-add win-paste-load ! : copy-console { \ gblhndl gblptr b/l l/s len -- } \ Copy text to Windows clipboard ! marked? 0= ! if beep EXIT ! then ! conhndl call OpenClipboard 0= if beep else getmaxcolrow to l/s \ lines per screen (really total) --- 498,510 ---- then then ; ! ' _paste-load is paste-load ! : copy-console { \ gblhndl gblptr b/l l/s len -- } ! \ *G Copy text to Windows clipboard ! marked? 0= ! if beep EXIT ! then ! conhndl call OpenClipboard 0= if beep else getmaxcolrow to l/s \ lines per screen (really total) *************** *** 566,569 **** --- 559,563 ---- : cut-console ( -- ) + \ *G Cut the complete text from the console window to the clipboard. marked? if beep *************** *** 575,577 **** MODULE \ finish up the module - |
