Skip to content

GitLab

C
clean-ide

We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

Commit bbc8e5a5 authored by John van Groningen's avatar John van Groningen
Browse files
Options

implement Project Directory Up and Down

parent efa0357e
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 170 additions and 138 deletions
Ide/IDE.icl
View file @ bbc8e5a5
......@@ -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)
]
......
Ide/PmDialogues.dcl
View file @ bbc8e5a5
......@@ -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
......
Ide/PmDialogues.icl
View file @ bbc8e5a5
......@@ -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
......
Ide/projwin.icl
View file @ bbc8e5a5
......@@ -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)
......
Ide/targetui.icl
View file @ bbc8e5a5
......@@ -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
......
Pm/PmFiles.dcl
View file @ bbc8e5a5
......@@ -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
}
......
Pm/PmFiles.icl
View file @ bbc8e5a5
......@@ -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
......
Pm/PmProject.dcl
View file @ bbc8e5a5
......@@ -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}
Pm/PmProject.icl
View file @ bbc8e5a5
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