win32forth-cvs — CVS Commit List

[Win32forth-cvs] Fw: Thanks for your recent refinance debt request, we are ready to give you a loan

[Herbert L. <jel...@au...>]

Your credit does not matter to us!

If you OWN property and want IMMEDIATE pin money to spend ANY way you =
like, or simply require to LOWER your entire payment by a third or more, =
here is our best deal we can offer you THIS NIGHT (hurry, this deal will =
expire THIS EVENING):

$221,000+ debt

AND EVEN MORE: After further review, our lenders have set the lowest =
current payments!

Hurry, when the deal is gone, it is gone. Simply complete this =
one-minute form... 

Don't worry about approval, your your credit report will not disqualify =
you!

http://whoodiasir.com/

[Win32forth-cvs] collocation belate conclude

[Pat G. <hnd...@az...>]

bellini cannon  brewster blindfold.  coney bock aggregate auctioneer  cud directrices.  abolish ali 
besiege  abusive  bagatelle coventry   borax  atreus coat.   ballard  consonant admitting  bimini acton  decorum    deviant.

[Win32forth-cvs] We like to call them Quick Shots.

[Armstrong M. <zh...@on...>]

SREA Jumps 25% After News Releases!

Score One Inc.
SREA
$0.25 UP 25%

SREA announced its plan to develop a $75 Million project duplicates a
successful plan in 2006 than returned over $100 million in profits.
Investors are getting in fast. Read the news and get all over SREA
Tuesday!

that's tomorrow if you are checking.

We look forward to your comments and suggestions. no go secure that
hill.

And like the companies themselves, it's clear that the company that
seems COOLER is the one with the cooler nerd. Two of the paper towel
dispensers appear to differ only in color. Now if it was James
VanDeerBeek. The MSNBC article cites online policies as exempting the
airlines from customer tantrums, so  I wanted to see how easy this
information was to find on the web site.

Maybe this guy was upset with the Wendy's Kids menu?

He goes up against Willy Wonka himself Gene Wilder. "Motorized" turned
out to be the wrong word.

To get there from the home page, you need merely realize that the Help
link isn't just help for the web site.
That way madness lies, especially considering the lawsuits filed by
several sites to prevent "deep linking". One of the features of
HammRadio.
The enMotion line was prominently featured, but neither the photograph
of the dispenser nor the enMotion logo was a link.
My guess is that it's simply to be different from the square shape of
the checkbox, but there's probably some other detail that I'm missing.
Like Britney Spears parents.

I don't think so, or I wouldn't be looking at an error message, seeing
as Opera is in the top four browsers.

These nerds don't seem to like each other much.

I can't argue that a hobbyist weathering a flash crowd might be hit with
some bandwidth overage charges. You'd think they'd've put more thought
into the last paragraph on the error page: CVS. In the mean time, here's
an interesting game about the Sopranos from HBO. Bill Simmons makes a
Kobe Trade workHe's right.

Oh you better believe it. A far simpler candidate, though, would be to
reduce the file size. The web is possibly the first medium whose
distribution costs are determined by the size of the audience, but with
no upper bound on audience size.
com is committed to your satisfaction, and we want you to have a
pleasant and secure shopping experience with us. We like to call them
Quick Shots.
When you pushed in the button for the first preset, all of the other
preset buttons would pop out.

