Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdDebug.f, 1.7, 1.8 EdMenu.f, 1.34, 1.35 EdRemote.f, 1.12, 1.13
|
From: George H. <geo...@us...> - 2011-05-25 20:53:11
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE
In directory vz-cvs-4.sog:/tmp/cvs-serv7471
Modified Files:
EdDebug.f EdMenu.f EdRemote.f
Log Message:
Sorted loading of projects in running IDE
Index: EdDebug.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdDebug.f,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** EdDebug.f 11 Jul 2010 02:45:17 -0000 1.7
--- EdDebug.f 25 May 2011 20:53:09 -0000 1.8
***************
*** 52,60 ****
create edname maxstring allot
! :Object DbgButtonsDlg <Super ModelessDialog
! IDD_DEBUG WINEDIT find-dialog-id constant template
! int HexBase
Font dbFont
int inq-running?
--- 52,60 ----
create edname maxstring allot
! True [if] \ True gives new dialog, False gives old.
! :Object frmDbgButtonsDlg <Super frmDebug
! int HexBase
Font dbFont
int inq-running?
***************
*** 64,84 ****
FALSE to HexBase \ FALSE = Decimal, TRUE = Hex
FALSE to inq-running?
- 8 Width: dbFont
- 14 Height: dbFont
- s" Courier" SetFaceName: dbFont \ default to Courier
;M
- :M GetTemplate: ( -- template )
- template ;M
-
- :M ExWindowStyle: ( -- )
- ExWindowStyle: super WS_EX_TOOLWINDOW or ;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
! 0 LB_ADDSTRING IDL_STACK SendDlgItemMessage: self drop ;
: "addreturn { adr len \ ztemp -- }
--- 64,74 ----
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 -- }
***************
*** 86,91 ****
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp
! 0 LB_ADDSTRING IDL_RETURN SendDlgItemMessage: self drop ;
: n>" ( n1 -- a1 n2 )
--- 76,80 ----
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp AddStringTo: lstRStack ;
: n>" ( n1 -- a1 n2 )
***************
*** 105,110 ****
s" Debugging: " temp$ place
edname count temp$ +place
! temp$ count IDT_NAME SetDlgItemText: self drop
! 0 0 LB_RESETCONTENT IDL_STACK SendDlgItemMessage: self drop
edstack @ ?dup
IF dup 0<
--- 94,99 ----
s" Debugging: " temp$ place
edname count temp$ +place
! temp$ count SetText: lblDebugging
! Clear: lstDStack
edstack @ ?dup
IF dup 0<
***************
*** 118,122 ****
ELSE s" Empty" "addstack
THEN
! 0 0 LB_RESETCONTENT IDL_RETURN SendDlgItemMessage: self drop
edreturn count bl skip
bl scan bl skip \ skip "RETURN"
--- 107,111 ----
ELSE s" Empty" "addstack
THEN
! Clear: lstRStack
edreturn count bl skip
bl scan bl skip \ skip "RETURN"
***************
*** 130,140 ****
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp
! 0 LB_ADDSTRING IDL_WORDS SendDlgItemMessage: self drop ;
:M ShowDebug: { addr \ ed-dbgline -- }
addr count dup 1+ localalloc: ed-dbgline
ed-dbgline place
! 0 0 LB_RESETCONTENT IDL_WORDS SendDlgItemMessage: self drop
prev-lines dup MAXSTRING + swap MAXSTRING 4 * move
ed-dbgline count 2dup 0x0D scan 2dup 1 /string 2>r
--- 119,128 ----
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
***************
*** 152,156 ****
?DO addr i 1+ cells+ @ n>" temp$ +place
s" " temp$ +place
! LOOP temp$ count IDT_RESULT SetDlgItemText: self ;M
: inquirebp ( -- )
--- 140,144 ----
?DO addr i 1+ cells+ @ n>" temp$ +place
s" " temp$ +place
! LOOP temp$ count SetText: txtResult ;M
: inquirebp ( -- )
***************
*** 173,248 ****
THEN ;
:M On_Init: ( -- )
On_Init: super
! HexBase
! IF IDR_HEX
! ELSE IDR_DECIMAL
! THEN IDR_DECIMAL IDR_HEX CheckRadioButton: self
! Handle: dbFont 0=
! IF Create: dbFont
! THEN
! Handle: dbFont
! IF Handle: dbFont IDL_STACK SetDlgItemFont: self
! Handle: dbFont IDL_RETURN SetDlgItemFont: self
! Handle: dbFont IDL_WORDS SetDlgItemFont: self
! THEN
ShowStack: self
;M
! :M On_Command: ( hCtrl code ID -- f1 ) \ returns 0=cancel
! CASE
! IDB_STEP OF stepbp ENDOF
! IDB_NEST OF nestbp ENDOF
! IDB_UNEST OF unestbp ENDOF
! IDB_CONT OF contbp ENDOF
! IDB_JUMP OF jumpbp ENDOF
! IDB_PROC OF beginbp ENDOF
! IDB_HERE OF herebp ENDOF
! IDB_DONE OF donebp ENDOF
! IDB_INQUIRE OF inquirebp ENDOF
! IDR_HEX OF TRUE to HexBase ShowStack: self ENDOF
! IDR_DECIMAL OF FALSE to HexBase ShowStack: self ENDOF
! IDCANCEL OF FALSE to debug-buttons?
! Delete: dbFont
! DestroyWindow: self ENDOF
! false swap ( default result )
! ENDCASE ;M
! :M WM_CLOSE ( -- )
! FALSE to debug-buttons?
! Delete: dbFont
! WM_CLOSE WM: Super
! ;M
;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?
--- 161,243 ----
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 -- )
\ *G Get stack from Forth
! 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 -- )
\ *G display the debug line sent by Forth
! count edname place ;
+ [else]
! :Object DbgButtonsDlg <Super ModelessDialog
! IDD_DEBUG WINEDIT find-dialog-id constant template
!
! int HexBase
Font dbFont
int inq-running?
***************
*** 252,262 ****
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 -- }
--- 247,267 ----
FALSE to HexBase \ FALSE = Decimal, TRUE = Hex
FALSE to inq-running?
+ 8 Width: dbFont
+ 14 Height: dbFont
+ s" Courier" SetFaceName: dbFont \ default to Courier
;M
+ :M GetTemplate: ( -- template )
+ template ;M
+
+ :M ExWindowStyle: ( -- )
+ ExWindowStyle: super WS_EX_TOOLWINDOW or ;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
! 0 LB_ADDSTRING IDL_STACK SendDlgItemMessage: self drop ;
: "addreturn { adr len \ ztemp -- }
***************
*** 264,268 ****
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp AddStringTo: lstRStack ;
: n>" ( n1 -- a1 n2 )
--- 269,274 ----
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp
! 0 LB_ADDSTRING IDL_RETURN SendDlgItemMessage: self drop ;
: n>" ( n1 -- a1 n2 )
***************
*** 282,287 ****
s" Debugging: " temp$ place
edname count temp$ +place
! temp$ count SetText: lblDebugging
! Clear: lstDStack
edstack @ ?dup
IF dup 0<
--- 288,293 ----
s" Debugging: " temp$ place
edname count temp$ +place
! temp$ count IDT_NAME SetDlgItemText: self drop
! 0 0 LB_RESETCONTENT IDL_STACK SendDlgItemMessage: self drop
edstack @ ?dup
IF dup 0<
***************
*** 295,299 ****
ELSE s" Empty" "addstack
THEN
! Clear: lstRStack
edreturn count bl skip
bl scan bl skip \ skip "RETURN"
--- 301,305 ----
ELSE s" Empty" "addstack
THEN
! 0 0 LB_RESETCONTENT IDL_RETURN SendDlgItemMessage: self drop
edreturn count bl skip
bl scan bl skip \ skip "RETURN"
***************
*** 307,316 ****
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
--- 313,323 ----
ztemp MAXSTRING erase \ null fill buffer
adr ztemp len MAXSTRING 1- min move \ move text to buffer
! ztemp
! 0 LB_ADDSTRING IDL_WORDS SendDlgItemMessage: self drop ;
:M ShowDebug: { addr \ ed-dbgline -- }
addr count dup 1+ localalloc: ed-dbgline
ed-dbgline place
! 0 0 LB_RESETCONTENT IDL_WORDS SendDlgItemMessage: self drop
prev-lines dup MAXSTRING + swap MAXSTRING 4 * move
ed-dbgline count 2dup 0x0D scan 2dup 1 /string 2>r
***************
*** 328,332 ****
?DO addr i 1+ cells+ @ n>" temp$ +place
s" " temp$ +place
! LOOP temp$ count SetText: txtResult ;M
: inquirebp ( -- )
--- 335,339 ----
?DO addr i 1+ cells+ @ n>" temp$ +place
s" " temp$ +place
! LOOP temp$ count IDT_RESULT SetDlgItemText: self ;M
: inquirebp ( -- )
***************
*** 349,424 ****
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 -- )
! \ *G Get stack from Forth
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 -- )
! \ *G display the debug line sent by Forth
count edname place ;
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
--- 356,430 ----
THEN ;
:M On_Init: ( -- )
On_Init: super
! HexBase
! IF IDR_HEX
! ELSE IDR_DECIMAL
! THEN IDR_DECIMAL IDR_HEX CheckRadioButton: self
! Handle: dbFont 0=
! IF Create: dbFont
! THEN
! Handle: dbFont
! IF Handle: dbFont IDL_STACK SetDlgItemFont: self
! Handle: dbFont IDL_RETURN SetDlgItemFont: self
! Handle: dbFont IDL_WORDS SetDlgItemFont: self
! THEN
ShowStack: self
;M
! :M On_Command: ( hCtrl code ID -- f1 ) \ returns 0=cancel
! CASE
! IDB_STEP OF stepbp ENDOF
! IDB_NEST OF nestbp ENDOF
! IDB_UNEST OF unestbp ENDOF
! IDB_CONT OF contbp ENDOF
! IDB_JUMP OF jumpbp ENDOF
! IDB_PROC OF beginbp ENDOF
! IDB_HERE OF herebp ENDOF
! IDB_DONE OF donebp ENDOF
! IDB_INQUIRE OF inquirebp ENDOF
! IDR_HEX OF TRUE to HexBase ShowStack: self ENDOF
! IDR_DECIMAL OF FALSE to HexBase ShowStack: self ENDOF
! IDCANCEL OF FALSE to debug-buttons?
! Delete: dbFont
! DestroyWindow: self ENDOF
! false swap ( default result )
! ENDCASE ;M
! :M WM_CLOSE ( -- )
! FALSE to debug-buttons?
! Delete: dbFont
! WM_CLOSE WM: Super
! ;M
;Object
! DbgButtonsDlg to frmDebugDlg
+ : 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 ;
+
+ [then]
\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Index: EdMenu.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** EdMenu.f 12 Feb 2011 02:45:24 -0000 1.34
--- EdMenu.f 25 May 2011 20:53:09 -0000 1.35
***************
*** 320,325 ****
\ Win32Forth menu
! \ dup Enable: mp_setbp
! \ dup Enable: mp_debug
dup Enable: mp_compileSel
dup Enable: mp_compileLine
--- 320,325 ----
\ Win32Forth menu
! \ dup Enable: mp_setbp
! \ dup Enable: mp_debug
dup Enable: mp_compileSel
dup Enable: mp_compileLine
Index: EdRemote.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdRemote.f,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** EdRemote.f 28 Apr 2011 18:02:49 -0000 1.12
--- EdRemote.f 25 May 2011 20:53:09 -0000 1.13
***************
*** 32,42 ****
ed-filename count file-exist?
if ed-filename count
! IsHtmlFile?
! if ed-filename count (OpenHtmlFile)
! else \ avoid duplicate files loaded when compiling and error occurs
! ed-filename count (OpenRemoteFile) \ switch if already loaded
! ed-line GotoLine: ActiveRemote
! \ ed-line ed-filename count LoadHyperFile: ActiveRemote \ load the file
! flag 2 = SetBrowseMode: ActiveRemote \ browsing?
then
then
--- 32,46 ----
ed-filename count file-exist?
if ed-filename count
! IsProjectFile?
! if ed-filename count (open-project)
! else
! ed-filename count IsHtmlFile?
! if ed-filename count (OpenHtmlFile)
! else \ avoid duplicate files loaded when compiling and error occurs
! ed-filename count (OpenRemoteFile) \ switch if already loaded
! ed-line GotoLine: ActiveRemote
! \ ed-line ed-filename count LoadHyperFile: ActiveRemote \ load the file
! flag 2 = SetBrowseMode: ActiveRemote \ browsing?
! then
then
then
|
