From: George H. <geo...@us...> - 2007-11-01 22:04:10
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30338/win32forth/src/console Modified Files: BasicWin.f CommandWindow.f NewConsole.f NoConsole.f Statbar.f Log Message: gah: Added $Id: $ identifiers Index: Statbar.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Statbar.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Statbar.f 17 May 2006 20:13:33 -0000 1.5 --- Statbar.f 1 Nov 2007 22:03:54 -0000 1.6 *************** *** 1,2 **** --- 1,4 ---- + \ $Id$ + \ File: Statbar.f \ Author: Jeff Kelm Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** NewConsole.f 28 Oct 2007 15:51:17 -0000 1.2 --- NewConsole.f 1 Nov 2007 22:03:54 -0000 1.3 *************** *** 1,4 **** \ NewConsole.f Console window to replace w32fConsole.dll ! Needs CommandWindow.f --- 1,6 ---- + \ $Id$ + \ NewConsole.f Console window to replace w32fConsole.dll ! Needs CommandWindow.f *************** *** 142,147 **** : c_cr ( -- ) crlf$ count c_type ; : c_?cr ( n -- ) CharsNotFit: cmd IF c_cr THEN ; ! \ : c_cls ( -- ) ZeroText: cmd 0 caretX: cmd ptrNull +ztext: cmd paint: cmd updateVscroll: cmd ; ! : c_cls ( -- ) DA: cmd ; : c_getcolrow ( -- col row ) VisibleColRow: cmd ; : c_getxy ( -- x y ) LastColRow: cmd ; --- 144,149 ---- : c_cr ( -- ) crlf$ count c_type ; : c_?cr ( n -- ) CharsNotFit: cmd IF c_cr THEN ; ! \ : c_cls ( -- ) ZeroText: cmd 0 caretX: cmd ptrNull +ztext: cmd paint: cmd updateVscroll: cmd ; ! : c_cls ( -- ) DA: cmd ; : c_getcolrow ( -- col row ) VisibleColRow: cmd ; : c_getxy ( -- x y ) LastColRow: cmd ; *************** *** 178,182 **** prompt: cmd ShowCaret: cmd KeyBufferEmpty: cmd IF BEGIN c_key? UNTIL THEN Hidecaret: cmd ! GetKey: cmd cmd.CaretX 1- CaretX: cmd KeysOn: cmd --- 180,184 ---- prompt: cmd ShowCaret: cmd KeyBufferEmpty: cmd IF BEGIN c_key? UNTIL THEN Hidecaret: cmd ! GetKey: cmd cmd.CaretX 1- CaretX: cmd KeysOn: cmd *************** *** 188,192 **** \ prompt: cmd KeyBufferEmpty: cmd IF BEGIN c_key? UNTIL THEN ! GetKey: cmd \ cmd.CaretX 1- CaretX: cmd KeysOn: cmd --- 190,194 ---- \ prompt: cmd KeyBufferEmpty: cmd IF BEGIN c_key? UNTIL THEN ! GetKey: cmd \ cmd.CaretX 1- CaretX: cmd KeysOn: cmd *************** *** 252,256 **** ['] c_BG@ IS BG@ ['] K_NOOP2 IS CHARWH \ no ! ['] 2DROP IS SETCHARWH \ no ['] 2DROP IS SETCOLROW \ no ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ??? --- 254,258 ---- ['] c_BG@ IS BG@ ['] K_NOOP2 IS CHARWH \ no ! ['] 2DROP IS SETCHARWH \ no ['] 2DROP IS SETCOLROW \ no ['] DROP IS SET-CURSOR \ no big-cursor, norm-cursor ??? *************** *** 303,307 **** ; ! : NN NewConsole 0 call SetFocus drop SetFocus: ConsoleWindow ; --- 305,309 ---- ; ! : NN NewConsole 0 call SetFocus drop SetFocus: ConsoleWindow ; Index: NoConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NoConsole.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** NoConsole.f 31 Oct 2007 18:51:39 -0000 1.8 --- NoConsole.f 1 Nov 2007 22:03:54 -0000 1.9 *************** *** 1,2 **** --- 1,4 ---- + \ $Id$ + \ File: NoConsole.f \ Author: Dirk Busch di...@wi... Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** CommandWindow.f 28 Oct 2007 13:02:18 -0000 1.1 --- CommandWindow.f 1 Nov 2007 22:03:54 -0000 1.2 *************** *** 1,3 **** ! \ CommandWindow.f Font CommandFont --- 1,3 ---- ! \ $Id$ Font CommandFont *************** *** 244,248 **** r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin --- 244,248 ---- r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin *************** *** 255,259 **** ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin --- 255,259 ---- ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin *************** *** 272,276 **** Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN --- 272,276 ---- Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN *************** *** 286,290 **** SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll --- 286,290 ---- SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll *************** *** 296,302 **** IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN --- 296,302 ---- IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN *************** *** 318,322 **** ;M ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away --- 318,322 ---- ;M ! :M WM_MOUSEWHEEL ( h m w l -- res ) over word-split 32768 and \ get the Key flags (loword of wParam) and the WHEEL_DELTA (hiword of wParam) \ A positive value indicates that the wheel was rotated forward, away *************** *** 359,363 **** CaretStart caretX + TextEnd #chars - CaretStart - GetHandle: dc call GetTabbedTextExtent ! loword scrollpos.left + iLeftMargin + vertline lines 1- * scrollpos.top + width iLeftMargin + iRightMargin + height setrect: CaretPos --- 359,363 ---- CaretStart caretX + TextEnd #chars - CaretStart - GetHandle: dc call GetTabbedTextExtent ! loword scrollpos.left + iLeftMargin + vertline lines 1- * scrollpos.top + width iLeftMargin + iRightMargin + height setrect: CaretPos *************** *** 389,393 **** ScrollRange -1 Text GetHandle: dc call DrawTextEx VertLine / to lines DRAWTEXTPARAMS DT_NOCLIP DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollPos -1 Text GetHandle: dc call DrawTextEx drop \ Set the caret on the commandline (last line) --- 389,393 ---- ScrollRange -1 Text GetHandle: dc call DrawTextEx VertLine / to lines DRAWTEXTPARAMS DT_NOCLIP DT_EXPANDTABS or DT_TABSTOP or DT_NOPREFIX or ! ScrollPos -1 Text GetHandle: dc call DrawTextEx drop \ Set the caret on the commandline (last line) *************** *** 442,446 **** (( :M gt: ( x a n -- n ) ! get-dc hFont SetFont: dc GetTabbedCharsFromPoint release-dc --- 442,446 ---- (( :M gt: ( x a n -- n ) ! get-dc hFont SetFont: dc GetTabbedCharsFromPoint release-dc *************** *** 449,453 **** : GetColRow ( X Y -- col row ) \ needs dc ScrollRange.bottom min scrollpos.top - VertLine / lines 1- min 0max >r ! ScrollRange.right iRightMargin - ( HorzLine + ) min scrollpos.left - iLeftMargin - r@ RowAddress r@ RowLength GetTabbedCharsFromPoint r@ RowLength min r> ; --- 449,453 ---- : GetColRow ( X Y -- col row ) \ needs dc ScrollRange.bottom min scrollpos.top - VertLine / lines 1- min 0max >r ! ScrollRange.right iRightMargin - ( HorzLine + ) min scrollpos.left - iLeftMargin - r@ RowAddress r@ RowLength GetTabbedCharsFromPoint r@ RowLength min r> ; *************** *** 464,468 **** StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only --- 464,468 ---- StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only *************** *** 472,476 **** BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle --- 472,476 ---- BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle *************** *** 488,492 **** :M Select: ( col row -- ) \ select text from SelStart to SelEnd - col row ! get-dc hFont SetFont: dc SelEndCol SelEndRow \ previous SelEnd col row 2swap to SelEndRow to SelEndCol --- 488,492 ---- :M Select: ( col row -- ) \ select text from SelStart to SelEnd - col row ! get-dc hFont SetFont: dc SelEndCol SelEndRow \ previous SelEnd col row 2swap to SelEndRow to SelEndCol *************** *** 504,508 **** IF SelEndCol SelStartCol - ELSE 0 ! THEN to CaretLength THEN release-dc --- 504,508 ---- IF SelEndCol SelStartCol - ELSE 0 ! THEN to CaretLength THEN release-dc *************** *** 510,514 **** : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc --- 510,514 ---- : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc *************** *** 518,524 **** :M Deselect: ( -- ) ! 0 to SelectedLength 0 to CaretLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust --- 518,524 ---- :M Deselect: ( -- ) ! 0 to SelectedLength 0 to CaretLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust *************** *** 528,532 **** : SetStart ( x y -- ) ! get-dc hFont SetFont: dc GetColRow 2dup to SelStartRow to SelStartCol 2dup to SelEndRow to SelEndCol 2dup ColRow>XY to SelEndY to SelEndX over >r OnCommandLine --- 528,532 ---- : SetStart ( x y -- ) ! get-dc hFont SetFont: dc GetColRow 2dup to SelStartRow to SelStartCol 2dup to SelEndRow to SelEndCol 2dup ColRow>XY to SelEndY to SelEndX over >r OnCommandLine *************** *** 583,587 **** ;M :M DR: ( a n -- ) ! ptrNull 0 2swap ReplaceGivenText: self paint: self Update: self --- 583,587 ---- ;M :M DR: ( a n -- ) ! ptrNull 0 2swap ReplaceGivenText: self paint: self Update: self *************** *** 589,593 **** UpdateHScroll: self ;M ! :M ReplaceText: { a n n1 n2 \ a1 -- } \ replace selected range (on commandline) n1 n2 with string a n n1 n2 2dup min to n1 max to n2 \ make sure n2 > n1 --- 589,593 ---- UpdateHScroll: self ;M ! :M ReplaceText: { a n n1 n2 \ a1 -- } \ replace selected range (on commandline) n1 n2 with string a n n1 n2 2dup min to n1 max to n2 \ make sure n2 > n1 *************** *** 629,633 **** IF 0 to CaretX #chars to CaretLength ! ptrNull InsertText: self true CaretPos InvalidateRect: self THEN --- 629,633 ---- IF 0 to CaretX #chars to CaretLength ! ptrNull InsertText: self true CaretPos InvalidateRect: self THEN *************** *** 646,650 **** :M ForwardDelete: ( -- ) SelStartCol SelStartRow OnCommandLine IF ! #chars CaretX > IF CaretLength 0= IF 1 to CaretLength THEN --- 646,650 ---- :M ForwardDelete: ( -- ) SelStartCol SelStartRow OnCommandLine IF ! #chars CaretX > IF CaretLength 0= IF 1 to CaretLength THEN *************** *** 668,672 **** Text zcount dup>r + swap move 0 text 2r> + + c! ! 0 ScrollRange.bottom ScrollPage.bottom min VertLine - width height \ update from previous line to bottom of window false UpdateRectangle \ no erase background --- 668,672 ---- Text zcount dup>r + swap move 0 text 2r> + + c! ! 0 ScrollRange.bottom ScrollPage.bottom min VertLine - width height \ update from previous line to bottom of window false UpdateRectangle \ no erase background *************** *** 715,720 **** :M Paste: ( -- ) \ paste only the first line (less CR) in commandline CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup call GlobalLock zcount --- 715,720 ---- :M Paste: ( -- ) \ paste only the first line (less CR) in commandline CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup call GlobalLock zcount *************** *** 729,735 **** SelectedLength IF ! hWnd call OpenClipboard drop call EmptyClipboard drop ! SelectedLength 1+ GMEM_DDESHARE call GlobalAlloc dup Call GlobalLock dup SelectedLength 1+ erase SelectedAddress over SelectedLength move --- 729,735 ---- SelectedLength IF ! hWnd call OpenClipboard drop call EmptyClipboard drop ! SelectedLength 1+ GMEM_DDESHARE call GlobalAlloc dup Call GlobalLock dup SelectedLength 1+ erase SelectedAddress over SelectedLength move *************** *** 772,776 **** THEN ScrollAdjust SetSelection ;M ! :M ShiftRight: ( -- ) SelEndCol SelEndRow lines 1- dup RowLength swap d= IF exitm THEN SelEndCol SelEndRow RowLength = IF 0 SelEndX SelEndY VertLine + nip ELSE get-dc hFont SetFont: dc SelEndCol 1+ SelEndRow ColRow>XY release-dc --- 772,776 ---- THEN ScrollAdjust SetSelection ;M ! :M ShiftRight: ( -- ) SelEndCol SelEndRow lines 1- dup RowLength swap d= IF exitm THEN SelEndCol SelEndRow RowLength = IF 0 SelEndX SelEndY VertLine + nip ELSE get-dc hFont SetFont: dc SelEndCol 1+ SelEndRow ColRow>XY release-dc *************** *** 791,797 **** EndCase ;M ! :M WM_CHAR ( h m w l -- res ) ! over KeysOn IF HandleChar: self ELSE dup 27 = IF true to Abort? THEN PutKey: self ELSE false to Abort? --- 791,797 ---- EndCase ;M ! :M WM_CHAR ( h m w l -- res ) ! over KeysOn IF HandleChar: self ELSE dup 27 = IF true to Abort? THEN PutKey: self ELSE false to Abort? *************** *** 800,804 **** :M HandleKeyDown: ( n -- ) ! CASE VK_HOME of ?shift IF 0 0 ?control IF CtrlShiftHome: self ELSE ShiftHome: self THEN ELSE SB_TOP WM_HSCROLL THEN endof VK_END of ?shift IF 0 0 ?control IF CtrlShiftEnd: self ELSE ShiftEnd: self THEN ELSE SB_BOTTOM WM_HSCROLL THEN endof --- 800,804 ---- :M HandleKeyDown: ( n -- ) ! CASE VK_HOME of ?shift IF 0 0 ?control IF CtrlShiftHome: self ELSE ShiftHome: self THEN ELSE SB_TOP WM_HSCROLL THEN endof VK_END of ?shift IF 0 0 ?control IF CtrlShiftEnd: self ELSE ShiftEnd: self THEN ELSE SB_BOTTOM WM_HSCROLL THEN endof Index: BasicWin.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/BasicWin.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** BasicWin.f 7 Nov 2006 11:24:29 -0000 1.5 --- BasicWin.f 1 Nov 2007 22:03:54 -0000 1.6 *************** *** 1,2 **** --- 1,4 ---- + \ $Id$ + \ File: BasicWin.f \ Author: Jeff Kelm |