From: Ezra B. <ezr...@us...> - 2010-07-11 02:45:25
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv7079 Modified Files: CommandID.f EdCompile.f EdDebug.f EdPreferences.f Log Message: Updates. Enhancement to search & replace, auto detect disk file changes,debug tab and others. EAB Index: EdDebug.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdDebug.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** EdDebug.f 2 Sep 2008 06:38:41 -0000 1.6 --- EdDebug.f 11 Jul 2010 02:45:17 -0000 1.7 *************** *** 8,11 **** --- 8,12 ---- \ Debug an application in the Editor + needs DebugForm.frm \ ----------------------------------------------------------------------------- *************** *** 216,223 **** ;Object ! : debug-buttons ( -- ) \ *G Open the Debug dialog ! Frame Start: DbgButtonsDlg ! TRUE to debug-buttons? ; : receive-stack ( addr -- ) --- 217,405 ---- ;Object ! \ Uncomment the following to use the old dialog ! \ : debug-buttons ( -- ) \ using original dialog \ *G Open the Debug dialog ! \ Frame Start: DbgButtonsDlg ! \ TRUE to debug-buttons? ; ! \ ! \ : receive-stack ( addr -- ) ! \ *G Get stack from Forth ! \ dup edstack 64 cells cmove ! \ 64 cells + edreturn maxstring cmove ! \ ShowStack: DbgButtonsDlg ; ! \ ! \ : receive-response ( addr -- ) ! \ *G Get response from Forth to a WM_INQUIRE msg ! \ ShowResponse: DbgButtonsDlg ; ! \ ! \ : receive-debug ( addr -- ) ! \ *G display the debug line sent by Forth ! \ ShowDebug: DbgButtonsDlg ; ! \ ! \ : receive-name ( addr -- ) ! \ *G display the debug line sent by Forth ! \ count edname place ; ! ! ! :Object frmDbgButtonsDlg <Super frmDebug ! ! int HexBase ! Font dbFont ! int inq-running? ! ! :M ClassInit: ( -- ) ! ClassInit: super ! FALSE to HexBase \ FALSE = Decimal, TRUE = Hex ! FALSE to inq-running? ! ;M ! ! : "addstack { adr len \ ztemp -- } ! MAXSTRING LocalAlloc: ztemp \ allocate buffer ! ztemp MAXSTRING erase \ null fill buffer ! adr ztemp len MAXSTRING 1- min move \ move text to buffer ! ztemp AddStringTo: lstDStack ; ! ! : "addreturn { adr len \ ztemp -- } ! MAXSTRING LocalAlloc: ztemp \ allocate buffer ! ztemp MAXSTRING erase \ null fill buffer ! adr ztemp len MAXSTRING 1- min move \ move text to buffer ! ztemp AddStringTo: lstRStack ; ! ! : n>" ( n1 -- a1 n2 ) ! base @ >r ! HexBase ! IF HEX ! ELSE DECIMAL ! THEN ! HexBase ! IF 0 <# #s s" 0x" "hold #> ! ELSE s>d tuck dabs <# #s rot sign #> ! THEN ! r> base ! ; ! ! :M ShowStack: { \ temp$ -- } ! MAXSTRING LocalAlloc: temp$ ! s" Debugging: " temp$ place ! edname count temp$ +place ! temp$ count SetText: lblDebugging ! Clear: lstDStack ! edstack @ ?dup ! IF dup 0< ! IF drop 11 0 ! ?DO s" UnderFlow!" "addstack ! LOOP ! ELSE 10 min 1 swap ! DO edstack i cells+ @ n>" "addstack ! -1 +LOOP ! THEN ! ELSE s" Empty" "addstack ! THEN ! Clear: lstRStack ! edreturn count bl skip ! bl scan bl skip \ skip "RETURN" ! bl scan bl skip \ skip "STACK[xx]" ! BEGIN 2dup bl scan 2dup 2>r nip - dup ! WHILE "addreturn 2r> bl skip ! REPEAT 2drop 2r> 2drop ;M ! ! : "adddebug { adr len \ ztemp -- } ! MAXSTRING LocalAlloc: ztemp \ allocate buffer ! ztemp MAXSTRING erase \ null fill buffer ! adr ztemp len MAXSTRING 1- min move \ move text to buffer ! ztemp AddStringTo: lstWords ; ! ! :M ShowDebug: { addr \ ed-dbgline -- } ! addr count dup 1+ localalloc: ed-dbgline ! ed-dbgline place ! Clear: lstWords ! prev-lines dup MAXSTRING + swap MAXSTRING 4 * move ! ed-dbgline count 2dup 0x0D scan 2dup 1 /string 2>r ! 2drop ! 2r> prev-lines MAXSTRING 4 * + place ! 5 0 ! ?DO prev-lines i MAXSTRING * + count "adddebug ! LOOP ! ;M ! ! :M ShowResponse: { addr \ temp$ -- } ! MAXSTRING LocalAlloc: temp$ ! s" " temp$ place \ init to empty type ! addr @ 4 min 0 ! ?DO addr i 1+ cells+ @ n>" temp$ +place ! s" " temp$ +place ! LOOP temp$ count SetText: txtResult ;M ! ! : inquirebp ( -- ) ! \ *G inquire for the value of a data item ! \ ??? ed-ptr 0= ?EXIT \ only if we have shared memory ! msgpad off ! inq-running? 0= ! IF TRUE to inq-running? ! ! SelTextToPad ?dup ! if msgpad place else drop then ! ! msgpad self Start: InquireDlg ! msgpad c@ 0> and ! IF msgpad dup c@ 1+ WM_INQUIRE w32fForth Sendw32fMsg drop ! THEN ! ! FALSE to inq-running? ! ELSE beep ! THEN ; ! ! :M Close: ( -- ) ! FALSE to debug-buttons? ! Close: Super ;M ! ! : command-func ( ID obj -- ) ! drop ! CASE ! GetID: btnStep OF stepbp ENDOF ! GetId: btnInto OF nestbp ENDOF ! GetID: btnOutOf OF unestbp ENDOF ! GetID: btnSteps OF contbp ENDOF ! GetId: btnBreak OF jumpbp ENDOF ! GetID: btnBP OF beginbp ENDOF ! GetID: btnHere OF herebp ENDOF ! GetID: btnRun OF donebp ENDOF ! GetId: btnInquire OF inquirebp ENDOF ! GetId: btnSetBP OF IDM_SET_BREAK_POINT DoCommand ENDOF ! GetID: radHex OF TRUE to HexBase ShowStack: self ENDOF ! GetID: radDecimal OF FALSE to HexBase ShowStack: self ENDOF ! ENDCASE ; ! ! :M On_Init: ( -- ) ! WS_BORDER dup AddStyle: lstWords ! dup AddStyle: lstDStack ! AddStyle: lstRStack ! On_Init: super ! true ReadOnly: txtResult ! HexBase dup Check: radHex 0= Check: radDecimal ! ShowStack: self ! ['] command-func SetCommand: self ! ;M ! ! :M ExWindowStyle: ( -- ) ! WS_EX_CLIENTEDGE ;M ! ! :M Clear: ( -- ) ! Clear: lstWords ! Clear: lstDStack ! Clear: lstRStack ! s" " SetText: txtResult ! s" " SetText: lblDebugging ;M ! ! ;Object ! ! frmDbgButtonsDlg to frmDebugDlg ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ Comment out the following if using the old dialog ! : debug-buttons ( -- ) \ using frmDebugDlg ! \ *G Open the Debug dialog ! debugtab# -1 <> ! if debugtab# ShowTab: cTabWindow ! then TRUE to debug-buttons? ; : receive-stack ( addr -- ) *************** *** 225,237 **** dup edstack 64 cells cmove 64 cells + edreturn maxstring cmove ! ShowStack: DbgButtonsDlg ; : receive-response ( addr -- ) \ *G Get response from Forth to a WM_INQUIRE msg ! ShowResponse: DbgButtonsDlg ; : receive-debug ( addr -- ) \ *G display the debug line sent by Forth ! ShowDebug: DbgButtonsDlg ; : receive-name ( addr -- ) --- 407,419 ---- dup edstack 64 cells cmove 64 cells + edreturn maxstring cmove ! ShowStack: frmDebugDlg ; : receive-response ( addr -- ) \ *G Get response from Forth to a WM_INQUIRE msg ! ShowResponse: frmDebugDlg ; : receive-debug ( addr -- ) \ *G display the debug line sent by Forth ! ShowDebug: frmDebugDlg ; : receive-name ( addr -- ) *************** *** 239,242 **** --- 421,426 ---- count edname place ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ ----------------------------------------------------------------------------- \ ----------------------------------------------------------------------------- *************** *** 270,271 **** --- 454,456 ---- IF debug-buf count "debug-word THEN ; IDM_SET_BREAK_POINT SetCommand + Index: CommandID.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/CommandID.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** CommandID.f 1 Feb 2010 01:41:48 -0000 1.22 --- CommandID.f 11 Jul 2010 02:45:17 -0000 1.23 *************** *** 97,100 **** --- 97,101 ---- NewID IDM_COMPILE NewID IDM_COMPILE_SELECTION + NewID IDM_COMPILE_LINE NewID IDM_DEBUG NewID IDM_SET_BREAK_POINT *************** *** 102,105 **** --- 103,107 ---- NewID IDM_SET_BOOKMARK NewID IDM_BUILD_CODE_TREE + NewID IDM_MSGBOX_BUILDER \ Window menu Index: EdPreferences.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdPreferences.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** EdPreferences.f 1 Feb 2010 01:41:48 -0000 1.8 --- EdPreferences.f 11 Jul 2010 02:45:17 -0000 1.9 *************** *** 83,90 **** IsButtonChecked?: chkSingleControl to SingleControl? IsButtonChecked?: chkDetached to detached? detached? r> <> \ if this status changed if IDM_SHOW_FORMTAB DoCommand ! then Update ! Resize: MainWindow ; : DisplayFontName ( -- ) --- 83,100 ---- IsButtonChecked?: chkSingleControl to SingleControl? IsButtonChecked?: chkDetached to detached? + IsButtonChecked?: chkAutoDetect to autodetect? + IsButtonChecked?: chkAutoSession to autosavesession? + IsButtonChecked?: chkProject to show-projtab? + IsButtonChecked?: chkFile to show-filetab? + IsButtonChecked?: chkDirectory to show-dirtab? + IsButtonChecked?: chkClass to show-classtab? + IsButtonChecked?: chkVocabulary to show-voctab? + IsButtonChecked?: chkForm to show-formtab? + IsButtonChecked?: chkDebug to show-debugtab? + detached? r> <> \ if this status changed if IDM_SHOW_FORMTAB DoCommand ! then Refresh: cTabWindow \ any tab changes ! Update Resize: MainWindow ; : DisplayFontName ( -- ) *************** *** 118,127 **** on_init: super ! autoindent? Check: chkAutoIndent ! with-tabs? Check: chkShowTabs ! include-libs? Check: chkIncludeLibs ! AutoProperty? Check: chkAutoProperty ! SingleControl? Check: chkSingleControl ! detached? Check: chkDetached SetPFont backup-colors --- 128,148 ---- on_init: super ! autoindent? Check: chkAutoIndent ! with-tabs? Check: chkShowTabs ! include-libs? Check: chkIncludeLibs ! AutoProperty? Check: chkAutoProperty ! SingleControl? Check: chkSingleControl ! detached? Check: chkDetached ! autodetect? Check: chkAutoDetect ! autosavesession? Check: chkAutoSession ! ! show-projtab? Check: chkProject ! show-filetab? Check: chkFile ! show-dirtab? Check: chkDirectory ! show-classtab? Check: chkClass ! show-voctab? Check: chkVocabulary ! show-formtab? Check: chkForm ! show-debugtab? Check: chkDebug ! SetPFont backup-colors Index: EdCompile.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdCompile.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** EdCompile.f 27 Jul 2008 07:21:50 -0000 1.10 --- EdCompile.f 11 Jul 2010 02:45:17 -0000 1.11 *************** *** 45,48 **** --- 45,49 ---- : Compile-Selection ( -- ) + IsEditWnd? not ?exit GetSelectionEnd: CurrentWindow GetSelectionStart: CurrentWindow - if Copy: CurrentWindow *************** *** 55,61 **** then ; IDM_COMPILE_SELECTION SetCommand ! ! ! --- 56,74 ---- then ; IDM_COMPILE_SELECTION SetCommand ! : Compile-Line { \ buf$ -- } ! IsEditWnd? not ?exit ! GetCurrentPos: CurrentWindow ! LineFromPosition: CurrentWindow ! LineLength: CurrentWindow dup 2 - 0 <= \ if line doesn't have a length? ! if drop exit ! then 1+ dup LocalAlloc: buf$ ! buf$ GetCurLine: CurrentWindow drop ! buf$ zcount copy-clipboard ! 0 0 ExecForth ! 0 0 WM_PASTELOAD w32fForth Sendw32fMsg drop ! 200 ms ! 0x0D msgpad c! ! msgpad 1 WM_KEY w32fForth Sendw32fMsg drop \ send CR to execute the string ! ; IDM_COMPILE_LINE SetCommand |