[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdToolbar.f, 1.10, 1.11

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv6272

Modified Files:
	EdToolbar.f 
Log Message:
Minor change to the "view source for"  routine to allow searching all vocabs. EAB

Index: EdToolbar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdToolbar.f,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** EdToolbar.f	3 Feb 2007 11:02:53 -0000	1.10
--- EdToolbar.f	17 Jun 2007 05:24:10 -0000	1.11
***************
*** 352,364 ****
  
  : ?viewsource    { addr cnt -- }
!                 addr cnt "CLIP" pad place        \ save string in find buffer
!                 pad caps-find
! 		            if
  \in-system-ok         get-viewfile
! 		                  if       count $browse
!                       else	    2drop
! 		                  then     addr cnt InsertString: helpbox	\ save help string as entered
!                else	  drop beep
! 		           then   ;
  
  \ copied from WinED
--- 352,363 ----
  
  : ?viewsource    { addr cnt -- }
!                 addr cnt "CLIP" "anyfind 	\ find it if it exist		\
! 	        if
  \in-system-ok         get-viewfile
! 		      if       count $browse
!                       else     2drop
! 		      then     addr cnt InsertString: helpbox	\ save help string as entered
!                else   drop beep
! 	       then   ;
  
  \ copied from WinED

[Win32forth-cvs] win32forth-stc/src Utils.f,1.7,1.8

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv9470/win32forth-stc/src

Modified Files:
	Utils.f 
Log Message:
gah: updated .platform for vista

Index: Utils.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Utils.f,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Utils.f	20 May 2007 15:53:23 -0000	1.7
--- Utils.f	14 Jun 2007 08:19:22 -0000	1.8
***************
*** 73,76 ****
--- 73,77 ----
                   WINXP     of ." XP" endof
                   WIN2003   of ." 2003" endof
+                  WINVISTA  of ." VISTA" endof
                  endcase ;
  

[Win32forth-cvs] win32forth/src Utils.f,1.15,1.16

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8711/win32forth/src

Modified Files:
	Utils.f 
Log Message:
gah: updated .platform for vista

Index: Utils.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** Utils.f	6 Feb 2007 11:31:32 -0000	1.15
--- Utils.f	14 Jun 2007 08:17:35 -0000	1.16
***************
*** 63,66 ****
--- 63,67 ----
                   WINXP     of ." XP" endof
                   WIN2003   of ." 2003" endof
+                  WINVISTA  of ." VISTA" endof
                  endcase ;
  

[Win32forth-cvs] win32forth/apps/Internet/WebServer WebServer.F, 1.1, 1.2

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet/WebServer
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28259/apps/Internet/WebServer

Modified Files:
	WebServer.F 
Log Message:
Made the WebServer a turnkey application.

Index: WebServer.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Internet/WebServer/WebServer.F,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** WebServer.F	13 Jun 2007 13:00:44 -0000	1.1
--- WebServer.F	13 Jun 2007 17:38:15 -0000	1.2
***************
*** 2,16 ****
  \ Tom Dixon
  
  needs http
  needs httpecho
  needs httpmime
  needs httpfile
  
- \ Setup Server
  80 httpserver http
! http setup-http
! http serv-init
  
! \ Run the Server
! : www-server begin http serv-poll 10 ms key? until ;
  
--- 2,103 ----
  \ Tom Dixon
  
+ anew -WebServer.f
+ 
+ true value create-turnkey? \ set to false when you don't want a turnkey app
+ 
  needs http
  needs httpecho
  needs httpmime
  needs httpfile
+ needs browsefld
  
  80 httpserver http
! \ *G our http-server instance
  
! : server-set-title ( -- )
! \ *G set title of the console window
!     Z" Win32Forth - HTTP Web Server" conHndl call SetWindowText drop ;
! 
! s" doc\" Prepend<home>\ webpath place
! \ *G the path to the web content
! 
! : server-choose-path   { \ $path -- }
! \ *G chosse the path for the folder with the web content
!     z" Choose the web content folder."
!     MAXSTRING LocalAlloc: $path webpath count $path place
!     $path conHndl BrowseForFolder
!     if   $path count webpath place
!          webpath ?+\
!     then ;
! 
! : server-init   ( -- )
! \ *G init the server
!     http setup-http http serv-init ;
! 
! : server-run    ( -- )
! \ *G run the server
!     begin http serv-poll 10 ms key? until ;
! 
! : server-exit   ( -- )
! \ *G close the server
!     http serv-close
! 
!     create-turnkey?
!     if   bye
!     else cr ." Type 'www-server <cr>' to restart the server."
!     then ;
! 
! : www-server
! \ *G main
!     server-set-title
! 
!     cls ." The Win32Forth HTTP Web Server is running." cr
! 
!     server-choose-path
! 
!     cr ." webpath = " webpath count type cr
!     cr ." Press any key to stop the server."
! 
!     server-init
!     server-run
!     server-exit
!     ;
! 
! \ create a turnkey application
! create-turnkey? [IF]
! 
! also hidden
! 
! : www-server-hello ( -- )  \ startup stuff
! 
!         \ default initialization (needed for all turnkey apps)
!         init-console
!         if initialization-chain do-chain then
!         exception@ if bye then
! 
!         \ our own initialization
!         menu-off                        \ close menubar
!         ['] _interpret is interpret     \ close the statusbar
!         Destroy: ConsoleStatusbar
!         init-screen                     \ show console
! 
!         get-commandline       \ copy commandline to SOURCE
!         default-application   \ and run our app
! ;
! 
! previous
! 
! \ override default-hello with our own one
! ' www-server-hello is default-hello
! 
! \ and create the application
! &forthdir count &appdir place
! 0 0 ' www-server APPLICATION WebServer.exe
! 1 pause-seconds bye
! 
! [else]
! 
! www-server
! 
! [then]
  

[Win32forth-cvs] win32forth/apps/WebServer - New directory

[Dirk B. <db...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/WebServer
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv8337/WebServer

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/WebServer added to the repository

[Win32forth-cvs] win32forth/apps/Internet iRipper.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14491

Added Files:
	iRipper.f 
Log Message:
Jos: iRipper enables you to copy files from the internet to your local PC using a script.

--- NEW FILE: iRipper.f ---
anew iRipper.f  \ Copies files from the internet.

INTERNAL WinLibrary URLMON.DLL  EXTERNAL PREVIOUS

string: CollectFile$    s" 20070613.htm" CollectFile$ place

: $CreateFile ( Filename$ - fid )
    count r/w create-file abort" Can't create file" ;

: CreateCollectFile  ( - )
    CollectFile$ $createFile  close-file abort" close error"  ;

: UrlDownloadToFile ( z"url" - )
    CollectFile$ count drop swap 0 0 2swap  0 call URLDownloadToFile drop ;

create site$ LMAXCOUNTED allot
create long$ LMAXCOUNTED allot

: .long$ ( - )   cr long$ lcount 100 min type   ;

\ Rip will copy the specified file from the internet to the current
\ directory using the same name.

: rip ( name-file cnt -)
    2dup
    current-dir$ count CollectFile$ place s" \"  CollectFile$ +place
    CollectFile$ +place  CreateCollectFile
    site$  lcount long$ lplace
    long$ +lplace
    long$ +LNULL .long$
    long$ lcount drop UrlDownloadToFile
 ;

\ SetSite: To target the internetsite. It must end with a "/" !
: SetSite ( adr count - )  site$  lplace  ;

\s Disable this line to run the demo.

\ It will copy Forth Dimensions from http://www.forth.org/fd/contents.html
\ That might take some time

s" http://www.forth.org/fd/" SetSite
\ chdir F:\Development\FORTH\4th_dimensions \ Sets the target directory on the local PC

cr cr .date space .time

 s" FD-V01N1.pdf" rip
 s" FD-V01N2.pdf" rip
 s" FD-V01N3.pdf" rip
 s" FD-V01N4.pdf" rip
 s" FD-V01N5.pdf" rip
 s" FD-V01N6.pdf" rip

 s" FD-V02N1.pdf" rip
 s" FD-V02N2.pdf" rip
 s" FD-V02N3.pdf" rip
 s" FD-V02N4.pdf" rip
 s" FD-V02N5.pdf" rip
 s" FD-V02N6.pdf" rip

 s" FD-V03N1.pdf" rip
 s" FD-V03N2.pdf" rip
 s" FD-V03N3.pdf" rip
 s" FD-V03N4.pdf" rip
 s" FD-V03N5.pdf" rip
 s" FD-V03N6.pdf" rip

 s" FD-V04N1.pdf" rip
 s" FD-V04N2.pdf" rip
 s" FD-V04N3.pdf" rip
 s" FD-V04N4.pdf" rip
 s" FD-V04N5.pdf" rip
 s" FD-V04N6.pdf" rip

 s" FD-V05N1.pdf" rip
 s" FD-V05N2.pdf" rip
 s" FD-V05N3.pdf" rip
 s" FD-V05N4.pdf" rip
 s" FD-V05N5.pdf" rip
 s" FD-V05N6.pdf" rip

 s" FD-V06N1.pdf" rip
 s" FD-V06N2.pdf" rip
 s" FD-V06N3.pdf" rip
 s" FD-V06N4.pdf" rip
 s" FD-V06N5.pdf" rip
 s" FD-V06N6.pdf" rip

 s" FD-V07N1.pdf" rip
 s" FD-V07N2.pdf" rip
 s" FD-V07N3.pdf" rip
 s" FD-V07N4.pdf" rip
 s" FD-V07N5.pdf" rip
 s" FD-V07N6.pdf" rip

 s" FD-V08N1.pdf" rip
 s" FD-V08N2.pdf" rip
 s" FD-V08N3.pdf" rip
 s" FD-V08N4.pdf" rip
 s" FD-V08N5.pdf" rip
 s" FD-V08N6.pdf" rip

 s" FD-V09N1.pdf" rip
 s" FD-V09N2.pdf" rip
 s" FD-V09N3.pdf" rip
 s" FD-V09N4.pdf" rip
 s" FD-V09N5.pdf" rip
 s" FD-V09N6.pdf" rip

 s" FD-V10N1.pdf" rip
 s" FD-V10N2.pdf" rip
 s" FD-V10N3.pdf" rip
 s" FD-V10N4.pdf" rip
 s" FD-V10N5.pdf" rip
 s" FD-V10N6.pdf" rip

 s" FD-V11N1.pdf" rip
 s" FD-V11N2.pdf" rip
 s" FD-V11N3.pdf" rip
 s" FD-V11N4.pdf" rip
 s" FD-V11N5.pdf" rip
 s" FD-V11N6.pdf" rip

 s" FD-V12N1.pdf" rip
 s" FD-V12N2.pdf" rip
 s" FD-V12N3.pdf" rip
 s" FD-V12N4.pdf" rip
 s" FD-V12N5.pdf" rip
 s" FD-V12N6.pdf" rip

 s" FD-V13N1.pdf" rip
 s" FD-V13N2.pdf" rip
 s" FD-V13N3.pdf" rip
 s" FD-V13N4.pdf" rip
 s" FD-V13N5.pdf" rip
 s" FD-V13N6.pdf" rip

 s" FD-V14N1.pdf" rip
 s" FD-V14N2.pdf" rip
 s" FD-V14N3.pdf" rip
 s" FD-V14N4.pdf" rip
 s" FD-V14N5.pdf" rip
 s" FD-V14N6.pdf" rip

 s" FD-V15N1.pdf" rip
 s" FD-V15N2.pdf" rip
 s" FD-V15N3.pdf" rip
 s" FD-V15N4.pdf" rip
 s" FD-V15N5.pdf" rip
 s" FD-V15N6.pdf" rip

 s" FD-V16N1.pdf" rip
 s" FD-V16N2.pdf" rip
 s" FD-V16N3.pdf" rip
 s" FD-V16N4.pdf" rip
 s" FD-V16N5.pdf" rip
 s" FD-V16N6.pdf" rip

 s" FD-V17N1.pdf" rip
 s" FD-V17N2.pdf" rip
 s" FD-V17N3.pdf" rip
 s" FD-V17N4.pdf" rip
 s" FD-V17N5.pdf" rip
 s" FD-V17N6.pdf" rip

 s" FD-V18N1.pdf" rip
 s" FD-V18N2.pdf" rip
 s" FD-V18N3.pdf" rip
 s" FD-V18N4.pdf" rip
 s" FD-V18N5.pdf" rip
 s" FD-V18N6.pdf" rip

 s" FD-V19N1.pdf" rip
 s" FD-V19N2.pdf" rip
 s" FD-V19N3.pdf" rip
 s" FD-V19N4.pdf" rip
 s" FD-V19N5.pdf" rip
 s" FD-V19N6.pdf" rip

 s" FD-V20N1.pdf" rip
 s" FD-V20N2.pdf" rip
 s" FD-V20N3.pdf" rip
 s" FD-V20N4.pdf" rip
 s" FD-V20N5.pdf" rip
 s" FD-V20N6.pdf" rip

 s" FD-V20N1,2.pdf" rip

\s  Note: The coding of the demo could be better.

[Win32forth-cvs] win32forth/src/tools DexH-CreateDocs.f,1.19,1.20

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/tools
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv1203

Modified Files:
	DexH-CreateDocs.f 
Log Message:
Jos: Updated for sockserv.f

Index: DexH-CreateDocs.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-CreateDocs.f,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** DexH-CreateDocs.f	13 Jun 2007 13:10:10 -0000	1.19
--- DexH-CreateDocs.f	13 Jun 2007 13:46:11 -0000	1.20
***************
*** 89,93 ****
          s" src\tools\W32fdexh.f"        create-doc
          s" src\tools\DexH-CreateDocs.f" create-doc
!         s" src\lib\Sock.f"           create-doc
          ;
  
--- 89,95 ----
          s" src\tools\W32fdexh.f"        create-doc
          s" src\tools\DexH-CreateDocs.f" create-doc
!         s" src\lib\Sock.f"              create-doc
! 
!         s" apps\Internet\WebServer\sockserv.f" create-doc
          ;
  

[Win32forth-cvs] win32forth/doc SockServer.htm,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/doc
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22435

Added Files:
	SockServer.htm 
Log Message:
Jos: Added: SockServer.htm

--- NEW FILE: SockServer.htm ---
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" />
<meta name="GENERATOR" content="DexH v03" />
<style type="text/css">
</style>
<title>
</title>
</head>
<body>
<hr /><h1>Socket Library Extension for Servers
</h1><hr /><h3><i>Tom Dixon
</i></h3><p></p><p>This library is built off of the socket library and provides some
generic support for socket servers. &nbsp;The current implementation is
asycronous, single-threaded and is select-based and does not use
the poll() function.
</p><h2>Socket Event Vectors
</h2>These words are used to define the behavior of the sockets on the
server.<br />
Each event is defined as a word with no stack effects ( -- ).<br />
Defining these vectors applies to the currently active client
connection. &nbsp;If you want to set the default behavior for incoming
client connections, please see 'serv-vecselect'.
<pre><b><a name="0">: OnClose! ( xt -- ) 
</a></b></pre><p>This word stores a new closure behavior for the socket connection.
</p><pre><b><a name="1">: OnRead! ( xt -- ) 
</a></b></pre><p>This word stores a new read behavior for the socket connection.
</p><pre><b><a name="2">: OnWrite! ( xt -- ) 
</a></b></pre><p>This word stores a new write behavior for the socket connection.
</p><pre><b><a name="3">: OnConnect! ( xt -- ) 
</a></b></pre><p>This word stores a new connection behavior for the socket.
</p><h2>Global Socket Data
</h2>When a socket event is being processed, these words contain are to
be used in obtaining specific information about the request.
<pre><b><a name="4">: servdata ( -- addr ) 
</a></b></pre><p>Returns a pointer to the user-defined data area associated with
every request. &nbsp;The size of this user area is specified by the
server.
</p><pre><b><a name="5">: servsock ( -- sock ) 
</a></b></pre><p>Returns the socket that the event has been triggered on.
</p><pre><b><a name="6">: close-client ( -- ) 
</a></b></pre><p>Closes the current socket at frees up the memory from the server.
</p><h2>Socket Server Words
</h2>A socket server is the listening server that takes requests,
processes them, and closes them.
<pre><b><a name="7">: serv-vecselect ( server -- ) 
</a></b></pre><p>Selects the server for vector behavior. &nbsp;Directly after this word
is called, default behaviors for the entire server can be specified.
</p><pre><b><a name="8">: sockserver ( datasize p &lt;name&gt; -- )
</a></b></pre><p>This word defines a socket server on port &quot;p&quot; and the size of the
user-defined data area per client.
</p><pre><b><a name="9">: serv-init ( server -- ) 
</a></b></pre><p>Initializes the server and starts listening for requests.
</p><pre><b><a name="10">: serv-close ( server -- ) 
</a></b></pre><p>Closes the server - open requests are still able to execute, though.
</p><pre><b><a name="11">: serv-poll ( server -- ) 
</a></b></pre><p>The meat-and-potatoes function of the socket server. &nbsp;This
word will deal with all incoming socket requests, poll through
and process existing socket requests, and cleanup after closed
requests.
</p><h2>Example Code
</h2>This is a simple test of the socket server code. &nbsp;Typing in the
word 'demo' will start the test. &nbsp;Any incoming request will simply
be printed to the console. &nbsp;(Yes, it's not very useful, but it is
a minmal example of use. &nbsp;Please see other examples that should
be with this file).
<pre>256 8000 sockserver test
test serv-vecselect
:noname servdata 256 servsock sock-read servdata swap type ;
onread!

test serv-init
: demo begin test serv-poll 10 ms key? until ;

[Win32forth-cvs] win32forth/doc Sock.htm,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/doc
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21180

Added Files:
	Sock.htm 
Log Message:
Jos: Added sock.htm

--- NEW FILE: Sock.htm ---
<?xml version="1.0"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
<meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" />
<meta name="GENERATOR" content="DexH v03" />
<style type="text/css">
</style>
<title>
</title>
</head>
<body>
<hr /><h1>Simple Socket Library
</h1><hr /><h3><i>Tom Dixon
</i></h3><p></p><p>This is intended to be a simple wordset for sockets in forth.
The words do not match the standard socket api. &nbsp;It has been adapted to
be easier to use in Forth.
It's simplicity should make it easy to port network apps to other
forth systems.
</p><h2>Network Formatting Words
</h2>These words are for converting 16-bit and 32-bit values to the right
format so any machine should be able to convert them back into their
values.
<pre><b><a name="0">1 PROC htonl ( hostlong -- u_long )
</a></b></pre><p>Convert a 32-bit number on the stack to a network acceptable
byte-ordered value.
</p><pre><b><a name="1">1 PROC htons ( hostshort -- u_short )
</a></b></pre><p>Convert a 16-bit number on the stack to a network acceptable
byte-ordered value.
</p><pre><b><a name="2">1 PROC ntohl ( netlong -- u_long )
</a></b></pre><p>Convert a network compatible 32-bit number on the stack to the
correct 32-bit integer
</p><pre><b><a name="3">1 PROC ntohs ( netshort -- u_short )
</a></b></pre><p>Convert a network compatible 16-bit number on the stack to the
correct 16-bit integer
</p><h2>Socket Library and Initialization Words
</h2>These words are for initializing and unloading the windows socket
dll. &nbsp;They are automatically called when the console is initialized
and right before it closes, so normally a developer would never need
to use these.
<pre><b><a name="4">: wsocket2-init ( -- ) 
</a></b></pre><p>Initializes the windows socket dll <br />
called in initialization-chain
</p><pre><b><a name="5">: wsocket2-cleanup ( -- )
</a></b></pre><p>Initializes the windows socket dll <br />
called in initialization-chain
</p><h2>Main Socket Words
</h2>These words represent the core of the socket library.
They have been written to be thread-safe.
<pre><b><a name="6">: host&gt;iaddr ( str len -- iaddr )
</a></b></pre><p>This function converts a host string to an ip address <br />
The host string could be anything from a domain name to ip address. <br />
Returns 0 if the host is unable to be looked up.
</p><pre><b><a name="7">: iaddr&gt;str ( iaddr -- str len ) 
</a></b></pre><p>This converts an ip address to a readable string.
It does not look up the host name, the string is in the &quot;255.255.255.255&quot; format
</p><br><br><U>Example:</U> simple host lookup.<br>
<pre>s&quot; www.win32forth.org&quot; host&gt;iaddr
dup . \ should be anything other than 0
iaddr&gt;str type \ should return ip address of win32forth.org
</pre><pre><b><a name="8">: sock-open ( addr len port -- sock )
</a></b></pre><p>This opens up a new socket to a host name on a given port number <br />
the host name will be looked up and the port number is converted implicitly <br />
If the socket cannot be opened, a exception will be thrown.
</p><pre><b><a name="9">: sock-read ( addr len sock -- len ) 
</a></b></pre><p>Reads data from the socket to a buffer. <br />
It works very similarly to 'read-file', but has different return parameters <br />
a returned 'len' of -1 means there was a socket error (SOCKET_ERROR) <br />
If the provided 'len' is larger than the amount of data ready to be read from the socket,
the socket will block until it has revceived the full amount of data.<br />
If the socket is a non-blocking socket, it will read what it can and return
right away.
</p><pre><b><a name="10">: sock-write ( addr len sock -- len ) 
</a></b></pre><p>Write data from a buffer to the socket. <br />
It works very similarly to 'write-file' <br />
a returned 'len' of -1 means there was a socket error (SOCKET_ERROR) <br />
If the socket is currently unable to take any data,
the socket will block until it has room in it's internal buffer to send the data.<br />
If the socket is a non-blocking socket, it will write what it can and return
right away. (amount actually written is returned as 'len')
</p><pre><b><a name="11">: sock-close ( sock -- ior )
</a></b></pre><p>Closes socket - very similar to close-file<br />
ior is 0 if the close was successful
</p><br><br><U>Example:</U> Get data from a socket.<br>
This will dump the html data from google's homepage through the use of sockets.<br>
<pre>create tbuf 256 allot
0 value sock
: sdump ( sock -- )
&nbsp;&nbsp;begin
&nbsp;&nbsp;&nbsp;&nbsp;dup sock-read? if dup tbuf 256 rot sock-read tbuf swap type then
&nbsp;&nbsp;&nbsp;&nbsp;dup sock-closed? key? or until
&nbsp;&nbsp;sock-close drop ;

s&quot; www.google.com&quot; 80 sock-open value sock
s&quot; GET / HTTP/1.0&quot; sock sock-write .
crlf$ count sock sock-write .
crlf$ count sock sock-write .
sock sdump
</pre><h2>Socket Listening Words
</h2>These words are for writting the serving-end of network applications.<br />
They have also been written to be thread-safe.
<pre><b><a name="12">: sock-create ( p -- sock )
</a></b></pre><p>Make a new socket for listening on port 'p'
Used only for server-side sockets
</p><pre><b><a name="13">: sock-listen ( n sock -- ) &nbsp;
</a></b></pre><p>This tells a socket to start queuing sockets that want to connect.<br />
'n' is the size of the queue that should be created to listen.
after 'n' sockets have tried to connect and have yet to be accepted,
further sockets will be refused until waiting sockets are accepted.
(standard queue size is 5)
</p><pre><b><a name="14">: sock-accept ( sock -- sock iaddr ) 
</a></b></pre><p>This will accept a socket that is in the listening queue. <br />
'iaddr' is the ip address of the connecting socket and can be converted
into an easy-to-read number through the 'iaddr&gt;str' word. <br />
If no sockets are in queue to be accepted, this function will block
until one tries to connect. <br />
If the socket is a non-blocking socket, then the function will fail
and return immediately if the queue has no sockets to accept. <br />
If the function fails, it will return '0' as the iaddr and '-1'
(or INVALID_SOCKET) as the socket.
</p><h2>Asyncronous Socket Words
</h2>These words are for the ability to use the sockets without having them block.<br />
Very useful for apps that need to do many things at once.
<pre><b><a name="15">: sock-read? ( sock -- n )
</a></b></pre><p>This function returns the amount of data that the socket can read
without blocking. &nbsp;It is useful for working with socket asyncronously.<br />
It will return -1 if the socket has no data to read (will block, or socket closed).
</p><pre><b><a name="16">: sock-write? ( sock -- flag )
</a></b></pre><p>This function returns true if the socket can write data without blocking.<br />
You can send 0-1024 bytes to the socket asyncronously without blocking if
the flag is true.
</p><pre><b><a name="17">: sock-accept? ( sock -- flag )
</a></b></pre><p>This function returns true if the socket has other sockets in queue that
want to be connected. &nbsp;It is to be used in conjunction with 'sock-accept'
so you can call sock-accept without blocking.
</p><pre><b><a name="18">: sock-closed? ( sock -- flag ) 
</a></b></pre><p>This function tests to see if the socket has been closed at the other end
or broken at any point.
</p><pre><b><a name="19">: sock-err? ( sock -- n )
</a></b></pre><p>This function tests to see if there are any errors on the socket.
</p><pre><b><a name="20">: sock-blocked ( flag sock -- )
</a></b></pre><p>This function sets a socket to blocked or unblocked mode.<br />
If the flag is false, the socket will be set to 'unblocked'.<br />
If the flag is true, the socket will be set to 'blocked'.<br />
</p>

[Win32forth-cvs] win32forth/doc WinSock.htm,1.2,NONE

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/doc
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv20375

Removed Files:
	WinSock.htm 
Log Message:
Jos: Removed WinSock.htm. I will add sock.htm

--- WinSock.htm DELETED ---

[Win32forth-cvs] win32forth/src/tools DexH-CreateDocs.f,1.18,1.19

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/tools
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18425

Modified Files:
	DexH-CreateDocs.f 
Log Message:
Jos: Adapted for sock.f

Index: DexH-CreateDocs.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/tools/DexH-CreateDocs.f,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** DexH-CreateDocs.f	26 May 2007 10:24:13 -0000	1.18
--- DexH-CreateDocs.f	13 Jun 2007 13:10:10 -0000	1.19
***************
*** 89,93 ****
          s" src\tools\W32fdexh.f"        create-doc
          s" src\tools\DexH-CreateDocs.f" create-doc
!         s" src\lib\WinSock.f"           create-doc
          ;
  
--- 89,93 ----
          s" src\tools\W32fdexh.f"        create-doc
          s" src\tools\DexH-CreateDocs.f" create-doc
!         s" src\lib\Sock.f"           create-doc
          ;
  

[Win32forth-cvs] win32forth/src/lib WinSock.f,1.1,NONE

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17621

Removed Files:
	WinSock.f 
Log Message:
Jos: Removed Winsock since the new name is sock.f

--- WinSock.f DELETED ---

[Win32forth-cvs] win32forth/src/lib sock.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/lib
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv16846

Added Files:
	sock.f 
Log Message:
Jos: Added sock.f for the webserver.

--- NEW FILE: sock.f ---
\ Socket Library
\ Tom Dixon

\ *! Sock
\ *T Simple Socket Library
\ *Q Tom Dixon

\ *P This is intended to be a simple wordset for sockets in forth.
\ ** The words do not match the standard socket api.  It has been adapted to 
\ ** be easier to use in Forth.
\ ** It's simplicity should make it easy to port network apps to other
\ ** forth systems.


\ these constants come from a complicated formula in winsock2.h
$4004667f constant FIONREAD 
$8004667e constant FIONIO
$8004667d constant FIONASYNC

\ Import WinSock2 Dll

winlibrary ws2_32.dll


\ Import functions from the dll

\ *S Network Formatting Words
\ ** These words are for converting 16-bit and 32-bit values to the right 
\ ** format so any machine should be able to convert them back into their
\ ** values.  

1 PROC htonl ( hostlong -- u_long )
\ *G Convert a 32-bit number on the stack to a network acceptable 
\ ** byte-ordered value.

1 PROC htons ( hostshort -- u_short )
\ *G Convert a 16-bit number on the stack to a network acceptable 
\ ** byte-ordered value.

1 PROC ntohl ( netlong -- u_long )
\ *G Convert a network compatible 32-bit number on the stack to the
\ ** correct 32-bit integer

1 PROC ntohs ( netshort -- u_short )
\ *G Convert a network compatible 16-bit number on the stack to the
\ ** correct 16-bit integer


1 PROC inet_addr ( *cp -- in_addr )
1 PROC inet_ntoa ( in_addr -- *char )

2 PROC listen ( backlog sock -- int )
4 PROC recv   ( flags len *buf sock -- int )
5 PROC select ( *timeout *exceptfds *writefds *readfds nfds -- int )
4 PROC send   ( flags len *buf sock -- int )
2 PROC shutdown ( how sock -- int )
3 PROC socket ( protocol type af-- sock )
3 PROC bind ( namelen 'sock sock -- int )
1 PROC closesocket ( sock -- int )
3 PROC connect ( len 'sock sock -- int )
3 PROC ioctlsocket ( *argp cmd sock -- int )
1 PROC gethostbyname ( *name -- hostent )

2 PROC WSAStartup ( lpWSAData wVersionRequired -- int )
0 PROC WSACleanup ( -- int )


\ *S Socket Library and Initialization Words
\ ** These words are for initializing and unloading the windows socket 
\ ** dll.  They are automatically called when the console is initialized
\ ** and right before it closes, so normally a developer would never need
\ ** to use these.

\ API Setup and Closure (linked to initialization and closure chains)

: wsocket2-init ( -- ) 
\ *G Initializes the windows socket dll \n
\ ** called in initialization-chain
  pad $202 WSAStartup drop ;
  
: wsocket2-cleanup ( -- )
\ *G Initializes the windows socket dll \n
\ ** called in initialization-chain
  WSACleanup drop ;

initialization-chain    chain-add wsocket2-init
unload-chain            chain-add wsocket2-cleanup

wsocket2-init   \ initialize sockets


\ User Area Definition
\ This is to make all socket functions thread-safe

16 newuser saddr \ socket address structure

\ *S Main Socket Words
\ ** These words represent the core of the socket library.
\ ** They have been written to be thread-safe.

: host>iaddr ( str len -- iaddr )
\ *G This function converts a host string to an ip address \n
\ ** The host string could be anything from a domain name to ip address. \n
\ ** Returns 0 if the host is unable to be looked up.
  pad place 0 pad c+place pad 1+ gethostbyname 
  dup if 12 + @ @ @ then ;
  
: iaddr>str ( iaddr -- str len ) 
\ *G This converts an ip address to a readable string.  
\ ** It does not look up the host name, the string is in the "255.255.255.255" format
  inet_ntoa zcount ;

  
\ *W <br><br><U>Example:</U> simple host lookup.<br>
\ *E s" www.win32forth.org" host>iaddr
\ ** dup . \ should be anything other than 0
\ ** iaddr>str type \ should return ip address of win32forth.org



: sock-open ( addr len port -- sock )
\ *G This opens up a new socket to a host name on a given port number \n
\ ** the host name will be looked up and the port number is converted implicitly \n
\ ** If the socket cannot be opened, a exception will be thrown. 
  htons saddr 2 + w!
  AF_INET saddr w!
  host>iaddr saddr 4 + ! 
  0 SOCK_STREAM AF_INET socket dup
  16 saddr rot connect abort" Unable to connect!" ;


: sock-read ( addr len sock -- len ) 
\ *G Reads data from the socket to a buffer. \n
\ ** It works very similarly to 'read-file', but has different return parameters \n
\ ** a returned 'len' of -1 means there was a socket error (SOCKET_ERROR) \n
\ ** If the provided 'len' is larger than the amount of data ready to be read from the socket, 
\ ** the socket will block until it has revceived the full amount of data.\n
\ ** If the socket is a non-blocking socket, it will read what it can and return 
\ ** right away.
  >r swap 0 -rot r> recv ;

: sock-write ( addr len sock -- len ) 
\ *G Write data from a buffer to the socket. \n
\ ** It works very similarly to 'write-file' \n
\ ** a returned 'len' of -1 means there was a socket error (SOCKET_ERROR) \n
\ ** If the socket is currently unable to take any data,
\ ** the socket will block until it has room in it's internal buffer to send the data.\n
\ ** If the socket is a non-blocking socket, it will write what it can and return 
\ ** right away. (amount actually written is returned as 'len')
  >r swap 0 -rot r> send ;

: sock-close ( sock -- ior )
\ *G Closes socket - very similar to close-file\n
\ ** ior is 0 if the close was successful
  closesocket ;


\ *W <br><br><U>Example:</U> Get data from a socket.<br>
\ *W This will dump the html data from google's homepage through the use of sockets.<br>
\ *E create tbuf 256 allot
\ ** 0 value sock
\ ** : sdump ( sock -- ) 
\ **   begin 
\ **     dup sock-read? if dup tbuf 256 rot sock-read tbuf swap type then 
\ **     dup sock-closed? key? or until 
\ **   sock-close drop ;
\ **
\ ** s" www.google.com" 80 sock-open value sock 
\ ** s" GET / HTTP/1.0" sock sock-write .
\ ** crlf$ count sock sock-write .
\ ** crlf$ count sock sock-write . 
\ ** sock sdump 



\ *S Socket Listening Words
\ ** These words are for writting the serving-end of network applications.\n
\ ** They have also been written to be thread-safe.

: sock-create ( p -- sock )
\ *G Make a new socket for listening on port 'p'
\ ** Used only for server-side sockets
  htons saddr 2 + w!
  AF_INET saddr w!
  INADDR_ANY saddr 4 + ! 
  0 SOCK_STREAM AF_INET socket dup
  16 saddr rot bind abort" Unable to bind socket!" ;

: sock-listen ( n sock -- )  
\ *G This tells a socket to start queuing sockets that want to connect.\n
\ ** 'n' is the size of the queue that should be created to listen.
\ ** after 'n' sockets have tried to connect and have yet to be accepted, 
\ ** further sockets will be refused until waiting sockets are accepted.
\ ** (standard queue size is 5)
  listen drop ;

: sock-accept ( sock -- sock iaddr ) 
\ *G This will accept a socket that is in the listening queue. \n
\ ** 'iaddr' is the ip address of the connecting socket and can be converted
\ ** into an easy-to-read number through the 'iaddr>str' word. \n
\ ** If no sockets are in queue to be accepted, this function will block
\ ** until one tries to connect. \n
\ ** If the socket is a non-blocking socket, then the function will fail
\ ** and return immediately if the queue has no sockets to accept. \n
\ ** If the function fails, it will return '0' as the iaddr and '-1' 
\ ** (or INVALID_SOCKET) as the socket.
  16 >r rp@ saddr rot call accept r> drop 
  dup INVALID_SOCKET = if 0 
  else saddr 4 + @ then ;
  


\ *S Asyncronous Socket Words
\ ** These words are for the ability to use the sockets without having them block.\n
\ ** Very useful for apps that need to do many things at once.


: sock-read? ( sock -- n )
\ *G This function returns the amount of data that the socket can read 
\ ** without blocking.  It is useful for working with socket asyncronously.\n
\ ** It will return -1 if the socket has no data to read (will block, or socket closed).
  0 >r rp@ FIONREAD rot ioctlsocket if r> drop -1 exit then r> ;

: sock-write? ( sock -- flag )
\ *G This function returns true if the socket can write data without blocking.\n
\ ** You can send 0-1024 bytes to the socket asyncronously without blocking if 
\ ** the flag is true.
  1 saddr ! 
    saddr 4 + ! 
  0 saddr 8 + ! 
  0 saddr 12 + ! 
  saddr 8 + 0 saddr 0 0 select ;

: sock-accept? ( sock -- flag )
\ *G This function returns true if the socket has other sockets in queue that 
\ ** want to be connected.  It is to be used in conjunction with 'sock-accept'
\ ** so you can call sock-accept without blocking.
  1 saddr ! 
    saddr 4 + ! 
  0 saddr 8 + ! 
  0 saddr 12 + ! 
  saddr 8 + 0 0 saddr 0 select ;

: sock-closed? ( sock -- flag ) 
\ *G This function tests to see if the socket has been closed at the other end
\ ** or broken at any point.
  dup sock-accept? 1 = swap sock-read? 0 = and ;

: sock-err? ( sock -- n )
\ *G This function tests to see if there are any errors on the socket.
  1 saddr ! 
    saddr 4 + ! 
  0 saddr 8 + ! 
  0 saddr 12 + ! 
  saddr 8 + saddr 0 0 0 select ;
  
  
: sock-blocked ( flag sock -- )
\ *G This function sets a socket to blocked or unblocked mode.\n
\ ** If the flag is false, the socket will be set to 'unblocked'.\n
\ ** If the flag is true, the socket will be set to 'blocked'.\n
  swap not >r rp@ FIONIO rot ioctlsocket r> 2drop ;  
  
  

[Win32forth-cvs] win32forth/apps/Internet telnet.f,NONE,1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv15694

Added Files:
	telnet.f 
Log Message:
Jos: Added the telnet client of Thomas Dixon

--- NEW FILE: telnet.f ---
\ TelNet Client
\ Thomas Dixon

needs sock.f            \ Socket Library

0 value tsock     \ socket handle
0 value tparam1
0 value tparam2
2variable oldcursor

\ special keys for telnet session
131081  value bkchar   \ break key
131078  value upchar
131079  value downchar
131076  value leftchar
131077  value rightchar
        

: telsend ( ch -- ) \ send a byte to the connection
  pad ! pad 1 tsock sock-write drop ;
  
: teltype ( str len -- ) \ write a string to the connection 
  tsock sock-write drop ;
  
: telget ( -- ch ) \ get a byte from the connection
  pad 1 tsock sock-read drop pad c@ ;

: teliac ( cmd -- ) \ interactive command dispatcher
  case
    253 of telget 252 255 telsend telsend telsend endof
    254 of telget 252 255 telsend telsend telsend endof
  endcase ;
  
: telparam ( -- )
  telget dup [char] 0 [char] 9 1+ within
  if [char] 0 - tparam1 10 * + to tparam1 recurse exit then    
  case
    [char] ; of tparam1 to tparam2 0 to tparam1 recurse endof
    [char] J of page endof
    [char] H of tparam1 tparam2 at-xy endof
    [char] s of getxy oldcursor 2! endof
    [char] u of oldcursor 2@ at-xy endof
    [char] A of getxy tparam1 1 max - at-xy endof
    [char] B of getxy tparam1 1 max + at-xy endof
    [char] C of getxy swap tparam1 1 max + swap at-xy endof
    [char] D of getxy swap tparam1 1 max - swap at-xy endof
    [char] f of tparam1 tparam2 at-xy endof
  endcase ;

: telesc ( -- ) \ escape code dispatcher
  telget case
    [char] [ of telparam endof
    [char] H of tab endof
    [char] 7 of getxy oldcursor 2! endof
    [char] 8 of oldcursor 2@ at-xy endof
  endcase ;

: telchar ( ch -- ) \ handle an incoming byte
  dup 32 127 within if emit exit then 
  case
    8   of 8  emit endof
    9   of tab endof
    10  of 10 emit endof
    12  of page endof
    13  of 13 emit endof
    27  of 0 0 to tparam1 to tparam2 telesc endof
    255 of telget teliac endof
  endcase ;

: telnetloop ( -- ) \ main loop of telnet program
  begin tsock sock-closed? 0= while
    tsock sock-read? 0> if 
      telget telchar
    else 1 ms then  
    key? if 
      key dup  case
        13        of telsend 10 telsend endof
        bkchar    of drop exit endof
        upchar    of drop 27 telsend s" [1A" teltype endof
        downchar  of drop 27 telsend s" [1B" teltype endof
        leftchar  of drop 27 telsend s" [1C" teltype endof
        rightchar of drop 27 telsend s" [1D" teltype endof
        telsend
      endcase
    then
  repeat ;

: telnet ( addr len port -- ) \ open a telnet session
  sock-open to tsock
  telnetloop
  tsock sock-close drop ;


\ This works very similar to the command line utility
\ Examples:
\ s" myserver" 23 telnet

\ On the Internet ASCII Art:
\ s" towel.blinkenlights.nl" 23 telnet

[Win32forth-cvs] win32forth/apps/Internet/WebServer DSTR.F, NONE, 1.1 HTTP.F, NONE, 1.1 HTTPecho.f, NONE, 1.1 HTTPerr.F, NONE, 1.1 HTTPfile.F, NONE, 1.1 HTTPmime.F, NONE, 1.1 SCOOP.F, NONE, 1.1 WebServer.F, NONE, 1.1 sockserv.f, NONE, 1.1

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet/WebServer
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14911

Added Files:
	DSTR.F HTTP.F HTTPecho.f HTTPerr.F HTTPfile.F HTTPmime.F 
	SCOOP.F WebServer.F sockserv.f 
Log Message:
Jos: Added the webserver of Thomas Dixon

--- NEW FILE: HTTPecho.f ---
\ HTTP Server Component - Echo
\ Tom Dixon

\ This just repeats back the request when the url starts with /echo/
\ Usefull for debugging

with httpreq
  : doEcho ( -- flag )  
    url [char] / scan [char] / skip 
    2dup [char] / scan nip - s" ECHO" istr=
    if with dstr 
         reply free cr
         s" <HTML><BODY><PRE>" reply append
         request count reply append
         s" </PRE></BODY></HTML>" reply append
       endwith 200 code ! true
    else false then ;
    
  doURL doEcho http-done
endwith

--- NEW FILE: HTTPfile.F ---
\ HTTP Server Component - Files
\ Tom Dixon

\ URL points to a file

create webpath 256 allot
s" c:\cprparse\" webpath place

: chreplace ( newch oldch str len -- )
  over + swap ?do dup i c@ = if over i c! then loop 2drop ;

with httpreq
  : doURLFile ( -- flag )  
    webpath count hbuf place
    url [char] / scan [char] / skip 
    2dup [char] ? scan nip - hbuf +place
    [char] \ [char] / hbuf count chreplace
    hbuf count + 1- c@ [char] \ = if s" \index.html" hbuf +place then
    hbuf count r/o open-file 
    if drop false exit then 
    file ! hbuf count get-mediatype
    s" Content-Type: " type type cr cr
    true ;
    
  doURL doURLFile http-done
endwith

--- NEW FILE: HTTP.F ---
\ Simple HTTP Server
\ Tom Dixon

needs SCOOP     \ scopes
needs DSTR      \ dynamic strings
needs sock      \ socket library
needs sockserv  \ socket server extention
needs HTTPerr   \ http error codes

\ Make the http request object
scope httpreq
with httpreq definitions

  \ Size of a request
  2 cells with dstr size endwith 2 * + CONSTANT size
  
  \ Data members
  : code ( -- addr ) servdata ;
  : file ( -- addr ) servdata cell+ ;
  : request ( -- dstr ) servdata 2 cells + ;
  : reply ( -- dstr ) servdata with dstr size endwith + 2 cells + ;
  
  1000 CONSTANT pktsize \ size of chunk to send
  create stopstr 4 c, 13 c, 10 c, 13 c, 10 c,
  create hbuf 256 allot \ temporary buffer
  
  0 value urllist  \ URL processing list
  
  defer next-req ' noop is next-req \ pass on to next request
    
  : freestrs ( -- ) \ free all strings and files
    with dstr
      request free
      reply free
    endwith 
    file @ if file @ close-file drop 0 file ! then ;
  
  : -lf ( addr len -- addr len ) \ trim the last line feed
    dup if 2dup + 1- c@ 13 = if 1- then then ;
  
  : toline ( n str len -- str len ) \ get the nth line
    rot 0 ?do 10 scan 10 skip loop 
    2dup 10 scan nip - -lf ;
    
  : toarg ( n str len -- str len ) \ get the nth argument
    rot 0 ?do bl scan bl skip loop 
    2dup bl scan nip - ;
    
  : getparam ( arg line -- str len ) \ get a parameter from the header
    request with dstr count endwith
    toline toarg ;
  
  : param ( str len -- str len ) \ gets a HTTP header parameter
    with dstr 
      request count 2swap search 
      if bl scan bl skip 2dup 10 scan nip - -lf -trailing
      else 2drop s" " then 
    endwith ;
    
  : url ( --  str len ) 1 0 getparam ; \ requested URL
  
  : (crcr?) ( dstr -- str len flag ) 
    with dstr count endwith stopstr count search ;
    
  : crcr? ( -- str len flag ) request (crcr?) ; \ search for double cr
  
  : bodylen ( -- n ) \ size of body
    file @ if file @ file-size drop d>s 
    else reply (crcr?) if nip 4 - else 2drop 0 then then ; 
    
  : stdheader ( -- ) \ generate a standard header
    s" HTTP/1.1 " hbuf place
    code @ (.) hbuf +place  s"  " hbuf +place 
    code @ err-code hbuf +place
    stopstr 1+ 2 hbuf +place
    s" Server: Win32forth " hbuf +place
    version# (.) hbuf +place s"  " hbuf +place build# (.) hbuf +place
    stopstr 1+ 2 hbuf +place
    bodylen if s" Content-Length: " hbuf +place bodylen (.) hbuf +place then
    stopstr 1+ 2 hbuf +place
    hbuf count reply with dstr prepend endwith ;
  

  \ socket server vectors
  : http-connect ( -- ) freestrs ;
  
  : http-Close ( -- ) freestrs ;
    
  : http-write ( -- )
    begin servsock sock-write? 0> while
      code @ reply with dstr count nip endwith >= if
        file @ if 
          hbuf 256 file @ read-file drop dup
          if hbuf swap servsock sock-write drop 
          else drop next-req exit then
        else
          next-req exit
        then
      else
        code @ pktsize reply with dstr mid endwith
        servsock sock-write code +!        
      then 
    repeat ;

  : http-done ( -- ) 
    stdheader 0 code ! ['] http-write onWrite! ;
    
  : process ( -- ) 
    urllist >r
    begin r@ while
      r@ cell+ @ execute if r> 2 cells + @ onWrite! exit then
      r> lrest >r 
    repeat r@ drop ;
  
  : http-read ( -- ) 
    begin servsock sock-read? 0> while
      hbuf 255 servsock sock-read hbuf swap
      request with dstr append endwith
      drop true
    repeat 
    crcr? nip nip if 
      200 code ! ['] process onWrite! ['] noop onRead! 
    then ;

\ Start next request     
  : connclose? ( -- flag ) 
    s" Connection:" param s" close" istr=
    reply with dstr count endwith 
    s" Content-Length:" search nip nip 0= or ;

  : next-request ( -- ) 
    file @ if file @ close-file drop 0 file ! then 
    connclose? if freestrs close-client exit then 
    crcr? if 4 /string 
      with dstr 
        reply place 
        reply count request place 
        reply free 
      endwith 
    else with dstr request free endwith then 
    ['] noop onWrite! 
    ['] http-read onRead! ;  
    
  ' next-request is next-req
    
  \ some simple IO overloading
  : type ( str len -- ) reply with dstr append endwith ;
  : cr ( -- ) stopstr count drop 2 type ;
  : emit ( n -- ) hbuf c! hbuf 1 type ;
  : space ( -- ) bl emit ;
  : . ( n -- ) (.) type ;
  : ." ( "str" -- ) [char] " parse type ;
    
endwiths definitions


\ Setup the initial vectors of a HTTP server
: setup-http ( server -- )
  serv-vecselect
  with httpreq
    ['] http-connect  onConnect!
    ['] http-read     onRead!
    ['] http-close    onClose!
    ['] noop          onWrite!
  endwith ;

\ Define a HTTP Server
: httpserver ( port <name> -- ) 
  with httpreq size endwith swap sockserver ;


\ This is how you add components to the http server

: doURL ( <test-xt> <do-xt> -- ) 
  node, ' , ' , with httpreq urllist cons to urllist endwith ;
  
\ test-xt returns a flag if the compnent accepts the request.
\ if accepted, do-xt will be called repetatively each time 
\ the server polls until 'http-done' is called by it.


\ default behavior for HTTP server
with httpreq
  : doNotFound ( -- )  404 code !
    s" <html><body>HTTP Error 404 - File or directory not found.</body></html>" type
    http-done ;
  doURL true doNotFound
endwith


\ extra functionality is added to the HTTP server through
\ the 'doURL' function.  See HTTPecho for a simple example.

--- NEW FILE: HTTPerr.F ---
\ HTTP Error Codes
\ Thomas Dixon

: err-code ( n -- err ) \ translates some of the many many error codes
  case
    200 of s" OK" exit endof
    201 of s" Created" exit endof
    202 of s" Accepted" exit endof
    203 of s" Non-Authoritative Information" exit endof
    204 of s" No Content" exit endof
    205 of s" Reset Content" exit endof
    206 of s" Partial Content" exit endof
    300 of s" Multiple Choices" exit endof
    301 of s" Moved Permanently" exit endof
    302 of s" Found" exit endof
    303 of s" See Other" exit endof
    304 of s" Not Modified" exit endof
    305 of s" Use Proxy" exit endof
    306 of s" (Unused)" exit endof
    307 of s" Temporary Redirect" exit endof
    400 of s" Bad Request" exit endof
    401 of s" Unauthorized" exit endof
    402 of s" Payment Required" exit endof
    403 of s" Forbidden" exit endof
    404 of s" Not Found" exit endof
    405 of s" Method Not Allowed" exit endof
    406 of s" Not Acceptable" exit endof
    407 of s" Proxy Authentication Required" exit endof
    408 of s" Request Timeout" exit endof
    409 of s" Conflict" exit endof
    410 of s" Gone" exit endof
    411 of s" Length Required" exit endof
    412 of s" Precondition Failed" exit endof
    413 of s" Request Entity Too Large" exit endof
    414 of s" Request-URI Too Long" exit endof
    415 of s" Unsupported Media Type" exit endof
    416 of s" Requested Range Not Satisfiable" exit endof
    417 of s" Expectation Failed" exit endof
    500 of s" Internal Sever Error" exit endof
    501 of s" Not Implemented" exit endof
    502 of s" Bad Gateway" exit endof
    503 of s" Service Unavailable" exit endof
    504 of s" Gateway Timeout" exit endof
    505 of s" HTTP Version Not Supported" exit endof
  endcase s" Error" ;
--- NEW FILE: WebServer.F ---
\ HTTP Web Server
\ Tom Dixon

needs http
needs httpecho
needs httpmime
needs httpfile

\ Setup Server
80 httpserver http
http setup-http
http serv-init

\ Run the Server
: www-server begin http serv-poll 10 ms key? until ;


--- NEW FILE: sockserv.f ---
\ Socket Server
\ Tom Dixon


\ *! SockServer
\ *T Socket Library Extension for Servers
\ *Q Tom Dixon

\ *P This library is built off of the socket library and provides some 
\ ** generic support for socket servers.  The current implementation is
\ ** asycronous, single-threaded and is select-based and does not use 
\ ** the poll() function.

needs Sock.F \ Socket Library

\ Re-Define the list library if it is not already in the system
[DEFINED] cons NOT [IF]

: cons ( node list -- list ) over ! ;
: lrest ( list -- list ) @ ;

[THEN]

\ This value ought to be made into a user variable to give it better
\ multithreaded support.
0 value sservdata

6 cells constant servuser
  \ structure: |link|sock|onconnect|onread|onwrite|onclose|


\ *S Socket Event Vectors
\ ** These words are used to define the behavior of the sockets on the 
\ ** server.\n
\ ** Each event is defined as a word with no stack effects ( -- ).\n
\ ** Defining these vectors applies to the currently active client 
\ ** connection.  If you want to set the default behavior for incoming
\ ** client connections, please see 'serv-vecselect'.

: OnClose! ( xt -- ) 
\ *G This word stores a new closure behavior for the socket connection.
  sservdata 5 cells + ! ;
  
: doOnClose ( -- ) sservdata 5 cells + @ execute ;
 
: OnRead! ( xt -- ) 
\ *G This word stores a new read behavior for the socket connection.
  sservdata 3 cells + ! ;
  
: doOnRead ( -- ) sservdata 3 cells + @ execute ;
  
: OnWrite! ( xt -- ) 
\ *G This word stores a new write behavior for the socket connection.
  sservdata 4 cells + ! ;
  
: doOnWrite ( -- ) sservdata 4 cells + @ execute ;
  
: OnConnect! ( xt -- ) 
\ *G This word stores a new connection behavior for the socket.
  sservdata 2 cells + ! ;
  
: doOnConnect ( -- ) sservdata 2 cells + @ execute ;


\ *S Global Socket Data
\ ** When a socket event is being processed, these words contain are to 
\ ** be used in obtaining specific information about the request.

: servdata ( -- addr ) 
\ *G Returns a pointer to the user-defined data area associated with 
\ ** every request.  The size of this user area is specified by the 
\ ** server.
  sservdata servuser + ;
  
: servsock ( -- sock ) 
\ *G Returns the socket that the event has been triggered on.
  sservdata cell+ @ ;
  
: close-client ( -- ) 
\ *G Closes the current socket at frees up the memory from the server.
  servsock sock-close drop 
  0 sservdata cell+ ! ;
  
  
  
\ *S Socket Server Words
\ ** A socket server is the listening server that takes requests, 
\ ** processes them, and closes them.

: serv-vecselect ( server -- ) 
\ *G Selects the server for vector behavior.  Directly after this word
\ ** is called, default behaviors for the entire server can be specified.
  4 cells + to sservdata ;  

: sockserver ( datasize p <name> -- )
\ *G This word defines a socket server on port "p" and the size of the 
\ ** user-defined data area per client.
  create here serv-vecselect
  0 , 0 , , servuser + , servuser allot 
  ['] noop onconnect!
  ['] noop onwrite!
  ['] noop onread!
  ['] noop onclose! ;
  
: serv-init ( server -- ) 
\ *G Initializes the server and starts listening for requests.
  dup 2 cells + @ sock-create dup rot ! 5 swap sock-listen ;
  
: serv-close ( server -- ) 
\ *G Closes the server - open requests are still able to execute, though.
  dup @ sock-close drop 0 swap ! ;

: serv-accept ( server -- ) 
  begin dup @ sock-accept? while
    dup @ sock-accept drop ?dup if 
      over 3 cells + @ allocate throw
      to sservdata 
      sservdata cell+ ! 
      dup 4 cells + 2 cells + 
      sservdata 2 cells + 4 cells cmove
      dup cell+ lrest sservdata swap cons drop 
      dup cell+ sservdata cons drop 
      >r doOnConnect r> 
    then     
  repeat drop ;
  

: (serv-poll) ( server -- )
  cell+ @ to sservdata 
  begin sservdata while
    servsock sock-err? if close-client then
    servsock sock-closed? if doOnClose close-client then
    servsock sock-read? if doOnRead then
    servsock sock-write? if doOnWrite then
    sservdata lrest to sservdata
  repeat ;
  
: (serv-cleanup) ( server -- ) 
  cell+ to sservdata 
  begin sservdata lrest while
    sservdata lrest cell+ @ 0= if 
      sservdata lrest dup lrest sservdata swap cons drop 
      free throw 
    then 
    sservdata lrest ?dup if to sservdata then 
  repeat ;
  
: serv-poll ( server -- ) 
\ *G The meat-and-potatoes function of the socket server.  This 
\ ** word will deal with all incoming socket requests, poll through
\ ** and process existing socket requests, and cleanup after closed
\ ** requests.
  dup serv-accept dup >r (serv-poll) r> (serv-cleanup) ;
  

\ *S Example Code
\ ** This is a simple test of the socket server code.  Typing in the 
\ ** word 'demo' will start the test.  Any incoming request will simply 
\ ** be printed to the console.  (Yes, it's not very useful, but it is
\ ** a minmal example of use.  Please see other examples that should 
\ ** be with this file).

\ *E 256 8000 sockserver test
\ ** test serv-vecselect 
\ ** :noname servdata 256 servsock sock-read servdata swap type ; 
\ ** onread!
\ ** 
\ ** test serv-init
\ ** : demo begin test serv-poll 10 ms key? until ;

--- NEW FILE: HTTPmime.F ---
\ Mime Types
\ Thomas Dixon

: get-mediatype ( addr len -- addr len ) \ media type MIME translation
  [char] . scan [char] . skip drop 3
  2dup s" htm" ISTR= if 2drop s" text/html" exit then
  2dup s" txt" ISTR= if 2drop s" text/plain" exit then
  2dup s" jpg" ISTR= if 2drop s" image/jpeg" exit then
  2dup s" gif" ISTR= if 2drop s" image/gif" exit then
  2dup s" bmp" ISTR= if 2drop s" image/x-xbitmap" exit then
  2dup s" doc" ISTR= if 2drop s" application/msword" exit then
  2dup s" rtf" ISTR= if 2drop s" application/rtf" exit then
  2dup s" zip" ISTR= if 2drop s" application/zip" exit then
  2dup s" avi" ISTR= if 2drop s" video/avi" exit then
  2dup s" mpg" ISTR= if 2drop s" video/mpeg" exit then
  2dup s" mov" ISTR= if 2drop s" video/quicktime" exit then
  2dup s" wav" ISTR= if 2drop s" audio/wav" exit then
  2dup s" mal" ISTR= if 2drop s" message/RFC822" exit then
  2dup s" mp3" ISTR= if 2drop s" audio/mp3" exit then
  2drop s" text/plain" ;
--- NEW FILE: SCOOP.F ---
\ SCOOP = Scoped Component Polymorphic library
\ Tom Dixon

\ This is a few simple words to allow development of 
\ Components and objects.  Should be pretty easy to 
\ port to whatever.


\ *** List Library ***

: cons ( node list -- list ) over ! ;
: lrest ( list -- list ) @ ;
: node, ( -- node ) here 0 , ;

: lmap ( xt list -- )
  begin dup while
    2dup 2>r CELL+ swap execute 2r>
  lrest repeat 2drop ;


\ *** Parsing Helpers ***

: atoi ( str len -- n ) 0 0 2swap >number 2drop d>s ;
: peek-word ( -- str len ) >in @ parse-word rot >in ! ;
: skip-word ( -- ) parse-word 2drop ;
: peek ( -- str len )
  begin peek-word dup 0= while
    refill 0= if exit else 2drop then
  repeat ;


\ *** Simple Scoped Polymorphism Library ***

sys-warning-off
: scope ( <name> -- ) wordlist value ;

0 value withlength

: with ( <name> -- ) 
  withlength 1+ to withlength ' execute 
  >r get-order r> swap 1+ set-order ; IMMEDIATE
  
: endwith ( -- ) 
  withlength 0= if exit then
  get-order nip 1- set-order 
  withlength 1- to withlength ; IMMEDIATE
  
: endwiths ( -- ) 
  withlength 0 ?do ['] endwith execute loop ;

: disp-bind ( xt f -- ) 
  0> if execute exit then 
  state @ if compile, else execute then ;

: (dispatch) ( str len scope -- ) 
  search-wordlist dup if disp-bind else drop then ; 
  
: dispatch ( scope -- ) 
  peek rot search-wordlist dup 
  if skip-word disp-bind else drop then ; 


\ *** Simple Object Extentions to Scopes ***

: osize ( scope -- n ) s" size" rot (dispatch) ;

: object: ( scope -- ) 
  create dup , osize allot IMMEDIATE
  does> dup cell+ state @ 
    if POSTPONE literal else swap then @ dispatch ;

: array: ( n scope -- ) 
  create dup , osize dup , * allot IMMEDIATE
  does> dup >r 2 cells + r@ cell+ @ state @ 
    if POSTPONE literal POSTPONE * POSTPONE literal POSTPONE + 
    else rot * + then r> @ dispatch ;  

sys-warning-on

--- NEW FILE: DSTR.F ---
\ Dynamic Strings
\ Tom Dixon

scope dstr
with dstr definitions

  2 cells CONSTANT size
  
  : null? @ 0= ; 
  
  : count ( o -- str len ) dup @ swap cell+ @ ;
  
  : . ( o -- ) [char] " emit count type [char] " emit ;
  
  : free ( o -- ) dup >r @ dup if free then drop 0 0 r> 2! ;
  
  : (buf+) ( len o -- addr ) 
    dup >r cell+ @ + r> dup null? if drop allocate throw 
    else @ swap resize throw then ;
    
  : append ( str len o -- )
    >r dup r@ (buf+) dup r@ ! r@ CELL+ @ + 
    swap dup r> CELL+ +! cmove ;
    
  : prepend ( str len 0 -- )
    >r dup r@ (buf+)
    dup r@ ! 2dup + r@ CELL+ @ cmove>
    r@ @ swap dup r> CELL+ +! cmove ;
  
  : place ( str len o -- ) dup free append ;
  
  : Left ( n o -- str len ) count rot min ;
  : Right ( n o -- str len ) count rot /string ;
  : Mid ( start len o -- str len ) rot swap Right rot min ;
  
endwiths definitions

[Win32forth-cvs] win32forth/apps/Internet/WebServer - New directory

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet/WebServer
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv14045/WebServer

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/Internet/WebServer added to the repository

[Win32forth-cvs] win32forth/apps/Internet - New directory

[Jos v.d.V. <jo...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Internet
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv13610/Internet

Log Message:
Directory /cvsroot/win32forth/win32forth/apps/Internet added to the repository

[Win32forth-cvs] win32forth/src WINMSG.F,1.5,1.6

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv29445/src

Modified Files:
	WINMSG.F 
Log Message:
Eliminate task bar text.  EAB

Index: WINMSG.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/WINMSG.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** WINMSG.F	9 May 2007 07:46:40 -0000	1.5
--- WINMSG.F	11 Jun 2007 22:26:51 -0000	1.6
***************
*** 58,61 ****
--- 58,62 ----
  :M ExWindowStyle: ( -- extended_style )
                  ExWindowStyle: super
+                 WS_EX_TOOLWINDOW or
                  WS_EX_DLGMODALFRAME or
                  ontop?                          \ is this a modal message?

[Win32forth-cvs] win32forth/apps/Win32ForthIDE ProjectTree.f, 1.17, 1.18

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv28986

Modified Files:
	ProjectTree.f 
Log Message:
Bug fix for crash when building projects.  EAB

Index: ProjectTree.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ProjectTree.f,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** ProjectTree.f	14 May 2007 05:37:39 -0000	1.17
--- ProjectTree.f	11 Jun 2007 22:25:42 -0000	1.18
***************
*** 20,24 ****
  \   0 value TheStatusBar
     0 value TheStatusBar
!    0 value module?
     0 value dirty?
     0 value Modified
--- 20,24 ----
  \   0 value TheStatusBar
     0 value TheStatusBar
! 
     0 value dirty?
     0 value Modified
***************
*** 75,80 ****
              short itemflags
             1 bits itemid            \ item id, 0 for child item
!            1 bits recursed
!           14 bits reservedflags
          4 cells bytes reserved
  ;recordsize: sizeof(iteminfo)
--- 75,79 ----
              short itemflags
             1 bits itemid            \ item id, 0 for child item
!           15 bits reservedflags
          4 cells bytes reserved
  ;recordsize: sizeof(iteminfo)
***************
*** 117,126 ****
  :m isitemid:    ( f -- )
                  to itemid ;m
- 
- :m recursed:	( -- recursed )
- 		recursed ;m
- 
- :m isrecursed:  ( f -- )
- 		to recursed ;m
  ;class
  
--- 116,119 ----
***************
*** 294,322 ****
                  ;
  
- :M InList?:	{ str cnt thelist -- f }
- 		#items: TheList ?dup
-                 if      1+ 1
-                         do      i >Link#: TheList
-                                 Data@: TheList Getname: [ dup ] zcount
-                                 str cnt istr=
-                                 if      unloop exitm
-                                 then	drop
-                         loop
-                 then	0 ;M
- 
  :M AddItem:     ( str cnt parentlist -- )
                  to ThisList pad place
                  no-duplicates?
!                 if      pad count ThisList inlist?: self ?exitm
                  then    Data@: ThisList
!                 if      AddLink: ThisList
                  then    New> TreeItem dup Data!: ThisList to ThisItem
!                 pad count 2dup cr type UpdateList ;M
  
  :m AddModule:   ( str cnt -- )
!                 true to module? ModuleList AddItem: self ;m
  
  :m AddForm:     ( str cnt -- )
!                 false to module? FormList AddItem: self ;m
  
  :m AddDLL:      ( str cnt -- )
--- 287,312 ----
                  ;
  
  :M AddItem:     ( str cnt parentlist -- )
                  to ThisList pad place
                  no-duplicates?
!                 if      #items: ThisList ?dup
!                         if      1+ 1
!                                 do      i >Link#: ThisList
!                                         Data@: ThisList Getname: [ ] zcount
!                                         pad count istr=
!                                         if      unloop exitm
!                                         then
!                                 loop
!                         then
                  then    Data@: ThisList
!                 if              AddLink: ThisList
                  then    New> TreeItem dup Data!: ThisList to ThisItem
!                 pad count UpdateList ;M
  
  :m AddModule:   ( str cnt -- )
!                 ModuleList AddItem: self ;m
  
  :m AddForm:     ( str cnt -- )
!                 FormList AddItem: self ;m
  
  :m AddDLL:      ( str cnt -- )
***************
*** 978,982 ****
                  s" sys-winlibrary"  "of  true to skip-recurse?                 true  endof    \ don't search .dll file
                  s" load-dialog"     "of  true to skip-recurse? true to dialog? true  endof    \ add .res and .h later
! \                s" load-bitmap"     "of   bl word drop  true to skip-recurse?   true  endof    \ skip bitmap name
                  s" toolbar"         "of  bl word drop  true to skip-recurse?   true  endof    \ skip bitmap name
                  ( default ) false swap
--- 968,973 ----
                  s" sys-winlibrary"  "of  true to skip-recurse?                 true  endof    \ don't search .dll file
                  s" load-dialog"     "of  true to skip-recurse? true to dialog? true  endof    \ add .res and .h later
!                 s" thisfile"        "of  true to skip-recurse?                 true  endof    \ special word for PM   ???
!                 s" load-bitmap"     "of  bl word drop  true to skip-recurse?   true  endof    \ skip bitmap name
                  s" toolbar"         "of  bl word drop  true to skip-recurse?   true  endof    \ skip bitmap name
                  ( default ) false swap
***************
*** 999,1005 ****
  
  \ Given file name search for needed files
! : BuildNeededFiles  { fname fcnt \ tmp$ obj -- }      \ recursive routine
                  false to comment?
!                 maxstring localalloc: tmp$
                  fname fcnt "open
                  if   drop exit
--- 990,996 ----
  
  \ Given file name search for needed files
! : BuildNeededFiles  { fname fcnt \ tmp$ -- }      \ recursive routine
                  false to comment?
!                 maxstring malloc to tmp$
                  fname fcnt "open
                  if   drop exit
***************
*** 1014,1018 ****
                  begin   more? dup 0=
                          if      drop refill dup
!                                 if      1 +to #linecount    \ bump line count
                                  then
                          then
--- 1005,1009 ----
                  begin   more? dup 0=
                          if      drop refill dup
!                                 if       1 +to #linecount     \ bump line count
                                  then
                          then
***************
*** 1021,1037 ****
                              if
                                  2dup addfile
                                  dialog? IF
                                              2dup pad place -2 pad c+! s" .res" pad +place
                                              pad count addfile
                                          THEN
                                  skip-recurse?
                                  if     2drop
!                                 else   comment? >r  2dup module?
! 					if  modulelist: theproject
! 					else	formlist: theproject
! 					then	inlist?: theproject to obj recursed: obj 0=
! 					if	cr ." recursing " type recurse      \ save comment? on stack
! 					else	2drop
! 					then	r> to comment? true isrecursed: obj
                                  then
                              then
--- 1012,1024 ----
                              if
                                  2dup addfile
+ \                                2dup SetText: ProjStatus
                                  dialog? IF
                                              2dup pad place -2 pad c+! s" .res" pad +place
                                              pad count addfile
+ 
                                          THEN
                                  skip-recurse?
                                  if     2drop
!                                 else   comment? -rot  recurse   to comment?   \ save comment? on stack
                                  then
                              then
***************
*** 1040,1044 ****
                  2r> (source) 2!
                  r> >in !
!                 r> to source-id ;
  
  : (build-project) { fClear \ old-path$ -- }
--- 1027,1032 ----
                  2r> (source) 2!
                  r> >in !
!                 r> to source-id
!                 tmp$ release ;
  
  : (build-project) { fClear \ old-path$ -- }
***************
*** 1058,1069 ****
                                  SetBuildFile: TheProject
                          else    drop exit
!                         then
                  then
                  fClear if Clear: TheProject then
                  GetBuildFile: TheProject ModuleList: TheProject
                  AddItem: TheProject
                  true to Modified
! 
                  GetBuildFile: TheProject BuildNeededFiles
  
                  SortParentLists: TheProject
--- 1046,1071 ----
                                  SetBuildFile: TheProject
                          else    drop exit
!                         then    GetBuildFile: TheProject ModuleList: TheProject
!                                 AddItem: TheProject
!                                 true to Modified
                  then
                  fClear if Clear: TheProject then
+ \                s" " SetText: ProjStatus
                  GetBuildFile: TheProject ModuleList: TheProject
                  AddItem: TheProject
                  true to Modified
! 		s" Building project" "message
                  GetBuildFile: TheProject BuildNeededFiles
+                 message-off
+                 #addedfiles Modified or to Modified
+                 #addedfiles (.) pad place
+                 s"  files added\n " pad +place
+                 #linecount 0 (UD,.) pad +place
+                 s"  lines searched totalling " pad +place
+                 total-size 0 (UD,.) pad +place
+                 s"  bytes" pad +place
+                 true pad count ?Messagebox
+ 
+                 GetBuildFile: TheProject SetBuildFile: TheProject \ update info
  
                  SortParentLists: TheProject

[Win32forth-cvs] Betters' thought taken from "Why?

[Osmond <jd...@ag...>]

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
  <meta content="text/html;charset=ISO-8859-1" http-equiv="Content-Type">
</head>
<body background="http://ljminer.com/cogently.gif">
Each chapter is a step of her journey in which God reveals a treasure in
the darkness.<br>
</body>
</html>

[Win32forth-cvs] win32forth/apps/ForthForm FORMOBJECT.F,1.19,1.20

[Ezra B. <ezr...@us...>]

Update of /cvsroot/win32forth/win32forth/apps/ForthForm
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv23438/apps/ForthForm

Modified Files:
	FORMOBJECT.F 
Log Message:
Minor bug fix when compiling a form.  EAB

Index: FORMOBJECT.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORMOBJECT.F,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** FORMOBJECT.F	4 Mar 2007 02:58:40 -0000	1.19
--- FORMOBJECT.F	10 Jun 2007 03:44:27 -0000	1.20
***************
*** 749,752 ****
--- 749,755 ----
                  then    ;
  
+ \ The following four routines adjust the selection rectangle using the arrow keys
+ \ Each press of the arrow key adjusts by 4, but can be modified
+ \ Handy when a group of controls has been moved out of the selection rectangle
  : adjust-left   ( -- )
                  selecting? not ?exit
***************
*** 1214,1230 ****
  
  : SaveIt?       { \ temp$ -- f }
!                 maxstring LocalAlloc: temp$
!                 s" File " temp$ place formname count temp$ +place
!                 s"  has been modified. Save it?" temp$ +place
!                 temp$ +NULL temp$ 1+
                  z" Heads up!" MB_YESNO MB_ICONQUESTION or
                  MessageBox: self IDYES = ;
  
  : ShowFileName  { \ temp$ -- }
!                 maxstring LocalAlloc: temp$
!                 ForthFormTitle$ temp$ place
!                 s"  - " temp$ +place
!                 formname count temp$ +place
!                 temp$ count SetText: TheMainWindow ;
  
  : ?addext       ( -- )
--- 1217,1232 ----
  
  : SaveIt?       { \ temp$ -- f }
!                 join$( 	s" File "
! 			formname count
! 			s"  has been modified. Save it?"
!                 )join$  1+
                  z" Heads up!" MB_YESNO MB_ICONQUESTION or
                  MessageBox: self IDYES = ;
  
  : ShowFileName  { \ temp$ -- }
!                 join$(  ForthFormTitle$
! 			s"  - "
! 			formname count
!                 )join$  count SetText: TheMainWindow ;
  
  : ?addext       ( -- )
***************
*** 1456,1460 ****
                  FontChanged: ThisControl
                  if     s" Set-" append fontname append&crlf 2tabs
!                        s" Create: " append fontname append s"  drop   \ ignore return flag" append&crlf 2tabs
                         s" Handle: " append fontname append s"  SetFont: " append GetName: ThisControl append
                  else   s" Handle: Winfont SetFont: " append GetName: ThisControl append
--- 1458,1462 ----
                  FontChanged: ThisControl
                  if     s" Set-" append fontname append&crlf 2tabs
!                        s" Create: " append fontname append&crlf 2tabs
                         s" Handle: " append fontname append s"  SetFont: " append GetName: ThisControl append
                  else   s" Handle: Winfont SetFont: " append GetName: ThisControl append

[Win32forth-cvs] Adobe Suite 3 Design Premium ready to download

[Maurice S. <ale...@ch...>]

<html>
<body bgcolor=3D"#ffffff" text=3D"#000000">
<img src=3D"cid:A0E8DCEA=2E33A20098">
<br>
There is no genius in life like the genius of energy and industry=2E
<br>
A jury consists of twelve persons chosen to decide who has the better la=
wyer=2E
<br>
I am I plus my surroundings and if I do not preserve the latter, I do no=
t preserve myself=2E
<br>
Prefer a loss to dishonest gain the one brings pain at the moment, the o=
ther for all time=2E
<br>
To know the right means of getting something done is virtually to have d=
one it=2E
<br>
There is no excitement anywhere in the world, short of war, to match the=
 excitement of the American presidential campaign=2E
<br>
What is a Communist? One who has yearnings for equal division of unequal=
 earnings=2E
<br>
I like trying [to get pregnant]=2E I'm not so sure about childbirth=2E
<br>
When a man gets talking about himself, he seldom fails to be eloquent an=
d often reaches the sublime=2E
<br>
Dignity belongs to the conquered=2E
<br>
O, had I but followed the arts!
<br>
No cord or cable can draw so forcibly, or bind so fast, as love can do w=
ith a single thread=2E
<br>
The people of England are the most enthusiastic in the world=2E
</body>
</html>