win32forth-cvs — CVS Commit List

[Win32forth-cvs] win32forth/src/gdi gdiDC.f,1.7,1.8

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

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

Modified Files:
	gdiDC.f 
Log Message:
gah:Bugfix to use SelectObject: method and not API call

Index: gdiDC.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/gdi/gdiDC.f,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** gdiDC.f	8 Jan 2006 09:28:08 -0000	1.7
--- gdiDC.f	28 Apr 2007 10:09:12 -0000	1.8
***************
*** 98,102 ****
  \ *P \i nObject \d Specifies the type of stock object. This parameter can be one of the following
  \ ** values. (see GetStockObject:)
!         GetStockObject: self SelectObject self ;M
  
  winver win2k >= [IF] \ only w2k or later
--- 98,102 ----
  \ *P \i nObject \d Specifies the type of stock object. This parameter can be one of the following
  \ ** values. (see GetStockObject:)
!         GetStockObject: self SelectObject: self ;M
  
  winver win2k >= [IF] \ only w2k or later

[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdMenu.f, 1.18, 1.19 EdRemote.f, 1.5, 1.6 Main.f, 1.37, 1.38

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

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

Modified Files:
	EdMenu.f EdRemote.f Main.f 
Log Message:
gah:Added control R to accelerator table for Replace

Index: Main.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v
retrieving revision 1.37
retrieving revision 1.38
diff -C2 -d -r1.37 -r1.38
*** Main.f	15 Apr 2007 02:55:45 -0000	1.37
--- Main.f	28 Apr 2007 10:02:29 -0000	1.38
***************
*** 933,936 ****
--- 933,937 ----
          0                       VK_F3   IDM_FIND_NEXT           ACCELENTRY
          FSHIFT                  VK_F3   IDM_FIND_PREVIOUS       ACCELENTRY
+         FCONTROL                'R'     IDM_REPLACE_TEXT        ACCELENTRY
  
          FALT                    'D'     IDM_INSERT_DATE         ACCELENTRY

Index: EdMenu.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** EdMenu.f	15 Apr 2007 02:55:45 -0000	1.18
--- EdMenu.f	28 Apr 2007 10:02:29 -0000	1.19
***************
*** 69,81 ****
                  :MenuItem me_lineduplicate "&Line duplicate\tCtrl+D"	IDM_LINEDUPLICATE	DoCommand ;
                  MenuSeparator
!                 :MenuItem me_selectall "&Select all\tCtrl+A"		IDM_SELECT_ALL		DoCommand ;
!                 :MenuItem me_removesel "R&emove selection" 		IDM_REMOVE_SELECTION	DoCommand ;
                  MenuSeparator
!                 :MenuItem me_find "Se&arch...\tCtrl+F"			IDM_FIND_TEXT		DoCommand ;
!                 :MenuItem me_findnext "Search &next\tF3"		IDM_FIND_NEXT		DoCommand ;
!                 :MenuItem me_findprev "Search &prev\tShift+F3"		IDM_FIND_PREVIOUS	DoCommand ;
!                 :MenuItem me_replace "Search and Replace"			IDM_REPLACE_TEXT	DoCommand ;
                  MenuSeparator
!                 :MenuItem me_findinfiles "Find Text in Files...\tCtrl+Shift+F"	IDM_FIND_IN_FILES	DoCommand ;
                  MenuSeparator
                  :MenuItem me_date      "&Insert Date\tAlt+D"		IDM_INSERT_DATE		DoCommand ;
--- 69,81 ----
                  :MenuItem me_lineduplicate "&Line duplicate\tCtrl+D"	IDM_LINEDUPLICATE	DoCommand ;
                  MenuSeparator
!                 :MenuItem me_selectall "&Select all\tCtrl+A"                   IDM_SELECT_ALL       DoCommand ;
!                 :MenuItem me_removesel "R&emove selection"                     IDM_REMOVE_SELECTION DoCommand ;
                  MenuSeparator
!                 :MenuItem me_find "Se&arch...\tCtrl+F"                         IDM_FIND_TEXT        DoCommand ;
!                 :MenuItem me_findnext "Search &next\tF3"                       IDM_FIND_NEXT        DoCommand ;
!                 :MenuItem me_findprev "Search &prev\tShift+F3"                 IDM_FIND_PREVIOUS    DoCommand ;
!                 :MenuItem me_replace "Search and &Replace\tCtrl+R"             IDM_REPLACE_TEXT     DoCommand ;
                  MenuSeparator
!                 :MenuItem me_findinfiles "Find Text in Files...\tCtrl+Shift+F" IDM_FIND_IN_FILES DoCommand ;
                  MenuSeparator
                  :MenuItem me_date      "&Insert Date\tAlt+D"		IDM_INSERT_DATE		DoCommand ;
***************
*** 276,282 ****
                  dup Enable: me_dexParagraph
                  dup Enable: me_dexCodeParagraph
! 		dup Enable: me_dexStyleBold
! 		dup Enable: me_dexStyleItalic
! 		dup Enable: me_dexStyleTypewriter
  
                  \ View menu
--- 276,282 ----
                  dup Enable: me_dexParagraph
                  dup Enable: me_dexCodeParagraph
!                 dup Enable: me_dexStyleBold
!                 dup Enable: me_dexStyleItalic
!                 dup Enable: me_dexStyleTypewriter
  
                  \ View menu
***************
*** 286,290 ****
                  dup Enable: mp_colorize
                  dup Enable: mp_browse
! 		dup Enable: mp_viewhtml
  
                  \ Options menu
--- 286,290 ----
                  dup Enable: mp_colorize
                  dup Enable: mp_browse
!                 dup Enable: mp_viewhtml
  
                  \ Options menu
***************
*** 307,313 ****
  
  : EnableMenuBar	( -- )  \ enable/disable the menu items
! 		IsEditWnd? dup EnableEdit
  
! 		if   	\ File menu
   			?Modified:     ActiveChild 0<> ?BrowseMode: ActiveChild not and Enable: mf_save
   			?BrowseMode:   ActiveChild not Enable: mf_saveas
--- 307,313 ----
  
  : EnableMenuBar	( -- )  \ enable/disable the menu items
!                 IsEditWnd? dup EnableEdit
  
!                 if      \ File menu
   			?Modified:     ActiveChild 0<> ?BrowseMode: ActiveChild not and Enable: mf_save
   			?BrowseMode:   ActiveChild not Enable: mf_saveas

Index: EdRemote.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdRemote.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** EdRemote.f	21 Oct 2006 11:11:47 -0000	1.5
--- EdRemote.f	28 Apr 2007 10:02:29 -0000	1.6
***************
*** 35,45 ****
                  if    dup
                        CASE
!                         ED_OPEN_EDIT   OF dup remote-open r>drop false >r ENDOF
!                         ED_OPEN_BROWSE OF dup remote-open r>drop false >r ENDOF
!                         ED_WATCH       OF dup remote-open r>drop false >r ENDOF
!                         ED_WORD        OF remote-word     r>drop false >r ENDOF
!                         ED_STACK       OF receive-stack   r>drop false >r ENDOF
!                         ED_DEBUG       OF receive-debug   r>drop false >r ENDOF
!                         ED_NOTINBP     OF no-breakpoint   r>drop false >r ENDOF
                       endcase
                  then drop r> ;
--- 35,45 ----
                  if    dup
                        CASE
!                         ED_OPEN_EDIT   OF dup remote-open rdrop false >r ENDOF
!                         ED_OPEN_BROWSE OF dup remote-open rdrop false >r ENDOF
!                         ED_WATCH       OF dup remote-open rdrop false >r ENDOF
!                         ED_WORD        OF remote-word     rdrop false >r ENDOF
!                         ED_STACK       OF receive-stack   rdrop false >r ENDOF
!                         ED_DEBUG       OF receive-debug   rdrop false >r ENDOF
!                         ED_NOTINBP     OF no-breakpoint   rdrop false >r ENDOF
                       endcase
                  then drop r> ;

[Win32forth-cvs] win32forth/src/kernel fkernel.f,1.41,1.42

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

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

Modified Files:
	fkernel.f 
Log Message:
gah:Added RDROP as an alias of R>DROP to be consistent with STC version

Index: fkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v
retrieving revision 1.41
retrieving revision 1.42
diff -C2 -d -r1.41 -r1.42
*** fkernel.f	30 Oct 2006 12:01:43 -0000	1.41
--- fkernel.f	28 Apr 2007 10:00:20 -0000	1.42
***************
*** 498,501 ****
--- 498,503 ----
                  next    c;
  
+ ' r>drop alias rdrop
+ 
  CODE 2>R        ( n1 n2 -- )    \ push two items onto the returnstack
                  mov     -2 CELLS [ebp], ebx

[Win32forth-cvs] Acronyma is a search engine for acronyms.

[Sears <cc...@in...>]

CHFR continues its Steady Climb, UP Another 23% Since Monday!

China Fruits Corporation
Symbol: CHFR
Price: $0.42

CHFR is climbing steady all week. UP over 23% since Monday, investors
are enjoying the solid climb. Read CHFR's recent news, and get on it
Thursday!

Google Desktop Search goes corporate. Yahoo has an optimized advanced
search page. This week, we're taking a look at the things Google knows
about you. It is difficult for a web site with optimized content to get
high search engine rankings if it doesn't have good incoming links.
The information gathered from robots. Articles of the week Google CEO
defends privacy policies "Google Chief Executive Eric Schmidt
acknowledged that his company's search engine can ruffle privacy
feathers [.
Search engine news of the week Miva Inc.
Gates unveils MSN Virtual Earth.
Facts of the week: Google's Sitemaps service Last week, Google released
its new Google Sitemaps service.
Third party tools are also available.
High Google rankings are the result of optimized web page content and
good incoming links. Poorly configured firewalls can block search engine
spiders It turned out that the delisted web sites were all hosted by the
same hosting company. FindWhat to rebrand as Miva "The FindWhat and
Espotting networks will become Miva Media. Search engines use a simple
common-sense approach: optimized content tells search engines what your
web site is all about, incoming links tell search engines that your web
site is important. ad tech patent "The patent dispute over
bid-for-placement technology between Yahoo! You can now add a Yahoo
search box to your web site. " Attorneys seek advertisers for click
fraud class action   "The attorneys have a pending class action suit in
the circuit court of Miller County, Arkansas.
More than just search engine submission IBP is much more than just
search engine submission tool.
Remember that this patent doesn't mean that Google really uses all of
this. 's pioneering PayPal service, although he acknowledged some kind
of electronic payment product is in the works. Google Earth [lets you]
find a wide variety of geographical data for travel, business, or
educational purposes. Although nobody is forced to use Google's tools,
some people find it problematic that a single company can collect that
much information.
IBP and ARELIS are proven tools that are successfully used by webmasters
all over the world.
To enable such a feature, Google [.
com is a new PPC search engine just for Long Island.
The software giant is offering the feature through its MSN Search
toolbar instead. As you might have noticed, Google wasn't displaying the
PageRank information from 27 May to 30 May. This week, we're taking a
look at the importance of Google's PageRank.
We explained it in the past in this newsletter.
In this article, we try to collect a list of things that Google knows
about you. Search engine news of the week Miva Inc.
If the PageRank information wasn't available anymore, webmasters
wouldn't concentrate on a little green bar in their web browser but on
more substantial factors. this year plans to offer an electronic-payment
service that could help the Internet-search company diversify its
revenue and may heighten competition with eBay Inc. Remember that this
patent doesn't mean that Google really uses all of this. The official
PageRank value that Google displays in the toolbar has little value for
your ranking. Google Sitemaps is another way to submit your web pages to
Google. In the news: Google launches Google Sitemaps, FindWhat changes
its name and more.
Yahoo Movies get personal. Facts of the week: Google's PageRank - should
it be discontinued? If your web site has many good incoming links,
Google's spider will find your web site anyway.
Using Google Sitemaps will not influence your rankings. ad tech patent
"The patent dispute over bid-for-placement technology between Yahoo!
For example, you could ask yourself the following questions if you want
to optimize your web site: Does my web site has enough content that is
interesting to web surfers and search engines?
This new ranker also is based on [. If you see a good web site with good
content that has a low PageRank you should trade links with that site if
that web site is useful for your visitors.
In the news: Google launches Google Print beta, Ask Jeeves adds new
features, Yahoo tests a new search feature and more. Google Desktop
Search goes corporate.
Your web page content must be search engine ready so that search engines
can find out what your web site is about.
txt file before indexing your web site.
By combining, the two have taken a step to remove that thorn. ad tech
patent "The patent dispute over bid-for-placement technology between
Yahoo!
If you want to get high rankings on Google, take a loot at our ranking
optimization tool. Google Sitemaps service and your web site Google's
PageRank - should it be discontinued?
Yahoo acquires VoIP net phone provider DialPad.
You may publish one of the articles above on your Web site.
Recommended resources "I would recommend IBP to anyone. This week, we're
trying to find out if Google manually influences its search results.
Articles of the week Google CEO defends privacy policies "Google Chief
Executive Eric Schmidt acknowledged that his company's search engine can
ruffle privacy feathers [.
research labs releases Yahoo! Facts of the week: Google's PageRank -
should it be discontinued?

[Win32forth-cvs] win32forth-stc/src Class.f,1.1,1.2

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

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

Modified Files:
	Class.f 
Log Message:
gah:Added INT plus temporary hack to support TO and +TO

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/Class.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Class.f	24 Apr 2007 09:00:17 -0000	1.1
--- Class.f	25 Apr 2007 09:41:53 -0000	1.2
***************
*** 727,731 ****
                  if      dup find                           \ if its defined
                          if      dup >name n>tfa c@ tCon =  \ and a constant
!                                 if      nip execute        \ then user its value
                                  else    drop >selector  \ else get selector
                                  then
--- 727,731 ----
                  if      dup find                           \ if its defined
                          if      dup >name n>tfa c@ tCon =  \ and a constant
!                                 if      nip execute        \ then use its value
                                  else    drop >selector  \ else get selector
                                  then
***************
*** 1196,1211 ****
                  16 bitmax               \ verify & set bit field finished & new max
                  2 class-allot ;
  
  : int           ( -<name>- )              \ W32F          Class
  \ *G Long integer (32bit) instance variable. When used as an object variable has the same
  \ ** behaviour as VALUEs.
!                 header
!                 (iv@) ,
!                 ^Class DFA @ ,
!                 (iv!) ,
!                 (iv+!) ,
!                 32 bitmax               \ verify & set bit field finished & new max
!                 cell class-allot ;
  
  : dint          ( -<name>- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
--- 1196,1222 ----
                  16 bitmax               \ verify & set bit field finished & new max
                  2 class-allot ;
+ ))
+ 
+ : DoInt
+                 does> @ self + @ ;
  
  : int           ( -<name>- )              \ W32F          Class
  \ *G Long integer (32bit) instance variable. When used as an object variable has the same
  \ ** behaviour as VALUEs.
! \                 header
! \                 (iv@) ,
! \                 ^Class DFA @ ,
! \                 (iv!) ,
! \                 (iv+!) ,
! \                 32 bitmax               \ verify & set bit field finished & new max
! \                 cell class-allot ;
!                 Create ^Class dfa @ ,
!                 cell class-allot
!                 DoInt
!                 tint tfa! ;
! 
! 
  
+ ((
  : dint          ( -<name>- )              \ W32F          Class
  \ *G Double (64bit) instance variable.
***************
*** 1218,1221 ****
--- 1229,1258 ----
                  2 cells class-allot ;
  ))
+ 
+ in-system
+ 
+ 
+ \ Total Hack to be removed when TO and +TO are properly sorted.
+ 
+ code oldto call ' to >ct @ next ;c
+ 
+ : (classto)     ( n -<value>- -- )
+                 >in @ ^class if bl word count ^class (search-self)
+                 ?dup if  dup n>tfa c@ tint = if name>xt nip nip
+                 >body @ postpone ^base postpone literal postpone + postpone !
+                 exit else drop then then then >in ! oldto ;
+ 
+ ' (classto) compiles-for to
+ 
+ code old+to call ' +to >ct @ next ;c
+ 
+ : (class+to)     ( n -<value>- -- )
+                 >in @ ^class if bl word count ^class (search-self)
+                 ?dup if  dup n>tfa c@ tint = if name>xt nip nip
+                 >body @ postpone ^base postpone literal postpone + postpone +!
+                 exit else drop then then then >in ! old+to ;
+ 
+ ' (class+to) compiles-for +to
+ 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ Primatives for cell sized objects.
***************
*** 1432,1436 ****
  
  ;Class
! \s
  :Class Rectangle  <Super Object
  \ *G Class for rectangles for passing to the OS.
--- 1469,1473 ----
  
  ;Class
! 
  :Class Rectangle  <Super Object
  \ *G Class for rectangles for passing to the OS.
***************
*** 1480,1484 ****
  RECTANGLE temprect      \ a sample rectangle object, used by the system sometimes
  
! 
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ display all classes in the system
--- 1517,1521 ----
  RECTANGLE temprect      \ a sample rectangle object, used by the system sometimes
  
! \s
  \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  \ display all classes in the system

[Win32forth-cvs] win32forth-stc/src extend.f,1.17,1.18

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

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

Modified Files:
	extend.f 
Log Message:
gah: added loading of class.f

Index: extend.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/extend.f,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** extend.f	13 Mar 2007 23:49:34 -0000	1.17
--- extend.f	24 Apr 2007 09:25:52 -0000	1.18
***************
*** 33,36 ****
--- 33,37 ----
      FLOAD src\registry.f    \ Win32 Registry support
      FLOAD src\primhash.f    \ primitive hash functions for OOP later  *** to be done ***
+     FLOAD src\class.f       \ ***** Object Oriented Programming Support *****
  
  here fence ! mark empty     \ Prevent forgetting anything before this
***************
*** 57,61 ****
  sys-FLOAD src\debug.f
  sys-FLOAD src\words.f
!     FLOAD src\class.f       \ ***** Object Oriented Programming Support *****
      FLOAD src\mapfile.f     \ Windows32 file into memory mapping words
      FLOAD src\Shell.f       \ load SHELL utility words
--- 58,62 ----
  sys-FLOAD src\debug.f
  sys-FLOAD src\words.f
! 
      FLOAD src\mapfile.f     \ Windows32 file into memory mapping words
      FLOAD src\Shell.f       \ load SHELL utility words

[Win32forth-cvs] win32forth-stc/src POINTER.F, 1.5, 1.6 forget.f, 1.2, 1.3

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

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

Modified Files:
	POINTER.F forget.f 
Log Message:
gah: Bugfixes to switching between application and system.

Index: POINTER.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/POINTER.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** POINTER.F	15 Mar 2007 17:55:15 -0000	1.5
--- POINTER.F	24 Apr 2007 09:15:01 -0000	1.6
***************
*** 24,33 ****
  
  : Pointer       ( bytes -<name>- )               \ make a pointer "name"
!                 in-application in-application       \ always in app space
                  128 max                          \ at least 160 bytes
                  create 0 ,                       \ initialize to unallocated
                  PHEAD link,                      \ link into chain
                  ,                                \ lay in size in bytes
!                 in-application does>                \ back to where we came from
                  dup @ if @ exit then             \ ok, straight fetch
                  dup (pointerlock)
--- 24,33 ----
  
  : Pointer       ( bytes -<name>- )               \ make a pointer "name"
!                 >application                     \ always in app space
                  128 max                          \ at least 160 bytes
                  create 0 ,                       \ initialize to unallocated
                  PHEAD link,                      \ link into chain
                  ,                                \ lay in size in bytes
!                 dp> does>                        \ back to where we came from
                  dup @ if @ exit then             \ ok, straight fetch
                  dup (pointerlock)
***************
*** 129,162 ****
  in-system
  
! \ These words need to be compile\interpret words
! 
! 
! \ : UnPointer>    ( name -- )     \ deallocate a pointer name following
! \                 ' STATE @
! \                 IF      POSTPONE LITERAL
! \                         POSTPONE %UNPOINTER
! \                 ELSE    %UNPOINTER
! \                 THEN    ; IMMEDIATE
! 
! : UnPointer>    ( name -- )     \ deallocate a pointer name following
                  ' %unpointer compilation> drop ' postpone literal postpone %unpointer ;
  
! : SizeOf!>      ( bytes | name -- ) \ set size of the following pointer
! \                 ' STATE @
! \                 IF      POSTPONE LITERAL
! \                         POSTPONE %SIZEOF!
! \                 ELSE    %SIZEOF!
! \                 THEN    ; IMMEDIATE
!                 ' %sizeof! compilation> drop ' postpone literal postpone %sizeof! ;
  
! : SizeOf@>      ( -<name>- bytes )  \ get size of the following pointer
! \                 ' STATE @
! \                 IF      POSTPONE LITERAL
! \                         POSTPONE %SIZEOF@
! \                 ELSE    %SIZEOF@
! \                 THEN    ; IMMEDIATE
!                 ' %sizeof@ compilation> drop ' postpone literal postpone %sizeof@ ;
  
! : named-new$    ( -<name>- )            \ a semi-static buffer of MAXSTRING length
                  MAXSTRING Pointer ;
  
--- 129,142 ----
  in-system
  
! : UnPointer>    ( "name" -- )     \ deallocate a pointer name following
                  ' %unpointer compilation> drop ' postpone literal postpone %unpointer ;
  
! : SizeOf!>      ( bytes "name" -- ) \ set size of the following pointer
!                 ' %sizeof! compilation> drop ' >pointer postpone literal postpone ! ;
  
! : SizeOf@>      ( "name" -- bytes )  \ get size of the following pointer
!                 ' %sizeof@ compilation> drop ' >pointer postpone literal postpone @ ;
  
! : named-new$    ( "name" -- )            \ a semi-static buffer of MAXSTRING length
                  MAXSTRING Pointer ;
  

Index: forget.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/forget.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** forget.f	30 Oct 2006 09:15:14 -0000	1.2
--- forget.f	24 Apr 2007 09:15:01 -0000	1.3
***************
*** 176,193 ****
  
  : mark  ( -<name>- )
!         in-previous in-system create last @ ,
          get-current get-order only forth also definitions
          Get-marking-info rot >forget-extra 2 cells+
          get-order dup>r 0 ?do drop loop r> cells+ -rot save-marking-info
          save-search-order set-order set-current
!         do-marker in-previous ;
  
  : marker ( -<name>- ) ( ANS)
!         in-previous in-system
  \        WARNING @ WARNING OFF
          Get-marking-info create last @ , Save-marking-info
  \        WARNING !
  \        save-source here body> ,
!         save-search-order do-marker in-previous ;
  
  : POSSIBLY  ( "name" -- )
--- 176,193 ----
  
  : mark  ( -<name>- )
!         get-section 2>r in-system create last @ ,
          get-current get-order only forth also definitions
          Get-marking-info rot >forget-extra 2 cells+
          get-order dup>r 0 ?do drop loop r> cells+ -rot save-marking-info
          save-search-order set-order set-current
!         do-marker 2r> set-section ;
  
  : marker ( -<name>- ) ( ANS)
!         get-section 2>r in-system
  \        WARNING @ WARNING OFF
          Get-marking-info create last @ , Save-marking-info
  \        WARNING !
  \        save-source here body> ,
!         save-search-order do-marker 2r> set-section ;
  
  : POSSIBLY  ( "name" -- )

[Win32forth-cvs] win32forth-stc/src primutil.f,1.25,1.26

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

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

Modified Files:
	primutil.f 
Log Message:
gah: Modified to support class.f

Index: primutil.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** primutil.f	11 Apr 2007 20:21:53 -0000	1.25
--- primutil.f	24 Apr 2007 09:13:14 -0000	1.26
***************
*** 134,137 ****
--- 134,141 ----
  in-application
  
+ : ?isClass       ( cfa -- f )
+                 >name n>tfa c@ dup tCla =
+                 swap t|Cl = or ;
+ 
  \ Moved to user area to make asciiz thread safe gah 28jun04
  MAXSTRING newuser z-buf

[Win32forth-cvs] win32forth-stc/src Class.f, NONE, 1.1 primhash.f, 1.2, 1.3

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

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

Modified Files:
	primhash.f 
Added Files:
	Class.f 
Log Message:
gah: Bugfix to primhash plus partial class support (only allows BYTES type and object IVARS; no INT DINT SHORT or BYTE yet).

--- NEW FILE: Class.f ---
\ $Id: Class.f,v 1.1 2007/04/24 09:00:17 georgeahubert Exp $

\   --------------------------- Change Block -------------------------------
\
\   arm 15/08/2005 22:56:45
\       First version 0.1 STC based kernel
\
\
\
\   ------------------------- End Change Block -----------------------------
\
\   Experimental: a fully optimising, STC based, ANS Forth compliant kernel
\
\   Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
\                         Dirk Busch    (dirk at win32forth.org)
\                         George Hubert (georgeahubert at yahoo.co.uk)
\   The original Win32Forth system was public domain; this kernel (and
\   currently the kernel alone) is GPL. Although the basic structure of
\   Win32Forth and many of its capabilities are employed in this code, most
[...1492 lines suppressed...]

: GetMethod     { \ m0cfa -- -<method: object>- m0cfa }  \ W32F        Class
\ *G Return the xt of method. Used in interpretive mode or to create parsing words.
                @word _msgFind 1 <> abort" Undefined Method"
                TRUE to get-reference?  \ tell do_message to return method
                depth >r
                execute to m0cfa        \ execute do_message
                depth r> <
                if      0               \ if it was a class, object is NULL
                then    to obj-save m0cfa ;

: [GetMethod]   ( compiling:- -<method: object>- -- ) ( runtime:-  -- m0cfa ) \ W32F Class
\ *G Compile the xt of the method as a literal into the current definition. Compile only.
                state @ >r postpone [
                GetMethod r> if ] then
                Postpone Literal ; Immediate

IN-APPLICATION

only forth also definitions

Index: primhash.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primhash.f,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** primhash.f	18 Apr 2007 09:13:04 -0000	1.2
--- primhash.f	24 Apr 2007 09:00:16 -0000	1.3
***************
*** 336,344 ****
  : lit>OP     ( n -- )
                 (comp-only) compilation> drop
!                >r macro[ mov OP [UP], # r> ]macro ;
  
  : lit+OP     ( n -- )
                 (comp-only) compilation> drop
!                >r macro[ add OP [UP], # r> ]macro ;
  
  in-previous
--- 336,344 ----
  : lit>OP     ( n -- )
                 (comp-only) compilation> drop
!                >r macro[ mov OP [UP], dword # r> ]macro ;
  
  : lit+OP     ( n -- )
                 (comp-only) compilation> drop
!                >r macro[ add OP [UP], r@ 127 > if dword then # r> ]macro ;
  
  in-previous
***************
*** 416,420 ****
          then    ;
  ))
! IN-APPLICATION
  
  
--- 416,422 ----
          then    ;
  ))
! 
! in-previous
! 
  
  

[Win32forth-cvs] win32forth-stc gkernel.exe,1.41,1.42

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

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

Modified Files:
	gkernel.exe 
Log Message:
gah: Modified to support class.f (partially TO still needs extending)

Index: gkernel.exe
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/gkernel.exe,v
retrieving revision 1.41
retrieving revision 1.42
diff -C2 -d -r1.41 -r1.42
Binary files /tmp/cvs7x91Oo and /tmp/cvsvpsH84 differ

[Win32forth-cvs] win32forth-stc/src/kernel gkernel.f,1.35,1.36

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

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

Modified Files:
	gkernel.f 
Log Message:
gah: Modified to support class.f (partially TO still needs extending)

Index: gkernel.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/kernel/gkernel.f,v
retrieving revision 1.35
retrieving revision 1.36
diff -C2 -d -r1.35 -r1.36
*** gkernel.f	11 Apr 2007 20:18:30 -0000	1.35
--- gkernel.f	24 Apr 2007 08:55:47 -0000	1.36
***************
*** 255,259 ****
                  add     eax, ebx
                  next;
!                 
  
  \ ------------------------- Vector Variables --------------------------
--- 255,259 ----
                  add     eax, ebx
                  next;
! 
  
  \ ------------------------- Vector Variables --------------------------
***************
*** 496,500 ****
                  add     eax, [ebp]
                  next;
!                 
  code negate     ( n1 -- n2 ) \ negate n1, returning 2's complement n2
       1 1 in/out
--- 496,500 ----
                  add     eax, [ebp]
                  next;
! 
  code negate     ( n1 -- n2 ) \ negate n1, returning 2's complement n2
       1 1 in/out
***************
*** 995,1000 ****
              (comp-only) compilation> drop _r>drop (copy-code) ;
              0 0 in/out
!             
! ' r>drop alias rdrop            
  
  gcode _2>r                                    \ push two items onto the rstack
--- 995,1000 ----
              (comp-only) compilation> drop _r>drop (copy-code) ;
              0 0 in/out
! 
! ' r>drop alias rdrop
  
  gcode _2>r                                    \ push two items onto the rstack
***************
*** 2457,2461 ****
                  dup if
                    $6D8D code-w, code-c, \ lea ebp, n [ebp]
!                 else drop then 
                  ste-reset               \ reset
                  ;
--- 2457,2461 ----
                  dup if
                    $6D8D code-w, code-c, \ lea ebp, n [ebp]
!                 else drop then
                  ste-reset               \ reset
                  ;
***************
*** 2499,2505 ****
  9 constant tcre
  10 constant toff
! \ 10 constant tflt
! \ 11 constant tstr
! \ 12 constant tobj
  
  : mov-tos,#n  ( n -- )                        \ generate a mov eax, # n
--- 2499,2508 ----
  9 constant tcre
  10 constant toff
! \ 11 constant tflt
! \ 12 constant tstr
! 13 constant tobj
! 14 constant tcla
! 16 constant t|cl
! 17 constant tint
  
  : mov-tos,#n  ( n -- )                        \ generate a mov eax, # n
***************
*** 2565,2569 ****
              ( -- n )                          \ run time
              ['] dovar tvar dogen-# 0 ,
!             ['] (comp-cons) compiles-last 
              0 1 in/out
              ; 0 0 in/out
--- 2568,2572 ----
              ( -- n )                          \ run time
              ['] dovar tvar dogen-# 0 ,
!             ['] (comp-cons) compiles-last
              0 1 in/out
              ; 0 0 in/out
***************
*** 2577,2581 ****
              0 1 in/out
              ; 1 0 in/out
!             
  : 2literal  ( n m -- )                        \ run-time skeleton for 2literal
      (comp-only)                               \ compile only
--- 2580,2584 ----
              0 1 in/out
              ; 1 0 in/out
! 
  : 2literal  ( n m -- )                        \ run-time skeleton for 2literal
      (comp-only)                               \ compile only
***************
*** 3413,3417 ****
                  mov     eax, esi
                  next;
!                 
  
  : base@         ( n -- base n )   base @ ;
--- 3416,3420 ----
                  mov     eax, esi
                  next;
! 
  
  : base@         ( n -- base n )   base @ ;
***************
*** 4947,4951 ****
                  code-here swap voc>vxt !               \ set the xt for this name
                  mov-ecx,#n ['] dovoc xt-jmp,           \ set ecx, jmp to dovoc
!                 ofa-calc 
                  ;
  
--- 4950,4954 ----
                  code-here swap voc>vxt !               \ set the xt for this name
                  mov-ecx,#n ['] dovoc xt-jmp,           \ set ecx, jmp to dovoc
!                 ofa-calc
                  ;
  
***************
*** 4956,4960 ****
  
  : lexicon       ( -- )                   \ like a vocabulary, but in app space
!                 lexthreads #lexicon 
                  0 0 in/out
                  ; 0 0 in/out
--- 4959,4963 ----
  
  : lexicon       ( -- )                   \ like a vocabulary, but in app space
!                 lexthreads #lexicon
                  0 0 in/out
                  ; 0 0 in/out
***************
*** 4966,4970 ****
  
  : vocabulary    ( -- )
!                 vthreads #vocabulary 
                  0 0 in/out
                  ; 0 0 in/out
--- 4969,4973 ----
  
  : vocabulary    ( -- )
!                 vthreads #vocabulary
                  0 0 in/out
                  ; 0 0 in/out
***************
*** 5024,5028 ****
                    if drop (file-kernel) then
                  then ;
!                 
  : (viewtype)    ( line# c-addr -- )
                  s" in file " type count type
--- 5027,5031 ----
                    if drop (file-kernel) then
                  then ;
! 
  : (viewtype)    ( line# c-addr -- )
                  s" in file " type count type
***************
*** 5296,5304 ****
  \     that does a sequential scan through the PROCs list
  
! : find          ( addr -- addr false | xt -1 | xt 1 )
                  dup count find-name dup if        \ find the name
                    nip name>xtimm                  \ xt imm
                  then ;                            \ else str 0
  
  \ ----------------------- Local values support -------------------------------
  
--- 5299,5311 ----
  \     that does a sequential scan through the PROCs list
  
! defer find
! 
! : parmfind          ( addr -- addr false | xt -1 | xt 1 )
                  dup count find-name dup if        \ find the name
                    nip name>xtimm                  \ xt imm
                  then ;                            \ else str 0
  
+ ' parmfind is find
+ 
  \ ----------------------- Local values support -------------------------------
  

[Win32forth-cvs] win32forth-stc/src 486asm.f,1.3,1.4

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

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

Modified Files:
	486asm.f 
Log Message:
gah: Bug fix to ;code

Index: 486asm.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/486asm.f,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** 486asm.f	22 Mar 2007 02:06:38 -0000	1.3
--- 486asm.f	24 Apr 2007 08:50:32 -0000	1.4
***************
*** 29,33 ****
  ( declare the vocabularies needed )
  only forth definitions ( vocabulary assembler ) also assembler definitions
! vocabulary asm-hidden also asm-hidden definitions 
  
  ( words to manipulate the vocabulary search order )
--- 29,33 ----
  ( declare the vocabularies needed )
  only forth definitions ( vocabulary assembler ) also assembler definitions
! vocabulary asm-hidden also asm-hidden definitions
  
  ( words to manipulate the vocabulary search order )
***************
*** 2032,2036 ****
  
  : _;code ( create the [;code] part of a low level defining word )
!         ?csp !csp compile (;code) postpone [ init-asm ;
  
  in-forth
--- 2032,2036 ----
  
  : _;code ( create the [;code] part of a low level defining word )
!         ?csp !csp postpone (;code) postpone unnest postpone [ init-asm ;
  
  in-forth
***************
*** 2045,2049 ****
  
  : macro: ( create a macro in the assembler vocabulary )
!         get-current >r also assembler definitions 
          : postpone enter-macro r> set-current ;
  
--- 2045,2049 ----
  
  : macro: ( create a macro in the assembler vocabulary )
!         get-current >r also assembler definitions
          : postpone enter-macro r> set-current ;
  
***************
*** 2061,2065 ****
  
  : endm ( end a macro definition )
!         postpone leave-macro postpone ; previous ; 
  also forth immediate previous
  
--- 2061,2065 ----
  
  : endm ( end a macro definition )
!         postpone leave-macro postpone ; previous ;
  also forth immediate previous
  

[Win32forth-cvs] Photoshop 7.0 OEM for $44.95!!??

[Marcy L. <mar...@ed...>]

<html>
<body bgcolor=3D"#ffffff" text=3D"#000000">
<img src=3D"cid:EE700674=2EA983AB7F">
<br>
The reading or non-reading a book will never keep down a single petticoa=
t=2E
<br>
What is forgiven is usually well remembered=2E
<br>
Experience which was once claimed by the aged is now claimed exclusively=
 by the young=2E
<br>
If you think you're free, there's no escape possible=2E
<br>
No scoundrel is so stupid as to not find a reason for his vile conduct=2E=

<br>
You need to make a commitment, and once you make it, then life will give=
 you some answers=2E
<br>
The jealous are possessed by a mad devil and a dull spirit at the same t=
ime=2E
<br>
I know the joy of fishes in the river through my own joy, as I go walkin=
g along the same river=2E
<br>
I have no greater joy then to hear that my children walk in truth=2E [Jo=
hn 4]
<br>
History repeats itself=2E That's one of the things wrong with history=2E=

<br>
America is the country where you can buy a lifetime supply of aspirin Fo=
r one dollar and use it up in two weeks=2E
<br>
The bigger the information media, the less courage and freedom they allo=
w=2E Bigness means weakness=2E
<br>
Every great man nowadays has his disciples, and it is usually Judas who =
writes the biography=2E
</body>
</html>

[Win32forth-cvs] win32forth/src PRIMHASH.F,1.6,1.7

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

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

Modified Files:
	PRIMHASH.F 
Log Message:
gah: Bug fix to work correctly for more than 2 method lists

Index: PRIMHASH.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/PRIMHASH.F,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** PRIMHASH.F	16 Apr 2007 09:07:23 -0000	1.6
--- PRIMHASH.F	18 Apr 2007 09:18:40 -0000	1.7
***************
*** 8,17 ****
  
  sys-here ' classes >body -                    \ voc-pfa-size
!           5 cells sys-reserve                 \ extra for a class
!           constant voc-pfa-size
  
! also classes get-current definitions
  
! 2 constant #mlists \ Number of method lists; must be a non-zero power of 2.
  
  set-current previous
--- 8,18 ----
  
  sys-here ' classes >body -                    \ voc-pfa-size
!           2 dup                               \ for #mlists below
!           4 + cells sys-reserve               \ extra for a class
!           swap constant voc-pfa-size
  
! also classes get-current swap definitions
  
! constant #mlists \ Number of method lists; must be a non-zero power of 2.
  
  set-current previous
***************
*** 51,55 ****
  @@2:            next    c;
  
! CODE ((FINDV))  ( SelID addr -- 0cfa t | f )
                  pop     eax                     \ selector id
  @@1:            mov     ebx, 0 [ebx]            \ follow link
--- 52,56 ----
  @@2:            next    c;
  
! CODE ((FINDV))  ( SelID addr -- 'ivar t | f )
                  pop     eax                     \ selector id
  @@1:            mov     ebx, 0 [ebx]            \ follow link
***************
*** 58,62 ****
                  cmp     eax, 4 [ebx]            \ selectors match?
                  jne     short @@1
!                 add     ebx, # 8                \ method cfa
                  push    ebx
                  mov     ebx, # -1               \ and true flag
--- 59,63 ----
                  cmp     eax, 4 [ebx]            \ selectors match?
                  jne     short @@1
!                 add     ebx, # 8                \ ivar structure
                  push    ebx
                  mov     ebx, # -1               \ and true flag

[Win32forth-cvs] win32forth-stc/src primhash.f,1.1,1.2

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

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

Modified Files:
	primhash.f 
Log Message:
gah: Converted code for STC (work in progress).

Index: primhash.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/primhash.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** primhash.f	13 Mar 2007 23:48:16 -0000	1.1
--- primhash.f	18 Apr 2007 09:13:04 -0000	1.2
***************
*** 2,50 ****
  \ PRIMHASH.F    primitive hash functions
  
! ((
!   --------------------------- Change Block -------------------------------
! 
!   arm 15/08/2005 22:56:45
!       First version 0.1 STC based kernel
! 
! 
! 
!   ------------------------- End Change Block -----------------------------
! 
!   Experimental: a fully optimising, STC based, ANS Forth compliant kernel
! 
!   Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
  
-   The original Win32Forth system was public domain; this kernel (and
-   currently the kernel alone) is GPL. Although the basic structure of
-   Win32Forth and many of its capabilities are employed in this code, most
-   of the original Win32Forth kernel has been completely rewritten. The
-   original code was originally developed by Tom Zimmer, Andrew McKewan
-   with minor contributions by others and placed in the public domain. I
-   acknowledge their copyrighted contributions and the structure and some
-   of the methods and concepts employed in this further development.
  
!   The assembler is Copyright [c] 1994, 1995, by Jim Schneider and is issued
!   under the LGPL.
  
!   This program is free software; you can redistribute it and/or modify it
!   under the terms of the GNU General Public License as published by the
!   Free Software Foundation; either version 2 of the License, or <at your
!   option> any later version.
  
!   This program is distributed in the hope that it will be useful, but
!   WITHOUT ANY WARRANTY; without even the implied warranty of
!   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
!   General Public License for more details.
  
!   You should have received a copy of the GNU General Public License along
!   with this program; if not, write to the Free Software Foundation, Inc.,
!   675 Mass Ave, Cambridge, MA 02139, USA.
  
!   ------------------------------------------------------------------------
! ))
  
! cr .( Loading Primitive Hash...)
  
  
  \ ---------------- 32-bit Hash Function for Objects ----------------
--- 2,67 ----
  \ PRIMHASH.F    primitive hash functions
  
! \   --------------------------- Change Block -------------------------------
! \
! \   arm 15/08/2005 22:56:45
! \       First version 0.1 STC based kernel
! \
! \
! \
! \   ------------------------- End Change Block -----------------------------
! \
! \   Experimental: a fully optimising, STC based, ANS Forth compliant kernel
! \
! \   Copyright [c] 2005 by Alex McDonald (alex at rivadpm dot com)
! \                         Dirk Busch    (dirk at win32forth.org)
! \                         George Hubert (georgeahubert at yahoo.co.uk)
! \   The original Win32Forth system was public domain; this kernel (and
! \   currently the kernel alone) is GPL. Although the basic structure of
! \   Win32Forth and many of its capabilities are employed in this code, most
! \   of the original Win32Forth kernel has been completely rewritten. The
! \   original code was originally developed by Tom Zimmer, Andrew McKewan
! \   with minor contributions by others and placed in the public domain. I
! \   acknowledge their copyrighted contributions and the structure and some
! \   of the methods and concepts employed in this further development.
! \
! \   The assembler is Copyright [c] 1994, 1995, by Jim Schneider and is issued
! \   under the LGPL.
! \
! \   This program is free software; you can redistribute it and/or modify it
! \   under the terms of the GNU General Public License as published by the
! \   Free Software Foundation; either version 2 of the License, or <at your
! \   option> any later version.
! \
! \   This program is distributed in the hope that it will be useful, but
! \   WITHOUT ANY WARRANTY; without even the implied warranty of
! \   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
! \   General Public License for more details.
! \
! \   You should have received a copy of the GNU General Public License along
! \   with this program; if not, write to the Free Software Foundation, Inc.,
! \   675 Mass Ave, Cambridge, MA 02139, USA.
! \
! \   ------------------------------------------------------------------------
  
  
! cr .( Loading Primitive Hash...)
  
! : sys-reserve ( n -- )
!                 get-section 2>r                        \ save dp and xdp
!                 in-system here over allot swap erase   \ move to in-system
!                 2r> set-section ;
  
! 7 #vocabulary classes
  
! sys-here ' classes >body -                    \ voc-pfa-size
!           2 dup
!           4 + cells sys-reserve                 \ extra for a class
!           swap constant voc-pfa-size
  
! also classes get-current swap definitions
  
! constant #mlists \ Number of method lists; must be a non-zero power of 2.
  
+ set-current previous
  
  \ ---------------- 32-bit Hash Function for Objects ----------------
***************
*** 67,87 ****
                  next    c;
  
- \s
- 
  \ -------------------- Method/Ivar Search --------------------
  
! CODE ((FINDM))  ( SelID addr -- 0cfa t | f )
!                 pop     eax                     \ selector id
! @@1:            mov     ebx, 0 [ebx]            \ follow link
!                 test    ebx, ebx                \ end of list?
                  je      short @@2
!                 cmp     eax, 4 [ebx]            \ selectors match?
                  jne     short @@1
!                 add     ebx, # 8                \ method cfa
!                 push    ebx
!                 mov     ebx, # -1               \ and true flag
! @@2:            next    c;
  
  
  \ -------------------- Runtime for Methods --------------------
  \ m0cfa is executed when the object address is on the stack
--- 84,121 ----
                  next    c;
  
  \ -------------------- Method/Ivar Search --------------------
  
! CODE ((FINDM))  ( SelID addr -- xt t | f )
!                 mov     edx, 0 [ebp]            \ selector id
!                 mov     ecx, edx
!                 and     ecx, # also classes #mlists 1- cells previous
!                 add     eax, ecx
! @@1:            mov     eax, 0 [eax]            \ follow link
!                 test    eax, eax                \ end of list?
                  je      short @@2
!                 cmp     edx, 4 [eax]            \ selectors match?
                  jne     short @@1
!                 mov     eax, 8 [eax]            \ method cfa
!                 mov     0 [ebp], eax
!                 mov     eax, # -1               \ and true flag
!                 ret
! @@2:            lea     ebp, 4 [ebp]
!                 next    c;
  
+ CODE ((FINDV))  ( SelID addr -- 'ivar t | f )
+                 mov     edx, 0 [ebp]            \ selector id
+ @@1:            mov     eax, 0 [eax]            \ follow link
+                 test    eax, eax                \ end of list?
+                 je      short @@2
+                 cmp     edx, 4 [eax]            \ selectors match?
+                 jne     short @@1
+                 add     eax, # 8                \ ivar structure
+                 mov     0 [ebp], eax
+                 mov     eax, # -1               \ and true flag
+                 ret
+ @@2:            lea     ebp, 4 [ebp]
+                 next    c;
  
+ ((
  \ -------------------- Runtime for Methods --------------------
  \ m0cfa is executed when the object address is on the stack
***************
*** 151,160 ****
  \ return the base of the current object
  
  CODE ^BASE      ( -- addr )
!                 push    ebx
!                 mov     ebx, OP [UP]
                  next    c;
  
! 
  \ -------------------- Runtime for Instance Variables --------------------
  
--- 185,200 ----
  \ return the base of the current object
  
+ ))
+ 
+ ' exit alias exitm
+ 
  CODE ^BASE      ( -- addr )
!                 0 1 in/out
!                 mov     -4 [ebp], eax
!                 mov     eax, OP [UP]
!                 lea     ebp, -4 [ebp]
                  next    c;
  
! ((
  \ -------------------- Runtime for Instance Variables --------------------
  
***************
*** 272,292 ****
                  next    c;
  
  
  \ -------------------- Object pointer --------------------
  
! : OP@  OP @ ;   \ to allow UP to be kept in the EDX register
  : OP!  OP ! ;
  
! \ -------------------- Find Name for Hashed Value --------------------
  
! 79 #vocabulary hashed
  
! ' hashed vcfa>voc constant hash-wid
  
! 7 #vocabulary classes
  
! sys-here ' classes >body -                    \ voc-pfa-size
!           5 cells sys-reserve                 \ extra for a class
!           constant voc-pfa-size
  
  : (unhash)  ( hash-val -- addr len flag )
--- 312,352 ----
                  next    c;
  
+ ))
  
  \ -------------------- Object pointer --------------------
  
! : OP@  OP @ ;   \ to allow UP to be kept in the EBX register
  : OP!  OP ! ;
  
! \ -------------------- Operations on OP ------------------
  
! \ Note these will probably be renamed when extensions are proposed
! \ for Forth200X
  
! in-system
  
! : PushOP  ( R: -- oldOP )
!                (comp-only) compilation> drop
!                macro[ push OP [UP] ]macro ;
  
! : PopOP   ( R: oldOP -- )
!                (comp-only) compilation> drop
!                macro[ pop OP [UP] ]macro ;
! 
! : lit>OP     ( n -- )
!                (comp-only) compilation> drop
!                >r macro[ mov OP [UP], # r> ]macro ;
! 
! : lit+OP     ( n -- )
!                (comp-only) compilation> drop
!                >r macro[ add OP [UP], # r> ]macro ;
! 
! in-previous
! 
! \ -------------------- Find Name for Hashed Value --------------------
! 
! 79 #vocabulary hashed
! 
! ' hashed >body constant hash-wid
  
  : (unhash)  ( hash-val -- addr len flag )
***************
*** 295,302 ****
                  begin   @ ?dup
                  while   ( hash-val link-field )
!                         2dup link> >body @ =
                          if      nip ( discard hash value )
!                                 l>name
! 				dup LATEST-NFA ! \ save nfa for other use (Sonntag, März 13 2005 dbu)
  				count ( addr len )
                                  true unloop exit
--- 355,362 ----
                  begin   @ ?dup
                  while   ( hash-val link-field )
!                         2dup link>name name>xt >body @ =
                          if      nip ( discard hash value )
!                                 link>name
! \				dup LATEST-NFA ! \ save nfa for other use (Sonntag, März 13 2005 dbu)
  				count ( addr len )
                                  true unloop exit
***************
*** 318,321 ****
--- 378,385 ----
  ' drop is clash
  
+ \ Temporary hack
+ : "constant    ( n addr len -- )
+                 s" constant " pad place pad +place pad count evaluate ;
+ 
  : add-hash  ( addr len hash-val -- )
          >r 2dup hash-wid search-wordlist
***************
*** 323,332 ****
                  r> 4drop  ( already found )
          else
!                 hash-wid swap-current >r
!                 "header docon ,
                  r> set-current
!                 r> dup , clash
          then ;
! 
  0 value obj-save
  
--- 387,396 ----
                  r> 4drop  ( already found )
          else
!                 hash-wid swap-current r@ swap >r -rot
!                 ( "header docon , , ) "constant \ needs adding to kernel
                  r> set-current
!                 r> clash
          then ;
! ((
  0 value obj-save
  
***************
*** 351,355 ****
          else    ."  self "
          then    ;
! 
  IN-APPLICATION
  
--- 415,419 ----
          else    ."  self "
          then    ;
! ))
  IN-APPLICATION
  

[Win32forth-cvs] win32forth/src Class.f, 1.27, 1.28 PRIMHASH.F, 1.5, 1.6

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

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

Modified Files:
	Class.f PRIMHASH.F 
Log Message:
gah: Minor corrections

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -d -r1.27 -r1.28
*** Class.f	16 Apr 2007 08:29:06 -0000	1.27
--- Class.f	16 Apr 2007 09:07:23 -0000	1.28
***************
*** 1252,1256 ****
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup ] cell- Free Abort" Disposing Object failed!" ;
  
  
--- 1252,1256 ----
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ;
  
  

Index: PRIMHASH.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/PRIMHASH.F,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** PRIMHASH.F	16 Apr 2007 08:29:06 -0000	1.5
--- PRIMHASH.F	16 Apr 2007 09:07:23 -0000	1.6
***************
*** 13,17 ****
  also classes get-current definitions
  
! 2 constant #mlists \ Number of method lists; must a non-zero be a power of 2.
  
  set-current previous
--- 13,17 ----
  also classes get-current definitions
  
! 2 constant #mlists \ Number of method lists; must be a non-zero power of 2.
  
  set-current previous

[Win32forth-cvs] win32forth/apps/SciEdit ClassBrowser.f,1.5,1.6

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

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

Modified Files:
	ClassBrowser.f 
Log Message:
gah: Added #mlists to enable multiple methods lists (currently set to2).

Index: ClassBrowser.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/SciEdit/ClassBrowser.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ClassBrowser.f	9 Jun 2006 12:10:32 -0000	1.5
--- ClassBrowser.f	16 Apr 2007 08:29:04 -0000	1.6
***************
*** 171,184 ****
                  drop -1 false ;
  
! : AddMethods    ( class-pfa -- )  \ add methods of a class to the treview
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA @ to superlist
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop ;
  
! : (AddClass)    ( class-pfa -- )  \ add class to the treview
                  dup BODY> hPrev hRoot true AddName \ add name
                  hPrev dup to hRoot to hSon AddMethods ; \ add methods
--- 171,187 ----
                  drop -1 false ;
  
! : AddMethods    ( class-pfa -- )  \ add methods of a class to the treeview
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA
!                 #mlists 0 do
!                 2dup i tuck cells+ @ to superlist cells+
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop
!                 loop   2drop ;
  
! : (AddClass)    ( class-pfa -- )  \ add class to the treeview
                  dup BODY> hPrev hRoot true AddName \ add name
                  hPrev dup to hRoot to hSon AddMethods ; \ add methods

[Win32forth-cvs] win32forth/src CHILDWND.F, 1.9, 1.10 CLASSDBG.F, 1.9, 1.10 Class.f, 1.26, 1.27 GENERIC.F, 1.14, 1.15 PRIMHASH.F, 1.4, 1.5

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

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

Modified Files:
	CHILDWND.F CLASSDBG.F Class.f GENERIC.F PRIMHASH.F 
Log Message:
gah: Added #mlists to enable multiple methods lists (currently set to2).

Index: CHILDWND.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CHILDWND.F,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** CHILDWND.F	8 Nov 2006 11:11:24 -0000	1.9
--- CHILDWND.F	16 Apr 2007 08:29:05 -0000	1.10
***************
*** 10,13 ****
--- 10,15 ----
  only forth also definitions
  
+ needs window.f
+ 
  :CLASS Child-Window     <Super Window
  \ *G Child-Window is the base class for all child windows.

Index: Class.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/Class.f,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
*** Class.f	21 Feb 2007 10:13:17 -0000	1.26
--- Class.f	16 Apr 2007 08:29:06 -0000	1.27
***************
*** 66,74 ****
  
  voc-pfa-size nostack1
! cell field+ MFA        \ method dictionary
! cell field+ IFA        \ instance variable dictionary
! cell field+ DFA        \ data area size in bytes
! cell field+ XFA        \ width of indexed items
! cell field+ SFA        \ pointer to superclass
  constant class-size    \ size of class pfa
  
--- 66,74 ----
  
  voc-pfa-size nostack1
! #mlists cells field+ MFA        \ method dictionary
!         cell  field+ IFA        \ instance variable dictionary
!         cell  field+ DFA        \ data area size in bytes
!         cell  field+ XFA        \ width of indexed items
!         cell  field+ SFA        \ pointer to superclass
  constant class-size    \ size of class pfa
  
***************
*** 247,251 ****
  : VFIND         ( str -- str f OR ^iclass t )
                  ^class
!                 IF      dup count method-hash ^class IFA ((findm))
                          -if  rot drop  then
                  ELSE    0
--- 247,251 ----
  : VFIND         ( str -- str f OR ^iclass t )
                  ^class
!                 IF      dup count method-hash ^class IFA ((findv))
                          -if  rot drop  then
                  ELSE    0
***************
*** 253,257 ****
  
  : classVFIND    ( str ^class -- str f OR ^iclass t )
!                 >r dup count method-hash r> IFA ((findm))
                  -if  rot drop  then  ;
  
--- 253,257 ----
  
  : classVFIND    ( str ^class -- str f OR ^iclass t )
!                 >r dup count method-hash r> IFA ((findv))
                  -if  rot drop  then  ;
  
***************
*** 634,638 ****
                  ?Class ?Exec
                  dup pocket count rot new-method on add-hash
!                 ^Class MFA link,        \ link
                  ,                       \ name is selector's hashed value
                  m0cfa ,                 \ build methods cfas
--- 634,639 ----
                  ?Class ?Exec
                  dup pocket count rot new-method on add-hash
!                 ^Class MFA over [ #mlists 1- cells ] literal and +
!                 link,        \ link
                  ,                       \ name is selector's hashed value
                  m0cfa ,                 \ build methods cfas
***************
*** 1251,1255 ****
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup>r ] r> cell- Free Abort" Disposing Object failed!" ;
  
  
--- 1252,1256 ----
  : Dispose       ( addr -- )
  \ *G Dispose of a dynamically allocated object.
!                 ~: [ dup ] cell- Free Abort" Disposing Object failed!" ;
  
  

Index: GENERIC.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/GENERIC.F,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** GENERIC.F	11 Aug 2006 10:09:45 -0000	1.14
--- GENERIC.F	16 Apr 2007 08:29:06 -0000	1.15
***************
*** 395,399 ****
  \ ** The foreground window is the window at the top of the Z order. It is the window that the
  \ ** user is working with. In a preemptive multitasking environment, you should generally let the
! \ ** user control which window is the foreground window. }n
  \ ** Windows 98, Windows 2000: The system restricts which processes can set the foreground window.
  \ ** A process can set the foreground window only if one of the following conditions is true: \n
--- 395,399 ----
  \ ** The foreground window is the window at the top of the Z order. It is the window that the
  \ ** user is working with. In a preemptive multitasking environment, you should generally let the
! \ ** user control which window is the foreground window. \n
  \ ** Windows 98, Windows 2000: The system restricts which processes can set the foreground window.
  \ ** A process can set the foreground window only if one of the following conditions is true: \n
***************
*** 431,438 ****
  \ ** application-defined message and title, plus any combination of predefined icons and push buttons.
  \ *L
! \ *| szText  | Pointer to a null-terminated string that contains the message to be displayed. \n
! \ *| szTitle | Pointer to a null-terminated string that contains the dialog box title. If this parameter is NULL, the default title Error is used. \n
! \ *| Type    | Specifies the contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags.
! \ *P To indicate the buttons displayed in the message box, specify one of the following values.
  \ *L
  \ *| MB_ABORTRETRYIGNORE  | The message box contains three push buttons: Abort, Retry, and Ignore. |
--- 431,438 ----
  \ ** application-defined message and title, plus any combination of predefined icons and push buttons.
  \ *L
! \ *| szText  | Pointer to a null-terminated string that contains the message to be displayed. |
! \ *| szTitle | Pointer to a null-terminated string that contains the dialog box title. If this parameter is NULL, the default title Error is used. |
! \ *| Type    | Specifies the contents and behavior of the dialog box. This parameter can be a combination of flags from the following groups of flags. |
! \ *P To indicate the buttons displayed in the message box, specify one of the following values. |
  \ *L
  \ *| MB_ABORTRETRYIGNORE  | The message box contains three push buttons: Abort, Retry, and Ignore. |

Index: PRIMHASH.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/PRIMHASH.F,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** PRIMHASH.F	5 Jan 2006 11:03:55 -0000	1.4
--- PRIMHASH.F	16 Apr 2007 08:29:06 -0000	1.5
***************
*** 5,8 ****
--- 5,19 ----
  cr .( Loading Primitive Hash...)
  
+ 7 #vocabulary classes
+ 
+ sys-here ' classes >body -                    \ voc-pfa-size
+           5 cells sys-reserve                 \ extra for a class
+           constant voc-pfa-size
+ 
+ also classes get-current definitions
+ 
+ 2 constant #mlists \ Number of method lists; must a non-zero be a power of 2.
+ 
+ set-current previous
  
  \ ---------------- 32-bit Hash Function for Objects ----------------
***************
*** 27,30 ****
--- 38,44 ----
  CODE ((FINDM))  ( SelID addr -- 0cfa t | f )
                  pop     eax                     \ selector id
+                 mov     ecx, eax
+                 and     ecx, # also classes #mlists 1- cells previous
+                 add     ebx, ecx
  @@1:            mov     ebx, 0 [ebx]            \ follow link
                  test    ebx, ebx                \ end of list?
***************
*** 37,40 ****
--- 51,65 ----
  @@2:            next    c;
  
+ CODE ((FINDV))  ( SelID addr -- 0cfa t | f )
+                 pop     eax                     \ selector id
+ @@1:            mov     ebx, 0 [ebx]            \ follow link
+                 test    ebx, ebx                \ end of list?
+                 je      short @@2
+                 cmp     eax, 4 [ebx]            \ selectors match?
+                 jne     short @@1
+                 add     ebx, # 8                \ method cfa
+                 push    ebx
+                 mov     ebx, # -1               \ and true flag
+ @@2:            next    c;
  
  \ -------------------- Runtime for Methods --------------------
***************
*** 238,247 ****
  ' hashed vcfa>voc constant hash-wid
  
- 7 #vocabulary classes
- 
- sys-here ' classes >body -                    \ voc-pfa-size
-           5 cells sys-reserve                 \ extra for a class
-           constant voc-pfa-size
- 
  : (unhash)  ( hash-val -- addr len flag )
          hash-wid dup voc#threads cells+ hash-wid  ( hash-wid end to hash-wid )
--- 263,266 ----

Index: CLASSDBG.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/CLASSDBG.F,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** CLASSDBG.F	10 Jun 2006 13:17:24 -0000	1.9
--- CLASSDBG.F	16 Apr 2007 08:29:06 -0000	1.10
***************
*** 17,24 ****
  
  : _methods      ( class_body -- )
!                 MFA
                  begin   @ ?dup
                  while   .method
!                 repeat  ;
  
  : ?.match       ( n lfa -- n )
--- 17,26 ----
  
  : _methods      ( class_body -- )
!                 MFA #mlists 0 do
!                 dup i cells+
                  begin   @ ?dup
                  while   .method
!                 repeat
!                 loop drop ;
  
  : ?.match       ( n lfa -- n )
***************
*** 50,58 ****
                  cr ." New Methods :-" cr
                  ' >body dup
!                 sfa @  swap
!                 mfa over mfa @ to superlist
                  begin   @ dup superlist <>
                  while   .method
                  repeat  drop
                  cr ." Inherited Methods :-" cr
                   _methods ;
--- 52,62 ----
                  cr ." New Methods :-" cr
                  ' >body dup
!                 sfa @ swap
!                 #mlists 0 do 2dup
!                 mfa i cells+ swap mfa i cells+ @ to superlist
                  begin   @ dup superlist <>
                  while   .method
                  repeat  drop
+                 loop    drop
                  cr ." Inherited Methods :-" cr
                   _methods ;

[Win32forth-cvs] win32forth/src/tools ClassBrowser.f,1.4,1.5

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

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

Modified Files:
	ClassBrowser.f 
Log Message:
gah: Added #mlists to enable multiple methods lists (currently set to2).

Index: ClassBrowser.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/tools/ClassBrowser.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** ClassBrowser.f	9 Jun 2006 10:42:37 -0000	1.4
--- ClassBrowser.f	16 Apr 2007 08:29:06 -0000	1.5
***************
*** 172,180 ****
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA @ to superlist
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop ;
  
  : (AddClass)    ( class-pfa -- )  \ add class to the treview
--- 172,183 ----
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA
!                 #mlists 0 do
!                 2dup i tuck cells+ @ to superlist cells+
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop
!                 loop   2drop ;
  
  : (AddClass)    ( class-pfa -- )  \ add class to the treview

[Win32forth-cvs] win32forth/apps/Win32ForthIDE ClassBrowser.f, 1.5, 1.6

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

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

Modified Files:
	ClassBrowser.f 
Log Message:
gah: Added #mlists to enable multiple methods lists (currently set to2).

Index: ClassBrowser.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ClassBrowser.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ClassBrowser.f	13 Oct 2006 03:55:11 -0000	1.5
--- ClassBrowser.f	16 Apr 2007 08:29:05 -0000	1.6
***************
*** 185,198 ****
                  drop -1 false ;
  
! : AddMethods    ( class-pfa -- )  \ add methods of a class to the treview
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA @ to superlist
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop ;
  
! : (AddClass)    ( class-pfa -- )  \ add class to the treview
                  dup BODY> hPrev hRoot true AddName \ add name
                  hPrev dup to hRoot to hSon AddMethods ; \ add methods
--- 185,201 ----
                  drop -1 false ;
  
! : AddMethods    ( class-pfa -- )  \ add methods of a class to the treeview
                  { \ superlist -- }
                  dup MFA swap
!                 SFA @ MFA
!                 #mlists 0 do
!                 2dup i tuck cells+ @ to superlist cells+
                  begin  @ dup  superlist <>
                  while  dup cell+ @ HASH> ( cfa )
                         if hPrev hSon false AddName else drop then
!                 repeat drop
!                 loop   2drop ;
  
! : (AddClass)    ( class-pfa -- )  \ add class to the treeview
                  dup BODY> hPrev hRoot true AddName \ add name
                  hPrev dup to hRoot to hSon AddMethods ; \ add methods

[Win32forth-cvs] win32forth/src/lib ScintillaControl.f,1.5,1.6

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

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

Modified Files:
	ScintillaControl.f 
Log Message:
Bug fixes to allow Search and Replace to work. EAB

Index: ScintillaControl.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/lib/ScintillaControl.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** ScintillaControl.f	11 Jun 2006 07:37:27 -0000	1.5
--- ScintillaControl.f	15 Apr 2007 03:30:53 -0000	1.6
***************
*** 964,968 ****
  
  :M GetTargetStart:  ( -- pos )
!                 0 0 SCI_GETTARGETSTART SendMessage:Self drop ;M
  
  :M SetTargetEnd:  ( pos -- )
--- 964,968 ----
  
  :M GetTargetStart:  ( -- pos )
!                 0 0 SCI_GETTARGETSTART SendMessage:Self  ;M
  
  :M SetTargetEnd:  ( pos -- )
***************
*** 970,974 ****
  
  :M GetTargetEnd:  ( -- pos )
!                 0 0 SCI_GETTARGETEND SendMessage:Self drop ;M
  
  \ Set the target start and end to the start and end positions of the selection.
--- 970,974 ----
  
  :M GetTargetEnd:  ( -- pos )
!                 0 0 SCI_GETTARGETEND SendMessage:Self  ;M
  
  \ Set the target start and end to the start and end positions of the selection.
***************
*** 979,986 ****
  \ option flags including a simple regular expression search.
  :M SetSearchFlags:  ( Flags -- )
!                 0 SCI_SETSEARCHFLAGS SendMessage:Self drop ;M
  
  :M GetSearchFlags:  ( -- Flags  )
!                 0 0 SCI_GETSEARCHFLAGS SendMessage:Self drop ;M
  
  \ This searches for the first occurrence of a text string in the target defined
--- 979,986 ----
  \ option flags including a simple regular expression search.
  :M SetSearchFlags:  ( Flags -- )
!                 0 swap SCI_SETSEARCHFLAGS SendMessage:Self drop ;M
  
  :M GetSearchFlags:  ( -- Flags  )
!                 0 0 SCI_GETSEARCHFLAGS SendMessage:Self  ;M
  
  \ This searches for the first occurrence of a text string in the target defined
***************
*** 991,995 ****
  \ search fails, the result is -1.
  :M SearchInTarget:  ( addr len -- n )
!                 swap SCI_SEARCHINTARGET SendMessage:Self ;M
  
  \ If length is -1, text is a zero terminated string, otherwise length sets the
--- 991,995 ----
  \ search fails, the result is -1.
  :M SearchInTarget:  ( addr len -- n )
!                  SCI_SEARCHINTARGET SendMessage:Self ;M
  
  \ If length is -1, text is a zero terminated string, otherwise length sets the

[Win32forth-cvs] win32forth/doc/ForthForm FF-History.htm,1.8,1.9

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

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

Modified Files:
	FF-History.htm 
Log Message:
Open supported files from the command line. EAB

Index: FF-History.htm
===================================================================
RCS file: /cvsroot/win32forth/win32forth/doc/ForthForm/FF-History.htm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** FF-History.htm	13 Jan 2007 02:15:06 -0000	1.8
--- FF-History.htm	15 Apr 2007 03:01:47 -0000	1.9
***************
*** 27,30 ****
--- 27,33 ----
  <P ALIGN=LEFT>
  
+ <b>Friday, March 16 2007</b> - Added the ability to load all supported  files (.ff, .tdf, .mdf)
+ from the command line.<br><br>
+ 
  <b>Thursday, January 11 2007</b> - Bug fix for static labels. Bitmap.f not loaded when
  control has an image, Been there for a while. Probably because I have never used static labels!

[Win32forth-cvs] win32forth/apps/ForthForm CreateToolBar.f, 1.6, 1.7 FORTHFORM.F, 1.20, 1.21

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

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

Modified Files:
	CreateToolBar.f FORTHFORM.F 
Log Message:
Open supported files from the command line. EAB

Index: FORTHFORM.F
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/FORTHFORM.F,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** FORTHFORM.F	25 Feb 2007 19:04:42 -0000	1.20
--- FORTHFORM.F	15 Apr 2007 02:59:51 -0000	1.21
***************
*** 101,105 ****
  false value ButtonText?             \ display button text ?, actually disabled
  true value ShowMonitor?             \ display  the window positioning monitor
- false value session-error?          \ did an error occurred while loading a session?
  0 value frmdata-size                \ set to values for checking a form
  0 value ctrldata-size               \ before opening it
--- 101,104 ----
***************
*** 222,226 ****
  : ShowPosition  { x y -- } \ display coordinates in status window
                  join$(   s" X= "
! 			 x (.) pad place pad count
  			 s"    "
  			 s" Y= "
--- 221,225 ----
  : ShowPosition  { x y -- } \ display coordinates in status window
                  join$(   s" X= "
! 			 x >str
  			 s"    "
  			 s" Y= "
***************
*** 230,234 ****
  : ShowSize      { w h -- }  \ display dimensions in status window
                  join$(	s" Width= "
! 			w (.) pad place pad count
  			s"   "
  			s" Height= "
--- 229,233 ----
  : ShowSize      { w h -- }  \ display dimensions in status window
                  join$(	s" Width= "
! 			w >str
  			s"   "
  			s" Height= "
***************
*** 440,451 ****
                  ;
  
- \ : ?data-size    ( -- )
- \                 frmdata-size 0<> ctrldata-size 0<> and ?exit
- \                 new> Form dup>r GetData: [ ] nip to frmdata-size
- \                 r> Dispose      \ discard
- \                 new> ControlObject dup>r Getdata: [ ] nip to ctrldata-size
- \                 r> Dispose         \ discard
- \                 ;
- 
  : check-file      { fname fcnt \ fsize -- f }      \ check integrity of file before opening
                    fname fcnt SetName: TheFile   \
--- 439,442 ----
***************
*** 470,477 ****
  
  :NoName         { fname fcnt -- } \ open form given its name
!                 fname fcnt check-file
                  if    join$(    fname fcnt
  				s"  is an invalid ForthForm file!"
! 		      )join$ true swap count ?MessageBox
                        exit
                  then  AddNewForm
--- 461,468 ----
  
  :NoName         { fname fcnt -- } \ open form given its name
!                 fname fcnt check-file ?dup
                  if    join$(    fname fcnt
  				s"  is an invalid ForthForm file!"
! 		      )join$  count ?MessageBox
                        exit
                  then  AddNewForm
***************
*** 498,507 ****
                  [CHAR] " -TRAILCHARS [CHAR] ' -TRAILCHARS BL -TRAILCHARS ;
  
  : HandleCmdLine ( -- ) \ open the Form given via command line (November 8th, 2003 - 9:52 - dbu)
                  CMDLINE ?dup
                  if   \ get command line address and length
                       strip-cmdline
!                      \ and open the form
!                      (OpenForm)
                  else drop
                  then ;
--- 489,511 ----
                  [CHAR] " -TRAILCHARS [CHAR] ' -TRAILCHARS BL -TRAILCHARS ;
  
+ : OpenByExtension { addr cnt -- }
+                   addr cnt ".ext-only" pad place pad uppercase
+                   case	s" .FF"		"of	addr cnt (OpenForm)	endof
+ 			s" .TDF"	"of	addr cnt LoadToolBarFile: frmCreateToolBar
+ 									endof
+ 			s" .MDF"	"of	addr cnt doCreateMenu Load: TheMenu
+ 									endof
+ 			s" .SES"	"of	addr cnt temp$ place
+ 						nostack1 temp$ ['] $fload catch
+ 						s" Session load aborted!" ?MessageBox
+ 									endof
+ 		  endcase ;
+ 
  : HandleCmdLine ( -- ) \ open the Form given via command line (November 8th, 2003 - 9:52 - dbu)
                  CMDLINE ?dup
                  if   \ get command line address and length
                       strip-cmdline
!                      \ and open the file
!                      OpenByExtension
                  else drop
                  then ;
***************
*** 761,765 ****
                  if   w l Handle_Notify: MainToolBar
                  else hwndfrom GetHandle: ControlToolBar =
!                      hwndfrom ToolTipHandle: COntrolToolBar = or
                       if    w l Handle_Notify: ControlToolBar
                       else  false
--- 765,769 ----
                  if   w l Handle_Notify: MainToolBar
                  else hwndfrom GetHandle: ControlToolBar =
!                      hwndfrom ToolTipHandle: ControlToolBar = or
                       if    w l Handle_Notify: ControlToolBar
                       else  false
***************
*** 854,858 ****
  :M On_Paint:    ( -- )
  \+ withbgnd     ReDrawImage: self
!                 canvas: self BackGroundColor FillArea: dc
                  ;M
  
--- 858,862 ----
  :M On_Paint:    ( -- )
  \+ withbgnd     ReDrawImage: self
!                 Canvas: self BackGroundColor FillArea: dc
                  ;M
  
***************
*** 861,865 ****
  
                  doCloseAllForms
- \                DisposeForms
                  close-windows
  
--- 865,868 ----
***************
*** 921,925 ****
                  SetForegroundWindow: self
                  param-buffer count ?dup
!                 if      (openForm)
                  else    drop
                  then    ;
--- 924,928 ----
                  SetForegroundWindow: self
                  param-buffer count ?dup
!                 if      OpenByExtension
                  else    drop
                  then    ;
***************
*** 1110,1114 ****
                  Start: frmPreferences
                  Disable: chkButtonText
!                 FlatToolbar? Check: chkFlatToolBar
                  ShowMonitor?  Check: chkShowMonitor
                  show-notes?   Check: chkSHowReleaseNotes
--- 1113,1117 ----
                  Start: frmPreferences
                  Disable: chkButtonText
!                 FlatToolbar?  Check: chkFlatToolBar
                  ShowMonitor?  Check: chkShowMonitor
                  show-notes?   Check: chkSHowReleaseNotes
***************
*** 1152,1171 ****
  handle sfile
  
! \ Yeah I know. A simple $fload should work. And it does but I am getting a lot of
! \ values left on the stack and it giving me licks to figure out why :<
! :NoName   ( -- )
!                 false to session-error?         \ reset flag
                  GetHandle: TheMainWindow Start: OpenSessionDlg dup c@
!                 if      count r/o open-file swap to sfile 0=
!                         if      begin   pad maxstring sfile read-line 0= swap 0<> and
!                                 while   pad swap ['] evaluate catch       \ interpret line
!                                         if      sfile close-file drop
!                                                 true s" Load session error!" ?MessageBox
!                                                 true to session-error? exit
!                                         then
!                                 repeat  drop sfile close-file drop
!                         else     true s" Error loading session file!" ?MessageBox
!                                 true to session-error?
!                         then
                  else    drop
                  then    ; is doLoadsession
--- 1155,1162 ----
  handle sfile
  
! :NoName   	( -- )
                  GetHandle: TheMainWindow Start: OpenSessionDlg dup c@
!                 if      nostack1 ['] $fload catch
!                         s" Session load aborted!" ?MessageBox
                  else    drop
                  then    ; is doLoadsession
***************
*** 1215,1219 ****
  
  \ According to the Windows API if the extension is not specified the following
! \ will fail. Strangely enough it works it Win32Forth...but not always.
  
  \+ sysgen       s" %DIRWin32ForthIDE.exe %FILENAME %LINE" editor$ place
--- 1206,1210 ----
  
  \ According to the Windows API if the extension is not specified the following
! \ will fail. Strangely enough it works in Win32Forth...but not always.
  
  \+ sysgen       s" %DIRWin32ForthIDE.exe %FILENAME %LINE" editor$ place

Index: CreateToolBar.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/ForthForm/CreateToolBar.f,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** CreateToolBar.f	27 Dec 2006 18:43:57 -0000	1.6
--- CreateToolBar.f	15 Apr 2007 02:59:51 -0000	1.7
***************
*** 1,10 ****
  \ CreateToolbar.f       \ Create a Win32 API Toolbar
  
- \ needs CreateToolBarForm.frm
- \ needs bitmap.f
- \ needs file.f
- \ needs linklist.f
- \ needs apps\forthform\rect.f
- \  needs apps\forthform\createtoolbarformII.frm
  0 value ThisTBButton
  0 value TBList
--- 1,4 ----
***************
*** 420,438 ****
  		nolist? ?exit
  		Data@: TBList to ThisTBButton
! 		GetText: txtToolTip isToolTip: ThisTBButton
! 		GetText: txtButtonText isButtonText: ThisTBButton
! 		GetText: txtDescription isDescription: ThisTBButton
! 		IsButtonChecked?: chkExtra isExtraButton: ThisTBButton
! 		IsButtonChecked?: chkSeparator isStyleSeparator: ThisTBButton
! 		IsButtonChecked?: chkButton isStyleButton: ThisTBButton
! 		IsButtonChecked?: chkCheck isStyleCheck: ThisTBButton
! 		IsButtonChecked?: chkCheckGroup isStyleCheckGroup: ThisTBButton
! 		IsButtonChecked?: chkGroup isStyleGroup: ThisTBButton
! 		IsButtonChecked?: chkPressed isStatePressed: ThisTBButton
! 		IsButtonChecked?: chkGrayed isStateGrayed: ThisTBButton
! 		IsButtonChecked?: chkEnabled isStateEnabled: ThisTBButton
! 		IsButtonChecked?: chkChecked isStateChecked: ThisTBButton
! 		IsButtonChecked?: chkHidden isStateHidden: ThisTBButton
! 		IsButtonChecked?: chkWrapped isStateWrap: ThisTBButton ;
  
  : UnCheckButtons (  -- )
--- 414,432 ----
  		nolist? ?exit
  		Data@: TBList to ThisTBButton
! 		GetText: txtToolTip                         isToolTip: ThisTBButton
! 		GetText: txtButtonText                   isButtonText: ThisTBButton
! 		GetText: txtDescription                 isDescription: ThisTBButton
! 		IsButtonChecked?: chkExtra 		isExtraButton: ThisTBButton
! 		IsButtonChecked?: chkSeparator 	     isStyleSeparator: ThisTBButton
! 		IsButtonChecked?: chkButton             isStyleButton: ThisTBButton
! 		IsButtonChecked?: chkCheck               isStyleCheck: ThisTBButton
! 		IsButtonChecked?: chkCheckGroup     isStyleCheckGroup: ThisTBButton
! 		IsButtonChecked?: chkGroup               isStyleGroup: ThisTBButton
! 		IsButtonChecked?: chkPressed           isStatePressed: ThisTBButton
! 		IsButtonChecked?: chkGrayed             isStateGrayed: ThisTBButton
! 		IsButtonChecked?: chkEnabled           isStateEnabled: ThisTBButton
! 		IsButtonChecked?: chkChecked           isStateChecked: ThisTBButton
! 		IsButtonChecked?: chkHidden             isStateHidden: ThisTBButton
! 		IsButtonChecked?: chkWrapped              isStateWrap: ThisTBButton ;
  
  : UnCheckButtons (  -- )
***************
*** 504,508 ****
  		if	-1 IsBitmapIndex: ThisTBButton	\ clear any bitmap
  		then	join$(   s" ToolBar Button "
! 				 Link#: TBList (.) pad place pad count
  				 s" /"
  				 #Links: TBList (.)
--- 498,502 ----
  		if	-1 IsBitmapIndex: ThisTBButton	\ clear any bitmap
  		then	join$(   s" ToolBar Button "
! 				 Link#: TBList >str
  				 s" /"
  				 #Links: TBList (.)
***************
*** 664,682 ****
  
  
! : OpenToolBarFile  ( -- )
                  hwnd Start: OpenToolbarDlg count ?dup
!                 if      SetName: TDFFile
! 			check-file abort" Invalid toolbar definition file!"
!                         Open: TDFFile 0=
!                         if  	NewToolBar
! 				ToolBarInfo sizeof(ToolbarInfo) Read: TDFFile
! 				if	Close: TDFFile exit
! 				then	ButtonCount 0
! 				?do	AddNewButton
! 					info: ThisTBButton Read: TDFFile ?leave
! 				loop	Close: TDFFile >FirstLink: TBList
! 			then    LoadProperties refresh
!                 else    drop
!                 then    ;
  
  :m setindex:   { n -- }
--- 658,683 ----
  
  
! : (OpenToolBarFile)  ( addr cnt -- )
!                 SetName: TDFFile
! 		check-file abort" Invalid toolbar definition file!"
!                 Open: TDFFile 0=
!                 if  	NewToolBar
! 			ToolBarInfo sizeof(ToolbarInfo) Read: TDFFile
! 			if	Close: TDFFile exit
! 			then	ButtonCount 0
! 			?do	AddNewButton
! 				info: ThisTBButton Read: TDFFile ?leave
! 			loop	Close: TDFFile >FirstLink: TBList
! 		then    LoadProperties refresh ;
! 
! : OpenToolBarFile	( -- )
                  hwnd Start: OpenToolbarDlg count ?dup
! 		if	(OpenToolBarFile)
! 		else	drop
! 		then	;
! 
! :M LoadToolBarFile:	( addr cnt -- )
! 			Start: self	\ set focus to self
! 			(OpenToolBarfile) ;M
  
  :m setindex:   { n -- }

[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdPrompt.ff, NONE, 1.1 EdPrompt.frm, NONE, 1.1 EdReplace.f, NONE, 1.1 EdReplace.ff, NONE, 1.1 EdReplace.frm, NONE, 1.1 CommandID.f, 1.9, 1.10 EdMenu.f, 1.17, 1.18 EdVersion.f, 1.4, 1.5 Main.f, 1.36, 1.37

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

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

Modified Files:
	CommandID.f EdMenu.f EdVersion.f Main.f 
Added Files:
	EdPrompt.ff EdPrompt.frm EdReplace.f EdReplace.ff 
	EdReplace.frm 
Log Message:
Search and Replace for the IDE editor. EAB

Index: EdVersion.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdVersion.f,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** EdVersion.f	13 Jan 2007 02:20:10 -0000	1.4
--- EdVersion.f	15 Apr 2007 02:55:45 -0000	1.5
***************
*** 262,266 ****
  	- Added a combobox for quick viewing of source for a word.
  	- Ability to open HTML source for editing. Control and double-click in directory window.
! 	- Quick editing and previewing of HTML source docs. Press F10 in HML source to preview in
  	  in browser.
  
--- 262,266 ----
  	- Added a combobox for quick viewing of source for a word.
  	- Ability to open HTML source for editing. Control and double-click in directory window.
! 	- Quick editing and previewing of HTML source docs. Press F10 in HTML source to preview in
  	  in browser.
  
***************
*** 269,270 ****
--- 269,274 ----
  	  Preferences dialog.
  	- Added display of the current column to the status bar.
+ 
+ EAB	Saturday, April 14 2007
+ 	- Added "Search and Replace" ability to the IDE editor. In the process corrected a few bugs in
+ 	  ScintillaControl.f .

Index: EdMenu.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** EdMenu.f	24 Feb 2007 18:15:44 -0000	1.17
--- EdMenu.f	15 Apr 2007 02:55:45 -0000	1.18
***************
*** 75,78 ****
--- 75,79 ----
                  :MenuItem me_findnext "Search &next\tF3"		IDM_FIND_NEXT		DoCommand ;
                  :MenuItem me_findprev "Search &prev\tShift+F3"		IDM_FIND_PREVIOUS	DoCommand ;
+                 :MenuItem me_replace "Search and Replace"			IDM_REPLACE_TEXT	DoCommand ;
                  MenuSeparator
                  :MenuItem me_findinfiles "Find Text in Files...\tCtrl+Shift+F"	IDM_FIND_IN_FILES	DoCommand ;
***************
*** 258,261 ****
--- 259,263 ----
                  dup Enable: me_findnext
                  dup Enable: me_findprev
+                 dup Enable: me_replace
                  dup Enable: me_date
                  dup Enable: me_date&time
***************
*** 325,328 ****
--- 327,331 ----
   			?Find:         ActiveChild Enable: me_findnext
   	                ?Find:         ActiveChild Enable: me_findprev
+  	                GetTextLength: ActiveChild Enable: me_replace
  			?BrowseMode:   ActiveChild not Enable: me_date
  			?BrowseMode:   ActiveChild not Enable: me_date&time

--- NEW FILE: EdReplace.ff ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: EdPrompt.frm ---
\ EDPROMPT.FRM
\- textbox needs excontrols.f


:Object frmPrompt                <Super DialogWindow

Font WinFont           \ default font
' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
ColorObject FrmColor      \ the background color 
150 175  2value XYPos  \ save screen location of form

Label lblPrompt
Label lblReplaceString
PushButton btnYes
PushButton btnNo
PushButton btncancel
PushButton btnYesToAll

:M ClassInit:   ( -- )
                ClassInit: super
                \ Insert your code here
                ;M

:M WindowStyle:  ( -- style )
                WS_POPUPWINDOW WS_DLGFRAME or 
                ;M

\ if this form is a modal form a non-zero parent must be set
:M ParentWindow:  ( -- hwndparent | 0 if no parent )
                hWndParent
                ;M

:M SetParentWindow:  ( hwndparent -- ) \ set owner window
                to hWndParent
                ;M

:M WindowTitle: ( -- ztitle )
                z" Please confirm"
                ;M

:M StartSize:   ( -- width height )
                325 120 
                ;M

:M StartPos:    ( -- x y )
                XYPos
                ;M

:M Close:        ( -- )
                \ Insert your code here
                Close: super
                ;M

:M On_Init:     ( -- )
                s" MS Sans Serif" SetFaceName: WinFont
                8 Width: WinFont
                Create: WinFont 

                \ set form color to system color
                COLOR_BTNFACE Call GetSysColor NewColor: FrmColor


                self Start: lblPrompt
                30 10 282 17 Move: lblPrompt
                Handle: Winfont SetFont: lblPrompt
                s" Replace this highlighted occurrence?" SetText: lblPrompt

                self Start: lblReplaceString
                30 29 282 17 Move: lblReplaceString
                Handle: Winfont SetFont: lblReplaceString
                s" " SetText: lblReplaceString

                self Start: btnYes
                21 85 68 25 Move: btnYes
                Handle: Winfont SetFont: btnYes
                s" Yes" SetText: btnYes

                self Start: btnNo
                91 85 68 25 Move: btnNo
                Handle: Winfont SetFont: btnNo
                s" No" SetText: btnNo

                self Start: btncancel
                161 85 68 25 Move: btncancel
                Handle: Winfont SetFont: btncancel
                s" Cancel" SetText: btncancel

                self Start: btnYesToAll
                231 85 68 25 Move: btnYesToAll
                Handle: Winfont SetFont: btnYesToAll
                s" Yes To All" SetText: btnYesToAll

                ParentWindow: self   \ if this is a modal form disable parent
                if   0 ParentWindow: self Call EnableWindow drop then
                ;M

:M WM_COMMAND   ( h m w l -- res )
                over LOWORD ( ID ) self   \ object address on stack
                WMCommand-Func ?dup    \ must not be zero
                if        execute
                else        2drop   \ drop ID and object address
                then        0 ;M

:M SetCommand:  ( cfa -- )  \ set WMCommand function
                to WMCommand-Func
                ;M

:M On_Paint:    ( -- )
                0 0 GetSize: self Addr: FrmColor FillArea: dc
                ;M

:M On_Done:    ( -- )
                Delete: WinFont
                originx originy 2to XYPos
                ParentWindow: self   \ if modal form re-enable parent
                if   1 ParentWindow: self Call EnableWindow drop
                     \ reset focus to parent if we have one
                     ParentWindow: self Call SetFocus drop
                then
                \ Insert your code here
                On_Done: super
                ;M

;Object

--- NEW FILE: EdReplace.f ---
\ EdReplace.f

needs EdReplace.frm
needs EdPrompt.frm

create findbuf 0 , maxstring allot
create replacebuf 0 , maxstring allot
0 value case?
0 value wholeword?
0 value prompt?
0 value direction
0 value scope
0 value replacecount

: SearchForText	( -- f )
		findbuf count SearchInTarget: CurrentWindow -1 <> ;

: setflags	( -- )
		0	\ default
		case?		if	SCFIND_MATCHCASE +	then
		wholeword?	if	SCFIND_WHOLEWORD +	then
		SetSearchFlags: CurrentWindow ;

: SetScope	( -- )  \ global or from cuurent position
		scope
		if	GetCurrentPos: CurrentWindow
		else	0
		then	GetTextLength: CurrentWindow	( -- start end )
		\ forward or backward search?
		direction
		if	scope 0=	\ if global just swap parameters
			if	swap
			else	2drop GetCurrentPos: CurrentWindow 0
			then
		then	SetTargetEnd: CurrentWindow SetTargetStart: CurrentWindow ;

: SetTargetRange	( -- ) \ what to search
		direction
		if	GetTargetStart: CurrentWindow 0
		else	GetTargetEnd: CurrentWindow GetTextLength: CurrentWindow
		then	SetTargetEnd: CurrentWindow SetTargetStart: CurrentWindow ;

: ReplaceFoundText	( -- )
		replacebuf count ReplaceTarget: CurrentWindow
		SetTargetRange
		1 +to replacecount ;

: ReplaceAllText	( -- )
		begin	ReplaceFoundText
			SearchForText 0=
		until	update ;

: ShowCount	( -- )
		s" Text was found and replaced " pad place
		replacecount (.) pad +place
		s"  time(s)." pad +place
		true pad count ?MessageBox
		0 GotoPos: CurrentWindow ;

:Object frmConfirmPrompt	<Super frmPrompt

:  ?MoreText	( -- )
		SearchForText 0=
		if	Close: self
		else	GetTargetStart: CurrentWindow GetTargetEnd: CurrentWindow
			SetSel: CurrentWindow	\ highlight found text
		then	;

: command-func	( id obj -- )
		drop
		case	GetID: btnYes		of	ReplaceFoundText update
							?MoreText			endof
			GetID: btnNo		of	SetTargetRange ?MoreText	endof
			GetID: btnYesToAll	of	ReplaceAllText
							Close: self
							ShowCount			endof
			GetID: btnCancel	of	Close: self			endof
		endcase	;

:M On_Init:	( -- )
		On_Init: Super

		['] command-func SetCommand: self

		\ give a little reminder
		findbuf count pad place
		s"  --> " pad +place
		replacebuf count pad +place
		pad count SetText: lblReplaceString

		;M

;Object

: StringNotFound	( -- )
		s" Text '" pad place
		findbuf count pad +place
		s"  ' not found!" pad +place
		true pad count ?MessageBox ;

: ReplaceText	( -- )
		findbuf c@ 0= ?exit	\ nothing to find
		SetFlags
		SetScope
		SearchForText
		if	prompt?
			if	GetTargetStart: CurrentWindow GetTargetEnd: CurrentWindow
				SetSel: CurrentWindow	\ highlight found text
				GetHandle: MainWindow SetParentWindow: frmConfirmPrompt
				Start: frmConfirmPrompt
			else	ReplaceAllText
				ShowCount
			then
		else	StringNotFound
		then	;

:Object frmSearch&Replace	<Super frmReplace

: SaveParameters ( -- )
		IsButtonChecked?: chkCase to case?
		IsButtonChecked?: chkWholeWord to wholeword?
		IsButtonChecked?: chkPrompt to prompt?
		IsButtonChecked?: radForward 0= to direction
		IsButtonChecked?: radGlobal 0= to scope
		GetText: txtSearch findbuf place
		GetText: txtReplace replacebuf place ;

: command-func	( id obj -- )
		drop
		case	IDOK		of	SaveParameters
						Close: self
						ReplaceText	endof
			IDCANCEL	of	Close: Self	endof
		endcase	;


:M ON_INIT:	( -- )
		IDOK SetID: btnOK
		IDCANCEL SetID: btnCancel

		On_Init: Super

		case?   Check: chkCase
		prompt?	Check: chkPrompt
		wholeword? Check: chkWholeWord

		direction 0= Check: radForward
		direction    Check: radBackward

		scope 0= Check: radGlobal
		scope    Check: radCurrent

		findbuf count SetText: txtSearch
		Replacebuf count SetText: txtReplace

		['] command-func SetCommand: self

		0 to replacecount

		;m

;Object

: Search&Replace	( -- )
		GetHandle: MainWindow SetParentWindow: frmSearch&Replace
		Start: frmSearch&Replace ; IDM_REPLACE_TEXT SetCommand

\s



--- NEW FILE: EdPrompt.ff ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: EdReplace.frm ---
\ EDREPLACE.FRM
\- textbox needs excontrols.f


:Object frmReplace                <Super DialogWindow

Font WinFont           \ default font
' 2drop value WmCommand-Func   \ function pointer for WM_COMMAND
ColorObject FrmColor      \ the background color 
150 175  2value XYPos  \ save screen location of form

GroupBox grpOptions
GroupBox grpDirection
GroupBox grpScope
Label lblSearch
TextBox txtSearch
Label lblReplace
TextBox txtReplace
CheckBox chkCase
CheckBox chkWholeWord
CheckBox chkPrompt
GroupRadioButton radForward
RadioButton radBackward
GroupRadioButton radGlobal
RadioButton radCurrent
PushButton btnOk
PushButton btnCancel

:M ClassInit:   ( -- )
                ClassInit: super
                \ Insert your code here
                ;M

:M WindowStyle:  ( -- style )
                WS_POPUPWINDOW WS_DLGFRAME or 
                ;M

\ if this form is a modal form a non-zero parent must be set
:M ParentWindow:  ( -- hwndparent | 0 if no parent )
                hWndParent
                ;M

:M SetParentWindow:  ( hwndparent -- ) \ set owner window
                to hWndParent
                ;M

:M WindowTitle: ( -- ztitle )
                z" Search & Replace"
                ;M

:M StartSize:   ( -- width height )
                441 243 
                ;M

:M StartPos:    ( -- x y )
                XYPos
                ;M

:M Close:        ( -- )
                \ Insert your code here
                Close: super
                ;M

:M On_Init:     ( -- )
                s" MS Sans Serif" SetFaceName: WinFont
                8 Width: WinFont
                Create: WinFont 

                \ set form color to system color
                COLOR_BTNFACE Call GetSysColor NewColor: FrmColor


                self Start: grpOptions
                6 68 128 104 Move: grpOptions
                Handle: Winfont SetFont: grpOptions
                s" Options" SetText: grpOptions

                self Start: grpDirection
                144 68 120 78 Move: grpDirection
                Handle: Winfont SetFont: grpDirection
                s" Direction" SetText: grpDirection

                self Start: grpScope
                273 68 144 77 Move: grpScope
                Handle: Winfont SetFont: grpScope
                s" Search Scope" SetText: grpScope

                self Start: lblSearch
                7 8 71 19 Move: lblSearch
                Handle: Winfont SetFont: lblSearch
                SS_RIGHT +Style: lblSearch
                s" Search for:" SetText: lblSearch

                self Start: txtSearch
                82 8 328 19 Move: txtSearch
                Handle: Winfont SetFont: txtSearch

                self Start: lblReplace
                7 29 74 19 Move: lblReplace
                Handle: Winfont SetFont: lblReplace
                SS_RIGHT +Style: lblReplace
                s" Replace with:" SetText: lblReplace

                self Start: txtReplace
                82 29 328 19 Move: txtReplace
                Handle: Winfont SetFont: txtReplace

                self Start: chkCase
                12 88 100 25 Move: chkCase
                WS_GROUP +Style: chkCase
                Handle: Winfont SetFont: chkCase
                s" Case Sensitive" SetText: chkCase

                self Start: chkWholeWord
                12 115 100 25 Move: chkWholeWord
                Handle: Winfont SetFont: chkWholeWord
                s" Whole words only" SetText: chkWholeWord

                self Start: chkPrompt
                12 142 118 25 Move: chkPrompt
                Handle: Winfont SetFont: chkPrompt
                s" Prompt each replace" SetText: chkPrompt

                self Start: radForward
                148 88 100 25 Move: radForward
                Handle: Winfont SetFont: radForward
                s" Forward" SetText: radForward

                self Start: radBackward
                149 116 100 25 Move: radBackward
                Handle: Winfont SetFont: radBackward
                s" Backward" SetText: radBackward

                self Start: radGlobal
                279 88 100 25 Move: radGlobal
                Handle: Winfont SetFont: radGlobal
                s" Global" SetText: radGlobal

                self Start: radCurrent
                279 115 119 25 Move: radCurrent
                Handle: Winfont SetFont: radCurrent
                s" From current position" SetText: radCurrent

                self Start: btnOk
                330 181 100 25 Move: btnOk
                WS_GROUP +Style: btnOk
                Handle: Winfont SetFont: btnOk
                s" OK" SetText: btnOk

                self Start: btnCancel
                330 211 100 25 Move: btnCancel
                Handle: Winfont SetFont: btnCancel
                s" Cancel" SetText: btnCancel

                ParentWindow: self   \ if this is a modal form disable parent
                if   0 ParentWindow: self Call EnableWindow drop then
                ;M

:M WM_COMMAND   ( h m w l -- res )
                over LOWORD ( ID ) self   \ object address on stack
                WMCommand-Func ?dup    \ must not be zero
                if        execute
                else        2drop   \ drop ID and object address
                then        0 ;M

:M SetCommand:  ( cfa -- )  \ set WMCommand function
                to WMCommand-Func
                ;M

:M On_Paint:    ( -- )
                0 0 GetSize: self Addr: FrmColor FillArea: dc
                ;M

:M On_Done:    ( -- )
                Delete: WinFont
                originx originy 2to XYPos
                ParentWindow: self   \ if modal form re-enable parent
                if   1 ParentWindow: self Call EnableWindow drop
                     \ reset focus to parent if we have one
                     ParentWindow: self Call SetFocus drop
                then
                \ Insert your code here
                On_Done: super
                ;M

;Object

Index: Main.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/Main.f,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** Main.f	25 Feb 2007 13:58:12 -0000	1.36
--- Main.f	15 Apr 2007 02:55:45 -0000	1.37
***************
*** 82,85 ****
--- 82,86 ----
  needs EdMenu.f
  needs EdPreferences.f
+ needs EdReplace.f
  
  AcceleratorTable AccelTable \ create the Accelerator-Key-Table

Index: CommandID.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/CommandID.f,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** CommandID.f	13 Oct 2006 03:55:11 -0000	1.9
--- CommandID.f	15 Apr 2007 02:55:45 -0000	1.10
***************
*** 60,63 ****
--- 60,64 ----
  NewID IDM_LINETRANSPOSE
  NewID IDM_LINEDUPLICATE
+ NewID IDM_REPLACE_TEXT
  
  \ DexH menu

[Win32forth-cvs] OEM, Retail Software?

[Simon G. <fer...@da...>]

<html>
<body bgcolor=3D"#ffffff" text=3D"#000000">
<img src=3D"cid:74436CAB=2ECD1900E6">
<br>
Those who promise us paradise on earth never produced anything but a hel=
l=2E
<br>
Each shot is important=2E
<br>
Praise those of your critics for whom nothing is up to standard=2E
<br>
A client is to me a mere unit, a factor in a problem=2E
<br>
The worst thing I can say about democracy is that it has tolerated the R=
ight Honorable Gentleman for four and a half years=2E
<br>
Dying is something we human beings do continuously, not just at the end =
of our physical lives on this earth=2E
<br>
Excellence in any department can be attained only by the labor of a life=
time it is not to be purchased at a lesser price=2E
<br>
The universe is full of magical things patiently waiting for our wits to=
 grow sharper=2E
<br>
If I die, I forgive you=2E If I live we shall see=2E
<br>
A colt is worth little if it does not break its halter=2E
<br>
To rid ourselves of our shadows -- who we are -- we must step into eithe=
r total light or total darkness=2E Goodness and evil=2E
<br>
Age does not depend upon years, but upon temperament and health=2E Some =
men are born old, and some never grow up=2E
<br>
Perpetual modernness is the measure of merit in every work of art=2E
</body>
</html>