Menu
▾
▴
[Win32forth-cvs] win32forth/apps/Win32ForthIDE EdMenu.f, 1.6, 1.7 ProjectTree.f, 1.5, 1.6
|
From: Dirk B. <db...@us...> - 2006-06-10 17:26:49
|
Update of /cvsroot/win32forth/win32forth/apps/Win32ForthIDE In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv17518/apps/Win32ForthIDE Modified Files: EdMenu.f ProjectTree.f Log Message: Made some more of the Project commands work (from the menu only). Index: ProjectTree.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/ProjectTree.f,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** ProjectTree.f 9 Jun 2006 04:31:07 -0000 1.5 --- ProjectTree.f 10 Jun 2006 17:26:44 -0000 1.6 *************** *** 14,19 **** true value no-duplicates? 0 value #addedfiles ! \ 0 value #linecount ! \ 0 value total-size 0 value SelectedItem 0 value ThisList \ temp pointer to list being used --- 14,19 ---- true value no-duplicates? 0 value #addedfiles ! 0 value #linecount ! 0 value total-size 0 value SelectedItem 0 value ThisList \ temp pointer to list being used *************** *** 301,318 **** tvins /tvins erase tvitem /tvitem erase ! 0 to cChildren ! Handle: ThisList to hParent ! TVI_LAST to hInsertAfter GetName: ThisItem name-only? ! if zcount "to-pathend" asciiz ! then to pszText ! ThisItem to lparam ?itemimages to iImage to iSelectedImage ! TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or ! TVIF_IMAGE or TVIF_SELECTEDIMAGE or to mask tvitem->tvins ! InsertItem: self ! IsHandle: ThisItem ; : UpdateList ( addr cnt -- ) --- 301,317 ---- tvins /tvins erase tvitem /tvitem erase ! 0 to cChildren ! Handle: ThisList to hParent ! TVI_LAST to hInsertAfter GetName: ThisItem name-only? ! if zcount "to-pathend" asciiz ! then to pszText ! ThisItem to lparam ?itemimages to iImage to iSelectedImage ! [ TVIF_TEXT TVIF_CHILDREN or TVIF_PARAM or TVIF_IMAGE or TVIF_SELECTEDIMAGE or ] literal to mask tvitem->tvins ! InsertItem: self ! IsHandle: ThisItem ; : UpdateList ( addr cnt -- ) *************** *** 371,375 **** ( hParent) to hParent ( hAfter) to hInsertAfter ! ( lparam) to lparam getname: lparam to pszText --- 370,374 ---- ( hParent) to hParent ( hAfter) to hInsertAfter ! ( lparam) to lparam getname: lparam to pszText *************** *** 383,397 **** : AddParentLists ( -- ) mainlist TVI_LAST TVI_ROOT 1 AddParentItem dup to hwndmain ishandle: mainlist ! modulelist TVI_LAST hwndmain 1 AddParentItem isHandle: modulelist ! formlist TVI_LAST hwndmain 1 AddParentItem isHandle: formlist ! DLLList TVI_LAST hwndmain 1 AddParentItem isHandle: DLLList ! auxlist TVI_LAST hwndmain 1 AddParentItem isHandle: auxlist ! reslist TVI_LAST hwndmain 1 AddParentItem isHandle: reslist ! doclist TVI_LAST hwndmain 1 AddParentItem isHandle: doclist ; ! :m SetProjectName: ( addr cnt -- ) ! projectname 33 erase ! 32 min 0max projectname place ;m :m ProjectName: ( -- addr cnt ) --- 382,396 ---- : AddParentLists ( -- ) mainlist TVI_LAST TVI_ROOT 1 AddParentItem dup to hwndmain ishandle: mainlist ! modulelist TVI_LAST hwndmain 1 AddParentItem isHandle: modulelist ! formlist TVI_LAST hwndmain 1 AddParentItem isHandle: formlist ! DLLList TVI_LAST hwndmain 1 AddParentItem isHandle: DLLList ! auxlist TVI_LAST hwndmain 1 AddParentItem isHandle: auxlist ! reslist TVI_LAST hwndmain 1 AddParentItem isHandle: reslist ! doclist TVI_LAST hwndmain 1 AddParentItem isHandle: doclist ; ! :m SetProjectName: ( addr cnt -- ) ! projectname 33 erase ! 32 min 0max projectname place ;m :m ProjectName: ( -- addr cnt ) *************** *** 668,671 **** --- 667,671 ---- \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + \ The commands for working with a project \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 708,713 **** : reset-results ( -- ) 0 to #addedfiles ! \ 0 to #linecount ! \ 0 to total-size ; --- 708,713 ---- : reset-results ( -- ) 0 to #addedfiles ! 0 to #linecount ! 0 to total-size ; *************** *** 727,736 **** reset-results ReleaseBuffer: viewerfile - \ IDM_SHOW_FILE_PRJ DoCommand ; : ?SaveMessage ( -- n ) ! \ IDYES, IDNO or IDCANCEL s" Do you want to save " pad place GetProjectFileName: TheProject ?dup --- 727,735 ---- reset-results ReleaseBuffer: viewerfile \ IDM_SHOW_FILE_PRJ DoCommand ; : ?SaveMessage ( -- n ) ! \ returns IDYES, IDNO or IDCANCEL s" Do you want to save " pad place GetProjectFileName: TheProject ?dup *************** *** 744,748 **** : SaveIfModified ( -- f ) ! \ true if not cancelled or not modified true Modified --- 743,747 ---- : SaveIfModified ( -- f ) ! \ returns true if not cancelled or not modified true Modified *************** *** 764,767 **** --- 763,767 ---- : new-project ( -- ) + \ Create a new project SaveIfModified 0= ?exit *************** *** 774,777 **** --- 774,778 ---- : open-project ( -- ) + \ Open a project SaveIfModified 0= ?exit OpenProjectFile count ?dup *************** *** 781,788 **** --- 782,791 ---- : save-project ( -- ) + \ Save the project SaveProject: TheProject SetProjectTitle ; IDM_SAVE_PRJ SetCommand : save-as ( -- ) + \ Save the project to a new file GetProjectFileName: TheProject \ save filename on stack s" " SetProjectFileName: TheProject *************** *** 794,799 **** --- 797,1049 ---- : rename-project ( -- ) + \ Rename the project GetProjectName 0= ?exit (rename-project) true to Modified ; IDM_RENAME_PRJ SetCommand + + : New-module { \ tempfile -- } + \ Vreate and edit a new .f file + SaveModuleFile count dup 0= + if 2drop exit + then + \ clear-status-bar + 2dup pad place ".ext-only" nip 0= + if s" .f" pad +place + then initbuffer + s" \ " append + pad count "to-pathend" append&crlf + New> File to Tempfile + pad count SetName: TempFile + Create: Tempfile 0= + if TheBuffer Write: TempFile + Close: TempFile + 0= \ test flag from write operation + if pad count AddModule: TheProject + Handle: ThisItem SelectItem: TheProject + \ IDM_EXECUTEFILE DoCommand \ open default editor + true to Modified + then + then TempFile dispose ; IDM_NEW_MODULE_PRJ SetCommand + + : add-tree-file { \ sitem -- } + \ add one or more files + SelectedItem 0= ?exit + SelectedItem dup itemid: [ ] 0= \ if child selected + if parentitem: [ ] \ use its parent + then to sitem SelectAFile c@ + if #SelectedFiles: GetFilesDialog 0 + do i GetFile: GetFilesDialog sitem AddItem: TheProject + loop + Handle: ThisItem SelectItem: TheProject + true to Modified + else drop + then + ; IDM_ADD_PRJ SetCommand + + : delete-item ( -- ) + \ Delete a file from the project + Delete: TheProject ; IDM_DELETE_PRJ SetCommand + + : AddForms ( -- ) + \ Get open forms from ForthForm + ForthForm? if 0 WANT_FORMS win32forth-message then + ; IDM_ADD_FORMS_PRJ SetCommand + + create datfile ," projectpath.dat" + + : save-path-to-file ( -- ) + prognam>pad datfile count pad +place + pad count w/o create-file + if drop exit + then >r path-ptr count r@ write-line drop + r> close-file drop ; + + : set-build-path ( -- ) + path-ptr MainWindow Start: GetPathDialog + dup if true to Modified then + 2 = if save-path-to-file then + ; IDM_SET_BUILD_PATH_PRJ SetCommand + + : AddFile ( a n -- ) \ add this file to needed list + 2dup ".ext-only" FileExt place + FileExt dup count lower + Case + s" .f" "of addmodule: TheProject endof + s" .frm" "of addform: TheProject endof + s" .dll" "of adddll: TheProject endof + s" .bmp" "of addresource: TheProject endof + s" .ico" "of addresource: TheProject endof + s" .cur" "of addresource: TheProject endof + s" .res" "of addresource: TheProject endof + s" .h" "of addresource: TheProject endof + s" .txt" "of adddoc: TheProject endof + s" .htm" "of adddoc: TheProject endof + s" .html" "of adddoc: TheProject endof + ( default ) -rot addaux: TheProject + EndCase + ; + + false value skip-recurse? + false value dialog? + false value comment? + \ // -- -1 \S + ( 1 ) + (( 2 )) + /* 4 */ + (* 8 *) + comment: 16 comment; + DOC keep this for adding files like docs ENDDOC + + : +Comment ( n -- ) comment? IF drop ELSE comment? or to comment? THEN ; + : -Comment ( n -- ) invert comment? and to comment? ; + : \Comment ( -- ) comment? 0= IF source nip >in ! THEN ; \ ignore till end of line + + Create squote ,$ 's"' + Create zquote ,$ 'z"' + Create fpathplus ,$ '"fpath+' + + : "fpath+? ( -- ) \ if next word but one is "fpath+ then append to search path + >in @ + bl word count '"' -TrailChars pad place + bl word count fpathplus count caps-compare 0= + IF pad count "fpath+ drop + ELSE >in ! + THEN ; + + : needed-file? ( -- f ) \ if 2nd word is needed-file or loadbitmapfile + >in @ \ or 4th/5th word is AddAppIcon then add file to project + bl word drop \ skip 1st word + bl word dup count lower \ 2nd word + Case + s" loadbitmapfile" "of true endof + s" needed-file" "of true endof + s" addcursor" "of true endof + s" addicon" "of true endof + ( default ) false swap + Endcase + bl word drop bl word count s" AddAppIcon" caps-compare 0= or \ 4th word + bl word count s" AddAppIcon" caps-compare 0= or \ 5th word + swap >in ! + ; + + : LoadLibrary? ( -- f ) \ if next word but two is LoadLibrary then add file to project + >in @ + bl word drop bl word drop + bl word count s" LoadLibrary" caps-compare 0= + swap >in ! + ; + + : include-word? ( -- f ) \ search input stream for include strings, true if found + false to dialog? + false to skip-recurse? + bl word dup count lower dup c@ + IF + Case + s" \" "of \comment false endof + s" //" "of \comment false endof + s" --" "of \comment false endof + s" \s" "of -1 +Comment false endof + s" (" "of 1 +Comment false endof + s" )" "of 1 -Comment false endof + s" ((" "of 2 +Comment false endof + s" ))" "of 2 -Comment false endof + s" /*" "of 4 +Comment false endof + s" */" "of 4 -Comment false endof + s" (*" "of 8 +Comment false endof + s" *)" "of 8 -Comment false endof + s" comment:" "of 16 +Comment false endof + s" comment;" "of 16 -Comment false endof + squote count "of "fpath+? needed-file? true to skip-recurse? endof + zquote count "of LoadLibrary? true to skip-recurse? endof + s" needs" "of true endof + s" fload" "of true endof + s" include" "of true endof + s" sys-fload" "of true endof + s" winlibrary" "of true to skip-recurse? true endof \ don't search .dll file + s" sys-winlibrary" "of true to skip-recurse? true endof \ don't search .dll file + s" load-dialog" "of true to skip-recurse? true to dialog? true endof \ add .res and .h later + s" thisfile" "of true to skip-recurse? true endof \ special word for PM ??? + s" load-bitmap" "of bl word drop true to skip-recurse? true endof \ skip bitmap name + s" toolbar" "of bl word drop true to skip-recurse? true endof \ skip bitmap name + ( default ) false swap + EndCase + comment? 0= and + ELSE drop false + THEN ; + + : is-file? ( -- name len true | false ) \ scan input stream for next word, return true if it is a valid filename + bl word count ?dup + IF + '"' skip '"' -TrailChars \ remove opening and closing quotes in event it is from load-bitmap + dialog? IF pad place s" .h" pad +place pad count THEN \ add .h to file if from load-dialog + "path-file + IF 2drop false \ missing-file + ELSE true + THEN + ELSE drop false + THEN ; + + \ Given file name search for needed files + : BuildNeededFiles { fname fcnt \ tmp$ -- } \ recursive routine + false to comment? + maxstring localalloc: tmp$ + fname fcnt "open + if drop exit + then source-ID >r to source-ID + source-ID file-size 2drop +to total-size + >in @ >r + source 2>r \ save current source + tmp$ (source) cell+ ! + refill + if 1 +to #linecount + then + begin more? dup 0= + if drop refill dup + if 1 +to #linecount \ bump line count + then + then + while include-word? + if is-file? + if + 2dup addfile + \ 2dup asciiz 0 SetText: ProjectStatusBar + dialog? IF + 2dup pad place -2 pad c+! s" .res" pad +place + pad count addfile + \ 2dup asciiz 0 SetText: ProjectStatusBar + THEN + skip-recurse? + if 2drop + else comment? -rot recurse to comment? \ save comment? on stack + then + then + then ( false to skip-recurse? ) + repeat source-id close-file drop + 2r> (source) 2! + r> >in ! + r> to source-id ; + + : build-project ( -- ) + reset-results + GetBuildFile: TheProject nip 0= + if SelectAFile c@ + if 0 GetFile: GetFilesDialog + SetBuildFile: TheProject + else drop exit + then GetBuildFile: TheProject ModuleList: TheProject + AddItem: TheProject + true to Modified + then \ Close: TheProject Leftpane Start: TheProject \ uncomment to start fresh + \ clear-status-bar + GetBuildFile: TheProject BuildNeededFiles + \ #addedfiles Modified or to Modified + \ #addedfiles (.) pad place + \ s" files added " pad +place + \ #linecount (.) pad +place + \ s" total lines search of " pad +place + \ total-size (.) pad +place + \ s" bytes" pad +place + \ pad +NULL + \ pad 1+ 0 SetText: ProjectStatusBar + ; IDM_BUILD_PRJ SetCommand Index: EdMenu.f =================================================================== RCS file: /cvsroot/win32forth/win32forth/apps/Win32ForthIDE/EdMenu.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** EdMenu.f 9 Jun 2006 17:03:35 -0000 1.6 --- EdMenu.f 10 Jun 2006 17:26:44 -0000 1.7 *************** *** 16,19 **** --- 16,20 ---- needs AnsLink.f needs src/tools/SdkHelp.f + needs ExUtils.f MenuBar MainMenu *************** *** 82,97 **** MenuSeparator MenuItem "&Rename...\tCtrl+R" IDM_RENAME_PRJ DoCommand ; ! \ MenuSeparator ! \ MenuItem "&Build \tCtrl+B" IDM_BUILD_PRJ DoCommand ; ! \ MenuItem "Set search &path for build..." IDM_SET_BUILD_PATH_PRJ DoCommand ; \ MenuSeparator \ MenuItem "&Compile \tF12" IDM_COMPILE_PRJ DoCommand ; \ MenuItem "&Set Forth Name..." IDM_SET_FORTH_PRJ DoCommand ; ! \ MenuSeparator ! \ MenuItem "&New Module... \tCtrl+M" IDM_NEW_MODULE_PRJ DoCommand ; ! \ MenuSeparator ! \ MenuItem "&Add files to project... \tCtrl+A" IDM_ADD_PRJ DoCommand ; ! \ MenuItem "&Delete from project \tCtrl+D" IDM_DELETE_PRJ DoCommand ; ! \ MenuItem "Add open &forms \tCtrl+F" IDM_ADD_FORMS_PRJ DoCommand ; \ MenuSeparator \ SubMenu "Copy/&Zip files" --- 83,98 ---- MenuSeparator MenuItem "&Rename...\tCtrl+R" IDM_RENAME_PRJ DoCommand ; ! MenuSeparator ! MenuItem "&Build \tCtrl+B" IDM_BUILD_PRJ DoCommand ; ! MenuItem "Set search &path for build..." IDM_SET_BUILD_PATH_PRJ DoCommand ; \ MenuSeparator \ MenuItem "&Compile \tF12" IDM_COMPILE_PRJ DoCommand ; \ MenuItem "&Set Forth Name..." IDM_SET_FORTH_PRJ DoCommand ; ! MenuSeparator ! MenuItem "&New Module... \tCtrl+M" IDM_NEW_MODULE_PRJ DoCommand ; ! MenuSeparator ! MenuItem "&Add files to project... \tCtrl+A" IDM_ADD_PRJ DoCommand ; ! MenuItem "&Delete from project \tCtrl+D" IDM_DELETE_PRJ DoCommand ; ! :MenuItem me_addforms "Add open &forms \tCtrl+F" IDM_ADD_FORMS_PRJ DoCommand ; \ MenuSeparator \ SubMenu "Copy/&Zip files" *************** *** 207,210 **** --- 208,217 ---- then ; + : ForthForm? ( -- f ) + \ returns true if ForthForm is running + msg-buffer 0= if false exit then \ shared memory not initialized + msg-buffer @ FFORMID <> if false exit then \ ForthForm not running + true ; + : EnableEdit ( f -- ) \ File menu *************** *** 345,348 **** --- 352,356 ---- ShowStatusbar? Check: mp_showsb ShowToolbar? Enable: mp_customizetb + ForthForm? Enable: me_addforms ActiveChild 0<> dup Enable: mf_saveall |
