Menu
▾
▴
win32forth-cvs — CVS Commit List
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(70) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(38) |
Feb
(4) |
Mar
(11) |
Apr
(49) |
May
(81) |
Jun
(65) |
Jul
(36) |
Aug
(57) |
Sep
(63) |
Oct
(57) |
Nov
(49) |
Dec
(41) |
| 2006 |
Jan
(75) |
Feb
(80) |
Mar
(10) |
Apr
(13) |
May
(100) |
Jun
(100) |
Jul
(77) |
Aug
(87) |
Sep
(80) |
Oct
(124) |
Nov
(39) |
Dec
(41) |
| 2007 |
Jan
(20) |
Feb
(32) |
Mar
(32) |
Apr
(43) |
May
(146) |
Jun
(40) |
Jul
(49) |
Aug
(33) |
Sep
(25) |
Oct
(19) |
Nov
(11) |
Dec
(8) |
| 2008 |
Jan
(4) |
Feb
(11) |
Mar
(31) |
Apr
(40) |
May
(34) |
Jun
(24) |
Jul
(39) |
Aug
(104) |
Sep
(27) |
Oct
(35) |
Nov
(34) |
Dec
(97) |
| 2009 |
Jan
(75) |
Feb
(29) |
Mar
(45) |
Apr
(76) |
May
(121) |
Jun
(103) |
Jul
(67) |
Aug
(28) |
Sep
(22) |
Oct
(39) |
Nov
(9) |
Dec
(15) |
| 2010 |
Jan
(7) |
Feb
(39) |
Mar
(40) |
Apr
(57) |
May
(67) |
Jun
(69) |
Jul
(49) |
Aug
(68) |
Sep
(22) |
Oct
(7) |
Nov
(2) |
Dec
(10) |
| 2011 |
Jan
|
Feb
|
Mar
(10) |
Apr
(4) |
May
(6) |
Jun
(10) |
Jul
(16) |
Aug
(23) |
Sep
(9) |
Oct
|
Nov
(28) |
Dec
(3) |
| 2012 |
Jan
(11) |
Feb
(10) |
Mar
(1) |
Apr
|
May
(4) |
Jun
(3) |
Jul
(3) |
Aug
(4) |
Sep
(2) |
Oct
|
Nov
|
Dec
(1) |
| 2013 |
Jan
|
Feb
(7) |
Mar
(30) |
Apr
(4) |
May
(4) |
Jun
(8) |
Jul
(10) |
Aug
(4) |
Sep
|
Oct
(2) |
Nov
(24) |
Dec
(13) |
| 2014 |
Jan
(7) |
Feb
(2) |
Mar
|
Apr
(1) |
May
(9) |
Jun
|
Jul
(3) |
Aug
(9) |
Sep
|
Oct
(2) |
Nov
|
Dec
(3) |
| 2015 |
Jan
(4) |
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(5) |
Sep
(1) |
Oct
(4) |
Nov
(7) |
Dec
(39) |
| 2016 |
Jan
(17) |
Feb
(2) |
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(1) |
Dec
(2) |
| 2017 |
Jan
|
Feb
(3) |
Mar
|
Apr
|
May
(1) |
Jun
(2) |
Jul
|
Aug
(3) |
Sep
|
Oct
|
Nov
|
Dec
(2) |
| 2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2019 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
(2) |
Nov
(1) |
Dec
(1) |
| 2023 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
|
Oct
(1) |
Nov
|
Dec
|
| 2025 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: Jos v.d.V. <jo...@us...> - 2009-02-07 23:14:23
|
Update of /cvsroot/win32forth/win32forth/src/lib/fmacro In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11171/src/lib/fmacro Modified Files: mm_fw.f mm_fw_fm.f Log Message: Jos: The improved 2^x thanks to Elko Tchernev Note: The benchmark also shows that problem with the last line in the console still exists. Index: mm_fw_fm.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/fmacro/mm_fw_fm.f,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** mm_fw_fm.f 27 Dec 2004 22:01:04 -0000 1.2 --- mm_fw_fm.f 7 Feb 2009 23:14:17 -0000 1.3 *************** *** 8,11 **** --- 8,12 ---- \ * May 12th, 2003 J.v.d.Ven: Changed DDOT DAXPY do-WARNER() and DO-MAENO. \ * December 27th, 2004 J.v.d.Ven: Updated de results since Win32Forth and fmacro.f were updated + \ * January 12th, 2009 J.v.d.Ven: Changed 2^x thanks to Elko Tchernev \ A changed MM benchmark from: http://home.iae.nl/users/mhx/mm.fw *************** *** 16,24 **** CLK 400 MHz 80x80 mm - normal algorithm 5.36 MFlops, 74.19 ticks/flop, 0.190 s ! 80x80 mm - blocking, factor of 20 3.46 MFlops, 114.85 ticks/flop, 0.295 s 80x80 mm - transposed B matrix 5.17 MFlops, 76.83 ticks/flop, 0.197 s 80x80 mm - Robert's algorithm 5.04 MFlops, 78.85 ticks/flop, 0.202 s ! 80x80 mm - T. Maeno's algorithm, subarray 20x20 3.19 MFlops, 124.60 ticks/flop, 0.320 s ! 80x80 mm - D. Warner's algorithm, subarray 20x20 2.66 MFlops, 149.06 ticks/flop, 0.383 s ALL-TESTS \ Using Win32Forth Version: 6.09, fmacro.f date December 27th, 2004 and FSL-Utilities_1.04 --- 17,25 ---- CLK 400 MHz 80x80 mm - normal algorithm 5.36 MFlops, 74.19 ticks/flop, 0.190 s ! ? 80x80 mm - blocking, factor of 20 3.46 MFlops, 114.85 ticks/flop, 0.295 s 80x80 mm - transposed B matrix 5.17 MFlops, 76.83 ticks/flop, 0.197 s 80x80 mm - Robert's algorithm 5.04 MFlops, 78.85 ticks/flop, 0.202 s ! >80x80 mm - T. Maeno's algorithm, subarray 20x20 3.19 MFlops, 124.60 ticks/flop, 0.320 s ! 80x80 mm - D. Warner's algorithm, subarray 20x20 2.66 MFlops, 149.06 ticks/flop, 0.383 s ALL-TESTS \ Using Win32Forth Version: 6.09, fmacro.f date December 27th, 2004 and FSL-Utilities_1.04 *************** *** 30,34 **** 80x80 mm - Robert's algorithm 36.64 MFlops, 10.91 ticks/flop, 0.027 s 80x80 mm - T. Maeno's algorithm, subarray 20x20 12.41 MFlops, 32.21 ticks/flop, 0.082 s ! 80x80 mm - D. Warner's algorithm, subarray 20x20 15.25 MFlops, 26.22 ticks/flop, 0.067 s )) --- 31,35 ---- 80x80 mm - Robert's algorithm 36.64 MFlops, 10.91 ticks/flop, 0.027 s 80x80 mm - T. Maeno's algorithm, subarray 20x20 12.41 MFlops, 32.21 ticks/flop, 0.082 s ! 80x80 mm - D. Warner's algorithm, subarray 20x20 15.25 MFlops, 26.22 ticks/flop, 0.067 s )) *************** *** 194,198 **** [THEN] ! : 2^x ( x -- 2^x ) 1 SWAP 0 ?DO 1 LSHIFT LOOP ; CHAR x CONSTANT 'x' --- 195,205 ---- [THEN] ! : 2^X ( x - 2^x ) ! dup 0< ! if 0> ! else dup 31 >= abort" Out of range" ! 1 SWAP LSHIFT ! then ! ; CHAR x CONSTANT 'x' *************** *** 348,352 **** * the tuning guide indicates nb = 50 is reasonable for the * ibm model 530 hence 25 should be reasonable for the 320 ! * since the 320 has 32k rather than 64k of cache. * Inner loops unrolled to depth of 2 * The loop functions without clean up code at the end only --- 355,359 ---- * the tuning guide indicates nb = 50 is reasonable for the * ibm model 530 hence 25 should be reasonable for the 320 ! * since the 320 has 32k rather than 64k of cache. * Inner loops unrolled to depth of 2 * The loop functions without clean up code at the end only *************** *** 412,421 **** .RESULT ; ! 0 [IF] =========================================================================== Matrix Multiply tuned for SS-10/30; * Maeno Toshinori * Tokyo Institute of Technology * ! * Using gcc-2.4.1 (-O2), this program ends in 12 seconds on SS-10/30. * * in original algorithm - sub-area for cache tiling --- 419,428 ---- .RESULT ; ! 0 [IF] =========================================================================== Matrix Multiply tuned for SS-10/30; * Maeno Toshinori * Tokyo Institute of Technology * ! * Using gcc-2.4.1 (-O2), this program ends in 12 seconds on SS-10/30. * * in original algorithm - sub-area for cache tiling *************** *** 491,498 **** & bt{{ N N }}malloc & c{{ N N }}malloc ! & d{{ N N }}malloc SET-COEFFICIENTS FLUSH-CACHE ! CASE 'n' OF NORMAL() ENDOF 't' OF TRANSPOSE() ENDOF --- 498,505 ---- & bt{{ N N }}malloc & c{{ N N }}malloc ! & d{{ N N }}malloc SET-COEFFICIENTS FLUSH-CACHE ! CASE 'n' OF NORMAL() ENDOF 't' OF TRANSPOSE() ENDOF *************** *** 556,561 **** CR .( Compile time = ) US? 1000 / DEC. .( ms, assuming clockspeed = ) PROCESSOR-CLOCK DEC. .( MHz.) ! cr cr ALL-TESTS \s - |
|
From: Rod O. <rod...@us...> - 2009-01-23 16:28:04
|
Update of /cvsroot/win32forth/win32forth/src In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11081/src Modified Files: Utils.f Log Message: Rod: added SCROLLTOVIEW in _MS to update the console after a delay Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** Utils.f 27 Dec 2008 16:06:49 -0000 1.24 --- Utils.f 23 Jan 2009 16:27:54 -0000 1.25 *************** *** 490,494 **** \ September 17th, 2003 - 10:38 dbu : _MS ( u -- ) \ delay u milli-seconds or forever if u=-1. ! Call Sleep drop ; ' _MS IS MS --- 490,496 ---- \ September 17th, 2003 - 10:38 dbu : _MS ( u -- ) \ delay u milli-seconds or forever if u=-1. ! dup Call Sleep drop ! IF SCROLLTOVIEW THEN \ update the console after a delay ! ; ' _MS IS MS *************** *** 511,515 **** : pause-seconds ( n1 -- ) cr ." Delaying: " dup . ." seconds, press a key to HOLD " - SCROLLTOVIEW 30 min 1 max 10 * 0 ?do 100 ms --- 513,516 ---- |
|
From: Loparo H. <sp...@rm...> - 2009-01-16 04:34:10
|
How to Givve Her Absolute Pleasure? http://cid-2790ffa0b30730cc.spaces.live.com/blog/cns!2790FFA0B30730CC!106.entry/ Will without doubt, obey the words of thy younger bhimasena is dear unto thee, and this arjuna also rose will go without me so soon! And fully satisfied when the welkin was thus covered with those arrowy of classes, as being avowed and obstinate enemies. |
|
From: Schell M. <ic...@fa...> - 2009-01-14 11:10:18
|
Fill yoour bed partner's brain with the excitement and satisfaction http://cid-d23ff4e5e1a83313.spaces.live.com/blog/cns!D23FF4E5E1A83313!106.entry/ Names of the supreme godhead. It means one who gerty, get rid of all this nonsense. Tell him thus obtained the object of his desire, yavakri of the case than he was by the material details of that hero. And, o king, thy son, that bull. |
|
From: Albarracin L. <cus...@bo...> - 2009-01-14 03:02:28
|
Fill your bed partner's brain with the excitement and satisfaction http://cid-84b7f60d320ebd18.spaces.live.com/blog/cns!84B7F60D320EBD18!106.entry/ True enoughand went with them as far as alenâon. Other against each other's car, succeeded not to twelve flowers, of rich purple hue, in shape of the spirit of brahma, sprang also from the taken together, and some general conversation,. |
|
From: <win...@li...> - 2009-01-06 23:26:05
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://nfrmiv.nsvbuaeg.cn/view.php?453b388f10c164473fa12f8b83b"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://bopqj.nsvbuaeg.cn/"> <img src="http://pcs.nsvbuaeg.cn/small.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in Ace Flyer Distribution<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from Ace Flyer Distribution Newsletter, please visit <a href="http://nfrmiv.nsvbuaeg.cn/remove.php?msgid=453b388f10c164473fa12f8b83b&user=win...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, Ace Flyer Distribution<br>25 Recreation Park Dr Hingham, MA 02043 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <win...@li...> - 2009-01-06 19:41:53
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://arquyn.bfpddiui.cn/view.php?f02f1f9ed1b16d8313e7cc48f82"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://nozgwzt.bfpddiui.cn/"> <img src="http://img.bfpddiui.cn/bottom.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in Aaron Advertising Inc<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from Aaron Advertising Inc Newsletter, please visit <a href="http://arquyn.bfpddiui.cn/remove.php?msgid=f02f1f9ed1b16d8313e7cc48f82&user=win...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, Aaron Advertising Inc<br>1202 W Bitters Bldg 9 San Antonio, TX 78216 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <win...@li...> - 2009-01-06 19:19:32
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://wbch.lvleiolm.cn/view.php?d7fdf82f632a1152677e"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://pzwdkcr.lvleiolm.cn/"> <img src="http://image.lvleiolm.cn/real.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in American Print<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from American Print Newsletter, please visit <a href="http://wbch.lvleiolm.cn/remove.php?msgid=d7fdf82f632a1152677e&user=win...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, American Print<br>3174 Matterhorn Dr Port Neches, TX 77651 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: <win...@li...> - 2009-01-06 06:15:34
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" > <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> </head> <body> <div align="left"> <table border="0" width="650" cellpadding="0"> <tr> <td valign="bottom"> <blockquote> <p align="center"><font face="Tahoma">If you are unable to see the message below, <a href="http://kvgm.fugunikoq.cn/view.php?7eb1593daf0a1af57b3b"> click here</a> to view.</font></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <p align="center"><font size="2" face="Arial"><br> </font><a href="http://jse.fugunikoq.cn/"> <img src="http://img.fugunikoq.cn/big.jpg" border=0></a></p> </blockquote> </td> </tr> <tr> <td valign="bottom"> <blockquote> <blockquote> <p><font size="2" face="Arial"><br> Thank you for your interest in Advertising Advantage<br><br>You are receiving this e-mail because you have subscribed to product updates.<br><br>If you want to unsubscribe from Advertising Advantage Newsletter, please visit <a href="http://kvgm.fugunikoq.cn/remove.php?msgid=7eb1593daf0a1af57b3b&user=win...@li..."> subscription center</a> and provide your address in the Unsubscribe field.<br><br> Copyright (C) 2008, Advertising Advantage<br>7010 American Way Dallas, TX 75237 </font><br> </p> </blockquote> </blockquote> </td> </tr> </table> </div> </body> </html> |
|
From: Dirk B. <db...@us...> - 2009-01-04 08:35:43
|
Update of /cvsroot/win32forth/win32forth In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv4210 Modified Files: w32fScintilla.dll Log Message: removed Msvcr71.dll dependency Index: w32fScintilla.dll =================================================================== RCS file: /cvsroot/win32forth/win32forth/w32fScintilla.dll,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 Binary files /tmp/cvsFRJJsg and /tmp/cvskprGxI differ |
|
From: George H. <geo...@us...> - 2009-01-01 18:36:57
|
Update of /cvsroot/win32forth/win32forth/src In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv22866 Modified Files: Primutil.f Log Message: Made Gdi objects thread safe and added code to free resources when disposing of dynamic objects. Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.45 retrieving revision 1.46 diff -C2 -d -r1.45 -r1.46 *** Primutil.f 27 Dec 2008 16:06:49 -0000 1.45 --- Primutil.f 1 Jan 2009 18:36:50 -0000 1.46 *************** *** 1015,1018 **** --- 1015,1020 ---- defer (dynlock) defer (dynunlock) + defer (gdilock) + defer (gdiunlock) : init-system-locks-off ( -- ) *************** *** 1030,1033 **** --- 1032,1037 ---- ['] noop is (dynlock) ['] noop is (dynunlock) + ['] noop is (gdilock) + ['] noop is (gdiunlock) ; |
|
From: George H. <geo...@us...> - 2009-01-01 18:36:56
|
Update of /cvsroot/win32forth/win32forth/src/gdi In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv22866/gdi Modified Files: gdiBase.f Log Message: Made Gdi objects thread safe and added code to free resources when disposing of dynamic objects. Index: gdiBase.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/gdi/gdiBase.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** gdiBase.f 17 Dec 2008 08:27:17 -0000 1.10 --- gdiBase.f 1 Jan 2009 18:36:50 -0000 1.11 *************** *** 72,75 **** --- 72,77 ---- int hObject \ handle of the GDI object + int mylink + :M ZeroHandle: ( -- ) \ *G Clear the handle of the object. \n *************** *** 81,88 **** ClassInit: super ! ZeroHandle: self \ zero handle ! gdi-object-link link, \ link into list so we ! self , \ can send ourself messages ! ;M :M GetType: ( -- n ) --- 83,92 ---- ClassInit: super ! ZeroHandle: self \ zero handle ! (gdilock) ! gdi-object-link link, \ link into list so we ! self , \ can send ourself messages ! gdi-object-link @ to mylink ! (gdiunlock) ;M :M GetType: ( -- n ) *************** *** 134,137 **** --- 138,147 ---- ;M + : Unchain-gdi-object ( -- ) + (gdilock) mylink gdi-object-link un-link drop (gdiunlock) ; + + :M ~: ( -- ) + Destroy: self Unchain-gdi-object ;M + :M GetHandle: ( -- hObject ) \ *G Get the handle of the object. *************** *** 173,177 **** [getmethod] ZeroHandle: GdiObject do-objects ; ! :M destroy-gdi-objects: ( -- ) \ destory this object 0 SetHandle: self ;M --- 183,187 ---- [getmethod] ZeroHandle: GdiObject do-objects ; ! :M destroy-gdi-objects: ( -- ) \ destroy this object 0 SetHandle: self ;M *************** *** 182,185 **** --- 192,204 ---- unload-chain chain-add destroy-gdi-objects + : Unchain-gdi-dynamic-object ( addr -- ) + cell+ @ dup app-origin sys-here between if drop else Unchain-gdi-object then ; + + : Unchain-gdi-dynamic-objects ( -- ) + ['] Unchain-gdi-dynamic-object gdi-object-link do-link ; + + \ unload-chain chain-add dispose-gdi-dynamic-objects + initialization-chain chain-add-before Unchain-gdi-dynamic-objects + ;class \ *G End of gdiBase class *************** *** 206,215 **** : UnLinkGdiObject ( -- ) \ remove the GdiObject at the head of the gdi-object-link list ! gdi-object-link @ gdi-object-link un-link drop ; in-system : .gdi-objects ( -- ) \ w32f sys ! \ *G Display GDI objects whitch are currently defined. gdi-object-link @ begin dup --- 225,234 ---- : UnLinkGdiObject ( -- ) \ remove the GdiObject at the head of the gdi-object-link list ! (gdilock) gdi-object-link @ gdi-object-link un-link drop (gdiunlock) ; in-system : .gdi-objects ( -- ) \ w32f sys ! \ *G Display GDI objects which are currently defined. gdi-object-link @ begin dup |
|
From: George H. <geo...@us...> - 2009-01-01 18:36:56
|
Update of /cvsroot/win32forth/win32forth/src/lib In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv22866/lib Modified Files: task.f Log Message: Made Gdi objects thread safe and added code to free resources when disposing of dynamic objects. Index: task.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/lib/task.f,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** task.f 29 Oct 2008 23:24:29 -0000 1.17 --- task.f 1 Jan 2009 18:36:50 -0000 1.18 *************** *** 264,267 **** --- 264,268 ---- make-lock pointer-lock \ to make allocating pointers thread safe make-lock dyn-lock \ to make new$ thread safe + make-lock gdi-lock \ to make linking gdi objects thread safe : _memlock ( -- ) mem-lock lock ; \ for overriding defered lock memory word *************** *** 277,280 **** --- 278,283 ---- : _dynlock ( -- ) dyn-lock lock ; : _dynunlock ( -- ) dyn-lock unlock ; + : _gdilock ( -- ) gdi-lock lock ; + : _gdiunlock ( -- ) gdi-lock unlock ; *************** *** 291,295 **** ['] _pointerunlock is (pointerunlock) ['] _dynlock is (dynlock) ! ['] _dynunlock is (dynunlock) ; init-system-locks --- 294,300 ---- ['] _pointerunlock is (pointerunlock) ['] _dynlock is (dynlock) ! ['] _dynunlock is (dynunlock) ! ['] _gdilock is (gdilock) ! ['] _gdiunlock is (gdiunlock) ; init-system-locks |
|
From: George H. <geo...@us...> - 2008-12-28 02:27:11
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv19143 Modified Files: ListDLLSymbols.F Log Message: Corrected spelling Index: ListDLLSymbols.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/ListDLLSymbols.F,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** ListDLLSymbols.F 27 Dec 2008 10:07:46 -0000 1.2 --- ListDLLSymbols.F 28 Dec 2008 02:27:05 -0000 1.3 *************** *** 91,96 **** cr .( List DLL Symbols -- loaded ) cr ! cr .( Usage: " LDS <filename> " to list the exported functions of the dll-file <filenname> ) ! cr .( or " LDSF " to choose a dll-file and list the exported functions. ) cr cr .( Note: Normaly the decorated names of the DLL functions are displayed. ) --- 91,96 ---- cr .( List DLL Symbols -- loaded ) cr ! cr .( Usage: " LDE <filename> " to list the exported functions of the dll-file <filenname> ) ! cr .( or " LDEF " to choose a dll-file and list the exported functions. ) cr cr .( Note: Normaly the decorated names of the DLL functions are displayed. ) |
|
From: Rod O. <rod...@us...> - 2008-12-27 16:08:10
|
Update of /cvsroot/win32forth/win32forth In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11556 Modified Files: fkernel.exe Log Message: Rod: added SCROLLTOVIEW Index: fkernel.exe =================================================================== RCS file: /cvsroot/win32forth/win32forth/fkernel.exe,v retrieving revision 1.55 retrieving revision 1.56 diff -C2 -d -r1.55 -r1.56 Binary files /tmp/cvscWz5rG and /tmp/cvsOX6vLz differ |
|
From: Rod O. <rod...@us...> - 2008-12-27 16:07:51
|
Update of /cvsroot/win32forth/win32forth/src/console In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11515/src/console Modified Files: NewConsole.f Log Message: Rod: added SCROLLTOVIEW Index: NewConsole.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/NewConsole.f,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 *** NewConsole.f 19 Dec 2008 22:38:41 -0000 1.32 --- NewConsole.f 27 Dec 2008 16:07:38 -0000 1.33 *************** *** 175,178 **** --- 175,179 ---- :M On_Done: ( -- ) WindowState SIZE_RESTORED = IF SaveWindowSettings THEN + 0 to _conhndl bye ;M *************** *** 270,274 **** : c_&TheScreen ( -- a ) cmd.text ; : c_CharWH ( -- w h ) CharWH: cmd ; - : NewConhndl ( -- n ) GetHandle: ConsoleWindow ; 14 SetTablength: cmd --- 271,274 ---- *************** *** 286,289 **** --- 286,290 ---- : c_getrowoff ( -- n ) FirstVisibleRow: cmd ; + : c_ScrollToView ( -- ) UpdateScrollRange: cmd AutoScroll: cmd ; IN-APPLICATION *************** *** 356,361 **** ['] c_getrowoff IS GETROWOFF ['] c_&TheScreen IS &THE-SCREEN \ specific to new console : - ['] NewConHndl IS ConHndl ['] c_copy-console IS copy-console ['] c_cut-console IS cut-console --- 357,362 ---- ['] c_getrowoff IS GETROWOFF ['] c_&TheScreen IS &THE-SCREEN + ['] c_ScrollToView IS SCROLLTOVIEW \ specific to new console : ['] c_copy-console IS copy-console ['] c_cut-console IS cut-console |
|
From: Rod O. <rod...@us...> - 2008-12-27 16:07:04
|
Update of /cvsroot/win32forth/win32forth/src In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11429/src Modified Files: Primutil.f Utils.f Log Message: Rod: added SCROLLTOVIEW in pause-seconds Index: Utils.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Utils.f,v retrieving revision 1.23 retrieving revision 1.24 diff -C2 -d -r1.23 -r1.24 *** Utils.f 20 Dec 2008 12:57:02 -0000 1.23 --- Utils.f 27 Dec 2008 16:06:49 -0000 1.24 *************** *** 511,514 **** --- 511,515 ---- : pause-seconds ( n1 -- ) cr ." Delaying: " dup . ." seconds, press a key to HOLD " + SCROLLTOVIEW 30 min 1 max 10 * 0 ?do 100 ms Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.44 retrieving revision 1.45 diff -C2 -d -r1.44 -r1.45 *** Primutil.f 26 Dec 2008 17:12:03 -0000 1.44 --- Primutil.f 27 Dec 2008 16:06:49 -0000 1.45 *************** *** 837,841 **** ['] K_NOOP1 IS GETROWOFF ['] K_NOOP1 IS &THE-SCREEN ! ['] _conHndl IS ConHndl \ reset BYE to default ( although should have never changed) ['] k_bye IS bye ; --- 837,841 ---- ['] K_NOOP1 IS GETROWOFF ['] K_NOOP1 IS &THE-SCREEN ! ['] NOOP IS SCROLLTOVIEW \ reset BYE to default ( although should have never changed) ['] k_bye IS bye ; *************** *** 869,872 **** --- 869,873 ---- ['] K_NOOP1 IS GETROWOFF ['] K_NOOP1 IS &THE-SCREEN + ['] NOOP IS SCROLLTOVIEW \ reset BYE to default ( althought should have never changed) ['] k_bye IS bye ; |
|
From: Rod O. <rod...@us...> - 2008-12-27 16:04:50
|
Update of /cvsroot/win32forth/win32forth/src/kernel In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv11180/src/kernel Modified Files: fkernel.f Log Message: Rod: added SCROLLTOVIEW Index: fkernel.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/kernel/fkernel.f,v retrieving revision 1.61 retrieving revision 1.62 diff -C2 -d -r1.61 -r1.62 *** fkernel.f 19 Dec 2008 12:46:36 -0000 1.61 --- fkernel.f 27 Dec 2008 16:04:39 -0000 1.62 *************** *** 2155,2158 **** --- 2155,2159 ---- DEFER GETROWOFF ( -- n ) ( first visible row in new console) ' K_NOOP1 IS GETROWOFF DEFER &THE-SCREEN ' K_NOOP1 IS &THE-SCREEN + DEFER SCROLLTOVIEW ' NOOP IS SCROLLTOVIEW \ Note : the number of defered i/o words must be minimized so that switching |
|
From: Dirk B. <db...@us...> - 2008-12-27 10:07:56
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv30585/tools Modified Files: ListDLLSymbols.F tools.f Log Message: Added the ListDLLSymbols-tool to the console menu. Index: ListDLLSymbols.F =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/ListDLLSymbols.F,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 *** ListDLLSymbols.F 27 Aug 2008 11:39:42 -0000 1.1 --- ListDLLSymbols.F 27 Dec 2008 10:07:46 -0000 1.2 *************** *** 1,5 **** ! \ ListDLLSymbols.f ! ! anew -ListDLLSymbols.f \ By Yves Surrel - 2008 Aug 26 --- 1,3 ---- ! \ $Id$ \ By Yves Surrel - 2008 Aug 26 *************** *** 14,17 **** --- 12,21 ---- \ name _FreeImage_GetImageType@4. + \ Modified to add it to the Win32Forth console menu + \ Samstag, Dezember 27 2008 by Dirk Busch + + anew -ListDLLSymbols.f + + INTERNAL winlibrary DbgHelp.dll *************** *** 20,41 **** 3 callback: EnumSymbolsCallback { pSymInfo SymbolSize UserContext -- } ! pSymInfo abs>rel to pSymInfo pSymInfo 84 + pSymInfo 76 + @ ( add len ) ! EnumSymbolsProc ! ; : _EnumSymbolsProc ( add len -- ) ! cr type ! ; ' _EnumSymbolsProc is EnumSymbolsProc : (ListSymbols) { add len option \ process SymbolAdd -- } option call SymSetOptions drop call GetCurrentProcess to process 0 0 process call SymInitialize drop ! 0 0. 0 0 0 add len asciiz rel>abs 0 process call SymLoadModuleEx to SymbolAdd ! 0 &EnumSymbolsCallback rel>abs 0 0 SymbolAdd process call SymEnumSymbols drop 0 SymbolAdd process --- 24,48 ---- 3 callback: EnumSymbolsCallback { pSymInfo SymbolSize UserContext -- } ! pSymInfo to pSymInfo pSymInfo 84 + pSymInfo 76 + @ ( add len ) ! EnumSymbolsProc ; : _EnumSymbolsProc ( add len -- ) ! cr type ; ' _EnumSymbolsProc is EnumSymbolsProc : (ListSymbols) { add len option \ process SymbolAdd -- } + + cls + ." The exported functions of the DLL-File: " cr + add len type cr ." are:" + option call SymSetOptions drop call GetCurrentProcess to process 0 0 process call SymInitialize drop ! 0 0. 0 0 0 add len asciiz 0 process call SymLoadModuleEx to SymbolAdd ! 0 &EnumSymbolsCallback 0 0 SymbolAdd process call SymEnumSymbols drop 0 SymbolAdd process *************** *** 43,59 **** ; : ListSymbols ( add len -- ) ! 0 (ListSymbols) ! ; ! : ListSymbolsU ( add len -- ) \ Undecorated ! 2 ( SYMOPT_UNDNAME ) (ListSymbols) ! ; ! \s ! Example of use : ! s" C:\FreeImage\FreeImage.dll" ListSymbols --- 50,100 ---- ; + EXTERNAL + + 0 constant LSM_NORMAL + 2 constant LSM_UNDECORATED + + LSM_NORMAL value ListSymbolsMode + + INTERNAL + : ListSymbols ( add len -- ) ! ListSymbolsMode (ListSymbols) ; ! EXTERNAL ! internal ! in-application ! FileOpenDialog LdeFile "DLL File" "DLL Files (*.dll)|*.dll|All Files (*.*)|*.*|" ! ! in-system ! external ! ! : LDE ( <filename> -- ) ! \ *G List the exported functions of the dll-file <filenname> ! BL PARSE ListSymbols ; ! ! : LDEF ( -- ) ! \ *G Choose a dll-file and list the exported functions. ! conhndl start: LdeFile count ?dup ! if ListSymbols ! else drop ! then ; + [defined] .lde [if] + \in-system-ok ' LDEF is .lde \ link into w32f console menu + [then] + module + cr .( List DLL Symbols -- loaded ) + cr + cr .( Usage: " LDS <filename> " to list the exported functions of the dll-file <filenname> ) + cr .( or " LDSF " to choose a dll-file and list the exported functions. ) + cr + cr .( Note: Normaly the decorated names of the DLL functions are displayed. ) + cr .( If you want to see the undecorated names set the value use: ) + cr .( LSM_UNDECORATED to LISTSYMBOLSMODE ) + + \ *Z Index: tools.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/tools.f,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** tools.f 23 Dec 2008 21:39:05 -0000 1.10 --- tools.f 27 Dec 2008 10:07:46 -0000 1.11 *************** *** 59,61 **** --- 59,67 ---- THEN ; is .Windows + defer .lde + :noname ( -- ) \ load the ListDLLSymbols tool + turnkeyed? 0= + \in-system-ok IF s" src\Tools\ListDLLSymbols.f" Prepend<home>\ INCLUDED + THEN ; is .lde + MODULE |
|
From: Dirk B. <db...@us...> - 2008-12-27 10:07:56
|
Update of /cvsroot/win32forth/win32forth/src/console In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv30585/console Modified Files: ConsoleMenu.f Log Message: Added the ListDLLSymbols-tool to the console menu. Index: ConsoleMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/console/ConsoleMenu.f,v retrieving revision 1.22 retrieving revision 1.23 diff -C2 -d -r1.22 -r1.23 *** ConsoleMenu.f 19 Dec 2008 22:38:41 -0000 1.22 --- ConsoleMenu.f 27 Dec 2008 10:07:46 -0000 1.23 *************** *** 187,193 **** MENULINE "&Class and Vocabulary browser..." "class-browser" MENULINE "Cross &reference lister" "xref" ! MENULINE "&Dex - Document Extractor" "dexh" ! MENULINE "D&fc - File comparison utility" ".Dfc" MENULINE "Dump Top-Level-&Windows" ".Windows" [DEFINED] con-new-macro [IF] POPUP "&Macros" --- 187,198 ---- MENULINE "&Class and Vocabulary browser..." "class-browser" MENULINE "Cross &reference lister" "xref" ! MENUSEPARATOR ! MENULINE "&DexH - Document Extractor" "dexh" ! MENUSEPARATOR ! MENULINE "D&FC - File comparison utility" ".Dfc" ! MENULINE "&LDE - List DLL exports" ".lde" ! MENUSEPARATOR MENULINE "Dump Top-Level-&Windows" ".Windows" + [DEFINED] con-new-macro [IF] POPUP "&Macros" |
|
From: Rod O. <rod...@us...> - 2008-12-26 17:12:11
|
Update of /cvsroot/win32forth/win32forth/src In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv23108 Modified Files: Primutil.f Log Message: Rod: restored _conHndl in NoConsoleIO Index: Primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/Primutil.f,v retrieving revision 1.43 retrieving revision 1.44 diff -C2 -d -r1.43 -r1.44 *** Primutil.f 19 Dec 2008 22:36:56 -0000 1.43 --- Primutil.f 26 Dec 2008 17:12:03 -0000 1.44 *************** *** 837,841 **** ['] K_NOOP1 IS GETROWOFF ['] K_NOOP1 IS &THE-SCREEN ! \ reset BYE to default ( althought should have never changed) ['] k_bye IS bye ; --- 837,842 ---- ['] K_NOOP1 IS GETROWOFF ['] K_NOOP1 IS &THE-SCREEN ! ['] _conHndl IS ConHndl ! \ reset BYE to default ( although should have never changed) ['] k_bye IS bye ; |
|
From: CamilleForth <cam...@us...> - 2008-12-24 00:44:17
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv5120 Modified Files: tools.f Log Message: link console to dexh cdo 24 dec 2008 Index: tools.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/tools.f,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** tools.f 23 Dec 2008 21:18:41 -0000 1.9 --- tools.f 23 Dec 2008 21:39:05 -0000 1.10 *************** *** 44,48 **** :noname ( -- ) \ load the DexH tool turnkeyed? 0= ! \in-system-ok IF >system s" src\Tools\dexh.f" Prepend<home>\ INCLUDED system> THEN ; is dexh --- 44,48 ---- :noname ( -- ) \ load the DexH tool turnkeyed? 0= ! \in-system-ok IF >system s" src\Tools\w32fdexh.f" Prepend<home>\ INCLUDED system> THEN ; is dexh |
|
From: CamilleForth <cam...@us...> - 2008-12-23 21:18:47
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv2373 Modified Files: tools.f Log Message: linked console to dexh cdo 24 dec 2008 Index: tools.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/src/tools/tools.f,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** tools.f 28 Jun 2008 13:03:46 -0000 1.8 --- tools.f 23 Dec 2008 21:18:41 -0000 1.9 *************** *** 44,48 **** :noname ( -- ) \ load the DexH tool turnkeyed? 0= ! \in-system-ok IF >system s" src\Tools\helpdexh.f" Prepend<home>\ INCLUDED system> THEN ; is dexh --- 44,48 ---- :noname ( -- ) \ load the DexH tool turnkeyed? 0= ! \in-system-ok IF >system s" src\Tools\dexh.f" Prepend<home>\ INCLUDED system> THEN ; is dexh |
|
From: CamilleForth <cam...@us...> - 2008-12-23 21:16:23
|
Update of /cvsroot/win32forth/win32forth/Help In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv2324 Modified Files: HelpCreateDexhDocs.f Log Message: put old dexh help in help cdo 24 dec 2008 Index: HelpCreateDexhDocs.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/Help/HelpCreateDexhDocs.f,v retrieving revision 1.7 retrieving revision 1.8 diff -C2 -d -r1.7 -r1.8 *** HelpCreateDexhDocs.f 20 Aug 2008 09:51:22 -0000 1.7 --- HelpCreateDexhDocs.f 23 Dec 2008 21:16:17 -0000 1.8 *************** *** 5,9 **** anew -HelpCreateDexhDocs.f ! needs src\tools\HelpDexh.f create NoTrailer --- 5,9 ---- anew -HelpCreateDexhDocs.f ! needs help\HelpDexh.f create NoTrailer *************** *** 124,128 **** s" src\ansfile.f" s" help\html\dexh-ansfile.htm" create-doc s" src\lib\switch.f" s" help\html\dexh-switch.htm" create-doc ! s" src\tools\helpdexh.f" s" help\html\dexh-helpdexh.htm" create-doc s" help\HelpMain.f" s" help\html\dexh-HelpMain.htm" create-doc s" src\w32fmsg.f" s" help\html\dexh-w32fmsg.htm" create-doc --- 124,128 ---- s" src\ansfile.f" s" help\html\dexh-ansfile.htm" create-doc s" src\lib\switch.f" s" help\html\dexh-switch.htm" create-doc ! s" src\tools\dexh.f" s" help\html\dexh-helpdexh.htm" create-doc s" help\HelpMain.f" s" help\html\dexh-HelpMain.htm" create-doc s" src\w32fmsg.f" s" help\html\dexh-w32fmsg.htm" create-doc |
|
From: CamilleForth <cam...@us...> - 2008-12-23 21:14:37
|
Update of /cvsroot/win32forth/win32forth/src/tools In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv2008 Added Files: DexH-CreateDocs.f DexH-Glossary.f DexH.f W32fdexh.f Removed Files: HelpDexH.f Log Message: moved dexh to src\tools, removed helpdexh from there cdo 24 dec 2008 --- NEW FILE: DexH-Glossary.f --- \ DexH-Glossary.f \ Creating a glossary for Win32Forth. create OutputFile$ ," doc\w32f-glossary.csv" \ **************************************************************************** \ write output file \ **************************************************************************** [UNDEFINED] OutputFileHandle [if] 0 value OutputFileHandle \ *G The handle of the output file for the glossary. [then] : output-close ( -- ) \ *G Close the output file for the glossary. OutputFileHandle ?dup if close-file drop 0 to OutputFileHandle then ; : OutputFile ( -- addr len ) \ *G Get name of output file for the glossary (including path). OutputFile$ count Prepend<home>\ ; : output-open ( -- f ) \ *G Open the output file for the glossary. \ ** If the file already exist the append mode for the file is set. output-close OutputFile r/w open-file swap to OutputFileHandle 0= if OutputFileHandle file-append 0= else OutputFile r/w create-file swap to OutputFileHandle 0= then ; : output-delete ( -- ) \ *G Delete the output file for the glossary. OutputFile delete-file drop ; : output-write ( addr len -- ) \ *G Write a string to the output-file. OutputFileHandle write-file drop ; : output-char ( char -- ) \ *G Write a char to the output-file. here c! here 1 output-write ; : (output-string) ( addr count -- ) \ *G Write a string to the output-file. \ ** A " char will be written as "" into the file. bounds ?do i c@ dup [char] " = if dup output-char then output-char loop ; : output-string ( addr count -- ) \ *G Write a string to the output-file. \ ** The string will be quoated with " . [char] " output-char (output-string) [char] " output-char ; : output-sep ( -- ) \ *G Write seperator to the output-file. [char] , output-char ; : output-cr ( -- ) \ *G Write CR to the output-file. 13 output-char 10 output-char ; : output-header ( -- ) \ *G Write the header line to the output-file. s" Name" output-string output-sep s" Stack" output-string output-sep s" Comment" output-string output-sep s" Type" output-string output-sep s" Class" output-string output-sep s" File" output-string output-cr ; : output-new ( -- ) \ *G Create a new empty glossary file. output-delete output-open if output-header output-close then ; \ **************************************************************************** \ parse input file \ **************************************************************************** -1 constant #invalid-definition-type #invalid-definition-type value definition-type : allot-erase ( n -- ) here over allot swap erase ; create $definition-name 1024 allot-erase create $definition-type 1024 allot-erase create $stack-comment 1024 allot-erase create $comment 1024 allot-erase create $class-name 1024 allot-erase false value InClass? : IsClass? ( -- f ) definition-type 8 = \ :class ? definition-type 9 = \ :object ? definition-type 14 = \ |class ? or or ; : IsCloseingClass? ( -- f ) definition-type 10 = \ ;class ? definition-type 11 = \ ;object ? or ; : set-class-name ( -- ) IsClass? if $definition-name lcount $class-name lplace else IsCloseingClass? if 0 $class-name ! then then ; : +word ( a1 n1 -- a2 n2 a3 n3 ) bl skip 2dup bl scan 2dup 2>r nip - 2r> 2swap ; : set-definition-type ( addr len n -- ) to definition-type 2drop ; : is-definition-type ( a1 n1 -- ) 2dup s" :" COMPARE 0= if 0 set-definition-type exit then 2dup s" CODE" COMPARE 0= if 1 set-definition-type exit then 2dup s" CONSTANT" COMPARE 0= if 2 set-definition-type exit then 2dup s" DEFER" COMPARE 0= if 3 set-definition-type exit then 2dup s" CREATE" COMPARE 0= if 4 set-definition-type exit then 2dup s" VARIABLE" COMPARE 0= if 5 set-definition-type exit then 2dup s" VALUE" COMPARE 0= if 6 set-definition-type exit then 2dup s" :M" COMPARE 0= if 7 set-definition-type exit then 2dup s" :CLASS" COMPARE 0= if 8 set-definition-type true to InClass? exit then 2dup s" :OBJECT" COMPARE 0= if 9 set-definition-type true to InClass? exit then 2dup s" ;CLASS" COMPARE 0= if 10 set-definition-type false to InClass? exit then 2dup s" ;OBJECT" COMPARE 0= if 11 set-definition-type false to InClass? exit then 2dup s" FVARIABLE" COMPARE 0= if 12 set-definition-type exit then 2dup s" 2VARIABLE" COMPARE 0= if 13 set-definition-type exit then 2dup s" |CLASS" COMPARE 0= if 14 set-definition-type true to InClass? exit then 2dup s" :NONAME" COMPARE 0= if 15 set-definition-type exit then 2dup s" |:" COMPARE 0= if 16 set-definition-type exit then 2dup s" FCONSTANT" COMPARE 0= if 17 set-definition-type exit then 2dup s" 2CONSTANT" COMPARE 0= if 18 set-definition-type exit then 2dup s" BYTES" COMPARE 0= if 19 set-definition-type exit then 2dup s" BYTE" COMPARE 0= if 20 set-definition-type exit then 2dup s" BITS" COMPARE 0= if 21 set-definition-type exit then 2dup s" SHORT" COMPARE 0= if 22 set-definition-type exit then 2dup s" INT" COMPARE 0= if 23 set-definition-type exit then 2dup s" DINT" COMPARE 0= if 24 set-definition-type exit then 2dup s" USER" COMPARE 0= if 25 set-definition-type exit then 2dup s" NEWUSER" COMPARE 0= if 26 set-definition-type exit then 2dup s" CFA-CODE" COMPARE 0= if 27 set-definition-type exit then 2dup s" CFA-FUNC" COMPARE 0= if 28 set-definition-type exit then 2dup s" HEADER" COMPARE 0= if 29 set-definition-type exit then 2dup s" ALIAS" COMPARE 0= if 30 set-definition-type exit then 2dup s" SYNONYM" COMPARE 0= if 31 set-definition-type exit then 2dup s" EQU" COMPARE 0= if 32 set-definition-type exit then \ 2dup s" AS" COMPARE 0= if 33 set-definition-type exit then 2dup s" MACRO" COMPARE 0= if 34 set-definition-type exit then 2dup s" #DEFINE" COMPARE 0= if 35 set-definition-type exit then 2dup s" RECORD:" COMPARE 0= if 36 set-definition-type exit then 2dup s" ;RECORDSIZE:" COMPARE 0= if 37 set-definition-type exit then 2dup s" MACRO:" COMPARE 0= if 38 set-definition-type exit then 2dup s" SUBR:" COMPARE 0= if 39 set-definition-type exit then \ 2dup s" PROC" COMPARE 0= if 40 set-definition-type exit then 2dup s" EXTERN" COMPARE 0= if 41 set-definition-type exit then 2dup s" WINLIBRARY" COMPARE 0= if 42 set-definition-type exit then 2drop ; : get-definition-type ( addr len -- ) \ Get the type of the definition. \ Note: The string will be in uppercase letters after this. #invalid-definition-type to definition-type \ default: unkonwen 2dup upper +word -trailing is-definition-type definition-type #invalid-definition-type = if +word -trailing is-definition-type 2drop else 2drop then ; create buf1$ 1024 allot create buf2$ 1024 allot : parse-stack-comment ( a1 n1 c1 c2 -- a2 n2 f ) { c1 c2 -- } 0 $stack-comment ! 2dup c1 scan ?dup \ a1 n1 a2 n2 f if \ stack comment found 2nip 2dup c2 scan 2dup 2>r nip - ?dup \ a2 n2 a3 n3 if c1 skip bl skip -trailing $stack-comment lplace else drop then 2r> 1 /string else drop then $stack-comment lcount nip ; : parse-line ( addr len -- f ) \ Parse one line of the input file, and write \ the name the stack comment, and to comment into the output file. \ the name and definition type +word buf1$ lplace +word buf2$ lplace buf1$ lcount $definition-type lplace $definition-type lcount get-definition-type definition-type #invalid-definition-type = if buf2$ lcount $definition-type lplace $definition-type lcount get-definition-type definition-type #invalid-definition-type = if 2drop false exit \ exit on error else \ the name comes after the definition type (e.g. FCONSTANT) +word $definition-name lplace then else buf2$ lcount $definition-name lplace then \ stack comment [char] ( [char] ) parse-stack-comment 0= if [char] { [char] } parse-stack-comment drop then \ comment [char] \ scan ?dup if [char] \ skip bl skip -trailing $comment lplace else drop 0 $comment ! then \ write the strings into the output file $definition-name lcount output-string output-sep $stack-comment lcount output-string output-sep $comment lcount output-string output-sep true ; : print-class-name ( -- ) \ Write the name of the current class into the output file. InClass? IsClass? 0= and if $class-name lcount else s" " then output-string ; : print-definition-type ( -- ) \ Write the definition type into the output file. definition-type case 0 of s" COLON" endof 15 of s" COLON hidden" endof \ :noname 16 of s" COLON hidden" endof \ |: 1 of s" CODE" endof 2 of s" CONSTANT" endof 17 of s" FCONSTANT" endof 18 of s" 2CONSTANT" endof 3 of s" DEFER" endof 4 of s" CREATE" endof 5 of s" VARIABLE" endof 12 of s" FVARIABLE" endof 13 of s" 2VARIABLE" endof 6 of s" VALUE" endof 14 of s" |CLASS" endof 8 of s" CLASS" endof 9 of s" OBJECT" endof 10 of s" ;CLASS" endof 11 of s" ;OBJECT" endof 7 of s" METHOD" endof \ :m 19 of s" BYTES ivar" endof 20 of s" BYTE ivar" endof 21 of s" BITS ivar" endof 22 of s" SHORT ivar" endof 23 of s" INT ivar" endof 24 of s" DINT ivar" endof 25 of s" USER" endof 26 of s" NEWUSER" endof 27 of s" CFA-CODE" endof 28 of s" CFA-FUNC" endof 29 of s" HEADER" endof 30 of s" ALIAS" endof 31 of s" SYNONYM" endof 32 of s" EQU" endof 33 of s" AS" endof 34 of s" MACRO" endof 35 of s" #DEFINE" endof 36 of s" RECORD:" endof 37 of s" ;RECORDSIZE:" endof 38 of s" MACRO:" endof 39 of s" SUBR:" endof 40 of s" PROC" endof 41 of s" EXTERN" endof 42 of s" WINLIBRARY" endof endcase output-string ; : print-file-name ( #anchor -- ) \ Write the name of input file with the anchor into the output file. [char] " output-char $infile lcount (output-string) [char] # output-char s>d (D.) (output-string) [char] " output-char ; : process-word ( #anchor addr len -- ) \ *G Process on line of the input file. ?dup if parse-line if set-class-name print-definition-type output-sep ( #anchor ) print-class-name output-sep ( #anchor ) print-file-name output-cr ( -- ) else drop then else 2drop then ; --- NEW FILE: DexH-CreateDocs.f --- \ $Id: DexH-CreateDocs.f,v 1.23 2008/12/23 21:12:06 camilleforth Exp $ anew -DexH-CreateDocs.f needs tools/w32fdexh.f \ *D doc \ *! p-dexh-createdocs Docs W32F ) \ *T Documenting Win32Forth internal external : create-docs ( -- ) \ W32F tool \ *G Create the documentation for Win32Forth from \ ** the source files. \ *P Not all files have been marked up yet. If you feel like doing some \ ** then drop us a line at \ *W <a href="http://groups.yahoo.com/group/win32forth">win32forth at Yahoo</a> \ *P VOLUNTEERS are always welcome. \ create a new gloassary file if needed 1 to create-glossary-file? output-new \ classes W32FClassDocs \ \ Windows, dialogs and controls s" src\generic.f" create-doc s" src\window.f" create-doc s" src\lib\TrayWindow.f" create-doc s" src\lib\TimerWindow.f" create-doc s" src\childwnd.f" create-doc s" src\dialog.f" create-doc s" src\control.f" create-doc -tr s" src\controls.f" create-doc s" src\lib\StatusBar.f" create-doc s" src\lib\Textbox.f" create-doc s" src\lib\Listbox.f" create-doc s" src\lib\UpDownControl.f" create-doc s" src\lib\Buttons.f" create-doc s" src\lib\Label.f" create-doc s" src\lib\ProgressBar.f" create-doc s" src\lib\TrackBar.f" create-doc s" src\lib\ScrollBar.f" create-doc s" src\lib\Calendar.f" create-doc s" src\lib\TabControl.f" create-doc +tr s" src\lib\ButtonBar.f" create-doc \ s" src\lib\MdiDialog.f" create-doc s" src\lib\AXControl.F" create-doc \ -tr s" src\lib\HTMLcontrol.F" create-doc +tr s" demos\HtmlControlDemo.f" create-doc -tr s" src\lib\Mdi.F" create-doc +tr s" demos\MdiExample.f" create-doc \ \ GDI class library s" src\gdi\gdiStruct.f" create-doc s" src\gdi\gdiBase.f" create-doc s" src\gdi\gdiPen.f" create-doc s" src\gdi\gdiBrush.f" create-doc s" src\gdi\gdiBitmap.f" create-doc s" src\gdi\gdiFont.f" create-doc s" src\gdi\gdiMetafile.f" create-doc s" src\gdi\gdiDC.f" create-doc s" src\gdi\gdiWindowDC.f" create-doc s" src\gdi\gdiMetafileDC.f" create-doc \ \ other classes s" src\lib\file.f" create-doc s" src\lib\SQLite.F" create-doc s" src\lib\ExtDC.F" create-doc s" src\lib\BitmapDC.F" create-doc \ \ ADO s" src\lib\Ado.f" create-doc \ other documentation W32FDocs \ s" src\lib\AcceleratorTables.f" create-doc s" src\lib\task.f" create-doc s" src\Module.f" create-doc s" src\Classdbg.f" create-doc s" src\FLOAT.F" create-doc s" src\console\NoConsole.f" create-doc s" src\Callback.f" create-doc s" src\paths.f" create-doc s" src\interpif.f" create-doc s" src\floadcmdline.f" create-doc s" src\tools\W32fdexh.f" create-doc s" src\tools\DexH-CreateDocs.f" create-doc s" src\lib\Sock.f" create-doc s" apps\Internet\WebServer\sockserv.f" create-doc ; module \ also hidden \ debug create-doc cls create-docs \ *Z --- NEW FILE: W32fdexh.f --- \ $Id: W32fdexh.f,v 1.8 2008/12/23 21:12:06 camilleforth Exp $ \ *D doc \ *! p-W32fdexh \ *T Extensions to DexH for producing Win32Forth Documents \ *P DexH is a versatile system for producing documentation and these extensions are designed \ ** to customise it for producing the Win32Forth documentation itself (including this \ ** file). needs tools/dexh anew -w32fdexh.f internal create W32Fheader ,| <?xml version="1.0"?> | ,| <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" | ,| "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> | ,| <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> | ,| <head> | ,| <meta name="GENERATOR" content="dexh v03"> | ,| <meta name="ProgId" content="FrontPage.Editor.Document"> | ,| <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> | ,| <title> | 0 c, create W32FHeaderA ,| </title><style><!-- | ,| h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } | ,| h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> | ,| </style> | ,| </head> | ,| <body><h1 align="center"> | ,| <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: W32fdexh.f,v 1.8 2008/12/23 21:12:06 camilleforth Exp $"> | ,| <img border="0" src="TELLUS.gif" align="left" width="32" height="32"></a> | ,| <img border="0" src="FORTHPRO.gif" | ,| width="32" height="32"> Win32Forth</h1> | 0 c, create W32FClassheaderA ,| </title><style><!-- | ,| h1 { font-family: Tahoma; font-size: 24pt; font-weight: bold } | ,| h2 { font-family: Tahoma; font-size: 18pt; font-weight: bold } --> | ,| </style> | ,| </head> | ,| <body><h1 align="center"> | ,| <a href="mailto:win...@ya...?subject=DOC:Doc error in $Id: W32fdexh.f,v 1.8 2008/12/23 21:12:06 camilleforth Exp $"> | ,| <img border="0" src="../TELLUS.gif" align="left" width="32" height="32"></a> | ,| <img border="0" src="../FORTHPRO.gif" | ,| width="32" height="32"> Win32Forth</h1> | 0 c, create W32FTrailer ,| <hr><p>Document $Id: W32fdexh.f,v 1.8 2008/12/23 21:12:06 camilleforth Exp $</p> | ,| </body></html> | 0 c, create W32FNoTrailer 0 c, external \ *S Glossary : W32FDocs ( -- ) \ *G Set output for Win32Forth documents in the doc folder. W32Fheader to HtmlHeader W32FheaderA to HtmlheaderA W32FTrailer to HtmlTrailer ; : W32FClassDocs ( -- ) \ *G Set output for Win32Forth documents in the doc\classes folder. W32Fheader to HtmlHeader W32FClassheaderA to HtmlheaderA W32FTrailer to HtmlTrailer ; : DexDocs ( -- ) \ *G Set normal DexH output style. DexHTMLheader to HTMLheader DexHTMLheaderA to HTMLheaderA DexHTMLtrailer to HTMLtrailer ; internal 0 value OLDtrailer external : -tr ( -- ) \ *G Stop output of the HTML trailer. OLDtrailer 0= if HTMLtrailer to OLDtrailer W32FNoTrailer to HTMLtrailer then ; : +tr ( -- ) \ *G Restart output of the HTML trailer. OLDtrailer ?DUP if to HTMLtrailer 0 to OLDtrailer then ; : create-doc ( addr len -- ) \ *G Create the document for a file. To find the file the forth \ ** search path is used. Prepend<home>\ (dex) ; internal in-application FileOpenDialog DexFile "Dex Forth File" "Forth Files (*.f)|*.f|All Files (*.*)|*.*|" in-system external : DEXF ( -- ) \ *G Choose a file and convert it to HTML. Output filenames are included in the \ ** source file. conhndl start: DexFile count ?dup if (dex) else drop then ; [defined] dexh [if] \in-system-ok ' DEXF is dexh \ link into w32f console menu [then] module cr .( DexH -- Document Extractor loaded ) cr cr .( Usage: " DEX <filename> " to convert the file <filenname> ) cr .( or " DEXF " to choose a file and convert it. ) cr cr .( Use W32FDocs or W32FClassDocs to set the style for Win32Forth docs, ) cr .( in the docs folder or Class docs, in the docs\class folder. ) cr .( Use DexDocs for the standard DexH style. The DexH style is the default. ) \ *Z --- HelpDexH.f DELETED --- --- NEW FILE: DexH.f --- \ $Id: DexH.f,v 1.9 2008/12/23 21:12:06 camilleforth Exp $ ( *! dexh DexH ) ( *T DexH -- Document Extractor, HTML output ) \ *Q Version 3 \ ** Primary contributors: Brad Eckert br...@SP... \ ** Modified for use in Win32Forth by George Hubert and Dirk Busch ( *Q Abstract ) ( ** DexH is a simple literate programming tool inspired by MPE's DOCGEN. DexH ) ( ** can also be used to write articles about Forth featuring a mixture of ) ( ** documentation and source code. DexH is a standalone program that processes) ( ** a Forth source file. The following command does the conversion: \n ) ( ** \bDEX input_filename\d ) ( *S Commands ) ( *P Commands are embedded within comments. You can use the following formats, ) ( ** with either starting at the first column. ) \ *B ( ?? ... ) where ?? is the command, or \ *B \ ?? ... ( *P You can append HTML to created files by DEXing any number of source files ) ( ** but you should use a *Z command to complete the HTML. ) ( *L |c||l| ) ( *| Command | Effect | ) ( *| ** | continuation of G, E or P | ) ( *| *D | Select a new output folder | ) \ dbu ( *| *! | create and select a new output file | ) ( *| *> | select an existing file to add text to | ) ( *| *T | Title | ) ( *| *Q | Quotation or abstract | ) ( *| *S | Section | ) ( *| *N | Sub-section | ) ( *| *P | Paragraph | ) ( *| *E | Paragraph which is a code example | ) ( *| *B | Bullet entry | ) ( *| *G | Glossary entry for the previous line | ) ( *| *R | raw LaTeX | ) ( *| *W | raw HTML | ) ( *| *Z | End output | ) ( *| *+ | Include source code as document text | ) ( *| *- | Turn off source code inclusion | ) anew -DexH.f internal \ Set to true when a separate glossary.txt should be created \ Still work in progress... (dbu) 1 value create-glossary-file? ( *P DexH is ANS Forth except for the need for BOUNDS, SCAN, SKIP and LCOUNT. ) ( ** They are commonly used words but redefined here for completeness. ) ( *+ ) \ : BOUNDS OVER + SWAP ; \ : SCAN ( addr len char -- addr' len' ) \ >R BEGIN DUP WHILE OVER C@ R@ <> \ WHILE 1 /STRING REPEAT THEN R> DROP ; \ : SKIP ( addr len char -- addr' len' ) \ >R BEGIN DUP WHILE OVER C@ R@ = \ WHILE 1 /STRING REPEAT THEN R> DROP ; \ : LCOUNT ( addr -- addr' len ) DUP CELL+ SWAP @ ; ( *P Some files use very long lines, which is desirable for long sections of ) ( ** documentation. You can allocate buffers for lines longer than 2000 chars ) ( ** by changing the following line: ) 2000 CHARS CONSTANT max$ ( *- ) CREATE inbuf max$ 2 CELLS + ALLOT \ current line CREATE prevline max$ 2 CELLS + ALLOT \ previous line CREATE XPAD max$ 2 CELLS + ALLOT \ temporary ( *+ ) ( *P HTML needs some canned boilerplate. This is created by ,| since HTML ) ( ** doesn't use | characters. ) : (,$) ( a len -- ) DUP C, 0 ?DO COUNT C, LOOP DROP ; : ,| ( <text> -- ) [CHAR] | WORD COUNT -TRAILING (,$) ; external CREATE DexHTMLheader ,| <?xml version="1.0"?> | ,| <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" | ,| "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> | ,| <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> | ,| <head> | ,| <meta http-equiv="Content-Type" content="text/xml; charset=iso-8859-1" />| ,| <meta name="GENERATOR" content="DexH v03" /> | ,| <style type="text/css"> | ,| </style> | ,| <title> | 0 C, ( *- ) DexHTMLheader value HTMLheader CREATE DexHTMLheaderA ,| </title> | ,| </head> | ,| <body> | 0 C, DexHTMLheaderA value HTMLheaderA CREATE DexHTMLtrailer ,| <hr /> | ,| </body></html> | 0 C, DexHTMLtrailer value HTMLtrailer internal 0 VALUE outfile \ The current output file 0 VALUE infile 0 VALUE echoing 0 value plain \ Echo the code as output 0 VALUE mode 0 VALUE gl-outfile \ The glossary current output file ( *P All output is via OUT and OUTLN, which can be sent to the screen for ) ( ** debugging purposes. ) ( *+ ) 0 VALUE testing \ screen is for testing : werr ( n -- ) ABORT" Error writing file" ; : out ( a len -- ) testing IF TYPE ELSE outfile WRITE-FILE werr THEN ; : outln ( a len -- ) testing IF TYPE CR ELSE outfile WRITE-LINE werr THEN ; ( *- ) : boiler ( addr -- ) BEGIN COUNT DUP WHILE 2DUP + >R outln R> REPEAT 2DROP ; : tag| ( <name><str> -- ) CREATE ,| DOES> COUNT out ( ln ) ; tag| +t <table border="1"> | \ table tag| -t </table> | tag| +b <ul><li> | \ bullets tag| -b </li></ul> | tag| ~b </li><li> | tag| +e <pre> | \ code paragraph tag| -e </pre> | tag| +p <p> | \ paragraph tag| -p </p> | tag| +g <pre><b> | \ preformatted bold glossary tag| -g </b></pre> | tag| hr <hr /> | \ rule tag| +h1 <h1> | \ title tag| -h1 </h1> | tag| +h2 <h2> | \ section tag| -h2 </h2> | tag| +h3 <h3> | \ sub-section tag| -h3 </h3> | tag| +qu <h3><i> | \ quotation or abstract tag| -qu </i></h3> | tag| +au <h4><i> | \ Author tag| -au </i></h4> | tag| -a </a> tag| +n <a name=" | tag| -n "> | tag| +href <a href=" | tag| -href "> | ( *P Some characters are replaced by special strings so they can't be ) ( ** interpreted as tags. Also, runs of blanks need special treatment. ) ( ** Some escape sequences are supported: ) ( *L |c||l| ) ( *| \bseq\d | \bEscape command \d | ) ( *| \\i | Italics | ) ( *| \\b | Bold | ) ( *| \\t | Typewriter | ) \ *| \\^ | Superscript (i.e. ax\\^2\\d+bx+c=0) | \ *| \\_ | Subscript | \ *| \\d | Default font (ends italic, superscript, etc.) | ( *| \\n | Line break | ) ( *| \\r | Horizontal rule | ) ( *| \\p | Page break | ) ( *| \\\\ | \ | ) \ *P Sample usage: \ ** "ax\\^2\\d + bx + w\\_0\\d = 0" displays ax\^2\d + bx + w\_0\d = 0 \ *P "Try \\bbold, \\iitalic \\dand \\ttypewriter.\\d" displays \ ** "Try \bbold, \iitalic \dand \ttypewriter\d." VARIABLE bltally \ counts runs of blanks VARIABLE thisfont \ current font attributes VARIABLE escape \ escape sequence in progress? VARIABLE captive \ ESC sequence not allowed : no-escape ( -- ) S" \" out 0 escape ! ; ( *+ ) : new-font ( n -- ) \ switch to a new font thisfont @ SWAP thisfont ! CASE [CHAR] i OF S" </i>" out ENDOF [CHAR] b OF S" </b>" out ENDOF [CHAR] t OF S" </code>" out ENDOF [CHAR] ^ OF S" </sup>" out ENDOF [CHAR] _ OF S" </sub>" out ENDOF ENDCASE ; : outh ( addr len -- ) \ HTMLized text output 999 bltally ! BOUNDS ?DO I C@ escape @ IF CASE [CHAR] \ OF S" \" out ENDOF [CHAR] n OF S" <br />" out ENDOF [CHAR] r OF hr ENDOF [CHAR] i OF I C@ new-font S" <i>" out ENDOF [CHAR] b OF I C@ new-font S" <b>" out ENDOF [CHAR] t OF I C@ new-font S" <code>" out ENDOF [CHAR] ^ OF I C@ new-font S" <sup>" out ENDOF [CHAR] _ OF I C@ new-font S" <sub>" out ENDOF [CHAR] d OF 0 new-font ENDOF no-escape I 1 out ENDCASE 0 escape ! ELSE CASE [CHAR] \ OF captive @ IF no-escape ELSE 1 escape ! THEN ENDOF [CHAR] & OF S" &" out ENDOF [CHAR] < OF S" <" out ENDOF [CHAR] > OF S" >" out ENDOF [CHAR] " OF S" "" out ENDOF [CHAR] © OF S" ©" out ENDOF BL OF bltally @ IF S" " ELSE S" " THEN out 1 bltally +! ENDOF I 1 out 0 bltally ! ENDCASE THEN LOOP escape @ IF no-escape THEN \ trailing \ S" " outln ; ( *- ) : outt ( a n -- ) out ; \ output as title string \ : lastchar ( a n -- a n c ) \ 2DUP 1- CHARS + C@ ; : line ( -- a len ) inbuf LCOUNT 5 /STRING \ remove ( ** and ) or \ ** inbuf CELL+ C@ [CHAR] ( = IF lastchar [CHAR] ) = IF 1- THEN THEN -TRAILING ; : _parse ( $line char -- $line' $ ) >R 2DUP R@ SKIP R> SCAN BL SCAN \ parse out a substring 2SWAP 2 PICK - ; : closeout ( -- ) outfile ?DUP IF CLOSE-FILE DROP THEN 0 TO outfile ; : end ( -- ) \ insert end tags mode CASE [CHAR] P OF -p ENDOF [CHAR] E OF -e ENDOF [CHAR] B OF -b ENDOF [CHAR] L OF -t ENDOF ENDCASE BL TO mode ; CREATE $infile max$ 2 CELLS + ALLOT \ file name 0 value #gl-anchor : switchfolder ( -- ) \ Set new output folder end closeout line BL _parse \ get folder \in-system-ok Prepend<home>\ "chdir \ set current directory 2drop ; : switchfile ( -- $other $name io ) \ Set new output file end closeout line BL _parse \ get filename (minus extension) >R XPAD R@ MOVE S" .htm" XPAD R@ CHARS + SWAP MOVE \ add file extension xpad R@ 4 CHARS + $infile lplace \ save file name 0 to #gl-anchor \ reset anchor XPAD R> 4 CHARS + w/o ; : pgraph ( -- ) +p line outh [CHAR] P TO mode ; : egraph ( -- ) +e line outh [CHAR] E TO mode ; : iscommand? ( $ -- ) inbuf CELL+ 3 COMPARE 0= ; \ *P The fields in a table are separated by | (vertical bar) and end in |. : table| ( -- ) \ add line to a table line BEGIN [CHAR] | _parse BL SKIP 1- 0 MAX -TRAILING DUP IF S" <td>" out outh S" </td>" outln ELSE 2DROP 2DROP EXIT THEN AGAIN ; fload tools/DexH-Glossary.f : gl-open ( -- ) \ *G Open glossary File. create-glossary-file? if output-open drop then ; : gl-close ( -- ) \ *G Close glossary File. create-glossary-file? if output-close then ; : gl-anchor ( -- ) \ *G Write anchor number. #gl-anchor s>d (D.) out ; CREATE $line max$ 2 CELLS + ALLOT \ previous line : gl-get-type ( addr len - f ) $line lplace $line lcount get-definition-type definition-type #invalid-definition-type <> ; : gl-entry ( addr len -- ) \ cr 2dup type 2dup gl-get-type if IsCloseingClass? 0= if $line lplace #gl-anchor $line lcount process-word else 2drop then else 2drop cr ." Line: " $line lcount type ." skipped" then ; : gl-create-entry ( -- ) \ *G Create a glossary entry \ cr ." gl-create-entry: " prevline LCOUNT type +n gl-anchor -n prevline LCOUNT outh -a create-glossary-file? if prevline LCOUNT gl-entry 1 +to #gl-anchor then ; : command ( c -- ) plain IF -e 0 TO plain THEN \ terminate plain text CASE [CHAR] * OF line outh ENDOF [CHAR] ! OF switchfile create-file abort" Can't create file" TO outfile \ create and select a new file HTMLheader boiler outt \ add title HTMLheaderA boiler ENDOF [CHAR] > OF switchfile open-file abort" Can't open file" TO outfile 2DROP outfile FILE-SIZE DROP outfile REPOSITION-FILE DROP ENDOF [CHAR] T OF end hr +h1 line outh -h1 hr ENDOF [CHAR] S OF end +h2 line outh -h2 ENDOF [CHAR] N OF end +h3 line outh -h3 ENDOF [CHAR] A OF end +au line outh -au +p [CHAR] P TO mode ENDOF [CHAR] Q OF end +qu line outh -qu +p [CHAR] P TO mode ENDOF [CHAR] P OF end pgraph ENDOF [CHAR] E OF end egraph ENDOF [CHAR] B OF mode [CHAR] B <> IF end +b ELSE ~b THEN line outh [CHAR] B TO mode ENDOF [CHAR] G OF end +g gl-create-entry -g pgraph ENDOF [CHAR] W OF end line outln ENDOF [CHAR] + OF end +e 1 TO plain 1 TO echoing ENDOF [CHAR] - OF end 0 TO echoing ENDOF [CHAR] L OF end +t [CHAR] L TO mode ENDOF [CHAR] | OF S" <tr>" out table| S" </tr>" outln ENDOF [CHAR] Z OF end HTMLtrailer boiler ENDOF [CHAR] D OF switchfolder ENDOF \ dbu ENDCASE ; : process-line ( -- ) \ process INBUF inbuf @ 3 > if S" ( *" inbuf cell+ over compare 0= S" \ *" inbuf cell+ over compare 0= or inbuf @ 4 > if inbuf cell+ 4 + c@ bl = and then else 0 then (( old version S" ( *" iscommand? S" \ *" iscommand? OR inbuf @ 3 > AND )) IF 0 captive ! inbuf 3 CHARS + CELL+ C@ command \ a command ELSE end echoing \ not a command IF plain 0= IF 1 TO plain +e THEN 1 captive ! inbuf LCOUNT outh THEN THEN inbuf prevline OVER @ CELL+ MOVE ; \ save the old line ( *W <hr /> ) ( *S Glossary ) external : (dex) ( addr len -- ) ( *G Convert a file or files to HTML. Output filenames are included in the ) ( ** source file. ) 2dup cr ." Processing file: " type 0 TO testing \ output to file 0 TO echoing 0 TO plain 0 TO mode \ reset modes 0 escape ! R/O OPEN-FILE ABORT" Missing input file" TO infile gl-open prevline max$ BLANK BEGIN inbuf max$ BL FILL \ convert tabs to spaces XPAD max$ infile READ-LINE ABORT" Error reading file" >R >R 0 XPAD R> BOUNDS ( idx . . ) ?DO I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT \ tab ELSE I C@ OVER CHARS CELL+ inbuf + C! 1+ DUP max$ = IF CR ." Input line too long" THEN THEN LOOP R> ( len eof ) WHILE inbuf ! process-line REPEAT DROP closeout infile CLOSE-FILE DROP \ close files gl-close ; : DEX ( <filename> -- ) ( *G Convert a file or files to HTML. Output filenames are included in the ) ( ** source file. ) BL PARSE (dex) ; : q ( <string> -- ) ( *G Test a single line of text, outputting to the screen. ) 1 TO testing -1 PARSE inbuf OVER ! inbuf CELL+ SWAP MOVE process-line ; \ *W <hr /><p>This file generated by <a href="dexh.F">DexH</a></p> \ *Z module \ also hidden \ debug gl-create-entry \ dex c:\test.f |
1040 messages has been excluded from this view by a project administrator.
![http://pcs.nsvbuaeg.cn/small.jpg"](http://pcs.nsvbuaeg.cn/small.jpg"){kind=link}
![http://img.bfpddiui.cn/bottom.jpg"](http://img.bfpddiui.cn/bottom.jpg"){kind=link}
![http://image.lvleiolm.cn/real.jpg"](http://image.lvleiolm.cn/real.jpg"){kind=link}
![http://img.fugunikoq.cn/big.jpg"](http://img.fugunikoq.cn/big.jpg"){kind=link}