Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: George H. <geo...@us...> - 2008-08-31 00:04:56
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22762 Modified Files: fkernel.exe Log Message: New Fkernel.f (use for latest rebuild) Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.50 retrieving revision 1.51 diff -C2 -d -r1.50 -r1.51 Binary files /tmp/cvs6PRFrO and /tmp/cvsSN1hSO differ |
|
From: kraig s. <ken...@th...> - 2008-08-29 19:43:03
|
check out prescriptions todays best solution view us |
|
From: Rod O. <rod...@us...> - 2008-08-29 08:55:29
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27307 Modified Files: CommandWindow.f Log Message: Rod: undone last change to CommandFont - was causing crashes Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** CommandWindow.f 26 Aug 2008 17:20:50 -0000 1.17 --- CommandWindow.f 29 Aug 2008 08:55:18 -0000 1.18 *************** *** 11,14 **** --- 11,21 ---- \ Cut, copy and paste + + Font CommandFont + 10 Height: CommandFont + \ FW_HEAVY Weight: CommandFont \ Optional + s" Courier" SetFaceName: CommandFont + \ s" Terminal" SetFaceName: CommandFont \ Optional choice + defer HandleKeys ' drop is HandleKeys \ define to handle keys e.g. 'O' +k_control defer HandleKeyDown ' drop is HandleKeyDown \ define to handle virtual keys e.g. VK_F12 *************** *** 25,33 **** :M SetAction: ( xt -- ) to action ;M ! int CommandFont int hFont :M SetFont: ( font -- ) ! delete: CommandFont to CommandFont create: CommandFont ! Handle: CommandFont to hFont paint: self PauseForMessages BigCursor: [ self ] ;M --- 32,40 ---- :M SetAction: ( xt -- ) to action ;M ! int font int hFont :M SetFont: ( font -- ) ! delete: font to font create: font ! Handle: font to hFont paint: self PauseForMessages BigCursor: [ self ] ;M *************** *** 1204,1207 **** --- 1211,1217 ---- 8 to HorzLine 13 to VertLine + CommandFont to font + Create: CommandFont + Handle: CommandFont to hFont Black to ForegroundColour White to BackgroundColour *************** *** 1227,1237 **** :M On_Init: ( -- ) - new> font to CommandFont - 10 Height: CommandFont - \ FW_HEAVY Weight: CommandFont \ Optional - s" Courier" SetFaceName: CommandFont - \ s" Terminal" SetFaceName: CommandFont \ Optional choice - Create: CommandFont - Handle: CommandFont to hFont MaxText malloc to text text MaxText 45 fill 0 text c! \ text MaxText erase CommandFont SetFont: self \ this creates a caret in BigCursor: self --- 1237,1240 ---- |
|
From: George H. <geo...@us...> - 2008-08-26 20:59:00
|
Update of /cvsroot/win32forth/win32forth/demos/MiniDB In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv2214 Modified Files: Tag: V612xx MiniDB.f Log Message: Removed code to build turnkey (which wasn't working anyway) Index: MiniDB.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/demos/MiniDB/MiniDB.f,v retrieving revision 1.2.2.1 retrieving revision 1.2.2.2 diff -C2 -d -r1.2.2.1 -r1.2.2.2 *** MiniDB.f 26 Aug 2008 20:54:00 -0000 1.2.2.1 --- MiniDB.f 26 Aug 2008 20:58:56 -0000 1.2.2.2 *************** *** 8,12 **** Require EditDB.f - 0 value turnkey? 20 constant FontHeight --- 8,11 ---- *************** *** 70,74 **** :M On_Done: ( h m w l -- res ) Close: self - turnkey? if 0 call PostQuitMessage drop then On_Done: super 0 ;M --- 69,72 ---- *************** *** 153,169 **** : main ( -- ) - [ turnkey? ] [if] Start-database [then] Start: SimpleDBWindow GetAllCustomers InitListViewColumns: SimpleDBWindow InitListViewItems: SimpleDBWindow ! true LVS_EX_FULLROWSELECT SetExtendedStyle: ListViewDB ! [ turnkey? ] [if] MessageLoop bye [then] ; ! turnkey? [if] ! ' main turnkey ListViewDemo.exe ! s" WIN32FOR.ICO" s" ListViewDemo.exe" AddAppIcon ! 1 pause-seconds bye ! [else] ! main ! [then] --- 151,159 ---- : main ( -- ) Start: SimpleDBWindow GetAllCustomers InitListViewColumns: SimpleDBWindow InitListViewItems: SimpleDBWindow ! true LVS_EX_FULLROWSELECT SetExtendedStyle: ListViewDB ; ! main |
|
From: George H. <geo...@us...> - 2008-08-26 20:54:04
|
Update of /cvsroot/win32forth/win32forth/demos/MiniDB In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv32682 Added Files: Tag: V612xx EditDB.f MiniDB.f STARTDB.F Log Message: Added MiniDB demo --- NEW FILE: MiniDB.f --- \ $Id: MiniDB.f,v 1.2.2.1 2008/08/26 20:54:00 georgeahubert Exp $ Anew -MiniDB.f Needs ListView.f Needs Resources.f Require startdb.f Require EditDB.f 0 value turnkey? 20 constant FontHeight : DoEdit ( record# -- ) Start: DBDialog ; : DoAdd ( -- ) 0 Start: DBDialog ; \ ------------------------------------------------------------------------ \ Define the Listview for the database table \ ------------------------------------------------------------------------ :object ListViewDB <super ListView :M WindowStyle: ( -- style ) WindowStyle: super [ LVS_REPORT LVS_SHOWSELALWAYS or LVS_SINGLESEL or ] literal or ;M ;object \ ------------------------------------------------------------------------ \ Define the main window. \ ------------------------------------------------------------------------ :Object SimpleDBWindow <Super Window 0 value ToolBarHeight \ set to height of toolbar if any 0 value StatusBarHeight \ set to height of status bar if any LV_COLUMN lvc LV_ITEM LvItem ButtonControl NewEntry :M WindowHasMenu: ( -- f ) true ;M :M WindowStyle: ( -- style ) WindowStyle: Super WS_CLIPCHILDREN or ;M :M WndClassStyle: ( -- style ) CS_DBLCLKS ;M :M StartSize: ( -- w h ) screen-size >r 2/ r> 2/ ;M :M On_Size: ( -- ) 0 0 width height 20 - Move: ListViewDB 0 height 20 - width 20 Move: NewEntry ;M :M On_Init: ( -- ) self Start: ListviewDB color: white SetBKColor: ListviewDB self Start: NewEntry 0 height 20 - width 20 Move: NewEntry s" New Record" SetText: NewEntry ['] DoAdd SetFunc: NewEntry ;M :M On_Done: ( h m w l -- res ) Close: self turnkey? if 0 call PostQuitMessage drop then On_Done: super 0 ;M : GetLParmItem ( nItem -- Lparm ) LVIF_PARAM SetMask: LvItem SetiItem: LvItem Addr: LvItem GetItem: ListViewDB drop GetlParam: LvItem ; : ItemEdit ( -- ) LVNI_SELECTED -1 GetNextItem: ListViewDB dup -1 = if drop else GetLParmItem DoEdit then ; : HandleListViewDB ( msg - ) 2 cells + @ case NM_DBLCLK of ItemEdit endof endcase ; :M WM_NOTIFY ( h m w l -- f ) dup @ GetHandle: ListViewDB = if HandleListViewDB then false ;M :M InitListViewColumns: ( -- ) LVCF_FMT LVCF_WIDTH LVCF_TEXT LVCF_SUBITEM or or or Setmask: lvc LVCFMT_LEFT Setfmt: lvc 120 Setcx: lvc fieldcnt: MiniDB ?dup if 1 ?do i fieldname: MiniDB drop SetpszText: lvc Addr: lvc i InsertColumn: ListViewDB drop loop then ;M :M InitListViewItems: ( -- ) -1 begin fieldcnt: MiniDB ?dup if 1 ?do LVIF_TEXT i 1 = if LVIF_PARAM or then SetMask: LvItem i 1 = if 1+ SetiItem: LvItem 0 getint: MiniDB SetlParam: LvItem 1 getstr: MiniDB drop SetpszText: LvItem Addr: LvItem InsertItem: ListViewDB else dup SetiItem: LvItem i 1- SetiSubItem: LvItem i getstr: MiniDB drop SetpszText: LvItem Addr: LvItem over SetItemText: ListViewDB drop then loop then nextrow: MiniDB until drop ;M :M RefreshListViewItems: ( -- ) GetAllCustomers InitListViewItems: self paint: self ;m ;Object \ Patch deferred words :noname ( -- ) Dirty: DBDialog if s" INSERT OR REPLACE INTO Customers (id, name, sirname, abode) VALUES(?,?,?,?)" execute: MiniDB record#: DBDialog -if 0 bindint: MiniDB else 0 0 0 bindstr: MiniDB then BindText: DBDialog DeleteAllItems: ListViewDB GetAllCustomers InitListViewItems: SimpleDBWindow then close: DBDialog ; is Add-modifyDB :noname ( -- ) close: DBDialog ; is RejectDB : main ( -- ) [ turnkey? ] [if] Start-database [then] Start: SimpleDBWindow GetAllCustomers InitListViewColumns: SimpleDBWindow InitListViewItems: SimpleDBWindow true LVS_EX_FULLROWSELECT SetExtendedStyle: ListViewDB [ turnkey? ] [if] MessageLoop bye [then] ; turnkey? [if] ' main turnkey ListViewDemo.exe s" WIN32FOR.ICO" s" ListViewDemo.exe" AddAppIcon 1 pause-seconds bye [else] main [then] --- NEW FILE: EditDB.f --- \ $Id: EditDB.f,v 1.1.4.1 2008/08/26 20:54:00 georgeahubert Exp $ \ Dialog for editing and adding to simple database. G. Hubert Friday, December 07 2007 Require TextBox.f \ Use TextBoxes rather than EditControls for the extra methods. defer Add-ModifyDB \ must be referenced outside of the dialog object defer RejectDB \ must be referenced outside of the dialog object COLOR_BTNFACE call GetSysColor New-Color DialogColor : InitDialogColor ( -- ) COLOR_BTNFACE call GetSysColor InitColor: DialogColor ; initialization-chain chain-add InitDialogColor :Object DBDialog <super DialogWindow int record# StaticControl FirstLabel StaticControl NameLabel StaticControl AbodeLabel TextBox First TextBox Name TextBox Abode ButtonControl Accept ButtonControl Reject :M WindowStyle: ( -- style ) WS_CAPTION WS_POPUPWINDOW or WS_CLIPCHILDREN or ;M :M StartSize: ( -- w h ) 250 160 ;m :m Start: ( record# -- ) to record# Start: Super ;m :m On_Init: ( -- ) record# if s" Editing Database" else s" Adding Record to Database" then SetTitle: self self Start: FirstLabel self Start: NameLabel self Start: AbodeLabel self Start: First self Start: Name self Start: Abode 10 20 80 20 move: FirstLabel 10 60 80 20 move: NameLabel 10 100 80 20 move: AbodeLabel 90 20 120 20 move: First 90 60 120 20 move: Name 90 100 120 20 move: Abode s" First Name:" SetText: FirstLabel s" Sirname:" SetText: NameLabel s" Abode:" SetText: AbodeLabel record# if s" SELECT * FROM Customers WHERE id = " new$ dup>r place record# (.) r@ +place r@ +null r> count execute: MiniDB 1 getstr: MiniDB SetText: First 2 getstr: MiniDB SetText: Name 3 getstr: MiniDB SetText: Abode false SetModify: First false SetModify: Name false SetModify: Abode then IDOK SetID: Accept self Start: Accept 10 130 100 25 Move: Accept s" Accept" SetText: Accept GetStyle: Accept BS_DEFPUSHBUTTON OR SetStyle: Accept ['] Add-modifyDB SetFunc: Accept self Start: Reject 140 130 100 25 Move: Reject s" Reject" SetText: Reject ['] RejectDB SetFunc: Reject ;m :M On_Paint: ( -- ) \ screen redraw procedure 0 0 width height ( LTGRAY ) DialogColor FillArea: dc ;M :m record#: ( -- record# ) record# ;m : BufferText ( addr len -- addr len ) new$ dup>r place r@ +null r> count ; :m BindText: ( -- ) GetText: First BufferText 1 bindstr: MiniDB GetText: Name BufferText 2 bindstr: MiniDB GetText: Abode BufferText 3 bindstr: MiniDB ;m :m Dirty: ( -- f ) IsModified?: First IsModified?: Name or IsModified?: Abode or ;m ;object --- NEW FILE: STARTDB.F --- \ $Id: STARTDB.F,v 1.1.4.1 2008/08/26 20:54:00 georgeahubert Exp $ \ Build the database if it doesn't already exist require sqlite.f SQLiteDB MiniDB : Create-Customers-Table ( -- ) s" CREATE TABLE Customers (id INTEGER PRIMARY KEY, name varchar, sirname varchar, abode varchar)" execute: MiniDB ; : Add-Customers ( -- ) s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Robin " 0 bindstr: MiniDB s" Hood " 1 bindstr: MiniDB s" Sherwood Forest " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Isaac " 0 bindstr: MiniDB s" Newton " 1 bindstr: MiniDB s" Cambridge " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Maid " 0 bindstr: MiniDB s" Marian " 1 bindstr: MiniDB s" Sherwood Forest " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Friar " 0 bindstr: MiniDB s" Tuck " 1 bindstr: MiniDB s" Sherwood Forest " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Will " 0 bindstr: MiniDB s" Scarlet " 1 bindstr: MiniDB s" Sherwood Forest " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Alan A " 0 bindstr: MiniDB s" Dale " 1 bindstr: MiniDB s" Sherwood Forest " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" George " 0 bindstr: MiniDB s" Hubert " 1 bindstr: MiniDB s" UK " 2 bindstr: MiniDB s" INSERT INTO Customers (name, sirname, abode) VALUES(?,?,?)" execute: MiniDB s" Queen " 0 bindstr: MiniDB s" Elizabeth " 1 bindstr: MiniDB s" Buckingham Palace" 2 bindstr: MiniDB ; : Create-database ( -- ) Create-Customers-Table Add-Customers ; : Start-database ( -- ) s" Mini.db" 2dup file-status nip -rot open: MiniDB if create-database then ; : GetAllCustomers ( -- ) s" SELECT * FROM Customers" execute: MiniDB ; : qdump ( -- ) fieldcnt: MiniDB 0 ?do i fieldname: MiniDB type 20 #tab loop cr cr begin fieldcnt: MiniDB 0 ?do i getstr: MiniDB type 20 #tab loop cr nextrow: MiniDB until ; Start-database GetAllCustomers cr .( The database contains the following data.) cr qdump |
|
From: George H. <geo...@us...> - 2008-08-26 20:26:15
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21759 Modified Files: Tag: V612xx fkernel.exe Log Message: Corrected bug in (LOCAL) Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.42 retrieving revision 1.42.2.1 diff -C2 -d -r1.42 -r1.42.2.1 Binary files /tmp/cvsP8084r and /tmp/cvszpCO3n differ |
|
From: George H. <geo...@us...> - 2008-08-26 20:26:14
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21759/src/kernel Modified Files: Tag: V612xx fkernel.f Log Message: Corrected bug in (LOCAL) Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.42 retrieving revision 1.42.2.1 diff -C2 -d -r1.42 -r1.42.2.1 *** fkernel.f 28 Apr 2007 10:00:20 -0000 1.42 --- fkernel.f 26 Aug 2008 20:26:10 -0000 1.42.2.1 *************** *** 5216,5221 **** THEN ; ! : (LOCAL) ( addr cnt -- ) \ create name in LOCALS vocab ! ?comp -IF \ looks like std vocab header 1 +TO PARMS --- 5216,5220 ---- THEN ; ! |: <LOCAL> ( addr cnt -- ) -IF \ looks like std vocab header 1 +TO PARMS *************** *** 5231,5234 **** --- 5230,5243 ---- THEN ; + |: {LOCAL} ( addr cnt -- ) \ create name in LOCALS vocab + ?comp <LOCAL> ; + + : (LOCAL) ( addr cnt -- ) \ create name in LOCALS vocab + ?comp + PARMS 0= IF + LOCALS-INIT + FALSE TO LOCDIR \ reversed stack order + THEN <LOCAL> ; + \ August 2nd, 1999 - 11:13 tjz \ modfied versin of a word suggested by Robert Smith, to get a word from the *************** *** 5258,5262 **** 2DUP S" \" STR= >R \ is it { [...] \ ... 2DUP S" |" STR= R> OR INVERT \ is it { [...] | ... ! IF (LOCAL) \ no, it's a local ELSE 2DROP 0 TO LOCFLG THEN \ onto uninited locals REPEAT --- 5267,5271 ---- 2DUP S" \" STR= >R \ is it { [...] \ ... 2DUP S" |" STR= R> OR INVERT \ is it { [...] | ... ! IF {LOCAL} \ no, it's a local ELSE 2DROP 0 TO LOCFLG THEN \ onto uninited locals REPEAT *************** *** 5271,5276 **** : LOCALS| ( -- ) \ ANS standard locals - LOCALS-INIT - FALSE TO LOCDIR \ reversed stack order BEGIN BLNEXTWORD 2DUP S" |" STR= INVERT --- 5280,5283 ---- |
|
From: Rod O. <rod...@us...> - 2008-08-26 19:17:34
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv23446/src/console Removed Files: NewConsoleTest.f ReadMe.txt Log Message: Rod: these files are no longer needed --- NewConsoleTest.f DELETED --- --- ReadMe.txt DELETED --- |
|
From: Rod O. <rod...@us...> - 2008-08-26 17:20:53
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10305 Modified Files: CommandWindow.f Log Message: Rod: new CommandFont for each instance of CommandWindow - this class can now be reused without interferring with the console Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** CommandWindow.f 25 Aug 2008 18:11:45 -0000 1.16 --- CommandWindow.f 26 Aug 2008 17:20:50 -0000 1.17 *************** *** 1,25 **** \ $Id$ ! (( [cdo] moved in primutil.f ! : PauseForMessages { | pMsg -- } \ Winpause ! 7 cells LocalAlloc: pMsg ! BEGIN PM_REMOVE 0 0 0 pMsg Call PeekMessage ! WHILE pMsg HandleMessages drop ! REPEAT ! ; ! )) ! ! ! 0 value cn ! Font CommandFont ! 10 Height: CommandFont ! \ FW_HEAVY Weight: CommandFont \ Optional ! s" Courier" SetFaceName: CommandFont ! \ s" Terminal" SetFaceName: CommandFont \ Optional choise ! ! defer HandleKeys ! defer HandleKeyDown ! defer LogKeyStrokes --- 1,17 ---- \ $Id$ + \ CommandWindow - a child window class to accept and edit text on a command line by Rod Oakford + \ + \ Features: + \ + \ Action when enter is pressed is deferred + \ Font changeable + \ Key buffer + \ Command history + \ Cut, copy and paste ! defer HandleKeys ' drop is HandleKeys \ define to handle keys e.g. 'O' +k_control ! defer HandleKeyDown ' drop is HandleKeyDown \ define to handle virtual keys e.g. VK_F12 ! defer LogKeyStrokes ' noop is LogKeyStrokes \ used in KeySave.f defined as menukey-more *************** *** 33,41 **** :M SetAction: ( xt -- ) to action ;M ! int font int hFont :M SetFont: ( font -- ) ! delete: font to font create: font ! Handle: font to hFont paint: self PauseForMessages BigCursor: [ self ] ;M --- 25,33 ---- :M SetAction: ( xt -- ) to action ;M ! int CommandFont int hFont :M SetFont: ( font -- ) ! delete: CommandFont to CommandFont create: CommandFont ! Handle: CommandFont to hFont paint: self PauseForMessages BigCursor: [ self ] ;M *************** *** 814,818 **** true to editing ;M ! :M DeleteSelectedText: ( -- ) \ adjust X if necessary SelectedLength --- 806,811 ---- true to editing ;M ! int cn ! (( :M DeleteSelectedText: ( -- ) \ adjust X if necessary SelectedLength *************** *** 836,839 **** --- 829,833 ---- THEN ;M + )) int cnn :M DeleteSelectedText: ( -- ) \ adjust X if necessary *************** *** 1210,1216 **** 8 to HorzLine 13 to VertLine - CommandFont to font - Create: CommandFont - Handle: CommandFont to hFont Black to ForegroundColour White to BackgroundColour --- 1204,1207 ---- *************** *** 1236,1239 **** --- 1227,1237 ---- :M On_Init: ( -- ) + new> font to CommandFont + 10 Height: CommandFont + \ FW_HEAVY Weight: CommandFont \ Optional + s" Courier" SetFaceName: CommandFont + \ s" Terminal" SetFaceName: CommandFont \ Optional choice + Create: CommandFont + Handle: CommandFont to hFont MaxText malloc to text text MaxText 45 fill 0 text c! \ text MaxText erase CommandFont SetFont: self \ this creates a caret in BigCursor: self *************** *** 1244,1248 **** ;Class - - ' drop is HandleKeys - ' drop is HandleKeyDown --- 1242,1243 ---- |
|
From: George H. <geo...@us...> - 2008-08-26 12:27:21
|
Update of /cvsroot/win32forth/win32forth In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv30003 Modified Files: fkernel.exe Log Message: New fkernel.exe (needed for build) Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.49 retrieving revision 1.50 diff -C2 -d -r1.49 -r1.50 Binary files /tmp/cvscoGD2E and /tmp/cvspLlDNn differ |
|
From: Rod O. <rod...@us...> - 2008-08-25 18:11:52
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8583 Modified Files: CommandWindow.f Console2.f ConsoleMenu.f NewConsole.f Log Message: Rod: enabled printing from the new console Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** NewConsole.f 24 Aug 2008 07:36:59 -0000 1.25 --- NewConsole.f 25 Aug 2008 18:11:45 -0000 1.26 *************** *** 321,324 **** --- 321,325 ---- : c_paste-load Paste: cmd ; + : c_GETROWOFF ( - n ) FirstVisibleRow: cmd ; : NewConsole ( -- ) *************** *** 338,342 **** ['] c_cr IS CR ['] c_?cr IS ?CR ! ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY --- 339,343 ---- ['] c_cr IS CR ['] c_?cr IS ?CR ! \ ['] NOOP IS CONSOLE \ no ( NewConsole ) ['] c_gotoxy IS GOTOXY ['] c_getxy IS GETXY *************** *** 354,358 **** \ ['] K_NOOP1 IS GET-CURSOR \ no \ ['] DROP IS SETROWOFF \ no ! \ ['] K_NOOP1 IS GETROWOFF \ no \ ['] K_NOOP2 IS GETMAXCOLROW \ max console size - see wrapper??? \ ['] 2DROP IS SETMAXCOLROW \ check wrapper??? --- 355,359 ---- \ ['] K_NOOP1 IS GET-CURSOR \ no \ ['] DROP IS SETROWOFF \ no ! ['] c_GETROWOFF IS GETROWOFF \ ['] K_NOOP2 IS GETMAXCOLROW \ max console size - see wrapper??? \ ['] 2DROP IS SETMAXCOLROW \ check wrapper??? *************** *** 365,368 **** --- 366,371 ---- ; + forth-io-chain chain-add NewConsole + :noname ( n -- ) Case *************** *** 370,374 **** 'W' +k_control of open-web endof 'L' +k_control of load-forth endof ! \ 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof [DEFINED] replay-macro [IF] --- 373,377 ---- 'W' +k_control of open-web endof 'L' +k_control of load-forth endof ! 'P' +k_control of print-screen endof 'D' +k_control of ChdirDlg endof [DEFINED] replay-macro [IF] Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/ConsoleMenu.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** ConsoleMenu.f 19 Aug 2008 12:48:34 -0000 1.17 --- ConsoleMenu.f 25 Aug 2008 18:11:45 -0000 1.18 *************** *** 147,152 **** MENUITEM "Pages Up Setup..." page-up-setup ; MENUITEM "&Print Forth File..." print-forth ; ! \ MENUITEM "Print Forth Console Window...\tCtrl+P" print-screen ; ! \ MENUITEM "Print Forth Console Buffer..." print-console ; MENUSEPARATOR MENUCONSOLE "E&xit Win32Forth \tBYE" bye ; --- 147,152 ---- MENUITEM "Pages Up Setup..." page-up-setup ; MENUITEM "&Print Forth File..." print-forth ; ! MENUITEM "Print Forth Console Window...\tCtrl+P" print-screen ; ! MENUITEM "Print Forth Console Buffer..." print-console ; MENUSEPARATOR MENUCONSOLE "E&xit Win32Forth \tBYE" bye ; Index: CommandWindow.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/CommandWindow.f,v retrieving revision 1.15 retrieving revision 1.16 diff -C2 -d -r1.15 -r1.16 *** CommandWindow.f 24 Aug 2008 07:36:59 -0000 1.15 --- CommandWindow.f 25 Aug 2008 18:11:45 -0000 1.16 *************** *** 243,247 **** \ :M VisibleCols: ( -- cols ) width iLeftMargin - iRightMargin - HorzLine / ;M ! :M VisibleCols: ( -- cols ) \ numbere of columns visible if scrollbars were present GetWindowRect: self drop nip swap - SM_CXVSCROLL call GetSystemMetrics - --- 243,247 ---- \ :M VisibleCols: ( -- cols ) width iLeftMargin - iRightMargin - HorzLine / ;M ! :M VisibleCols: ( -- cols ) \ number of columns visible if vertical scrollbar were present GetWindowRect: self drop nip swap - SM_CXVSCROLL call GetSystemMetrics - *************** *** 249,259 **** ;M ! \ :M VisibleRows: ( -- rows ) height VertLine / ;M ! ! :M VisibleRows: ( -- rows ) \ number of rows visible if scrollbars were present ! GetWindowRect: self nip swap - nip ! SM_CYHSCROLL call GetSystemMetrics - ! VertLine / ! ;M :M VisibleColRow: ( -- cols rows ) --- 249,253 ---- ;M ! :M VisibleRows: ( -- rows ) height ScrollPos.Top negate VertLine mod - VertLine / ;M :M VisibleColRow: ( -- cols rows ) *************** *** 262,268 **** --- 256,267 ---- ;M + :M FirstVisibleRow: ( -- n ) ScrollPos.Top negate VertLine + 1- VertLine / ;M \ number of first row completely visible + + :M LastVisibleRow: ( -- n ) FirstVisibleRow: self VisibleRows: self + ;M \ number of last row completely visible + :M CharsNotFit: ( n -- f ) \ when n more chars will not fit on line without scrolling X + VisibleCols: self > ;M + int ll :M LastColRow: ( -- col row ) -1 to ll *************** *** 278,282 **** r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin --- 277,281 ---- r> ScrollPos.top + ; ! :M UpdateVScroll: ( -- ) Top: ScrollPos negate to nPos Top: ScrollRange to nMin *************** *** 289,293 **** ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin --- 288,292 ---- ;M ! :M UpdateHScroll: ( -- ) Left: ScrollPos negate to nPos Left: ScrollRange to nMin *************** *** 306,310 **** Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN --- 305,309 ---- Bottom: ScrollRange - Top: ScrollPos - max dup ScrollPos 4 + +! 0 swap Scroll: self ! \ Update: self UpdateVScroll: self THEN *************** *** 320,324 **** SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll --- 319,323 ---- SB_PAGEUP OF VertPage ENDOF SB_THUMBTRACK OF dup negate Top: ScrollPos - ENDOF ! ( default case) 0 swap ENDCASE VScroll *************** *** 330,336 **** IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN --- 329,335 ---- IF Left: ScrollPos negate min Right: ScrollPage ! Right: ScrollRange - Left: ScrollPos - max dup ScrollPos +! 0 Scroll: self ! Update: self UpdateHScroll: self THEN *************** *** 352,356 **** ;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 --- 351,355 ---- ;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 *************** *** 425,429 **** : 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 --- 424,428 ---- : 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 *************** *** 437,441 **** : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition --- 436,440 ---- : SCP ( -- ) \ SetCommandPosition ! get-dc hFont SetFont: dc X Y SetSelectionStart SetCaretPosition *************** *** 449,453 **** : UpdateRange ( SelStartCol SelStartRow SelEndCol SelEndRow f -- ) >r 2>r ! get-dc hFont SetFont: dc ColRow>XY ScrollAdjust 2r> ColRow>XY VertLine + ScrollAdjust r> UpdateRectangle release-dc --- 448,452 ---- : UpdateRange ( SelStartCol SelStartRow SelEndCol SelEndRow f -- ) >r 2>r ! get-dc hFont SetFont: dc ColRow>XY ScrollAdjust 2r> ColRow>XY VertLine + ScrollAdjust r> UpdateRectangle release-dc *************** *** 522,526 **** 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 \ Draw highlighted text if any --- 521,525 ---- 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 \ Draw highlighted text if any *************** *** 565,569 **** : 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> ; --- 564,568 ---- : 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> ; *************** *** 578,582 **** StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only --- 577,581 ---- StartY EndY < dup IF ! StartX width min StartY width \ more than one line ELSE StartX StartY EndX \ one line only *************** *** 586,590 **** BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle --- 585,589 ---- BEGIN StartY EndY < ! WHILE 0 StartY width VertLine +to StartY StartY \ whole lines true UpdateRectangle *************** *** 598,602 **** :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 --- 597,601 ---- :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 *************** *** 626,630 **** : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc --- 625,629 ---- : On_Track ( h m -- h m ) ! get-dc hFont SetFont: dc MouseX MouseY GetColRow release-dc *************** *** 638,643 **** SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust --- 637,642 ---- SelectedLength IF ! 0 to SelectedLength ! get-dc hFont SetFont: dc SelStartCol SelStartRow ColRow>XY ScrollAdjust SelEndCol SelEndRow ColRow>XY ScrollAdjust *************** *** 648,652 **** : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine --- 647,651 ---- : SetStart ( x y -- ) \ used in On_Click and SelectAll: ! get-dc hFont SetFont: dc GetColRow 2dup SetSelectionStart over swap OnCommandLine *************** *** 697,701 **** :M DeleteLine: ( -- ) \ delete current row Y RowAddress TextEnd over - ! 2dup 13 scan 13 skip 10 skip nip - dup>r DeleteText: self \ 0 Y r> 1+ Y true UpdateRange \ no need to update here ;M --- 696,700 ---- :M DeleteLine: ( -- ) \ delete current row Y RowAddress TextEnd over - ! 2dup 13 scan 13 skip 10 skip nip - dup>r DeleteText: self \ 0 Y r> 1+ Y true UpdateRange \ no need to update here ;M *************** *** 703,707 **** :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M --- 702,706 ---- :M DeleteTextAndRedraw: ( a n -- ) \ DeleteText and update DeleteText: self ! Deselect: self Redraw: self ;M *************** *** 712,716 **** drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > --- 711,715 ---- drop text - nip Text swap DeleteTextAndRedraw: self ;M ! : CheckTextBuffer ( n -- ) dup text zcount nip + 256 + MaxText > *************** *** 799,803 **** CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing --- 798,802 ---- CommandStart to X X Y X #chars + Y true UpdateRange ! 0 to #chars SCP true to editing *************** *** 810,815 **** SelStartCol SelEndCol min to X \ Update: self X Y X #chars + Y true UpdateRange ! SelectedLength negate +to #chars ! Deselect: self SCP true to editing --- 809,814 ---- SelStartCol SelEndCol min to X \ Update: self X Y X #chars + Y true UpdateRange ! SelectedLength negate +to #chars ! Deselect: self SCP true to editing *************** *** 884,888 **** ELSE Deselect: self ! X CommandEnd < IF XYAddress 1 DeleteTextOnCommandLine: self --- 883,887 ---- ELSE Deselect: self ! X CommandEnd < IF XYAddress 1 DeleteTextOnCommandLine: self *************** *** 958,963 **** : OpenClipboard ( -- ) CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup to ClipboardHandle call GlobalLock zcount to ClipboardCount to ClipboardAddress --- 957,962 ---- : OpenClipboard ( -- ) CF_TEXT call IsClipboardFormatAvailable ! IF ! hWnd call OpenClipboard drop CF_TEXT call GetClipboardData dup to ClipboardHandle call GlobalLock zcount to ClipboardCount to ClipboardAddress *************** *** 994,998 **** :M PasteFirstLine: ( -- ) \ paste only the first line (less CR) to the commandline CF_TEXT call IsClipboardFormatAvailable ! IF hWnd call OpenClipboard drop CF_TEXT call GetClipboardData --- 993,997 ---- :M PasteFirstLine: ( -- ) \ paste only the first line (less CR) to the commandline CF_TEXT call IsClipboardFormatAvailable ! IF hWnd call OpenClipboard drop CF_TEXT call GetClipboardData *************** *** 1009,1015 **** 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 --- 1008,1014 ---- 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 *************** *** 1030,1034 **** ELSE StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd ELSE 0 THEN THEN SelStartRow Select: self ;M --- 1029,1033 ---- ELSE StartAfterCommandLine SameRowAsCommandLine and ! IF CommandEnd ELSE 0 THEN THEN SelStartRow Select: self ;M *************** *** 1039,1043 **** ELSE StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart ELSE SelStartRow RowLength THEN THEN SelStartRow Select: self ;M --- 1038,1042 ---- ELSE StartBeforeCommandLine SameRowAsCommandLine and ! IF CommandStart ELSE SelStartRow RowLength THEN THEN SelStartRow Select: self ;M *************** *** 1048,1052 **** ELSE StartAfterCommandLine ! IF CommandEnd Y ELSE 0 0 THEN THEN Select: self ;M --- 1047,1051 ---- ELSE StartAfterCommandLine ! IF CommandEnd Y ELSE 0 0 THEN THEN Select: self ;M *************** *** 1057,1061 **** ELSE StartBeforeCommandLine ! IF CommandStart Y ELSE LastColRow: self THEN THEN Select: self ;M --- 1056,1060 ---- ELSE StartBeforeCommandLine ! IF CommandStart Y ELSE LastColRow: self THEN THEN Select: self ;M *************** *** 1066,1071 **** 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 --- 1065,1070 ---- 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 *************** *** 1076,1080 **** 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 --- 1075,1079 ---- 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 *************** *** 1092,1096 **** THEN THEN ! Select: self ;M :M ShiftRight: ( -- ) --- 1091,1095 ---- THEN THEN ! Select: self ;M :M ShiftRight: ( -- ) *************** *** 1100,1104 **** 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 --- 1099,1103 ---- 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 *************** *** 1108,1112 **** CommandStart Y \ lines 1- 2dup SelEndCol SelEndRow d= ! SelStartRow SelStartCol d0= and IF 2drop \ if all is selected already ELSE Deselect: self 0 0 ScrollAdjust SetStart Select: self --- 1107,1111 ---- CommandStart Y \ lines 1- 2dup SelEndCol SelEndRow d= ! SelStartRow SelStartCol d0= and IF 2drop \ if all is selected already ELSE Deselect: self 0 0 ScrollAdjust SetStart Select: self *************** *** 1136,1144 **** ELSE dup 27 = IF true to Abort? THEN PutKey: self THEN ! \ drop false to Abort? 0 ;M :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 --- 1135,1143 ---- ELSE dup 27 = IF true to Abort? THEN PutKey: self THEN ! \ drop false to Abort? 0 ;M :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 *************** *** 1182,1186 **** VK_PAUSE of 0x20009 endof VK_PRIOR of 0x20010 endof ! VK_NEXT of 0x20011 endof ( default ) 0 swap EndCase --- 1181,1185 ---- VK_PAUSE of 0x20009 endof VK_PRIOR of 0x20010 endof ! VK_NEXT of 0x20011 endof ( default ) 0 swap EndCase Index: Console2.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/Console2.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** Console2.f 19 Aug 2008 12:48:34 -0000 1.11 --- Console2.f 25 Aug 2008 18:11:45 -0000 1.12 *************** *** 3,7 **** cr .( Loading... Console I/O Part 2) ! : forth-io ; \ ******* need to look at printing the console in dc.f ********** 1 proc HideCaret --- 3,7 ---- cr .( Loading... Console I/O Part 2) ! : forth-io ( -- ) forth-io-chain do-chain ; 1 proc HideCaret |
|
From: Rod O. <rod...@us...> - 2008-08-25 18:11:10
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8073 Modified Files: Dc.f Log Message: Rod: enabled printing from the new console Index: Dc.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Dc.f,v retrieving revision 1.16 retrieving revision 1.17 diff -C2 -d -r1.16 -r1.17 *** Dc.f 19 Aug 2008 12:47:52 -0000 1.16 --- Dc.f 25 Aug 2008 18:11:04 -0000 1.17 *************** *** 1427,1437 **** : 4print ( -- ) four-page fprint single-page ; ! (( ! 80 value MAXCONCOLS ! 80 value conscols : #print-screen ( start_line lines -- ) \ print a range of lines from saved \ Forth screen buffer - cols to conscols cursor-off #pages-up ?dup --- 1427,1437 ---- : 4print ( -- ) four-page fprint single-page ; ! ! : RowString ( row -- a n ) \ address and length of row (without CR) ! &the-screen zcount rot 0 ?DO 13 scan 1 /string 10 skip LOOP ! 2dup 13 scan nip - ; : #print-screen ( start_line lines -- ) \ print a range of lines from saved \ Forth screen buffer cursor-off #pages-up ?dup *************** *** 1444,1468 **** printer? IF ( -- start lines ) ! &the-screen -rot ! ( -- start lines ) bounds DO ! dup getmaxcolrow drop i * + \ line starting addr ! conscols MAXCONCOLS max getmaxcolrow drop min -trailing \ addr len Type: ThePrinter Cr: ThePrinter \ next line LOOP - drop ELSE 2drop THEN console single-page cursor-on ; ! : print-screen ( -- ) \ print the physical screen ! getrowoff rows #print-screen ; : print-console ( -- ) \ print all lines used in screen save buffer ! 0 getrowoff rows + #print-screen ; ! )) INTERNAL --- 1444,1465 ---- printer? IF ( -- start lines ) ! bounds DO ! i RowString -trailing \ addr len Type: ThePrinter Cr: ThePrinter \ next line LOOP ELSE 2drop THEN console single-page cursor-on ; ! : print-screen ( -- ) \ print the physical screen ! getrowoff rows \ print from first visible row to last visible row #print-screen ; : print-console ( -- ) \ print all lines used in screen save buffer ! 0 getrowoff rows + \ print from row 0 to last visible row (not lines scrolled off the bottom) #print-screen ; ! INTERNAL |
|
From: Rod O. <rod...@us...> - 2008-08-25 18:09:15
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv7196 Modified Files: fkernel.f Log Message: Rod: need GETROWOFF for printing in DC.f Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.53 retrieving revision 1.54 diff -C2 -d -r1.53 -r1.54 *** fkernel.f 23 Aug 2008 19:13:32 -0000 1.53 --- fkernel.f 25 Aug 2008 18:09:09 -0000 1.54 *************** *** 2157,2161 **** DEFER GET-CURSOR ' K_NOOP1 IS GET-CURSOR \ DEFER SETROWOFF ' DROP IS SETROWOFF ! \ DEFER GETROWOFF ' K_NOOP1 IS GETROWOFF \ DEFER GETMAXCOLROW ' K_NOOP2 IS GETMAXCOLROW \ DEFER SETMAXCOLROW ' 2DROP IS SETMAXCOLROW --- 2157,2161 ---- DEFER GET-CURSOR ' K_NOOP1 IS GET-CURSOR \ DEFER SETROWOFF ' DROP IS SETROWOFF ! DEFER GETROWOFF ( -- n ) ( first visible row in new console) ' K_NOOP1 IS GETROWOFF \ DEFER GETMAXCOLROW ' K_NOOP2 IS GETMAXCOLROW \ DEFER SETMAXCOLROW ' 2DROP IS SETMAXCOLROW |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 05:38:42
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv1490/src/kernel Modified Files: meta-fkernel.f Log Message: More application space needed for the IDE (for testing forms). Index: meta-fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/meta-fkernel.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** meta-fkernel.f 2 Aug 2008 22:11:09 -0000 1.6 --- meta-fkernel.f 24 Aug 2008 05:38:38 -0000 1.7 *************** *** 48,52 **** SYS-SIZE 0x1000 naligned TO IMAGE-SSIZE \ size of kernel system dictionary ! 1024000 0x1000 naligned constant MINAPPMEM \ minimum size of kernel application dictionary 40960 0x1000 naligned constant MINCODEMEM \ minimum size of kernel code dictionary 512000 0x1000 naligned constant MINSYSMEM \ minimum size of kernel system dictionary --- 48,52 ---- SYS-SIZE 0x1000 naligned TO IMAGE-SSIZE \ size of kernel system dictionary ! 1256000 0x1000 naligned constant MINAPPMEM \ minimum size of kernel application dictionary 40960 0x1000 naligned constant MINCODEMEM \ minimum size of kernel code dictionary 512000 0x1000 naligned constant MINSYSMEM \ minimum size of kernel system dictionary |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 04:09:52
|
Update of /cvsroot/win32forth/win32forth/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv1439/demos Added Files: Dirbox.ff dirbox.ff_code Log Message: Demo form with code. EAB --- NEW FILE: dirbox.ff_code --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Dirbox.ff --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 04:07:00
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv32134/src/lib Modified Files: ExUtils.f FileLister.f FolderView.f file.f Log Message: Slight enhancements. Folderview no longer needs conhndl. EAB Index: file.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/file.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** file.f 13 Jan 2006 17:50:33 -0000 1.7 --- file.f 24 Aug 2008 04:06:56 -0000 1.8 *************** *** 257,262 **** --- 257,264 ---- \ *G load a file into the file-buffer, f=true on success Setname: self + mode >r \ save current mode r/o SetMode: self Open: self + r> SetMode: self \ restore mode if false exitm then FileSize: self drop AllocBuffer: self Index: FolderView.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FolderView.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** FolderView.f 30 Dec 2007 03:41:09 -0000 1.1 --- FolderView.f 24 Aug 2008 04:06:56 -0000 1.2 *************** *** 145,148 **** --- 145,149 ---- max-path 1+ bytes itemname int iconhandle + int itemhandle \ parent handle cell bytes index *************** *** 195,198 **** --- 196,200 ---- Win32_Find_Data sizeof(Win32_Find_Data) erase 0 to iconhandle + 0 to itemhandle -1 index ! ;M *************** *** 206,210 **** \ transfer the info _Win32-Find-Data Win32_Find_Data sizeof(Win32_Find_Data) move ! index itemname conhndl Call ExtractAssociatedIcon to iconhandle ;M --- 208,212 ---- \ transfer the info _Win32-Find-Data Win32_Find_Data sizeof(Win32_Find_Data) move ! index itemname itemhandle Call ExtractAssociatedIcon to iconhandle ;M *************** *** 218,221 **** --- 220,226 ---- iconhandle ;M + :M SetHandle: ( hwnd -- ) + to itemhandle ;M + ;Class *************** *** 365,370 **** ?do i >Link#: FolderList Data@: FolderList to item ! IconHandle: item ! hwndSmallIcons Call ImageList_AddIcon drop loop ; --- 370,375 ---- ?do i >Link#: FolderList Data@: FolderList to item ! IconHandle: item ?dup if ! hwndSmallIcons Call ImageList_AddIcon drop then loop ; *************** *** 374,379 **** ?do i >Link#: FolderList Data@: FolderList to item ! IconHandle: item ! hwndLargeIcons Call ImageList_AddIcon drop loop ; --- 379,384 ---- ?do i >Link#: FolderList Data@: FolderList to item ! IconHandle: item ?dup if ! hwndLargeIcons Call ImageList_AddIcon drop then loop ; *************** *** 383,386 **** --- 388,392 ---- if AddLink: FolderList then New> FolderItem dup Data!: FolderList to ThisItem + hwnd SetHandle: ThisItem ( str cnt ) SetUp: ThisItem ; Index: FileLister.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/FileLister.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** FileLister.f 29 Jun 2008 05:12:40 -0000 1.8 --- FileLister.f 24 Aug 2008 04:06:56 -0000 1.9 *************** *** 106,109 **** --- 106,110 ---- int iconhandle + int itemhandle \ parent handle cell bytes index *************** *** 208,214 **** :M AddIcon: ( -- ) ! index itemname conhndl Call ExtractAssociatedIcon to iconhandle ;M \ Windows API say the following isn't necessary \ :M ~: ( -- ) --- 209,218 ---- :M AddIcon: ( -- ) ! index itemname itemhandle Call ExtractAssociatedIcon to iconhandle ;M + :M SetHandle: ( hwnd -- ) + to itemhandle ;M + \ Windows API say the following isn't necessary \ :M ~: ( -- ) *************** *** 448,451 **** --- 452,456 ---- if AddLink: FolderList then New> FolderItem dup Data!: FolderList to ThisItem + hwnd SetHandle: ThisItem ( str cnt ) UpdateList ; Index: ExUtils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/ExUtils.f,v retrieving revision 1.11 retrieving revision 1.12 diff -C2 -d -r1.11 -r1.12 *** ExUtils.f 29 Jun 2008 05:12:40 -0000 1.11 --- ExUtils.f 24 Aug 2008 04:06:56 -0000 1.12 *************** *** 100,113 **** then addr cnt str2 cnt2 ; ! : (fload-buffer) { s1 c1 -- } \ compile a memory file \ We need to save the string because if interpreting a line and a value is \ left on the stack, e.g from "if", the system hangs somewhat begin c1 ! while s1 c1 readline-memory to c1 to s1 ! evaluate ! repeat ; ! : fload-buffer ( addr cnt -- ) ! TheBuffer (fload-buffer) ; \ : ExecuteFile { addr cnt hndl \ temp$ -- } \ open file using default application --- 100,133 ---- then addr cnt str2 cnt2 ; ! : (fload-buffer) { s1 c1 \ curstr curlen lcnt -- f } \ compile a memory file \ We need to save the string because if interpreting a line and a value is \ left on the stack, e.g from "if", the system hangs somewhat + 0 to lcnt begin c1 ! while 1 +to lcnt ! s1 c1 readline-memory to c1 to s1 ! 2dup to curlen to curstr ! ['] evaluate catch ?dup ! if new$ >r ! s" Compile error!\nLine " r@ place ! lcnt (.) r@ +place ! s" : " r@ +place ! curstr curlen r@ +place ! true dup r> count ?MessageBox ! exit ! then ! repeat false ; ! \ : (fload-buffer) { s1 c1 -- } \ compile a memory file ! \ We need to save the string because if interpreting a line and a value is ! \ left on the stack, e.g from "if", the system hangs somewhat ! \ begin c1 ! \ while s1 c1 readline-memory to c1 to s1 ! \ evaluate ! \ repeat ; ! ! ! : fload-buffer ( addr cnt -- ) ! TheBuffer (fload-buffer) drop ; \ : ExecuteFile { addr cnt hndl \ temp$ -- } \ open file using default application |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 04:04:14
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv31153/Help/html/IDE Added Files: Win32ForthIDE.ico Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: Win32ForthIDE.ico --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 04:01:32
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29876/Help/html/IDE Added Files: CreateToolbar Window.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: CreateToolbar Window.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 04:00:47
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29581/Help/html/IDE Added Files: IDEWindow.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: IDEWindow.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:59:54
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29140/Help/html/IDE Added Files: ProjectTab.gif PropertyFormDialog.gif SplitterDialog.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: SplitterDialog.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: ProjectTab.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: PropertyFormDialog.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:58:50
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28748/Help/html/IDE Added Files: Form Property Window.gif Navigator.gif VocabulariesTab.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: VocabulariesTab.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Navigator.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Form Property Window.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:57:51
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28342/Help/html/IDE Added Files: GroupAction.gif GroupExample.gif Toolbar Preview Window.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: Toolbar Preview Window.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: GroupAction.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: GroupExample.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:56:37
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27904/Help/html/IDE Added Files: Directory Demo.gif DirectoryTab.gif FormDesignerTab.gif Forms Code Window.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: Forms Code Window.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Directory Demo.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: DirectoryTab.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: FormDesignerTab.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:54:48
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27082/Help/html/IDE Added Files: Control Property Window.gif Define Menu Window.gif New Window.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: Define Menu Window.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: New Window.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Control Property Window.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Ezra B. <ezr...@us...> - 2008-08-24 03:50:17
|
Update of /cvsroot/win32forth/win32forth/Help/html/IDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv25084/Help/html/IDE Added Files: Bitmap Preview Window.gif ClassesTab.gif EditorToolbar.gif FilesTab.gif Forthform.gif IDEStatusBar.gif IDEToolbar.gif Project Toolbar.gif back.gif textbutton.gif top.gif Log Message: Beginning of docs for the IDE. EAB --- NEW FILE: top.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: IDEToolbar.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: FilesTab.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Forthform.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Project Toolbar.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: ClassesTab.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: back.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: EditorToolbar.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: IDEStatusBar.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: Bitmap Preview Window.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: textbutton.gif --- (This appears to be a binary file; contents omitted.) |
1040 messages has been excluded from this view by a project administrator.
