Commit bbc8e5a5 authored by John van Groningen's avatar John van Groningen

implement Project Directory Up and Down

parent efa0357e
......@@ -10,13 +10,13 @@ import PmParse
import PmPath
from EdKeyMapping import macKeyMapping, ReadKeyMapFile, KeyMapFileName
from finder import sr_find, sr_find_next, sr_find_sel, sr_rep_find, sr_goto_cursor
from finder import sr_goto_line, sr_goto_selection
from finder import sr_find, sr_find_next, sr_find_sel, sr_rep_find, sr_goto_cursor,
sr_goto_line, sr_goto_selection
from edoptions import defaultFontAndTabs, optionsKeyMapping, editColours
from EdClient import :: EditAction, isEditWin, msgGetPathName,msgSelectAll
from EdClient import emptySelection, sendToActiveWindow, msgGetSelection
from EdClient import msgUndo,msgPaste,msgCopy,msgCut,msgClear,msgBalance,msgDetab
from EdClient import :: EditAction, isEditWin, msgGetPathName,msgSelectAll,
emptySelection, sendToActiveWindow, msgGetSelection,
msgUndo,msgPaste,msgCopy,msgCut,msgClear,msgBalance,msgDetab
import prefix, tools
import IdeState
......@@ -88,25 +88,16 @@ Start world
}
# (interact, force_update, proj_path, logfile, world)
= batchOptions world
#! (iniClip,pub,world) = iniGeneral
prefs
stup
interact logfile
mTargetId
eTargetId
lbId
#! (iniClip,pub,world) = iniGeneral prefs stup interact logfile
mTargetId eTargetId lbId
(initEditorState keymap)
emptyFindInfo
ffind
mEdUndoId
mMdEdOptId
emptyFindInfo ffind
mEdUndoId mMdEdOptId
iniTwi
// winOnly?
iniCons
iniTargets
mProjectId
mPrListId
mPrRecId
mProjectId mPrListId mPrRecId
world
# patt = [ ProcessClose (Quit prefspath)
, ProcessOpenFiles openfiles
......@@ -467,6 +458,8 @@ projectMenu
, MenuId (projIds!!12)
, MenuSelectState Unable
]
:+: MenuItem "Project Directory Up" [MenuFunction (noLS project_directory_up)]
:+: MenuItem "Project Directory Down" [MenuFunction (noLS project_directory_down)]
:+: MenuItem "Project Defaults..."
[ MenuFunction (noLS projectDefaults)
]
......
......@@ -6,6 +6,9 @@ import PmTypes, PmProject, IdeState
projectOptions :: !(PSt General) -> PSt General
projectDefaults :: !(PSt General) -> PSt General
project_directory_up :: !(PSt General) -> PSt General
project_directory_down :: !(PSt General) -> PSt General
doPathsDialog :: // Display a Paths dialogue
!String // Dialogue title string
!Pathname // Application path
......
......@@ -5,8 +5,8 @@ import StdFileSelect,StdPStClass,StdWindow
import PmTypes, PmProject, PmPath, UtilStrictLists
import tabcontrol, ExtListBox, ioutil, IdeState
import ExtNotice, UtilObjectIO
import Platform, morecontrols
from projwin import pm_update_project_window
:: PO_LS =
{ ao :: !ApplicationOptions
......@@ -40,8 +40,7 @@ projectDialog actualProject ps`
#(dp,ps) = getCurrentPaths ps
# prj = PR_SetPaths False dp ret.paths prj
# (appPath,ps) = getStup ps
# (prjPath,ps) = getProjectFilePath ps
# prjPath = RemoveFilename prjPath
# prjPath = PR_GetRootDir prj
# prj = PR_SetExecPath ret.xp prj
# prj = PR_SetStaticLibsInfo ret.sl prj
# (xxId,ps) = getPWX ps
......@@ -83,15 +82,16 @@ where
(lbdlibId,ps4) = openExtListBoxId ps3
(lbslibId,ps5) = openExtListBoxId ps4
(ap,ps6) = getStup ps5
(pp,ps7) = fix (getProjectFilePath ps6) where fix (l,r) = (RemoveFilename l,r)
pp = PR_GetRootDir project
(prefs,ps) = PlatformDependant
(getPrefs ps7) // Win
(getPrefs ps6) // Win
(getPrefs ps9) // Mac
// mac only...
(fontNames`, ps8)
= accPIO (accScreenPicture getFontNames) ps7 // filteren naar alleen fixed width fonts....
= accPIO (accScreenPicture getFontNames) ps6 // filteren naar alleen fixed width fonts....
// (fixed,ps9) = seqList (map (\f->accPIO (accScreenPicture (lisFixedWidth f))) fontNames`) ps8
(fixed,ps9) = accPIO (accScreenPicture (seqList (map lisFixedWidth fontNames`))) ps8
fontNames = lfilter fixed fontNames`
fontSizes = [7, 8, 9, 10, 12, 14, 18, 24 ]
inifn = ao.fn
......@@ -170,7 +170,7 @@ where
setexe (ls,ps)
# (prjPath,ps) = getProjectFilePath ps
# prjName = RemoveSuffix (RemovePath prjPath)
# prjPath = RemoveFilename prjPath
# prjPath = pp
# (exename,ps) = PlatformDependant
(selectOutputFile` "Executable" "*.exe" "Set" ps) // win
(selectOutputFile "Executable" prjName ps) // mac
......@@ -395,8 +395,7 @@ where
make_sym_path name ps
# (appPath,ps) = getStup ps
# (prjPath,ps) = getProjectFilePath ps
# prjPath = RemoveFilename prjPath
prjPath = pp
= (symPath appPath prjPath name,ps)
objectsPane = Pane "Extra Objects"
......@@ -645,6 +644,38 @@ setCheckControlMark full id io
True -> markCheckControlItems id [1] io
False -> unmarkCheckControlItems id [1] io
project_directory_up :: !(PSt General) -> PSt General
project_directory_up ps
# (project,ps) = getProject ps
| not (PR_ProjectSet project)
= okNotice ["No open project"] ps
# (project_file_path,ps) = getProjectFilePath ps
project_file_dir = RemoveFilename project_file_path
relative_root_dir = PR_GetRelativeRootDir project
parent_project_dir = make_project_dir (size relative_root_dir+1) project_file_dir
| size parent_project_dir==0 || parent_project_dir==PR_GetRootDir project
= okNotice ["Project directory cannot be moved further up"] ps
# relative_root_dir = relative_root_dir+++"."
project = change_root_directory_of_project relative_root_dir parent_project_dir project
ps = setProject project ps
= pm_update_project_window ps
project_directory_down :: !(PSt General) -> PSt General
project_directory_down ps
# (project,ps) = getProject ps
| not (PR_ProjectSet project)
= okNotice ["No open project"] ps
# (project_file_path,ps) = getProjectFilePath ps
project_file_dir = RemoveFilename project_file_path
relative_root_dir = PR_GetRelativeRootDir project
child_project_dir = make_project_dir (size relative_root_dir-1) project_file_dir
| size relative_root_dir<=1 || child_project_dir==PR_GetRootDir project
= okNotice ["Project directory cannot be moved further down"] ps
# relative_root_dir = relative_root_dir % (0,size relative_root_dir-2)
project = change_root_directory_of_project relative_root_dir child_project_dir project
ps = setProject project ps
= pm_update_project_window ps
doPathsDialog :: !String !Pathname !Pathname !(List Pathname) ((List Pathname) (PSt .l) -> (PSt .l)) (PSt .l) -> (PSt .l)
doPathsDialog titlestring ap pp lo set ps
# (wid,ps) = openId ps
......
......@@ -13,6 +13,7 @@ import ioutil, morecontrols, colorpickcontrol
import projmen, menubar, colourclip
//from IDE import OpenModule
import Platform, IdePlatform
import PmDirCache, UtilIO
//-- Project Window Options...
......@@ -475,8 +476,7 @@ pm_update_project_window_interactive ps
Just ws -> getControlViewDomain lbId.controlId ws
# (srcpaths,ps) = getProjwinPaths ps
# (appPath,ps) = getStup ps
# (prjPath,ps) = getProjectFilePath ps
# prjPath = RemoveFilename prjPath
(prjPath,ps) = getFromProject PR_GetRootDir ps
# lbItems = items srcpaths appPath prjPath modules prefs.prj_prefs.proj_shft
# ps = appendExtListBoxItems lbId lbItems ps
# ps = case mframe of
......@@ -499,7 +499,6 @@ where
# mods = filter isInPaths mods
# mods = sortBy (\(a,b,_,_) (c,d,_,_) -> less a b c d) mods
# moditems = makenice True "" mods
// # rootitem = (GetModuleName root, OpenModule (MakeImpPathname root) emptySelection, openif root)
# rootitem = (GetModuleName root, open_imp rootdir (MakeImpPathname root), openif rootdir root)
= [rootitem:moditems]
where
......@@ -516,8 +515,8 @@ where
# (exists,ps) = accFiles (FExists path) ps
| exists
= ed_open_path_sel path emptySelection ps
# imppath = MakeImpPathname root
= open_imp rootdir imppath ps
= open_imp rootdir (MakeImpPathname root) ps
less a b c d
| before b d = True // use < -ordening of searchpaths...
| b == d
......@@ -730,9 +729,8 @@ where
| not ok
= ps
# (lo,ps) = getFromProject PR_GetLinkOptions ps
# (prj_path,ps) = getProjectFilePath ps
(prj_path`,ps) = getFromProject PR_GetRootDir ps
# (app_path,ps) = getStup ps
# prj_path` = RemoveFilename prj_path
# execpath = fulPath app_path prj_path` execpath
| lo.method == LM_Dynamic
# execpath = (RemoveSuffix` execpath) +++. ".bat"
......@@ -742,9 +740,8 @@ where
pm_run :: !*(PSt *General) -> *PSt *General;
pm_run ps
# (app_path,ps) = getStup ps
# (prj_path,ps) = getProjectFilePath ps
(prj_path`,ps) = getFromProject PR_GetRootDir ps
# (execpath,ps) = getFromProject PR_GetExecPath ps
# prj_path` = RemoveFilename prj_path
# execpath = fulPath app_path prj_path` execpath
# (lo,ps) = getFromProject PR_GetLinkOptions ps
| lo.method == LM_Dynamic
......@@ -785,7 +782,7 @@ pm_copt ps
//-> only for module + ide, now added cursel in projwin
// current active added... (need to check if active is part of project...)
# (lbId,ps) = getPWI ps
# (project,ps) = accProject (\l->(l,l)) ps
# (project,ps) = getFromProject (\l->l) ps
# (path,ps) = sendToActiveWindow msgGetPathName ps
| isJust path
# path = fromJust path
......@@ -842,7 +839,6 @@ getActiveModules ps
# sel = map (MakeImpPathname o fst) sel
# (sel,ps) = seqList (map findModule sel) ps
# sel = [fromJust m \\ m <- sel | isJust m]
// # ps = trace_n` ("Sel",listToString sel) ps
= (sel,ps)
= ([],ps)
# winpath = fromJust winpath
......@@ -850,10 +846,8 @@ getActiveModules ps
= ([winpath],ps)
| IsDefPathname winpath
= ([MakeImpPathname winpath],ps)
// = trace_n` ("Regular",winpath) ([winpath],ps)
= ([],ps)
import PmDirCache, UtilIO
//import dodebug
findModule :: !.Modulename !*(PSt General) -> (!Maybe Pathname,!*PSt General)
findModule pathname ps
# (syspaths,ps) = getCurrentPaths ps
......@@ -865,10 +859,8 @@ findModule pathname ps
_ -> srcpaths
# ((ok,fullpath),ps) = accFiles (SearchDisk False pathname srcpaths) ps
| not ok
// = trace_n` ("NotFound",pathname,fullpath) (Nothing, ps)
= (Nothing, ps)
# fullpath` = GetLongPathName fullpath
// = trace_n` ("Found",fullpath`) (Just fullpath`, ps)
= (Just fullpath`, ps)
DoProcess msg compile cont ps
......@@ -878,7 +870,7 @@ DoProcess msg compile cont ps
= ps
where
init paths ps
# (project,ps) = accProject (\l->(l,l)) ps
# (project,ps) = getFromProject (\l->l) ps
ps = ew_safe_close ps
ps = tw_safe_close ps
= okcont paths project ps
......@@ -919,14 +911,14 @@ pm_save_copy_as ps
| isNothing pn
= ps
# pn = fromJust pn
# (project,ps) = accProject (\l->(l,l)) ps
# (project,ps) = getFromProject (\l->l) ps
# (project,ps) = pm_save_common pn project ps
# ps = appProject (const project) ps
= ps
pm_save :: !*(PSt *General) -> *PSt *General
pm_save ps
# (project,ps) = accProject (\l->(l,l)) ps
# (project,ps) = getFromProject (\l->l) ps
(pathname,ps) = getProjectFilePath ps
# (project,ps) = pm_save_common pathname project ps
# project = PR_SetSaved project
......@@ -976,8 +968,6 @@ isProjWin win ps
# (wId,ps) = getPWW ps
= (wId == win,ps)
//////////////////////////////////////
extKeyboard = ControlKeyboard keyFilter Able keyboard
keyFilter :: KeyboardState -> Bool
......@@ -1001,7 +991,7 @@ keyboard (CharKey '+' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
| not hasSelection
= ((lbState,ls),ps)
# (appPath,ps) = getStup ps
# (prjPath,ps) = getProjectFilePath ps
(prjPath,ps) = getFromProject PR_GetRootDir ps
# ps = updFstate` (map (\(p,b)-> (fulPath appPath prjPath p,b)) selItems) ps
# ps = pm_update_project_window_interactive ps
= ((lbState,ls),ps)
......@@ -1017,7 +1007,7 @@ keyboard (CharKey '-' (KeyDown False)) ((lbState=:{tMargin,listboxId,selection,i
| not hasSelection
= ((lbState,ls),ps)
# (appPath,ps) = getStup ps
# (prjPath,ps) = getProjectFilePath ps
(prjPath,ps) = getFromProject PR_GetRootDir ps
# ps = updFstate` (map (\(p,b)-> (fulPath appPath prjPath p,b)) selItems) ps
# ps = pm_update_project_window_interactive ps
= ((lbState,ls),ps)
......
......@@ -389,7 +389,7 @@ buttonWidth = ContentWidth "Append..."
editTargets getTs setTs ps
# (ap,ps) = getStup ps
# (pp,ps) = getProjectFilePath ps
# (pp,ps) = getFromProject PR_GetRootDir ps
# pp = RemoveFilename pp
# (ts,ps) = getTs ps
# (ct,ps) = getCurrentTarget ps
......@@ -897,8 +897,6 @@ remObject (ls=:{tg,ap,pp,lbobjId},ps)
ps = setExtListBoxSelection lbobjId [] ps
= (ls,ps)
//--
setCheckControlMarks ids full io
= seq [setCheckControlMark full id \\ id <- ids] io
setCheckControlMark full id io
......@@ -906,8 +904,6 @@ setCheckControlMark full id io
True -> markCheckControlItems id [1] io
False -> unmarkCheckControlItems id [1] io
//--
FullPath True _ _ p = p
FullPath False ap pp l = symPath ap pp l
......
......@@ -29,6 +29,7 @@ ProjectFileVersion :== "1.4"
, pg_target :: String // specify used environment
, pg_execpath :: String // move to ApplicationOptions
, pg_dynamic :: !ProjectDynamicInfo
, pg_root_directory :: !String
, pg_precompile :: !Maybe String // experiment: move to LinkOptions
, pg_postlink :: !Maybe String // experiment: move to LinkOptions
}
......
......@@ -22,6 +22,7 @@ ProjectFileVersion :== "1.4"
, pg_target :: String
, pg_execpath :: String
, pg_dynamic :: !ProjectDynamicInfo
, pg_root_directory :: !String
, pg_precompile :: !Maybe String
, pg_postlink :: !Maybe String
}
......@@ -68,16 +69,16 @@ EmptyUndefModule =
, path = ""
}
//--
project_root_option = SimpleOption "ProjectRoot" (\a->a.pg_root_directory) (\v a->{a & pg_root_directory = v})
ProjectGlobalOptionsTable :: OptionsTable ProjectGlobalOptions
ProjectGlobalOptionsTable =
{ SimpleOption "Built" (\a->a.pg_built) (\v a->{a & pg_built=v})
{ project_root_option
, SimpleOption "Built" (\a->a.pg_built) (\v a->{a & pg_built=v})
, SimpleOption "Target" (\a->a.pg_target) (\v a->{a & pg_target=v})
, SimpleWithStringConversionOption convert_exec_path_separators_and_extension "Exec" (\a->a.pg_execpath) (\v a->{a & pg_execpath=v})
, GroupedOption "CodeGen" CodeGenOptionsTable (\a->a.pg_codegen) (\v a->{a & pg_codegen=v})
, GroupedOption "Application" ApplicationOptionsTable (\a->a.pg_application) (\v a->{a & pg_application=v})
// , GroupedOption "Project" ProjectOptionsTable (\a->a.pg_projectOptions) (\v a->{a & pg_projectOptions=v})
, GroupedOption "Link" LinkOptionsTable (\a->a.pg_link) (\v a->{a & pg_link=v})
, ListOption "Paths" PathName "" (\a->a.pg_projectPaths) (\v a->{a & pg_projectPaths=v})
, GroupedOption "Static" StaticLibsInfoTable (\a->a.pg_staticLibInfo) (\v a->{a & pg_staticLibInfo=v})
......@@ -147,7 +148,6 @@ where
, showsync = True
*/ }
CompilerOptionsTable :: OptionsTable CompilerOptions
CompilerOptionsTable =
{
......@@ -211,13 +211,6 @@ ApplicationOptionsTable =
GroupedOption "Profile" ApplicationProfiletOptionsTable id const,
GroupedOption "Output" ApplicationOutputOptionsTable id const
}
/*
ProjectOptionsTable :: OptionsTable ProjectOptions
ProjectOptionsTable =
{
SimpleOption "Verbose" (\a->a.ProjectOptions.verbose) (\v a->{ProjectOptions | a & verbose=v})
}
*/
PathName :: OptionsTableEntry {#Char}
PathName
......
......@@ -22,12 +22,13 @@ SaveProjectFile ::
( !Bool // success
, !*Files // returned filesystem
);
ReadProjectFile ::
!String // path to projectfile
!String // the application directory
!*Files // the filesystem environment
->
((!Project // the project
(!(!Project // the project
, !Bool // success: true if successful except when failed to close
// project file. Then success is true but errmsg (next entry)
// is nonempty.
......@@ -35,6 +36,8 @@ ReadProjectFile ::
),!*Files // returned filesystem
)
change_root_directory_of_project :: !{#Char} !{#Char} !Project -> Project
getDynamicInfo :: !Project -> (ProjectDynamicInfo,Project)
setDynamicInfo :: !.ProjectDynamicInfo !.Project -> .Project
......@@ -64,6 +67,8 @@ PR_GetPaths :: !Project -> List String
PR_GetRootModuleName :: !Project -> String
PR_GetRootPathName :: !Project -> (!String,!Project)
PR_GetRootModuleDir :: !Project -> String
PR_GetRootDir :: !Project -> String
PR_GetRelativeRootDir :: !Project -> String
PR_GetModulenames :: !Bool !Def_and_Imp !Project -> (List String,Project)
PR_GetOpenModulenames :: !Project -> List String
PR_GetModuleStuff :: !Project -> List (Modulename,String,Modulename,String)
......@@ -110,3 +115,5 @@ PR_SetPrecompile :: !(Maybe String) !Project -> Project
PR_GetPrecompile :: !Project -> (!Maybe String, !Project)
PR_SetPostlink :: !(Maybe String) !Project -> Project
PR_GetPostlink :: !Project -> (!Maybe String, !Project)
make_project_dir :: !Int !{#Char} -> {#Char}
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment