Menu
▾
▴
[Win32forth-cvs] win32forth/src/console CommandWindow.f,1.32,1.33
|
From: Rod O. <rod...@us...> - 2014-07-27 10:17:20
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv29077 Modified Files: CommandWindow.f Log Message: Rod: Improved the function of the arrow keys and home and end keys. In particular Ctrl Left/Right to move to the next word and Ctrl Shift Left/Right to select up to the next word Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** CommandWindow.f 28 Jun 2013 12:41:24 -0000 1.32 --- CommandWindow.f 27 Jul 2014 10:17:18 -0000 1.33 *************** *** 114,117 **** --- 114,120 ---- int SelEndCol int SelEndRow + int SelEndColNew + int SelEndRowNew + int increasing int SelStartX int SelStartY *************** *** 404,408 **** CaretHeight CaretWidth 0 hWnd call CreateCaret drop CaretPos.top CaretPos.left call SetCaretPos drop ! Editing IF ShowCaret: self THEN true to cursor-on? ;M --- 407,411 ---- CaretHeight CaretWidth 0 hWnd call CreateCaret drop CaretPos.top CaretPos.left call SetCaretPos drop ! ShowCaret: self true to cursor-on? ;M *************** *** 431,437 **** ; ! : SetCaretPosition ( -- ) \ needs dc, also sets an update rectangle to end of line ! \ X Y ColRow>xy ScrollAdjust ! SelEndX SelEndY ScrollAdjust \ as long as SetSelectionStart is done first dup VertLine + width swap SetRect: CaretPos cursor-on? IF CaretPos.top CaretPos.left call SetCaretPos drop THEN --- 434,439 ---- ; ! : SetCaretPosition ( X Y -- ) \ needs dc, also sets an update rectangle to end of line ! over to X ColRow>xy ScrollAdjust dup VertLine + width swap SetRect: CaretPos cursor-on? IF CaretPos.top CaretPos.left call SetCaretPos drop THEN *************** *** 446,450 **** : SCP ( -- ) \ SetCommandPosition X Y SetSelectionStart ! SetCaretPosition ; --- 448,452 ---- : SCP ( -- ) \ SetCommandPosition X Y SetSelectionStart ! X Y SetCaretPosition ; *************** *** 663,667 **** GetColRow 2dup SetSelectionStart over swap OnCommandLine ! IF to X SetCaretPosition true ELSE drop false THEN to Editing --- 665,669 ---- GetColRow 2dup SetSelectionStart over swap OnCommandLine ! IF Y SetCaretPosition true ELSE drop false THEN to Editing *************** *** 799,803 **** IF SPCS X r@ - 2r> + InsertText: self ELSE 2r> 2drop THEN UpdateScrollRange: self ! scp XYAddress to XYA ;M --- 801,805 ---- IF SPCS X r@ - 2r> + InsertText: self ELSE 2r> 2drop THEN UpdateScrollRange: self ! SCP XYAddress to XYA ;M *************** *** 908,912 **** Y UpdateLine: self CommandStart Y RowAddress + to CommandLine ! scp ELSE StartAfterCommandLine --- 910,914 ---- Y UpdateLine: self CommandStart Y RowAddress + to CommandLine ! SCP ELSE StartAfterCommandLine *************** *** 982,1015 **** ;M - :M CaretLeft: ( -- ) - X CommandStart > - IF - -1 +to X - HideCaret: self - Deselect: self - false CaretPos InvalidateRect: self \ or to end of command line or one char - SCP - true to editing - ShowCaret: self - AutoHScroll: self - ELSE beep - THEN - ;M - - :M CaretRight: ( -- ) - X CommandEnd < - IF - 1 +to X - HideCaret: self - Deselect: self - false CaretPos InvalidateRect: self \ or to end of command line or one char - SCP - true to editing - ShowCaret: self - AutoHScroll: self - ELSE beep - THEN - ;M - int ClipboardHandle int ClipboardAddress --- 984,987 ---- *************** *** 1085,1167 **** ;M ! :M ShiftHome: ( -- ) Editing ! IF CommandStart ELSE StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd ELSE 0 THEN THEN ! SelStartRow Select: self ;M ! :M ShiftEnd: ( -- ) Editing ! IF CommandEnd ELSE StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart ELSE SelStartRow RowLength THEN THEN ! SelStartRow Select: self ;M ! :M CtrlShiftHome: ( -- ) Editing ! IF CommandStart Y ELSE StartAfterCommandLine IF CommandEnd Y ELSE 0 0 THEN THEN Select: self ;M ! :M CtrlShiftEnd: ( -- ) Editing ! IF CommandEnd Y ELSE StartBeforeCommandLine IF CommandStart Y ELSE LastColRow: self THEN THEN Select: self ;M ! :M ShiftUp: ( -- ) Editing ! IF CommandStart Y ELSE ! SelStartCol SelEndRow 1- 0max RowLength min SelEndRow 1- dup 0< IF 2drop 0 0 THEN StartAfterCommandLine SelEndRow 1- 0max Y = and IF swap CommandEnd max swap THEN THEN Select: self ;M ! ! :M ShiftDown: ( -- ) Editing ! IF CommandEnd Y ELSE ! SelStartCol SelEndRow 1+ RowLength min SelEndRow 1+ 2dup LastColRow: self d> IF 2drop LastColRow: self THEN StartBeforeCommandLine SelEndRow 1+ lines 1- min Y = and IF swap CommandStart min swap THEN ! StartBeforeCommandLine SameRowAsCommandLine and IF CommandStart Y THEN THEN Select: self ;M ! :M ShiftLeft: ( -- ) Editing ! IF SelEndCol CommandStart <= IF beep exitm THEN SelEndCol 1- SelEndRow ELSE ! SelEndCol SelEndRow d0= IF exitm THEN \ SelEndCol ! SelEndCol SelEndRow CommandEnd Y d= IF exitm THEN SelEndCol IF SelEndCol 1- SelEndRow ELSE SelEndRow 1- dup RowLength swap ! THEN THEN ! Select: self ;M ! :M ShiftRight: ( -- ) Editing ! IF SelEndCol CommandEnd >= IF beep exitm THEN SelEndCol 1+ SelEndRow ELSE ! SelEndCol SelEndRow CommandStart Y d= IF exitm THEN SelEndCol SelEndRow RowLength < IF SelEndCol 1+ SelEndRow ! ELSE lines 1- SelEndRow = IF exitm THEN 0 SelEndRow 1+ ! THEN THEN ! Select: self ;M :M SelectAll: ( -- ) \ up till the command line --- 1057,1258 ---- ;M ! : MoveCaret ( x -- ) ! to X ! HideCaret: self ! SCP ! true to editing ! ShowCaret: self ! AutoHScroll: self ! ; ! ! : MoveCaretAndDeselect ( x -- ) ! Deselect: self ! false CaretPos InvalidateRect: self \ or to end of command line or one char ! MoveCaret ! ; ! ! : ?MoveCaretAndDeselect ( x f -- ) IF MoveCaretAndDeselect ELSE beep drop THEN ; ! ! :M CaretLeft: ( -- ) X 1- X CommandStart > ?MoveCaretAndDeselect ;M \ move caret one character to left, deselects any text ! ! :M CaretRight: ( -- ) X 1+ X CommandEnd < ?MoveCaretAndDeselect ;M \ move caret one character to right, deselects any text ! ! :M Home: ( -- ) CommandStart X CommandStart > ?MoveCaretAndDeselect ;M \ move caret to beginning of line, deselects any text ! ! :M End: ( -- ) CommandEnd X CommandEnd < ?MoveCaretAndDeselect ;M \ move caret to end of line, deselects any text ! ! \ :M CtrlHome: ( -- ) ;M \ ( not defined, will scroll parent window horzontally ) ! ! \ :M CtrlEnd: ( -- ) ;M \ ( not defined, will scroll parent window horzontally ) ! ! : BeepEditEnd ( -- f ) SelEndCol SelEndRow CommandEnd Y d= ; \ editing at end of command line ! : BeepEditStart ( -- f ) SelEndCol SelEndRow CommandStart Y d= ; \ editing at start of command line ! ! : BeepEndCommandLine ( -- f ) SelEndCol SelEndRow CommandEnd Y d= increasing not and ; \ reached end of command line ! : BeepStartCommandLine ( -- f ) SelEndCol SelEndRow CommandStart Y d= increasing and ; \ reached start of command line ! ! : BeepLineUp ( -- f ) SelEndCol 0= increasing and ; \ start of any line, increasing ! : BeepLineDown ( -- f ) SelEndCol 0= increasing not and ; \ start of any line, decreasing ! ! : BeepStartText ( -- f ) SelEndCol SelEndRow d0= ; \ reached start of text ! : BeepEndText ( -- f ) SelEndCol SelEndRow RowLength = SelEndRow LastRow = and ; \ reached end of text ! ! :M ShiftHome: ( -- ) \ decrease the selection to beginning of line Editing ! IF BeepEditStart IF beep exitm THEN CommandStart Y 2dup SetCaretPosition ELSE + BeepEndCommandLine BeepLineDown or IF beep exitm THEN StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd Y ELSE 0 SelStartRow THEN ! false to increasing THEN ! Select: self ;M ! :M ShiftEnd: ( -- ) \ increase the selection to end of line Editing ! IF BeepEditEnd IF beep exitm THEN CommandEnd Y 2dup SetCaretPosition ELSE + BeepStartCommandLine BeepLineUp BeepEndText or or IF beep exitm THEN StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart Y ! ELSE SelStartRow LastRow = IF LastColRow: self ELSE 0 SelStartRow 1+ THEN ! THEN ! true to increasing THEN ! Select: self ;M ! :M CtrlShiftHome: ( -- ) \ decrease the selection to beginning of text Editing ! IF BeepEditStart IF beep exitm THEN CommandStart Y 2dup SetCaretPosition ELSE + BeepEndCommandLine BeepStartText or IF beep exitm THEN StartAfterCommandLine IF CommandEnd Y ELSE 0 0 THEN + false to increasing THEN Select: self ;M ! :M CtrlShiftEnd: ( -- ) \ increase the selection to end of text Editing ! IF BeepEditEnd IF beep exitm THEN CommandEnd Y 2dup SetCaretPosition ELSE + BeepStartCommandLine BeepEndText or IF beep exitm THEN StartBeforeCommandLine IF CommandStart Y ELSE LastColRow: self THEN + true to increasing THEN Select: self ;M ! :M ShiftUp: ( -- ) \ decrease the selection by one line Editing ! IF BeepEditStart IF beep exitm THEN CommandStart Y 2dup SetCaretPosition ELSE ! BeepEndCommandLine BeepStartText or IF beep exitm THEN ! SelStartCol SelEndRow 1- 0max RowLength min SelEndRow 1- ! dup 0< IF 2drop 0 0 THEN StartAfterCommandLine SelEndRow 1- 0max Y = and IF swap CommandEnd max swap THEN + StartAfterCommandLine SelEndRow Y = and IF 2drop CommandEnd Y THEN + false to increasing THEN Select: self ;M ! ! :M ShiftDown: ( -- ) \ increase the selection by one line Editing ! IF BeepEditEnd IF beep exitm THEN CommandEnd Y 2dup SetCaretPosition ELSE ! BeepStartCommandLine BeepEndText or IF beep exitm THEN ! SelStartCol SelEndRow 1+ RowLength min SelEndRow 1+ ! 2dup LastColRow: self d> IF 2drop LastColRow: self THEN StartBeforeCommandLine SelEndRow 1+ lines 1- min Y = and IF swap CommandStart min swap THEN ! StartBeforeCommandLine SelEndRow Y = and IF 2drop CommandStart Y THEN ! true to increasing THEN Select: self ;M ! :M CtrlRight: ( -- ) \ move the caret to the beginning of the next word ! XYAddress dup CommandEnd X - 32 scan 32 skip drop swap - ! X + X CommandEnd < ?MoveCaretAndDeselect ! ;M ! ! :M CtrlLeft: ( -- ) \ move the caret to the beginning of the previous word ! XYAddress 1- dup X CommandStart - 32 -skip 32 -scan drop - ! X swap - X CommandStart > ?MoveCaretAndDeselect ! ;M ! ! :M CtrlShiftLeft: ( -- ) \ decrease the selection to the beginning of the previous word Editing ! IF ! BeepEditStart IF beep exitm THEN ! Y RowAddress SelEndCol + 1- dup SelEndCol CommandStart - 32 -skip 32 -scan drop swap - ! SelEndCol + to SelEndColNew SelEndRow to SelEndRowNew ! SelEndColNew SelEndRowNew SetCaretPosition ELSE ! BeepStartText BeepEndCommandLine or IF beep exitm THEN ! SelEndCol ! IF SelEndCol SelEndRow ! ELSE SelEndRow 1- RowLength SelEndRow 1- ! THEN to SelEndRowNew to SelEndColNew ! SelEndRowNew RowAddress SelEndColNew + 1- dup SelEndColNew 32 -skip 32 -scan drop swap - ! +to SelEndColNew ! ! SelEndRow Y = SelEndColNew CommandStart CommandEnd within and SelEndCol ( 0= not ) and ! SelEndRow Y = SelEndColNew CommandEnd < and SelEndCol CommandEnd > and or ! SelEndRow Y 1+ = SelEndCol 0= and or ! IF CommandEnd SelEndColNew max to SelEndColNew THEN ! false to increasing ! THEN ! SelEndColNew SelEndRowNew Select: self ! ;M ! ! :M CtrlShiftRight: ( -- ) \ increase the selection to the beginning of the next word ! Editing ! IF ! BeepEditEnd IF beep exitm THEN ! Y RowAddress SelEndCol + dup CommandEnd SelEndCol - 32 scan 32 skip drop swap - ! SelEndCol + to SelEndColNew SelEndRow to SelEndRowNew ! SelEndColNew SelEndRowNew SetCaretPosition ! ELSE ! BeepEndText BeepStartCommandLine or IF beep exitm THEN ! SelEndRow RowAddress SelEndCol + dup SelEndRow Rowlength SelEndCol - 32 scan 32 skip drop swap - \ next word ! SelEndCol + to SelEndColNew SelEndRow to SelEndRowNew ! ! SelEndRow Y = ! SelEndCol CommandStart < SelEndColNew CommandStart > and ! SelEndCol CommandEnd > SelEndColNew CommandEnd < and or and ! IF SelEndColNew CommandStart min to SelEndColNew THEN ! ! SelEndColNew SelEndRow RowLength >= SelEndRow LastRow <> and IF 0 to SelEndColNew 1 +to SelEndRowNew THEN ! true to increasing ! THEN ! SelEndColNew SelEndRowNew Select: self ! ;M ! ! :M ShiftLeft: ( -- ) \ decrease the selection by one character ! Editing ! IF BeepEditStart IF beep exitm THEN SelEndCol 1- SelEndRow 2dup SetCaretPosition ! ELSE ! BeepStartText BeepEndCommandLine or IF beep exitm THEN ! SelEndCol IF SelEndCol 1- SelEndRow ELSE SelEndRow 1- dup RowLength swap ! THEN false to increasing THEN ! Select: self ! ;M ! :M ShiftRight: ( -- ) \ increase the selection by one character Editing ! IF BeepEditEnd IF beep exitm THEN SelEndCol 1+ SelEndRow 2dup SetCaretPosition ELSE ! BeepStartCommandLine BeepEndText or IF beep exitm THEN ! SelEndCol SelEndRow RowLength < IF SelEndCol 1+ SelEndRow ! ELSE 0 SelEndRow 1+ ! THEN true to increasing THEN ! Select: self ! ;M :M SelectAll: ( -- ) \ up till the command line *************** *** 1202,1213 **** :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 VK_INSERT of 0 0 endof VK_DELETE of DeleteForward: self 0 0 endof VK_PRIOR of ?shift IF SB_TOP ELSE SB_PAGEUP THEN WM_VSCROLL endof VK_NEXT of ?shift IF SB_BOTTOM ELSE SB_PAGEDOWN THEN WM_VSCROLL endof ! VK_LEFT of ?Shift IF ShiftLeft: self ELSE CaretLeft: self THEN 0 0 endof ! VK_RIGHT of ?Shift IF ShiftRight: self ELSE CaretRight: self THEN 0 0 endof VK_UP of ?Shift IF ShiftUp: self ELSE NextCommand 2dup CommandString compare IF DeleteCommand: self asciiz InsertTextOnCommandLine: self ELSE 2drop beep THEN THEN 0 0 endof VK_DOWN of ?Shift IF ShiftDown: self ELSE PrevCommand dup IF DeleteCommand: self asciiz InsertTextOnCommandLine: self ELSE NextCommand 4drop beep THEN THEN 0 0 endof --- 1293,1304 ---- :M HandleKeyDown: ( n -- ) CASE ! VK_HOME of 0 0 ?shift IF ?control IF CtrlShiftHome: self ELSE ShiftHome: self THEN ELSE ?control IF 2drop SB_TOP WM_HSCROLL ELSE Home: self THEN THEN endof ! VK_END of 0 0 ?shift IF ?control IF CtrlShiftEnd: self ELSE ShiftEnd: self THEN ELSE ?control IF 2drop SB_BOTTOM WM_HSCROLL ELSE End: self THEN THEN endof VK_INSERT of 0 0 endof VK_DELETE of DeleteForward: self 0 0 endof VK_PRIOR of ?shift IF SB_TOP ELSE SB_PAGEUP THEN WM_VSCROLL endof VK_NEXT of ?shift IF SB_BOTTOM ELSE SB_PAGEDOWN THEN WM_VSCROLL endof ! VK_LEFT of ?Shift IF ?control IF CtrlShiftLeft: self ELSE ShiftLeft: self THEN ELSE ?control IF CtrlLeft: self ELSE CaretLeft: self THEN THEN 0 0 endof ! VK_RIGHT of ?Shift IF ?control IF CtrlShiftRight: self ELSE ShiftRight: self THEN ELSE ?control IF CtrlRight: self ELSE CaretRight: self THEN THEN 0 0 endof VK_UP of ?Shift IF ShiftUp: self ELSE NextCommand 2dup CommandString compare IF DeleteCommand: self asciiz InsertTextOnCommandLine: self ELSE 2drop beep THEN THEN 0 0 endof VK_DOWN of ?Shift IF ShiftDown: self ELSE PrevCommand dup IF DeleteCommand: self asciiz InsertTextOnCommandLine: self ELSE NextCommand 4drop beep THEN THEN 0 0 endof |
