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: Jos v.d.V. <jo...@us...> - 2007-07-07 14:28:02
|
Update of /cvsroot/win32forth/win32forth-stc/doc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24969 Added Files: FORTHPRO.gif ONWEB.gif TELLUS.gif p-index.htm Log Message: Jos: Needed for the helpmenu --- NEW FILE: FORTHPRO.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: p-index.htm --- <html> <head> <meta http-equiv="Content-Language" content="en-gb"> <meta name="GENERATOR" content="Microsoft FrontPage 5.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <title>The Documentation Project</title> <style> <!-- h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> </style> </head> <body> <h1 align="center"><img border="0" src="FORTHPRO.gif" width="32" height="32"> Win32Forth</h1> <h2 align="center"><font face="Tahoma"> <a href="mailto:win...@ya...?subject=DOC: Doc error in $Id: p-index.htm,v 1.1 2007/07/07 14:27:57 jos_ven Exp $"> <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a>The Documentation</font></h2> <p>Welcome to Win32Forth, a Windows implementation of the <a href="dpans/dpans.htm">ANS Forth</a> programming language. Documentation is difficult stuff to write, and even more difficult to keep up to date, so please <a href="mailto:win...@ya...?subject=DOC: Doc error in $Id: p-index.htm,v 1.1 2007/07/07 14:27:57 jos_ven Exp $"> inform us if you find errors</a> or omissions, or speling erors like this; anything, no matter how small. You'll find the link to do so on all the documentation pages (it's marked with this icon <img border="0" src="TELLUS.gif" width="16" height="16"> in the top left hand corner of each page) or if you'd like to contribute (words only, there's no money involved in this at all), please jot up your ideas and <a href="mailto:win...@ya...?subject=DOC: Here's my doc I'd like you to consider."> let us know</a>. There are no navigation buttons on these pages; please use your browser's back and forward buttons.</p> <h2>Who's the We?</h2> <p>The <a href="http://groups.yahoo.com/group/win32forth">Win32Forth Project Group</a> was formed in 2002 as a loose affiliation of programmers and users of Tom Zimmer's Win32Forth system. Tom interests took him elsewhere in 2001 and 2002 (mainly Java), and he no longer took an active interest in his system. Tom gifted his product into the public domain; this group intends furthering the work of maintaining and developing a Forth product suitable for Windows and the 21st century based on his work. </p> <p>Some of this documentation is based on Tom's original work; when you see "we" it means the Win32Forth group; when you see I, it's Tom speaking. You is definitely not us or him. Anyhow, enough of that (or this), lets</p> <hr> <h2>START HERE!</h2> <p>ok, ok, I'll quit shouting. As the <a href="http://www.bbc.co.uk/cult/hitchhikers/">"Hitchhikers Guide To The Galaxy"</a> <img border="0" src="ONWEB.gif" width="16" height="16"> would say; </p> <h2 align="center"><b><font size="5" color="#FF0000">"DON'T PANIC"</font></b></h2> <p align="left">Getting started isn't that difficult and the rest, you can pickup along the way. </p> <p>You are about to embark on a great adventure. Your intelligence and determination will allow you to explore, discover and conquer the complex world of Forth in a Windows environment. Proceed slowly and carefully, you don't want to get shot down too often or too quickly, and remember that the rewards you receive for your effort, include: mastery of the well known, but little understood programming continent, called Windows. But, the fun is in the trip, so enjoy it. Don't be afraid to make mistakes, few of them are likely to be fatal. Share what you learn with others. Remember that discovery within a group is rewarding for everyone in the group. Don't take this too seriously. </p> <p>Most of the hyperlinks in this file take you to destinations that are in files loaded as part of the Win32Forth install, but some links will take you to Internet web addresses that contain additional resources. They're marked with this symbol: <img border="0" src="ONWEB.gif" width="16" height="16"> </p> <ul> <li><a href="p-history.htm">The History of Win32Forth </a></li> <li><a href="p-overview.htm">Overview, Philosophy & the Non Existent Warranty</a></li> <li><a href="p-architecture.htm">Overview of the Architecture</a></li> <li><a href="p-osvers.htm">Windows Versions Supported</a>; that means no Linux, no Mac. Sorry.</li> <li><a href="p-obtain.htm">Obtaining & Installing Win32Forth</a> for free! Legally!</li> <li>Running Win32Forth</li> <li><a href="p-getstart.htm">Getting Started</a></li> <li>Your First Forth Program</li> <li><a href="p-faq.htm">FAQ</a> Frequently Asked Questions; with some frequently given answers.</li> <li><a href="p-gethelp.htm">Getting Help</a></li> </ul> <h3>Win32Forth development tools</h3> <ul> <li><a href="SciEdit/SciEdit.htm">SciEdit</a> (Win32Forth Source-Editor)</li> <li><a href="ForthForm/ForthForm.htm">ForthForm</a> (Win32Forth Dialog-Editor)</li> <li><a href="ProMgr/ProjectManager.htm">ForthProject</a> (Win32Forth Project Manager)</li> <li><a href="p-dexh.htm">Dex</a> Document Extractor</li> <li><a href="p-w32fdexh.htm">W32FDex</a> Win32Forth extensions for the Document Extractor</li> </ul> <h3>Forth primers</h3> <ul> <li><a href="Forth_Primer.pdf">A Forth Primer: And So Forth</a> Copyright J.L. Bezemer 2001-04-06 under GPL (PDF format; you can <img border="0" src="ONWEB.gif" width="16" height="16"> <a href="http://www.adobe.com/products/acrobat/readermain.html">get Acrobat here</a>)</li> <li><a href="Guide/primer.htm">A Beginner's Guide to Forth</a> by <a href="http://galileo.phys.virginia.edu/~jvn/">Julian V. Noble <img border="0" src="ONWEB.gif" width="16" height="16"></a></li> <li><a href="http://home.iae.nl/users/mhx/">Starting Forth First Edition</a> <img border="0" src="ONWEB.gif" width="16" height="16"> (Marcel Hendrix's Forth website. Much disputed copyright about this, but a good introductory text)</li> <li><a href="http://thinking-forth.sourceforge.net/thinking-forth.pdf">Thinking Forth</a> <img border="0" src="ONWEB.gif" width="16" height="16"> For the more advanced user (PDF format)</li> <li><a href="http://www.mpeforth.com/arena/ProgramForth.pdf">Programming Forth</a> by <a href="mailto:sf...@mp...">Stephen Pelc</a> <img border="0" src="ONWEB.gif" width="16" height="16"> (PDF format)</li> </ul> <h3>ANS Forth documentation</h3> <ul> <li><a href="dpans/dpans.htm">ANS Forth</a>; the authoritative definition of Forth.</li> <li>The <a href="dpans/dpansf.htm">ANS Forth Wordlist</a>; all the standard words. Excellent bedtime reading for insomniacs.</li> <li><a href="p-ansi.htm">Win32Forth and the ANS Forth Standard; satisfying the documentation requirements of the ANS Forth Standard</a></li> </ul> <p>Once you've got to grips with the basics, it's time to move on to the:</p> <h3>Advanced Topics</h3> <p>Advanced topics aren't really that advanced, but if you're just starting out with Win32Forth, these are best revisited once you've got to grips with the basics. Oh, go on then. Read them anyhow...</p> <ul> <li><a href="p-debugging.htm">Debugging in Win32Forth</a></li> <li><a href="p-windlls.htm">Calling Windows Procedures</a></li> <li><a href="p-callback.htm">Using Callback functions</a></li> <li><a href="p-objects.htm">Object Oriented Programming</a></li> <li><a href="p-classes.htm">Win32Forth Classes</a></li> <li><a href="p-classdbg.htm">Class Debugging Words</a></li> <li><a href="p-float.htm">Floating point words in Win32Forth</a></li> <li><a href="p-module.htm">Using the Module Wordset</a></li> <li><a href="p-block.htm">Using the Block Wordset</a></li> <li><a href="p-interpif.htm">Interpretive conditionals in Win32Forth</a></li> <li><a href="p-task.htm">Using the Task Wordset</a></li> <li><a href="p-random.htm">The Random Number Generator</a></li> <li><a href="p-switch.htm">Using Switches</a></li> <li><a href="p-chains.htm">Chains and how to use them</a></li> <li><a href="p-locals.htm">Named input parameters and local variables</a></li> <li><a href="p-486asm.htm">Documentation for 486ASM.F</a> (the assembler)</li> <li><a href="p-imageman.htm">Building and saving an application</a></li> <li><a href="p-noconsole.htm">Building a turnkeyed application that runs without the console dll</a></li> <li><a href="p-arch1.htm">The Internal Architecture of Win32Forth</a></li> <li><a href="p-using-if.htm">Using -IF</a></li> <li><a href="p-structures.htm">Structures in Win32Forth</a></li> <li><a href="p-numconv.htm">Number Conversion</a></li> <li><a href="p-AcceleratorTables.htm">Accelerator tables</a></li> <li><a href="Paths.htm">Multiple search path support</a></li> <li><a href="p-ansfile.htm">File and directory searching words</a></li> <li><a href="Unicode.htm">Unicode Strings (for use with FCOM)</a></li> <li><a href="WinSock.htm">WinSock - Simple Socket Library</li> <li><a href="p-relnotes.6.12.htm">Release Notes</a></li> </ul> <h3>Distributions</h3> <dir> <li>SourceForge distributions at <a href="http://sourceforge.net/project/showfiles.php?group_id=55294"> http://sourceforge.net/project/showfiles.php?group_id=55294</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> <li>CVS at <a href="http://sourceforge.net/cvs/?group_id=55294"> http://sourceforge.net/cvs/?group_id=55294</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> <li>Prebuilt CVS distributions at <a href="http://www.win32forth.org"> www.win32forth.org</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> </dir> <h3>Mailing lists</h3> <dir> <li>Discussion group at <a href="http://groups.yahoo.com/group/win32forth"> http://groups.yahoo.com/group/win32forth</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> <li>Bug reports at <a href="http://sourceforge.net/tracker/?group_id=55294&atid=476499"> http://sourceforge.net/tracker/?group_id=55294&atid=476499</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> <li>CVS Commit List at <a href="http://sourceforge.net/mailarchive/forum.php?forum_id=43364"> http://sourceforge.net/mailarchive/forum.php?forum_id=43364</a> <img border="0" src="ONWEB.gif" width="16" height="16">, subscriptions at <a href="http://lists.sourceforge.net/lists/listinfo/win32forth-cvs"> http://lists.sourceforge.net/lists/listinfo/win32forth-cvs</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> </dir> <h3>Links to other websites</h3> <ul> <li><a href="http://t.webring.com/hub?ring=forth">The Forth WebRing</a> <img border="0" src="ONWEB.gif" width="16" height="16"></li> </ul> <hr> <p>Document $Id: p-index.htm,v 1.1 2007/07/07 14:27:57 jos_ven Exp $</p> </body> </html> --- NEW FILE: ONWEB.gif --- (This appears to be a binary file; contents omitted.) --- NEW FILE: TELLUS.gif --- (This appears to be a binary file; contents omitted.) |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-07 14:26:18
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24561 Modified Files: extend.f primutil.f Log Message: Jos: Added shell.f. for the help menu. Other words also work. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.36 retrieving revision 1.37 diff -C2 -d -r1.36 -r1.37 *** primutil.f 6 Jul 2007 09:06:39 -0000 1.36 --- primutil.f 7 Jul 2007 14:26:15 -0000 1.37 *************** *** 383,386 **** --- 383,424 ---- ; + + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ LONG counted string support + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + (( + \ March 2nd, 2000 - 11:14 tjz + You must not store more than 4k beyond where you currently are into the + stack, and since LMAXCOUNTED is passed to LOCALALLOC: a bunch of times in + WinEd, we must limit long counted strings to significantly less than + the 4k limit. So, I am limiting long counted strings to 3k bytes. + )) + + 1024 CONSTANT LMAXCOUNTED \ lines can be 1k characters long + LMAXCOUNTED 2 CELLS+ CONSTANT LMAXSTRING + \ room for leading cell count and trailing cell null + + : "LCLIP" ( a1 n1 -- a1 n1 ) \ clip a string to between 0 and LINE-MAX + LMAXCOUNTED MIN 0 MAX ; + + : LPLACE ( addr len dest -- ) + SWAP "LCLIP" SWAP + 2DUP 2>R + CELL+ SWAP MOVE + 2R> ! ; + + : +LPLACE ( addr len dest -- ) \ append string addr,len to LONG counted + \ string dest + >R "LCLIP" LMAXCOUNTED R@ @ - MIN R> \ clip total to LINE-MAX string + 2DUP 2>R + LCOUNT CHARS + SWAP MOVE + 2R> +! ; + + : C+LPLACE ( c1 a1 -- ) \ append char c1 to the LONG counted string at a1 + 1 OVER +! LCOUNT + 1- C! ; + + : +LNULL ( a1 -- ) \ append a NULL just beyond the counted chars + LCOUNT + 0 SWAP C! ; + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Limited support for the '#define' statment from 'C' Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.25 retrieving revision 1.26 diff -C2 -d -r1.25 -r1.26 *** extend.f 5 Jul 2007 20:06:05 -0000 1.25 --- extend.f 7 Jul 2007 14:26:15 -0000 1.26 *************** *** 43,46 **** --- 43,61 ---- FLOAD src\lib\BROWSEFLD.F \ SHBrowseForFolder() support + FLOAD src\Shell.f \ load SHELL utility words + + create config$ ," WIN32FOR.CFG" + create userconfig$ ," WIN32FORUSER.CFG" + + \ ........ set the default system access strings .......... + \ -rbs make shell work in other drives + : set-shell + winver winnt351 >= + if s" CMD.EXE " + else s" c:\command.com " then + 2dup dos$ place shell$ place + s" /c " shell$ +place ; + set-shell + FLOAD src\console\ConsoleMenu.f |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-07 14:16:19
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20643 Modified Files: ConsoleMenu.f Log Message: Jos: Renamed load-forth to fload-forth since load-forth is already used in the kernel. Enabled more menu's Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** ConsoleMenu.f 5 Jul 2007 20:18:27 -0000 1.10 --- ConsoleMenu.f 7 Jul 2007 14:16:13 -0000 1.11 *************** *** 2,5 **** --- 2,6 ---- \ ConsoleMenu.F + Require Shell.f Require Menu.f *************** *** 171,175 **** \ changed to work with blanks in file name \ January 31st, 2004 - 20:38 dbu ! : load-forth ( -- ) conhndl start: LoadForth dup c@ IF count pocket place --- 172,176 ---- \ changed to work with blanks in file name \ January 31st, 2004 - 20:38 dbu ! : fload-forth ( -- ) conhndl start: LoadForth dup c@ IF count pocket place *************** *** 205,212 **** 1 c" ADJFORTH.TXT" $browse ; : save-forth ( -- ) \ save a new Forth image turnkeyed? ?exit conhndl start: SaveForth dup c@ ! \in-system-ok if count "fsave else drop then ; --- 206,215 ---- 1 c" ADJFORTH.TXT" $browse ; + )) + : save-forth ( -- ) \ save a new Forth image turnkeyed? ?exit conhndl start: SaveForth dup c@ ! \in-system-ok if count cr .s "fsave else drop then ; *************** *** 218,222 **** IF web$ count conhndl "Web-Link THEN ; ! )) : ChdirDlg { \ path$ -- } \ set current directory MAXSTRING LocalAlloc: path$ --- 221,225 ---- IF web$ count conhndl "Web-Link THEN ; ! : ChdirDlg { \ path$ -- } \ set current directory MAXSTRING LocalAlloc: path$ *************** *** 226,230 **** \in-system-ok if path$ dup +null count "chdir .dir cr then ; ! (( \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Function key additions to the keyboard interpreter during commandline entry --- 229,233 ---- \in-system-ok if path$ dup +null count "chdir .dir cr then ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Function key additions to the keyboard interpreter during commandline entry *************** *** 243,247 **** ledit-chain chain-add ?f1-help \ help key recognition - )) : ?macro-keys ( chad flag -- char flag ) --- 246,249 ---- *************** *** 256,268 **** if 0= CONHNDL repeat-amacro EXIT then over [ 'O' +k_control ] literal = ! if 0= edit-forth EXIT then over [ 'W' +k_control ] literal = if 0= open-web EXIT then ! over [ K_F12 ] literal = ! if 0= 2>r >r LoadProject r> 2r> EXIT then )) over [ 'L' +k_control ] literal = ! if 0= load-forth EXIT then \ over [ 'P' +k_control ] literal = \ if 0= print-screen EXIT then --- 258,271 ---- if 0= CONHNDL repeat-amacro EXIT then over [ 'O' +k_control ] literal = ! if 0= edit-forth EXIT then )) over [ 'W' +k_control ] literal = if 0= open-web EXIT then ! \ over [ K_F12 ] literal = ! \ if 0= 2>r >r LoadProject r> 2r> EXIT then over [ 'L' +k_control ] literal = ! if 0= fload-forth EXIT then ! \ over [ 'P' +k_control ] literal = \ if 0= print-screen EXIT then *************** *** 315,327 **** \ MENUITEM "&Edit Forth File...\tCtrl+O" edit-forth ; ! MENUITEM "&Load Forth File...\tCtrl+L" load-forth ; MENUSEPARATOR MENUITEM "Set current directory...\tCtrl+D" ChdirDlg ; ! ! (( MENUSEPARATOR MENUITEM "Open a Web link...\tCtrl+W" open-web ; MENUSEPARATOR MENUCONSOLE "&Save Forth System..." save-forth ; ! MENUCONSOLE "&Adjust Forth Dictionaries..." adjust-forth ; MENUSEPARATOR --- 318,330 ---- \ MENUITEM "&Edit Forth File...\tCtrl+O" edit-forth ; ! MENUITEM "&Load Forth File...\tCtrl+L" fload-forth ; MENUSEPARATOR MENUITEM "Set current directory...\tCtrl+D" ChdirDlg ; ! MENUSEPARATOR MENUITEM "Open a Web link...\tCtrl+W" open-web ; + MENUSEPARATOR MENUCONSOLE "&Save Forth System..." save-forth ; ! (( MENUCONSOLE "&Adjust Forth Dictionaries..." adjust-forth ; MENUSEPARATOR *************** *** 350,357 **** 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 ; ! )) POPUP "&Edit" MENUITEM "&Cut and Clear Console \tCtrl+X" cut-console ; --- 353,360 ---- 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 ; ! POPUP "&Edit" MENUITEM "&Cut and Clear Console \tCtrl+X" cut-console ; *************** *** 415,430 **** MENUITEM "&Play Key File" con-play-macro ; MENUITEM "RePlay &Last Key File \tCtrl+Shft+M" replay-macro ; ! MENUITEM "&Repeat Key File 'n' times..\tCtrl+Shft+R" conhndl repeat-amacro ; POPUP "&Help" MENUITEM "Win32Forth &Documentation\tF1" F1-doc ; ! MENUITEM "&Help me get Started!\tF2" F2-help ; ! MENUITEM "Win32Forth &FAQ" s" doc\p-faq.htm" conhndl "file-link ; ! MENULINE "&Utilities in Win32Forth" "BROWSE doc\UTILDOC.TXT" ! MENUITEM "&Assembler Documentation" s" doc\p-486asm.htm" conhndl "file-link ; ! MENUSEPARATOR ! MENUITEM "ANS Forth &Standard" s" doc\dpans\DPANS.HTM" conhndl "file-link ; ! MENUITEM "ANS Forth &Word List" s" doc\dpans\DPANSF.HTM" conhndl "file-link ; ! MENUITEM "Win32&Forth ANS Documentation" s" doc\p-ansi.htm" conhndl "file-link ; MENUSEPARATOR SUBMENU "Web Based Resources" --- 418,433 ---- MENUITEM "&Play Key File" con-play-macro ; MENUITEM "RePlay &Last Key File \tCtrl+Shft+M" replay-macro ; ! MENUITEM "&Repeat Key File 'n' times..\tCtrl+Shft+R" conhndl repeat-amacro ; )) POPUP "&Help" MENUITEM "Win32Forth &Documentation\tF1" F1-doc ; ! \ MENUITEM "&Help me get Started!\tF2" F2-help ; ! \ MENUITEM "Win32Forth &FAQ" s" doc\p-faq.htm" conhndl "file-link ; ! \ MENULINE "&Utilities in Win32Forth" "BROWSE doc\UTILDOC.TXT" ! \ MENUITEM "&Assembler Documentation" s" doc\p-486asm.htm" conhndl "file-link ; ! \ MENUSEPARATOR ! \ MENUITEM "ANS Forth &Standard" s" doc\dpans\DPANS.HTM" conhndl "file-link ; ! \ MENUITEM "ANS Forth &Word List" s" doc\dpans\DPANSF.HTM" conhndl "file-link ; ! \ MENUITEM "Win32&Forth ANS Documentation" s" doc\p-ansi.htm" conhndl "file-link ; MENUSEPARATOR SUBMENU "Web Based Resources" *************** *** 454,460 **** ENDSUBMENU MENUSEPARATOR ! MENUITEM "&About Win32Forth" about-Win32Forth ; - )) ENDBAR --- 457,463 ---- ENDSUBMENU MENUSEPARATOR ! MENUITEM "&About Win32Forth" about-Win32Forth ; ! ENDBAR |
|
From: Alex M. <ale...@us...> - 2007-07-06 09:06:42
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12810/src Modified Files: paths.f primutil.f Log Message: arm: tidy up localalloc, remove uses of internal words _localalloc _localfree Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** primutil.f 21 May 2007 13:51:45 -0000 1.35 --- primutil.f 6 Jul 2007 09:06:39 -0000 1.36 *************** *** 263,267 **** : winver-init ( -- ) \ get windows version ! 148 dup _localalloc dup>r ! \ set length of structure r@ call GetVersionEx \ call os for version 0= abort" call failed" --- 263,267 ---- : winver-init ( -- ) \ get windows version ! 148 dup localalloc dup>r ! \ set length of structure r@ call GetVersionEx \ call os for version 0= abort" call failed" *************** *** 295,299 **** endof endcase to winver ! r>drop _localfree ; --- 295,299 ---- endof endcase to winver ! r>drop ; Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** paths.f 11 Dec 2006 10:42:37 -0000 1.7 --- paths.f 6 Jul 2007 09:06:39 -0000 1.8 *************** *** 36,48 **** 1 PROC PathRemoveExtension as (call-pre) ! : ("path-func") ( a1 n1 xt -- a2 n2 ) \ execute path function ! -rot \ save the xt under the string ! over >r \ save original address ! MAX-PATH _localalloc \ allocate space on stack ! ascii-z dup>r \ make a zstring ! swap execute drop \ call the function ! r> zcount \ count the chars ! _localfree ! nip r> swap \ use original address ; --- 36,47 ---- 1 PROC PathRemoveExtension as (call-pre) ! : ("path-func") ( a1 n1 xt -- a1 n2 ) \ execute path function a1 n1 xt ! localbuff >r \ allocate string space a1 n1 xt r:a2 ! -rot \ save the xt under the string xt a1 n1 r:a2 ! over r> swap >r \ swap addresses xt a1 n1 a2 r:a1 ! ascii-z dup>r \ make a zstring xt a2 r:a1 a2 ! swap execute drop \ call the function r:a1 a2 ! r> zcount \ count the chars a2 n2 r:a1 ! nip r> swap \ use original address a1 n2 ; *************** *** 64,71 **** \ *G return a2 and count=n1 of filename 2dup \ save originals ! MAX_PATH _LOCALALLOC ascii-z dup \ make zstring on the stack call PathFindFileName \ find the file part swap - /string \ remove the chars from caller - _LOCALFREE ; --- 63,69 ---- \ *G return a2 and count=n1 of filename 2dup \ save originals ! MAX_PATH LOCALALLOC ascii-z dup \ make zstring on the stack call PathFindFileName \ find the file part swap - /string \ remove the chars from caller ; *************** *** 356,364 **** : IsAbsolutePath? ( a1 n1 -- f ) \ *G Returns true if path is absolute. ! MAXCOUNTED _LOCALALLOC \ allocate a string dup>r place r@ +null \ move the string r> 1+ \ for call call PathIsRelative 0= \ call function - _LOCALFREE \ free buffer ; --- 354,361 ---- : IsAbsolutePath? ( a1 n1 -- f ) \ *G Returns true if path is absolute. ! MAXCOUNTED LOCALALLOC \ allocate a string dup>r place r@ +null \ move the string r> 1+ \ for call call PathIsRelative 0= \ call function ; |
|
From: Alex M. <ale...@us...> - 2007-07-06 09:06:42
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12810 Modified Files: gkernel.exe Log Message: arm: tidy up localalloc, remove uses of internal words _localalloc _localfree Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.47 retrieving revision 1.48 diff -C2 -d -r1.47 -r1.48 Binary files /tmp/cvs0uj3Dz and /tmp/cvsRnFo9u differ |
|
From: Alex M. <ale...@us...> - 2007-07-06 09:06:42
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv12810/src/kernel Modified Files: gkernel.f Log Message: arm: tidy up localalloc, remove uses of internal words _localalloc _localfree Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.40 retrieving revision 1.41 diff -C2 -d -r1.40 -r1.41 *** gkernel.f 1 Jul 2007 17:26:31 -0000 1.40 --- gkernel.f 6 Jul 2007 09:06:39 -0000 1.41 *************** *** 1157,1194 **** next c; - \ -------------------- Locals Allocation on rstack -------------------- - - \ These are internal words for use during meta-compilation. See - \ localalloc and locals words for user words. - - gcode __localsave \ save previous local ptr - push lp [up] \ push local ptr - mov lp [up] , esp \ new local ptr - ;g - - gcode __localalloc \ allocate local on rstack - sub esp, eax \ subtract n1 from return stack - and esp, # -4 \ cell align return stack - mov eax, esp \ move to top of stack - ;g - - gcode __localfree \ free local on rstack - mov esp, lp [up] \ restore rstack ptr - pop lp [up] \ restore old local ptr - ;g - - : _localallocp ( len -- addr ) \ allocate local on rstack - (comp-only) compilation> drop __localalloc (copy-code) ; - 1 1 in/out - - : _localalloc ( len -- addr ) \ allocate local on rstack - (comp-only) compilation> drop - __localsave (copy-code) __localalloc (copy-code) ; - 1 1 in/out - - : _localfree ( -- ) \ allocate local on rstack - (comp-only) compilation> drop __localfree (copy-code) ; - 0 0 in/out - \ -------------------- Double memory Operators ------------------------ --- 1157,1160 ---- *************** *** 1516,1520 **** next; ! code / ( n1 n2 -- quot ) \ equiv of >r s>d r> sm/rem swap drop 2 1 in/out mov ecx, eax \ >r --- 1482,1486 ---- next; ! code / ( n1 n2 -- quot ) \ equiv of >r s>d r> sm/rem nip 2 1 in/out mov ecx, eax \ >r *************** *** 4601,4608 **** \ See the locals wordset for details on localstk usage. ! 0 value localstk \ support for locals (including localalloc) ! \ EXIT compiles _LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile _LOCALFREE : exit ( -- ) \ exit current word --- 4567,4590 ---- \ See the locals wordset for details on localstk usage. ! 0 value localstk \ support for locals (including localalloc) ! gcode __localsave \ save previous local ptr ! push lp [up] \ push local ptr ! mov lp [up] , esp \ new local ptr ! ;g ! ! gcode __localalloc \ allocate local on rstack ! sub esp, eax \ subtract n1 from return stack ! and esp, # -4 \ cell align return stack ! mov eax, esp \ move to top of stack ! ;g ! ! gcode __localfree \ free local on rstack ! mov esp, lp [up] \ restore rstack ptr ! pop lp [up] \ restore old local ptr ! ;g ! ! \ EXIT compiles __LOCALFREE, but leaves LOCALSTK alone so that ; can ! \ also compile __LOCALFREE : exit ( -- ) \ exit current word *************** *** 4610,4614 **** compilation> ( -- xt ) drop localstk if ! postpone _localfree \ to unwind the stack then sync-code \ ensure everyting generated --- 4592,4596 ---- compilation> ( -- xt ) drop localstk if ! __localfree (copy-code) \ to unwind the stack then sync-code \ ensure everyting generated *************** *** 4749,4753 **** compilation> ( -- xt ) drop localstk if ! postpone _localfree \ to unwind the stack then 0 to localstk \ can have its own locals --- 4731,4735 ---- compilation> ( -- xt ) drop localstk if ! __localfree (copy-code) \ to unwind the stack then 0 to localstk \ can have its own locals *************** *** 5026,5030 **** : loading? ( -- flag ) \ are we loading? ! source-id -1 0 between 0= ; : (message) ( n addr len -- ) --- 5008,5013 ---- : loading? ( -- flag ) \ are we loading? ! \ source-id -1 0 between 0= ; ! source-id 0<> ; : (message) ( n addr len -- ) *************** *** 5587,5596 **** : localalloc ( n1 -- a1 ) \ allocate n1 bytes of return stack (comp-only) compilation> drop ! localstk if \ if not zero, already using locals ! postpone _localallocp \ so use the p form ! else ! postpone _localalloc -1 to localstk \ mark as localalloc ! then ; : localbuff ( -- addr ) \ maxbuffer alloc (260 bytes currently) --- 5570,5578 ---- : localalloc ( n1 -- a1 ) \ allocate n1 bytes of return stack (comp-only) compilation> drop ! localstk 0= if \ if zero, not using locals ! __localsave (copy-code) -1 to localstk \ mark as localalloc ! then ! __localalloc (copy-code) ; : localbuff ( -- addr ) \ maxbuffer alloc (260 bytes currently) |
|
From: Alex M. <ale...@us...> - 2007-07-06 09:01:56
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv10258 Modified Files: gmeta-fkernel.f Log Message: arm: correct executable types reported during meta Index: gmeta-fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gmeta-fkernel.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** gmeta-fkernel.f 22 Mar 2007 02:13:56 -0000 1.3 --- gmeta-fkernel.f 6 Jul 2007 09:01:53 -0000 1.4 *************** *** 85,89 **** .( Build: ) #build# . CR .( Build Image: ) KERN-NAME COUNT TYPE ! .( Type: ) Z" GUI CUI DLL " EXETYPE 1- CELLS+ 4 TYPE [debug] [if] cr .( [DEBUG] generating basic debug) [then] --- 85,89 ---- .( Build: ) #build# . CR .( Build Image: ) KERN-NAME COUNT TYPE ! .( Type: ) Z" GUI DLL CUI " EXETYPE 1- CELLS+ 4 TYPE [debug] [if] cr .( [DEBUG] generating basic debug) [then] |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-05 20:18:30
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26567 Modified Files: ConsoleMenu.f Log Message: Jos: Made ^V visible in the menu. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** ConsoleMenu.f 5 Jul 2007 20:05:53 -0000 1.9 --- ConsoleMenu.f 5 Jul 2007 20:18:27 -0000 1.10 *************** *** 357,361 **** MENUITEM "&Cut and Clear Console \tCtrl+X" cut-console ; MENUITEM "&Copy Highlighted Text \tCtrl+C" copy-console ; ! \ MENUITEM "&Paste to Keyboard \tCtrl+V" paste-load ; MENUSEPARATOR MENUITEM "&Mark all Text \tCtrl+A" mark-all ; --- 357,361 ---- MENUITEM "&Cut and Clear Console \tCtrl+X" cut-console ; MENUITEM "&Copy Highlighted Text \tCtrl+C" copy-console ; ! MENUITEM "&Paste to Keyboard \tCtrl+V" paste-load ; MENUSEPARATOR MENUITEM "&Mark all Text \tCtrl+A" mark-all ; |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-05 20:06:09
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21690 Modified Files: extend.f Log Message: Jos: Enabled ChdirDlg and ^D, Note: When ^D is used the cursor is 2 lines too much UP. I could not solve it. Index: extend.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** extend.f 2 Jun 2007 11:59:32 -0000 1.24 --- extend.f 5 Jul 2007 20:06:05 -0000 1.25 *************** *** 42,45 **** --- 42,46 ---- sys-FLOAD src\words.f + FLOAD src\lib\BROWSEFLD.F \ SHBrowseForFolder() support FLOAD src\console\ConsoleMenu.f |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-05 20:05:57
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21558 Modified Files: ConsoleMenu.f Log Message: Jos: Enabled ChdirDlg and ^D, Note: When ^D is used the cursor is 2 lines too much UP. I could not solve it. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** ConsoleMenu.f 4 Jul 2007 11:23:35 -0000 1.8 --- ConsoleMenu.f 5 Jul 2007 20:05:53 -0000 1.9 *************** *** 218,222 **** IF web$ count conhndl "Web-Link THEN ; ! : ChdirDlg { \ path$ -- } \ set current directory MAXSTRING LocalAlloc: path$ --- 218,222 ---- IF web$ count conhndl "Web-Link THEN ; ! )) : ChdirDlg { \ path$ -- } \ set current directory MAXSTRING LocalAlloc: path$ *************** *** 225,230 **** path$ conhndl BrowseForFolder \in-system-ok if path$ dup +null count "chdir .dir cr ! then ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Function key additions to the keyboard interpreter during commandline entry --- 225,230 ---- path$ conhndl BrowseForFolder \in-system-ok if path$ dup +null count "chdir .dir cr ! then ; ! (( \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Function key additions to the keyboard interpreter during commandline entry *************** *** 279,284 **** if 0= paste-load EXIT then turnkeyed? ?exit ! \ over [ 'D' +k_control ] literal = ! \ if 0= ChdirDlg EXIT then ; --- 279,284 ---- if 0= paste-load EXIT then turnkeyed? ?exit ! over [ 'D' +k_control ] literal = ! if 0= ChdirDlg EXIT then ; *************** *** 316,324 **** MENUITEM "&Load Forth File...\tCtrl+L" load-forth ; - (( - MENUSEPARATOR MENUITEM "Set current directory...\tCtrl+D" ChdirDlg ; ! MENUSEPARATOR MENUITEM "Open a Web link...\tCtrl+W" open-web ; MENUSEPARATOR --- 316,323 ---- MENUITEM "&Load Forth File...\tCtrl+L" load-forth ; MENUSEPARATOR MENUITEM "Set current directory...\tCtrl+D" ChdirDlg ; ! ! (( MENUSEPARATOR MENUITEM "Open a Web link...\tCtrl+W" open-web ; MENUSEPARATOR |
|
From: Tasha G. <bi...@mi...> - 2007-07-05 16:08:58
|
MRMT IS THE TRUE SUPERNOVA MONSTER MOTORS INC - Hires Award-Winning Design Studio for National Branding Television Commercial Ticker: MRMT Trade: July 05 Thursday, 2007 MRMT Price: $0.6 Monday July 2, 9:00 am ET - News Release CHICAGO, IL--(MARKET WIRE)--Jul 2, 2007 Monster Motors, Inc. (Other OTC:MRMT.PK - News) announces a major contract with top Commercial graphic producer Keech Studio for the production of a National advertising spot for Monster Motors, Inc. The Monster Motors commercial ad spot is designed for showing in Major cable television Markets nationwide represented by Viamedia including those markets serviced by Verizon FiOS, RCN, Knology, WOW, Surewest, New Wave, Everest, Grande, Blue Ridge, Service Electric, CATV and Atlantic Broadband. WATCH MRMT SHOOT THROUGH THE SKY THURSDAY! |
|
From: Jos v.d.V. <jo...@us...> - 2007-07-04 11:23:42
|
Update of /cvsroot/win32forth/win32forth-stc/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9283 Modified Files: ConsoleMenu.f Log Message: Jos: Enabled the control-keys: ^A ^C ^V ^L in the console. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/console/ConsoleMenu.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** ConsoleMenu.f 20 May 2007 15:36:21 -0000 1.7 --- ConsoleMenu.f 4 Jul 2007 11:23:35 -0000 1.8 *************** *** 12,15 **** --- 12,88 ---- INTERNAL \ internal definitions start here + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ paste clipboard into the keyboard + \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + 0 value paste-ptr + 0 value paste-len + 0 value paste-off + 0 value paste-hdl + + : macro/paste-close ( -- ) \ turn off macros and paste on error + ['] noop is auto_key \ disable playkey + ['] noop is auto_key? \ disable playkey? + \ PlayClose: key-log-file + paste-hdl 0= ?exit + paste-hdl call GlobalUnlock drop \ unlock it, done + 0 to paste-hdl \ clear handle + Call CloseClipboard ?win-error ; \ close clipboard + + forth-io-chain chain-add macro/paste-close \ turn off paste on error + + : paste1key ( -- ) + x_key? 0= + if paste-off paste-len u< 0= + if macro/paste-close + else paste-ptr paste-off + c@ \ get next key + 1 +to paste-off \ skip paste it + dup 0x0D = \ if its CR + if 1 +to paste-off \ skip LF + then pushkey \ push the key + then + then ; + + 0 value play0cnt + 50 value playrate + + : paste1key? ( f1 -- f1 ) + dup 0= + if play0cnt 1 < + if paste1key + playrate 0max to play0cnt + else -1 +to play0cnt + then + then ; + + : paste-load ( -- ) + \ *G Copy text from the clipboard to the console window and compile it. + conhndl call OpenClipboard 0= + if beep + else CF_TEXT call GetClipboardData ?dup + if dup to paste-hdl + call GlobalLock dup to paste-ptr \ lock memory + 0= if call CloseClipboard drop exit then + paste-ptr zcount nip dup to paste-len \ get len + if 0 to paste-off + 0 to play0cnt + 0x0 pushkey \ kick start playkeys + ['] paste1key is auto_key + ['] paste1key? is auto_key? + paste1key + else beep + 0 to paste-ptr + 0 to paste-len + 0 to paste-off + paste-hdl call GlobalUnlock drop \ unlock it, done + call CloseClipboard ?win-error + then \ cleanup for clipboard + else beep + Call CloseClipboard ?win-error + then + then ; + + \ ' _paste-load is paste-load + : copy-console { \ gblhndl gblptr b/l l/s len -- } \ *G Copy text to Windows clipboard *************** *** 170,177 **** ledit-chain chain-add ?f1-help \ help key recognition : ?macro-keys ( chad flag -- char flag ) dup ?exit ! over [ 'S' +k_control +k_shift ] literal = if 0= start/stop-macro EXIT then over [ 'M' +k_control +k_shift ] literal = --- 243,253 ---- ledit-chain chain-add ?f1-help \ help key recognition + )) : ?macro-keys ( chad flag -- char flag ) dup ?exit ! ! ! (( over [ 'S' +k_control +k_shift ] literal = if 0= start/stop-macro EXIT then over [ 'M' +k_control +k_shift ] literal = *************** *** 184,192 **** if 0= open-web EXIT then over [ K_F12 ] literal = ! if 0= 2>r >r LoadProject r> 2r> EXIT then over [ 'L' +k_control ] literal = if 0= load-forth EXIT then ! over [ 'P' +k_control ] literal = ! if 0= print-screen EXIT then over [ 'X' +k_control ] literal = if 0= cut-console --- 260,270 ---- if 0= open-web EXIT then over [ K_F12 ] literal = ! if 0= 2>r >r LoadProject r> 2r> EXIT then )) ! ! over [ 'L' +k_control ] literal = if 0= load-forth EXIT then ! \ over [ 'P' +k_control ] literal = ! \ if 0= print-screen EXIT then over [ 'X' +k_control ] literal = if 0= cut-console *************** *** 201,210 **** if 0= paste-load EXIT then turnkeyed? ?exit ! over [ 'D' +k_control ] literal = ! if 0= ChdirDlg EXIT then ; ledit-chain chain-add ?macro-keys \ add macro key recognition \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 279,289 ---- if 0= paste-load EXIT then turnkeyed? ?exit ! \ over [ 'D' +k_control ] literal = ! \ if 0= ChdirDlg EXIT then ; ledit-chain chain-add ?macro-keys \ add macro key recognition + (( \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:27:39
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29023 Modified Files: gkernel.exe Log Message: Rod: Added noop-chain-add-before and corrected d- Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 Binary files /tmp/cvsv2IMPE and /tmp/cvsKq3Xax differ |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:26:35
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28642/src/kernel Modified Files: gkernel.f Log Message: Rod: Added noop-chain-add-before and corrected d- Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 *** gkernel.f 27 Jun 2007 07:41:12 -0000 1.39 --- gkernel.f 1 Jul 2007 17:26:31 -0000 1.40 *************** *** 1565,1569 **** mov ecx, 4 [ebp] sub 8 [ebp], edx ! sbb eax, ecx next; --- 1565,1570 ---- mov ecx, 4 [ebp] sub 8 [ebp], edx ! sbb ecx, eax ! mov eax, ecx next; *************** *** 5895,5901 **** r> swap ! ; : chain-add-before ( chain_address -<word_to_add>- ) \ for reverse chains like BYE ' ?sys-chain >r ! here over @ , r> , swap ! ; : do-chain ( chain_address -- ) --- 5896,5909 ---- r> swap ! ; + : noop-chain-add-before ( chain_address -- addr ) \ add chain item, + \ return addr of xt added + here over @ , + swap ! + here ['] noop , ; + : chain-add-before ( chain_address -<word_to_add>- ) \ for reverse chains like BYE ' ?sys-chain >r ! noop-chain-add-before ! r> swap ! ; : do-chain ( chain_address -- ) |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:24:47
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv27875/src/lib Added Files: AcceleratorTables.f Log Message: Rod: Works with STC version but each table requires a dummy name. Used DOES> instead of #DOES> --- NEW FILE: AcceleratorTables.f --- \ $Id: AcceleratorTables.f,v 1.1 2007/07/01 17:24:43 rodoakford Exp $ \ AcceleratorTables.f Windows Accelerator Table support for Win32Forth \ October 2004 Rod Oakford \ *D doc \ *! p-AcceleratorTables \ *T Windows Accelerator Table support \ *P To use Accelerator Tables in an application: \ *P Define the Accelerator Tables required using: AcceleratorTable <name> \ *P Start the entries for each table with: <name> table \ *P Add entries with: ( flags key-code command-id ) AccelEntry \ *P End the table with: ( Window ) HandlesThem \ ** This will add code to process the Accelerator Keys in the message chain. \ *P Use: <name> EnableAccelerators to enable the accelerator commands \ ** and send them to the window used with HandlesThem. \ *P These accelerator commands are handled in the window's OnWmCommand: method. \ *P Use: <name> DisableAccelerators to disable the accelerator commands for this table. \ ** Always disable (destroy) every table before the application closes to prevent memory leaks. \ *S Glossary cr .( Loading Accelerator Tables...) anew -AcceleratorTables.f INTERNAL In-system 0 value CurrentTable \ current named accelerator table EXTERNAL : Dump-Accelerator-Key-Table ( a -- ) \ W32F sys \ *G Dump an Accelerator Table to the console window- \ cr dup BODY> .name ." Table:" \ different in STC cr ." Address Flags Key ID" cell+ 2@ 6 * bounds DO cr i 6 h.R i w@ 5 h.R i 2 + w@ 5 h.R i 4 + w@ 4 h.R 6 +LOOP cr ; : AcceleratorTable ( <name> -- ) \ *G Create a new named Accelerator Table Create here to CurrentTable ( Handle ) 0 , ( AccelEntries ) 0 , ( AccelTable ) here , ; : Table ( a -- ) \ W32F sys \ *G Start a table of entries in the dictionary dup to CurrentTable here 0 rot cell+ 2! ; : AccelEntry ( flags key-code command-id -- ) \ W32F sys \ *G Add a entry to the current table rot 3 ( FVIRTKEY FNOINVERT or ) or w, swap w, w, CurrentTable cell+ 1+! ; In-application \ HandlesThem requires a <name> because DOES> is used rather than #DOES> \ ( #DOES> is not defined in STC version ) \ See the example at the end of this file Sys-warning-off : HandlesThem ( Window <name> -- ) \ W32F \ *G Close a table and assign it to the given window. \ adds the code in DOES> to the message chain \ Changed to add it on the start of the chain instead of the end, because \ accelerator keys bust be handled before any other things happen in the \ message loop, to work correctly (Sonntag, Mai 21 2006 dbu). >in @ create >in ! CurrentTable , ( Window ) , ' msg-chain noop-chain-add-before ! DOES> ( pMsg f pfa -- pMsg f ) 2@ @ swap @ 2>r \ handle of table and handle of Window that will process the commands dup 2r@ * and \ only when accelerators are enabled and Window has a handle IF drop dup 2r@ Call TranslateAccelerator 0= THEN 2r> 2drop ; Sys-warning-on : DisableAccelerators ( a -- ) \ W32F \ *G Destroys the Windows Accelerator Table. \ It does not matter trying to destroy a table more than once. dup @ Call DestroyAcceleratorTable drop off ; : EnableAccelerators ( a -- ) \ W32F \ *G Creates the Windows Accelerator Table. \ It does not matter creating the same table again as long as it is destroyed first. dup DisableAccelerators dup cell+ 2@ swap Call CreateAcceleratorTable swap ! ; MODULE \ --------------------------------------------------------------------------------------------- \s \ *S Example \ *+ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Define some accelerator tables \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ AcceleratorTable FunctionKeys AcceleratorTable CharKeys AcceleratorTable NumKeys \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Define a small window that will receive the accelerator commands \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ :Object TEST <Super Window :M StartSize: 220 50 ;M :M On_Init: ( -- ) NumKeys EnableAccelerators FunctionKeys EnableAccelerators CharKeys EnableAccelerators ;M :M OnWmCommand: ( hwnd msg wparam lparam -- hwnd msg wparam lparam ) over LOWORD ( Command ID ) cr ." Accelerator command ID: " . ;M :M On_Done: ( -- ) NumKeys DisableAccelerators FunctionKeys DisableAccelerators CharKeys DisableAccelerators ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Accelerator table entries \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ NumKeys table \ Flags Key Code Command ID FCONTROL VK_NUMPAD0 0 AccelEntry FCONTROL VK_NUMPAD1 1 AccelEntry FCONTROL VK_NUMPAD2 2 AccelEntry FCONTROL VK_NUMPAD3 3 AccelEntry FCONTROL VK_NUMPAD4 4 AccelEntry FCONTROL VK_NUMPAD5 5 AccelEntry FCONTROL VK_NUMPAD6 6 AccelEntry FCONTROL VK_NUMPAD7 7 AccelEntry FCONTROL VK_NUMPAD8 8 AccelEntry FCONTROL VK_NUMPAD9 9 AccelEntry FCONTROL VK_DECIMAL 16 AccelEntry FCONTROL VK_RETURN 17 AccelEntry FCONTROL VK_ADD 18 AccelEntry FCONTROL VK_SUBTRACT 19 AccelEntry TEST HandlesThem T1 FunctionKeys table \ Flags Key Code Command ID FSHIFT VK_F1 65 AccelEntry FSHIFT VK_F2 66 AccelEntry FSHIFT VK_F3 67 AccelEntry FSHIFT VK_F4 68 AccelEntry TEST HandlesThem T2 CharKeys table \ Flags Key Code Command ID 0 'Z' 129 AccelEntry 0 'X' 130 AccelEntry 0 'C' 131 AccelEntry 0 'V' 132 AccelEntry 0 'B' 133 AccelEntry 0 'N' 134 AccelEntry 0 'M' 135 AccelEntry TEST HandlesThem T3 \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Instructions \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ cr NumKeys Dump-Accelerator-Key-Table FunctionKeys Dump-Accelerator-Key-Table CharKeys Dump-Accelerator-Key-Table start: test cr .( Make sure the test window has the focus.) cr .( Press some of the accelerator keys to see the IDs in the console window.) cr .( In this example NumPad keys need Ctrl [Num Lock needs to be on].) cr .( Function keys work with Shift, Char keys work without Shift, Ctrl or Alt.) cr .( All combinations of Shift, Ctrl, Alt or nothing are possible.) cr .( CharKeys DisableAccelerators will disable the CharKeys accelerators.) cr .( CharKeys EnableAccelerators will enable them again.) cr .( Closing the Test window will disable all the accelerators) \ *- \ *Z |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:22:03
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26728/src/lib Added Files: RecentFiles.f Log Message: Rod: Added, now the same as the ITC version --- NEW FILE: RecentFiles.f --- \ $Id: RecentFiles.f,v 1.1 2007/07/01 17:22:00 rodoakford Exp $ \ RecentFiles.f RecentFiles class by Rod Oakford \ July 2003 \ \ Use when defining menuitems before a MenuSeparator, usually on the File menu e.g. \ POPUP "&File" \ MENUITEM "Page Set&up..." ( word to do Page Setup ) ; \ 9 RECENTFILES RecentFiles ( -- FileName$ ) ( word to open file ) ; \ MENUSEPARATOR \ MENUITEM "E&xit \tAlt-F4" bye ; \ \ 9 RECENTFILES RecentFiles creates an object of the class RECENTFILES with space for 9 menuitems \ You can use the following methods: \ FileName$ Insert: RecentFiles to add FileName to the top of the list and push the others down \ Number SetNumber: RecentFiles to set the max number of Files shown in the list (max 9 in this case) \ nth GetRecentFile: RecentFiles to get the nth FileName$ in the list cr .( Loading RecentFiles class...) INTERNAL :Class RECENTFILES <Super MENUITEMS int mfunc \ the menu function int AllocatedFiles \ Maximum number of recent files allocated for int MaxFiles \ Largest number of recent files saved on file menu int NumberOfFiles \ Menu separator is removed if no recent files int FirstPos \ Pos of first recent file on file menu : WithoutFileNumber ( text$ -- text$ ) dup c@ 3 - 0 max >r 3 + r> over c! ; :M DoMenu: { ID \ Text$ -- } ID mid mid MaxFiles + within IF MAXSTRING LocalAlloc: Text$ MF_BYCOMMAND MAXSTRING Text$ 1+ ID popid Call GetMenuString Text$ c! Text$ WithoutFileNumber mfunc execute-menufunc THEN ;M :M ClassInit: ( n -- ) \ allot n menu IDs to recent files dup to AllocatedFiles to MaxFiles ClassInit: Super \In-system-OK :noname to mfunc !csp AllocatedFiles 1- +to IDcounter ;M :M LoadMenu: ( pid parent -- ) \ don't add anything to menu to parent to popid popid Call GetMenuItemCount 1+ to FirstPos 0 to NumberOfFiles ;M int ID int Pos :M Reset: { \ Text$ -- } \ Numbers recent files and deletes any more than allowed NumberOfFiles \ There must be a menu separator before any further menu items IF MAXSTRING LocalAlloc: Text$ FirstPos to Pos BEGIN MF_BYPOSITION MAXSTRING Text$ 1+ Pos popid Call GetMenuString dup Text$ c! WHILE Pos FirstPos MaxFiles + < IF Pos FirstPos - 49 + Text$ 2 + c! Text$ 1+ mid Pos + FirstPos - MF_BYPOSITION Pos popid Call ModifyMenu drop 1 +to Pos ELSE MF_BYPOSITION Pos popid Call DeleteMenu drop -1 +to NumberOfFiles THEN REPEAT MF_BYPOSITION MAXSTRING Text$ 1+ FirstPos popid Call GetMenuString 0= IF \ Remove second separator if no recent files MF_BYPOSITION FirstPos 1- popid Call DeleteMenu drop THEN THEN ;M :M Insert: { FileName$ \ MenuText$ Text$ -- } FileName$ c@ IF MAXSTRING LocalAlloc: MenuText$ s" &1 " MenuText$ place FileName$ count MenuText$ +place MenuText$ +NULL MAXSTRING LocalAlloc: Text$ NumberOfFiles 0= IF \ Insert second separator if no recent files 0 0 MF_BYPOSITION MF_SEPARATOR or FirstPos 1- popid Call InsertMenu drop THEN mid to ID BEGIN MF_BYCOMMAND MAXSTRING Text$ 1+ ID popid Call GetMenuString Text$ c! Text$ WithoutFileNumber count FileName$ count CAPS-COMPARE IF -1 ELSE MF_BYCOMMAND ID popid Call DeleteMenu drop -1 +to NumberOfFiles 0 THEN ID mid MaxFiles 1- + < and \ Text$ contains menutext of last recent file WHILE \ or menutext of matched file 1 +to ID \ or 0 if last Pos is empty and no match REPEAT \ insert filename with ID of match or last recent file MenuText$ 1+ ID MF_BYPOSITION FirstPos popid Call InsertMenu drop 1 +to NumberOfFiles Reset: self THEN ;M :M SetNumber: ( n -- ) AllocatedFiles min to MaxFiles Reset: self ;M :M GetRecentFile: { Index -- FileName$ } Index 1 NumberOfFiles between IF MF_BYPOSITION MAXSTRING temp$ 1+ Index FirstPos + 1- popid Call GetMenuString ELSE 0 THEN temp$ c! temp$ WithoutFileNumber ;M ;Class MODULE |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:20:29
|
Update of /cvsroot/win32forth/win32forth-stc/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv26313/src/lib Added Files: RegistrySupport.f Log Message: Rod: Added exactly the same as ITC version --- NEW FILE: RegistrySupport.f --- \ $Id: RegistrySupport.f,v 1.1 2007/07/01 17:20:25 rodoakford Exp $ \ RegistrySupport.f Extensions to the words in Registry.f by Rod Oakford \ July 20th, 2004 Works in v6.09.xx and later \ SetRegistryValue and GetRegistryValue are like \ RegSetString and RegGetString except that they take \ an extra parameter RegType. For REG_DWORD the integer value \ is returned and the length is 4. For REG_BINARY and REG_SZ \ address and length are returned. The registry key no longer \ includes "Settings" but any key name can be set in progreg. \ Values are set in the key HKEY_CURRENT_USER\Software\<progreg> \ Words are also included to save and restore sets of registry entries. \ A registry entry requires: \ Address, Length, DefaultAddress, DefaultLength, Reg Type and Reg Value Name \ For REG_DWORD length is omitted and default value is just an integer. \ For REG_SZ the address of a counted string and the max length that \ will be returned (to prevent a buffer overrun) are needed in address, \ the default value needs address and length. \ For REG_BINARY address and length are needed for both address and default. \ Please see the example at the end of this file. \ The address of Height, Width, OriginX, and OriginY in an object derived \ from class Window are 12, 16, 20 and 24 bytes offset from the object address. \ The address of the integer stored in a "value" is ' <value> 4 + cr .( Loading Registry Support...) INTERNAL [UNDEFINED] Messagebox [IF] \ must not be MessageBox in v6.09.08 or Windows procedure is found : MessageBox ( szText szTitle style hOwnerWindow -- result ) >r -rot swap r> Call MessageBox ; [THEN] 0 value RegistryTable \ address of current registry table in dictionary 0 value CurrentSet \ address of data in current registry entries set 0 value RegEntries \ number of registry entries in current set 0 value CurrentRegEntry \ index of registry entry in registry table 50 value MaxLength \ the maximum length of a ValueName incl null (clipped if longer) \ 50 makes a reg entry 64 bytes long ( 50 + count + 13 ) : RegistryTableEntry ( n -- a ) RegistryTable CurrentRegEntry MaxLength 14 + * + + MaxLength + ; : ValueName ( -- a n ) MaxLength negate RegistryTableEntry count ; : RegistryType ( -- n ) 1 RegistryTableEntry c@ ; : DefaultLength ( -- n ) 2 RegistryTableEntry w@ ; : DefaultAddress ( -- a ) 4 RegistryTableEntry @ ; : Length ( -- n ) 8 RegistryTableEntry w@ ; : Address ( -- a ) 10 RegistryTableEntry @ ; : UpdateAddress ( a n -- ) RegistryType Case REG_DWORD of drop Address ! endof REG_BINARY of drop Address Length move endof ( REG_SZ default ) -rot Length min Address place EndCase ; : SetCurrentRegSet ( a -- ) dup to CurrentSet dup @ to RegEntries cell+ dup @ to RegistryTable cell+ count progreg place ; EXTERNAL : SetRegistryValue { a1 n1 a2 n2 RegType \ khdl -- } \ a1,n1=value string, a2,n2=key string 0 0 RegGetKey to khdl \ no s" settings", include in progreg if needed khdl -1 = IF EXIT THEN \ just return, ignore error a1 n1 asciiz \ null-terminate value string RegType REG_SZ = IF 1 +to n1 THEN \ include null in count for REG_SZ n1 swap RegType 0 a2 2dup n2 + c! \ null-terminate key string khdl Call RegSetValueEx drop khdl Call RegCloseKey drop ; : GetRegistryValue ( a1 n1 RegType -- a2 n2 ) \ a1,n1=key string, a2,n2=value string >r 0 0 RegGetString \ n2=0 if key not found RegType @ Case REG_DWORD of drop @ RegLen @ endof \ for REG_DWORD a2=the value, n2=4 REG_BINARY of drop RegLen @ endof \ no extra 0 in length ( REG_SZ default ) EndCase dup r> RegType @ = not and IF \ RegType not as requested and n2>0 z" Registry type different" z" GetRegistrySetting" MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop THEN ; : RegistrySet ( a n <name> -- ) \ creates a new named registry entries set Create here >r ( RegEntries ) 0 , ( RegistryTable ) 0 , ( s" KeyName" ) dup c, Z", here r@ cell+ ! r> SetCurrentRegSet Does> ( -- ) SetCurrentRegSet ; : Entries ( -- ) here CurrentSet cell+ ! 0 to RegEntries ; : RegEntry ( Address a [n] Default a [n] RegistryType n <"RegValueName"> -- ) MaxLength here ,"Text" dup c@ MaxLength min over c! \ clip RegValueName to MaxLength characters incl null here - + 1+ allot \ allot for counted string and null (MaxLength 1+) dup c, REG_DWORD = IF 4 swap 4 THEN w, , w, , 1 +to RegEntries ; : EndEntries ( -- ) RegEntries CurrentSet ! ; : SaveSettings ( -- ) RegEntries 0 ?DO i to CurrentRegEntry Address Length RegistryType REG_SZ = IF drop count THEN ValueName RegistryType SetRegistryValue LOOP ; : DefaultSettings ( -- ) RegEntries 0 ?DO i to CurrentRegEntry DefaultAddress DefaultLength UpdateAddress LOOP ; : RestoreSettings ( -- ) RegEntries 0 ?DO i to CurrentRegEntry ValueName RegistryType GetRegistryValue RegType @ REG_SZ REG_DWORD between over or 0= IF 2drop DefaultAddress DefaultLength THEN UpdateAddress LOOP ; : DeleteKey ( -- ) \ deletes key HKEY_CURRENT_USER\Software\<progreg> basereg count pad place \ Software\ progreg count pad +place \ user defined key pad count asciiz HKEY_CURRENT_USER Call RegDeleteKey IF s" Unable to delete " pad place progreg count pad +place pad count asciiz z" DeleteKey" MB_ICONEXCLAMATION MB_OK or NULL MessageBox drop THEN ; MODULE \s \ RegistryExample \ An example on how to save Window and other settings in the registry by Rod Oakford \ Fload this file, resize the window, close the window, window settings are saved. \ 1. Near the beginning of an application define some sets of registry entries that \ you will want to save and restore e.g. \ s" MyName\MyApp\WindowPlacement" RegistrySet WindowSettings \ These sets are initially empty but contain the registry key name. This is placed \ in progreg when the "RegSetName" e.g. WindowSettings is executed and values are saved \ (or restored) in the key HKEY_CURRENT_USER\Software\<progreg> \ 2. Near the end of the application add specific entries to these sets then SaveSettings, \ DefaultSettings and RestoreSettings will work. \ A registry entry contains an address of the bytes to save, a default value which \ will be used if the key is not found, the type of registry entry (REG_DWORD, REG_BINARY \ or REG_SZ) and the name of the registry setting value. A set of registry enties is \ stored in a Registry table in the dictionary which is selected when "RegSetName" is \ executed. \ NOTE if you set a menu with MyMenu SetMenuBar: self you must also \ override the late bound method WindowHasMenu: to return TRUE \ otherwise the start size of the window will be wrong. Even so \ the height will still be wrong if the menu wraps to two or more rows. \ (AdjustWindowRect does not take this into account) \ It is better to use MyMenu to CurrentMenu in ClassInit: \ otherwise you are setting the default menu then replacing it. \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ **********EXAMPLE********** \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Needs RegistrySupport \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Define two registry sets \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ s" MyName\MyApp\Window" RegistrySet WindowSettings s" MyName\MyApp\Options" RegistrySet Options \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Define a simple window \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 0 value WindowState :Object Frame <Super Window :M ClassInit: ClassInit: super \ MyMenu to CurrentMenu ;M :M WindowHasMenu: ( -- f ) True ;M \ default menu will be displayed if another is not set :M On_Size: ( h m w -- h m w ) dup to WindowState \ get WindowState, don't save size of maximised or minimised window ;M :M On_Done: MenuHandle: CurrentMenu Call DestroyMenu drop \ need to destroy menu in v6.09 ZeroMenu: CurrentMenu \ otherwise window won't open again On_Done: super WindowState SIZE_RESTORED = IF WindowSettings SaveSettings THEN Options SaveSettings ;M ;Object \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Some other values to save and restore \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ Create Title ," Window Title" \ limited later to 9 characters in Options entries Create DefTitle ," Default" Create BinaryData -1 , -1 , Create DefaultBin 1 c, 2 c, 3 c, 4 c, 5 c, 6 c, 7 c, 8 c, False value Toolbar? \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Registry settings \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ WindowSettings entries \ Address Length Default Value Reg Type Reg Value Name Frame 12 + ( 4 ) 300 REG_DWORD RegEntry "WindowWidth" Frame 16 + 200 REG_DWORD RegEntry "WindowHeight" Frame 20 + 100 REG_DWORD RegEntry "WindowLeft" Frame 24 + 100 REG_DWORD RegEntry "WindowTop" EndEntries Options entries \ Address Length Default Value Reg Type Reg Value Name ' Toolbar? 4 + ( 4 ) True REG_DWORD RegEntry "Toolbar?" Title 9 DefTitle count REG_SZ RegEntry "Title" BinaryData 8 DefaultBin 8 REG_BINARY RegEntry "BinaryData" EndEntries : go WindowSettings RestoreSettings Start: frame Title count SetText: frame ; go \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Other testing words \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ : Close ( -- ) Close: frame ; : ShowData ( -- ) cr ." Window: " Frame 12 + ? Frame 16 + ? Frame 20 + ? Frame 24 + ? cr ." Title: " Title count type cr ." Binary: " BinaryData 8 0 DO dup i + c@ . LOOP drop cr ." Toolbar: " Toolbar? IF ." True" ELSE ." False" THEN ; : Open ( -- ) WindowSettings RestoreSettings Options RestoreSettings Start: frame Title count SetText: frame ShowData ; : Default ( -- ) WindowSettings DefaultSettings Options DefaultSettings Start: frame Title count SetText: frame ShowData ; : S1 ( -- ) WindowSettings SaveSettings ; : S2 ( -- ) Options SaveSettings ; : N1 ( -- ) BinaryData 8 erase s" New Title" Title place false to Toolbar? S2 open ; : N2 ( -- ) BinaryData 8 -1 fill s" Old Title" Title place true to Toolbar? S2 open ; : D1 ( -- ) WindowSettings DeleteKey ; : D2 ( -- ) Options DeleteKey ; comment: DeleteKey should be fairly safe as it will not delete keys containing subkeys. To delete MyName from the registry entirely delete Window, Options then MyApp first: s" MyName" RegistrySet MyName s" MyName\MyApp" RegistrySet MyApp WindowSettings DeleteKey Options DeleteKey MyApp DeleteKey MyName DeleteKey comment; |
|
From: Rod O. <rod...@us...> - 2007-07-01 17:16:32
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv24736/src/lib Modified Files: RecentFiles.f Log Message: Rod: Modified slightly to be compatible with STC version Index: RecentFiles.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/RecentFiles.f,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** RecentFiles.f 2 Oct 2005 09:07:36 -0000 1.1 --- RecentFiles.f 1 Jul 2007 17:16:27 -0000 1.2 *************** *** 44,49 **** dup to AllocatedFiles to MaxFiles ClassInit: Super ! here to mfunc ! hide !csp docol , ] AllocatedFiles 1- +to IDcounter ;M --- 44,48 ---- dup to AllocatedFiles to MaxFiles ClassInit: Super ! \In-system-OK :noname to mfunc !csp AllocatedFiles 1- +to IDcounter ;M |
|
From: Bradford L. <plo...@va...> - 2007-07-01 03:43:52
|
Price for 50mg x 10 pills $6.00 per pill http://simplethan.hk |
|
From: George H. <geo...@us...> - 2007-06-27 07:41:16
|
Update of /cvsroot/win32forth/win32forth-stc In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20682/win32forth-stc Modified Files: gkernel.exe Log Message: gah: modified words with local structures to use localalloc: Modified winpause to work with noconsole code and multi-tasking Index: gkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 Binary files /tmp/cvsYT73p0 and /tmp/cvsUqrx0X differ |
|
From: George H. <geo...@us...> - 2007-06-27 07:41:16
|
Update of /cvsroot/win32forth/win32forth-stc/src/kernel In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20682/win32forth-stc/src/kernel Modified Files: gkernel.f Log Message: gah: modified words with local structures to use localalloc: Modified winpause to work with noconsole code and multi-tasking Index: gkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v retrieving revision 1.38 retrieving revision 1.39 diff -C2 -d -r1.38 -r1.39 *** gkernel.f 13 May 2007 21:39:27 -0000 1.38 --- gkernel.f 27 Jun 2007 07:41:12 -0000 1.39 *************** *** 3122,3126 **** \ and the keyboard i/o \ f1=false if already inited ! STD_OUTPUT_HANDLE call GetStdHandle to stdout STD_INPUT_HANDLE call GetStdHandle to stdin --- 3122,3126 ---- \ and the keyboard i/o \ f1=false if already inited ! STD_OUTPUT_HANDLE call GetStdHandle to stdout STD_INPUT_HANDLE call GetStdHandle to stdin *************** *** 5062,5067 **** 1 PROC Sleep ! : winpause ( -- ) \ release control to OS, pump message loop (in wrapper) ! key? drop ; \ note: reset-stacks shouldn't be redefined in an application. --- 5062,5068 ---- 1 PROC Sleep ! defer winpause ( -- ) \ release control to OS, pump message loop (in wrapper) ! ! |: _winpause key? drop ; ' _winpause is winpause \ note: reset-stacks shouldn't be redefined in an application. |
|
From: George H. <geo...@us...> - 2007-06-27 07:41:16
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20682/win32forth-stc/src Modified Files: GENERIC.F Menu.f callback.f Log Message: gah: modified words with local structures to use localalloc: Modified winpause to work with noconsole code and multi-tasking Index: callback.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/callback.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** callback.f 6 Oct 2006 15:42:27 -0000 1.3 --- callback.f 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 118,122 **** defer DefaultWindowProc ' _DefaultWindowProc is DefaultWindowProc ! 1 callback: HandleMessages { pMsg -- 0 } pMsg TRUE msg-chain do-chain nip if pMsg Call TranslateMessage drop --- 118,122 ---- defer DefaultWindowProc ' _DefaultWindowProc is DefaultWindowProc ! : HandleMessages { pMsg -- 0 } pMsg TRUE msg-chain do-chain nip if pMsg Call TranslateMessage drop *************** *** 124,127 **** --- 124,142 ---- then 0 ; + \ ************************************************************************* + \ A definition of WINPAUSE that doesn't need the console window. + \ ************************************************************************* + + 5 proc PeekMessage + \ + :Noname ( -- ) + { | pMsg -- } + 7 cells LocalAlloc: pMsg + BEGIN PM_REMOVE 0 0 0 pMsg Call PeekMessage + WHILE pMsg HandleMessages drop + REPEAT ; is WINPAUSE + + 1 callback: _HandleMessages ( pMsg -- 0 ) HandleMessages ; + 4 callback: HandleWindowsMessages { lParam wParam msg hwnd -- flag } msg WM_WIN32FORTH = *************** *** 139,143 **** : HandleMessages-init ( -- ) ! ['] HandleMessages &CB-MSG ! ['] HandleWindowsMessages &CB-WINMSG ! ['] byebye &CB-BYE ! --- 154,158 ---- : HandleMessages-init ( -- ) ! ['] _HandleMessages &CB-MSG ! ['] HandleWindowsMessages &CB-WINMSG ! ['] byebye &CB-BYE ! Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/GENERIC.F,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** GENERIC.F 22 May 2007 07:36:20 -0000 1.3 --- GENERIC.F 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 58,65 **** : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint.x CursorPoint.y -- x y } ! &of CursorPoint.x Call GetCursorPos drop ! &of CursorPoint.x hWnd Call ScreenToClient drop ! CursorPoint.x CursorPoint.y ; in-system --- 58,66 ---- : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint -- x y } ! 2 cells localalloc: CursorPoint ! CursorPoint Call GetCursorPos drop ! CursorPoint hWnd Call ScreenToClient drop ! CursorPoint 2@ swap ; in-system Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/Menu.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** Menu.f 8 May 2007 08:34:39 -0000 1.3 --- Menu.f 27 Jun 2007 07:41:12 -0000 1.4 *************** *** 153,162 **** ;M ! :M Track: { x y win-handle -- } hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! &of x \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop --- 153,163 ---- ;M ! :M Track: { win-handle | point -- } ! 2 cells localalloc: point swap point 2! hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! point \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop *************** *** 164,169 **** win-handle 0 ! y \ recover absolute screen coordinates ! x [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> --- 165,169 ---- win-handle 0 ! point 2@ \ recover absolute screen coordinates [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> |
|
From: George H. <geo...@us...> - 2007-06-27 07:31:21
|
Update of /cvsroot/win32forth/win32forth/src/console In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16865/win32forth/src/console Modified Files: NoConsole.f Log Message: gah: modified words with local structures to use localalloc: Index: NoConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NoConsole.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** NoConsole.f 24 Sep 2006 08:17:27 -0000 1.6 --- NoConsole.f 27 Jun 2007 07:31:16 -0000 1.7 *************** *** 35,41 **** \ ** Use this instead of: \i BEGIN KEY DROP AGAIN \d. \n \ ** Also needs to be used by tasks that start their own windows. ! { \ hwnd mess wparm lparm time pt.x pt.y -- } ! Begin 0 0 0 &of hwnd call GetMessage ! While &of hwnd handlemessages drop Repeat ; --- 35,42 ---- \ ** Use this instead of: \i BEGIN KEY DROP AGAIN \d. \n \ ** Also needs to be used by tasks that start their own windows. ! { | pMsg -- } ! 7 cells LocalAlloc: pMsg ! Begin 0 0 0 pMsg call GetMessage ! While pMsg handlemessages drop Repeat ; |
|
From: George H. <geo...@us...> - 2007-06-27 07:31:21
|
Update of /cvsroot/win32forth/win32forth/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16865/win32forth/src Modified Files: CALLBACK.f GENERIC.F Menu.f Log Message: gah: modified words with local structures to use localalloc: Index: CALLBACK.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/CALLBACK.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** CALLBACK.f 17 May 2007 11:10:21 -0000 1.10 --- CALLBACK.f 27 Jun 2007 07:31:16 -0000 1.11 *************** *** 342,348 **** 5 proc PeekMessage :Noname ( -- ) ! { \ hwnd mess wparm lparm time pt.x pt.y -- } ! BEGIN PM_REMOVE 0 0 0 &of hwnd Call PeekMessage ! WHILE &of hwnd HandleMessages drop REPEAT ; is WINPAUSE --- 342,349 ---- 5 proc PeekMessage :Noname ( -- ) ! { | pMsg -- } ! 7 cells LocalAlloc: pMsg ! BEGIN PM_REMOVE 0 0 0 pMsg Call PeekMessage ! WHILE pMsg HandleMessages drop REPEAT ; is WINPAUSE Index: Menu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Menu.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Menu.f 28 Apr 2007 10:12:49 -0000 1.5 --- Menu.f 27 Jun 2007 07:31:16 -0000 1.6 *************** *** 153,162 **** ;M ! :M Track: { x y win-handle -- } hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! &of x \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop --- 153,163 ---- ;M ! :M Track: { win-handle | point -- } ! 2 cells localalloc: point swap point 2! hmenu -1 <> if 0 hmenu Call GetSubMenu >r ! point \ ClientToScreen begin here win-handle \ convert relative to absolute coords Call ClientToScreen drop *************** *** 164,169 **** win-handle 0 ! y \ recover absolute screen coordinates ! x [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> --- 165,169 ---- win-handle 0 ! point 2@ \ recover absolute screen coordinates [ TPM_LEFTALIGN TPM_RIGHTBUTTON or ] literal r> Index: GENERIC.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** GENERIC.F 22 May 2007 07:44:39 -0000 1.17 --- GENERIC.F 27 Jun 2007 07:31:16 -0000 1.18 *************** *** 58,65 **** : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint.x CursorPoint.y -- x y } ! &of CursorPoint.x Call GetCursorPos drop ! &of CursorPoint.x hWnd Call ScreenToClient drop ! CursorPoint.x CursorPoint.y ; in-system --- 58,66 ---- : get-mouse-xy ( hWnd -- x y) \ W32F \ *G Return the co-ordinates of the mouse pointer in window, hWnd. ! { hWnd | CursorPoint -- x y } ! 2 cells localalloc: CursorPoint ! CursorPoint Call GetCursorPos drop ! CursorPoint hWnd Call ScreenToClient drop ! CursorPoint 2@ swap ; in-system |
|
From: George H. <geo...@us...> - 2007-06-27 07:31:21
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16865/win32forth/src/lib Modified Files: MessageLoop.f Log Message: gah: modified words with local structures to use localalloc: Index: MessageLoop.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/MessageLoop.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 Binary files /tmp/cvsojas7p and /tmp/cvspVb1Ds differ |
1040 messages has been excluded from this view by a project administrator.
