Menu
▾
▴
win32forth-cvs
|
From: Ezra B. <ezr...@us...> - 2007-04-15 02:59:54
|
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 -- } |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X