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

Commit 079ce4c4 authored by Diederik van Arkel's avatar Diederik van Arkel

no message

parent 0427b8b5
......@@ -39,12 +39,13 @@ Global
Paths
Path: {Project}
Path: {Project}\BatchBuild
Path: {Application}\Directory
Path: {Application}\ArgEnvWindows
Path: {Project}\Pm
Path: {Project}\Util
Path: {Project}\Win
Path: {Project}\Interfaces\LinkerInterface
Path: {Project}\Win\PatchConsoleEvents
Path: {Project}\Win\ArgEnvWindows
Path: {Project}\Win\Directory
Precompile:
Postlink:
MainModule
......
......@@ -3,12 +3,12 @@ definition module IdeState
import StdPSt, StdId, StdPictureDef
import StdPathname
import UtilStrictLists
from PmAbcMagic import ABCCache
from PmProject import Project
from PmAbcMagic import :: ABCCache
from PmProject import :: Project
import PmCompilerOptions
import typewin
import PmEnvironment
from PmFileInfo import FileInfoCache
from PmFileInfo import :: FileInfoCache
:: *General
......@@ -58,6 +58,7 @@ getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
......
......@@ -3,14 +3,13 @@ implementation module IdeState
import StdPSt, StdId, StdPictureDef, StdMisc, StdList, StdProcess, StdPStClass
import StdPathname
import UtilStrictLists
from PmAbcMagic import ABCCache, AC_Init
from PmProject import Project, PR_GetTarget
from PmAbcMagic import :: ABCCache, AC_Init
from PmProject import :: Project, PR_GetTarget
import PmCompilerOptions
import typewin
import PmEnvironment
import logfile
import set_return_code
//import PmDriver
import PmFileInfo
:: *General =
......@@ -160,6 +159,11 @@ getCurrentLink ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_link,ps)
getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentDynl ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_dynl,ps)
getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
getCurrentVers ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
......
definition module messwin
import StdString, StdPSt
from IdeState import General
from IdeState import :: General
:: Info
= Level1 String
......
implementation module messwin
import StdString, StdPSt, StdBool, StdList, StdFunc
from IdeState import General, writeLog
from IdeState import :: General, writeLog
:: Info
= Level1 String
......
definition module EdClient
import EdMonad, EdState, EdCommon
from EdMessage import EditAction
from EdMessage import :: EditAction
sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
......
definition module EdCommon
from StdPSt import PSt, IOSt
from EdState import Editor, EditorState
from EdMonad import EditMonad, StateM, EditState
from EdSelection import Selection, Position, ColumnNr, LineNr
from StdPSt import :: PSt
from EdState import class Editor, :: EditorState
from EdMonad import :: EditMonad, :: StateM, :: EditState
from EdSelection import :: Selection, :: Position
:: *PLocState :== MyEditorState
:: MyEditorState = MES EditorState
......
implementation module EdCommon
from EdState import Editor, EditorState
from EdState import class Editor, :: EditorState
import EdMonad
:: *PLocState :== MyEditorState
......
......@@ -4,9 +4,8 @@
definition module EdEditMenu
from StdMenu import Menu, Title, MenuAttribute
from StdPSt import PSt, IOSt
from EdCommon import MyEditorState
from StdPSt import :: PSt
from EdCommon import :: MyEditorState
openEditMenu :: (PSt *MyEditorState) -> PSt *MyEditorState
......@@ -4,11 +4,9 @@
definition module EdFileMenu
from StdMenu import Menu, Title, MenuAttribute
from StdId import Id
from StdPSt import PSt, IOSt
from EdState import EditorState
from EdCommon import MyEditorState
from StdId import :: Id
from StdPSt import :: PSt
from EdCommon import :: MyEditorState
openFileMenu :: Id (PSt *MyEditorState) -> PSt *MyEditorState
......@@ -4,9 +4,8 @@
definition module EdOptionsMenu
from StdMenu import Menu, Title, MenuAttribute
from StdPSt import PSt, IOSt
from EdCommon import MyEditorState
from StdPSt import :: PSt
from EdCommon import :: MyEditorState
openOptionsMenu :: !(PSt *MyEditorState) -> PSt *MyEditorState
definition module ExtNotice
/*
0.0 [P88] The original notice class from the Object IO tutorial
1.0 [DvA] Modified for use with the new Clean IDE
2.0 [DvA] Added TimedNotice class
P88 = Peter Achten (peter88@cs.kun.nl)
DvA = Diederik van Arkel (diederik@cs.kun.nl)
*/
import StdWindow, StdTimerDef
:: Notice ls ps
= Notice [String] (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
:: NoticeButton ps
= NoticeButton String (IdFun ps)
instance Dialogs Notice
openNotice :: !(Notice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
:: TimedNotice ls ps
= TimedNotice [String] TimerInterval (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
instance Dialogs TimedNotice
openTimedNotice :: !(TimedNotice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
okTimedNotice text time ps :== openTimedNotice (TimedNotice text time (NoticeButton "OK" (\x->x)) []) ps
implementation module ExtNotice
import StdTuple, StdMisc, StdFunc
import StdId, StdPSt, StdWindow, StdTimer
:: Notice ls ps
= Notice [String] (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
:: NoticeButton ps
= NoticeButton String (IdFun ps)
instance Dialogs Notice
where
// openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (noticeToDialog wId okId notice) ps
// openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (noticeToDialog wId okId notice) ps
// getDialogType :: (Notice .ls .ps) -> WindowType
getDialogType _
= "Notice"
openNotice :: !(Notice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
openNotice notice ps
= snd (openModalDialog undef notice ps)
//noticeToDialog :: Id Id !(Notice .ls (PSt .l)) -> Dialog
noticeToDialog wid okid (Notice texts ok buttons)
= Dialog "" (texts` :+: ok` :+: buttons`)
[ WindowId wid
, WindowOk okid
]
where
texts` = LayoutControl
( ListLS
[ TextControl text [ControlPos (Left,zero)]
\\ text <- texts
]
)
[ ControlHMargin 0 0
, ControlVMargin 0 0
, ControlItemSpace 3 3
]
ok` = noticebutton ok [ControlPos (Right,zero), ControlId okid]
buttons` = ListLS
[ noticebutton button [ControlPos (LeftOfPrev,zero)]
\\ button <- buttons
]
noticebutton (NoticeButton text f) atts
= ButtonControl text [ControlFunction f`:atts]
where
f` (ls,ps) = f (ls,closeWindow wid ps)
okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
:: TimedNotice ls ps
= TimedNotice [String] TimerInterval (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
instance Dialogs TimedNotice
where
// openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openDialog ls (timednoticeToDialog wId okId notice) ps
// openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps
= openModalDialog ls (timednoticeToDialog wId okId notice) ps
// getDialogType :: (TimedNotice .ls .ps) -> WindowType
getDialogType _
= "TimerNotice"
openTimedNotice :: !(TimedNotice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
openTimedNotice notice ps
= snd (openModalDialog undef notice ps)
//timednoticeToDialog :: Id Id !(TimedNotice .ls (PSt .l)) -> Dialog
timednoticeToDialog wid okid (TimedNotice texts time ok buttons)
= Dialog "" (texts` :+: ok` :+: buttons`)
[ WindowId wid
, WindowOk okid
, WindowInit (noLS timestuff)
]
where
timestuff ps
# (err,ps) = openTimer undef timer` ps
| err <> NoError
# ps = okNotice ["Timer Creation Failed"] ps
# ps = closeWindow wid ps
= ps
= ps
texts` = LayoutControl
( ListLS
[ TextControl text [ControlPos (Left,zero)]
\\ text <- texts
]
)
[ ControlHMargin 0 0
, ControlVMargin 0 0
, ControlItemSpace 3 3
]
ok` = noticebutton ok [ControlPos (Right,zero), ControlId okid]
buttons` = ListLS
[ noticebutton button [ControlPos (LeftOfPrev,zero)]
\\ button <- buttons
]
timer` = Timer time NilLS [TimerFunction (\_ (ls,ps)->(ls,closeWindow wid ps))]
noticebutton (NoticeButton text f) atts
= ButtonControl text [ControlFunction f`:atts]
where
f` (ls,ps) = f (ls,closeWindow wid ps)
okTimedNotice text time ps :== openTimedNotice (TimedNotice text time (NoticeButton "OK" (\x->x)) []) ps
definition module expand_8_3_names_in_path;
expand_8_3_names_in_path :: !{#Char} -> {#Char};
implementation module expand_8_3_names_in_path;
import StdEnv;
FindFirstFile :: !String -> (!Int,!String);
FindFirstFile file_name
# find_data = createArray 318 '\0';
# handle = FindFirstFile_ file_name find_data;
= (handle,find_data);
FindFirstFile_ :: !String !String -> Int;
FindFirstFile_ file_name find_data
= code {
ccall FindFirstFileA@8 "Pss:I"
}
FindClose :: !Int -> Int;
FindClose handle = code {
ccall FindClose@4 "PI:I"
}
find_null_char_in_string :: !Int !String -> Int;
find_null_char_in_string i s
| i<size s && s.[i]<>'\0'
= find_null_char_in_string (i+1) s;
= i;
find_data_file_name find_data
# i = find_null_char_in_string 44 find_data;
= find_data % (44,i-1);
find_first_file_and_close :: !String -> (!Bool,!String);
find_first_file_and_close file_name
# (handle,find_data) = FindFirstFile file_name;
| handle <> (-1)
# r = FindClose handle;
| r==r
= (True,find_data);
= (False,find_data);
= (False,"");
find_last_backslash_in_string i s
| i<0
= (False,-1);
| s.[i]=='\\'
= (True,i);
= find_last_backslash_in_string (i-1) s;
expand_8_3_names_in_path :: !{#Char} -> {#Char};
expand_8_3_names_in_path path_and_file_name
# (found_backslash,back_slash_index) = find_last_backslash_in_string (size path_and_file_name-1) path_and_file_name;
| not found_backslash
= path_and_file_name;
# path = expand_8_3_names_in_path (path_and_file_name % (0,back_slash_index-1));
# file_name = path_and_file_name % (back_slash_index+1,size path_and_file_name-1);
# path_and_file_name = path+++"\\"+++file_name;
# (ok,find_data) = find_first_file_and_close (path_and_file_name+++"\0");
| ok
= path+++"\\"+++find_data_file_name find_data;
= path_and_file_name;
definition module flexwin
import StdEnv, StdIO
//import ShowProfile
//:: FlexBarWindow ls pst = FlexBarWindow Title [(String, Maybe Int)] [WindowAttribute *(ls,pst)]
//:: FlexBarWindow ls pst
// = FlexBarWindow Title [(String, Maybe Int)] .[FormattedProfile] (R2Id (MessageIn ls) MessageOut) [WindowAttribute *(ls,pst)]
//:: FlexBarWindow s ls pst
// = FlexBarWindow Title [(String, Maybe Int)] [s] (R2Id (MessageIn s) MessageOut) [WindowAttribute *(ls,pst)]
class content_size c :: FontMetrics c -> Int
::FlexBarState s
:: FlexBarWindow s ls pst
= FlexBarWindow Title [(String, Maybe Int)] s
(!s .Int .Int [.Int] -> (.SelectState .UpdateState -> .(*Picture -> *Picture)))
![(FlexBarState s) -> FlexBarState s]
(R2Id (MessageIn s) (MessageOut s)) [WindowAttribute *(ls,pst)]
:: MessageIn s
= FW_DummyIn
| FW_SetContent s //[.FormattedProfile]
| FW_ApplyFunction Int
| FW_GetContent
:: MessageOut s
= FW_DummyOut
| FW_ContentOut s
instance Windows (FlexBarWindow s) | content_size s
//--
appInfo :: (s->s) !(FlexBarState s) -> FlexBarState s
This diff is collapsed.
definition module handler;
import deltaDialog, deltaIOState;
//import intrface, clCrossCall,ioTypes;
InstallDDEHandler :: (String *s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
-> (*s, IOState *s);
\ No newline at end of file
implementation module handler;
import deltaDialog, deltaIOState;
import intrface, clCrossCall,ioTypes;
InstallDDEHandler :: (String *s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
-> (*s, IOState *s);
InstallDDEHandler funct s iostate = (s,iostate`);
where
{ (adm, os) = UnpackIOStateWithCheck iostate;
adm` = { adm & io_ddehandler = funct };
iostate` = PackIOState adm` os;
}
definition module ioutil
import StdOverloaded, StdBool, StdList
import StdPicture, StdPSt, StdId, StdIOCommon, StdFile
from commondef import unzip3,unzip4
//getParentWindowId :: !Id !(IOSt .l) -> (!Maybe Id, !IOSt .l)
safeOpenFixedFont :: !.FontDef !*Picture -> (Font,*Picture);
instance toString FontDef
instance accScreenPicture (PSt .l)
//instance Ids (PSt .l .p)
instance FileEnv Files
filterReturnKeys :: KeyboardStateFilter
escFilter :: KeyboardStateFilter
toMark :: !Bool -> MarkState
toSelect :: !Bool -> SelectState
noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
drawRight :: !.Point2 a !*Picture -> *Picture | toString a
setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a;
zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
//unzip3 ::![(.a,.b,.c)] -> ([.a],[.b],[.c]) // now in ObjectIO/commondef
getPenAttributeFont :: ![.PenAttribute] -> FontDef;
getPenAttributeColour :: ![.PenAttribute] -> Colour;
getPenAttributeBack :: ![.PenAttribute] -> Colour;
seqmap :: (.a -> .(.b -> .b)) ![.a] !.b -> .b;
notEmpty s :== not (isEmpty s)
implementation module ioutil
//import StdEnv, StdIO
import StdBool,StdList,StdFile
import StdControl,StdPSt
import iostate
/* zit nu in StdControl mar nog niet geexporteerd
getParentWindowId :: !Id !(IOSt .l) -> (!Maybe Id, !IOSt .l)
getParentWindowId controlId ioState
# (idtable,ioState) = IOStGetIdTable ioState
maybeParent = getIdParent controlId idtable
| isNothing maybeParent
= (Nothing,ioState)
# parent = fromJust maybeParent
# (ioId,ioState) = IOStGetIOId ioState
| ioId==parent.idpIOId && parent.idpDevice==WindowDevice
= (Just parent.idpId,ioState)
| otherwise
= (Nothing,ioState)
*/
safeOpenFixedFont :: !.FontDef !*Picture -> (Font,*Picture);
safeOpenFixedFont fdef pict
# ((ok,fnt),pict) = openFont fdef pict
# ((ok,fnt),pict) = case ok of
True -> ((ok,fnt),pict)
False -> openFont fdef` pict
| not ok
= openDefaultFont pict
= (fnt,pict)
where
fdef` = NonProportionalFontDef
instance toString FontDef
where
toString {fName,fSize,fStyles} = "<fName: "+++fName+++",fSize: "+++toString fSize+++",fStyles: "+++toS fStyles+++ ">"
where
toS [] = ""
toS [s] = s
toS [h:t] = h+++", "+++toS t
filterReturnKeys :: KeyboardStateFilter
filterReturnKeys = filterfun
where
filterfun (SpecialKey key (KeyDown False) _) = key==enterKey
filterfun (CharKey '\n' (KeyDown False)) = True
filterfun _ = False
escFilter :: KeyboardStateFilter
escFilter = filter
where
filter (SpecialKey key KeyUp mods) = (key == escapeKey) && (mods == NoModifiers)
filter _ = False
instance accScreenPicture (PSt .l)
where
accScreenPicture f ps = accPIO (accScreenPicture f) ps
/*
instance Ids (PSt .l .p)
where
openId ps = accPIO openId ps
openIds n ps = accPIO (openIds n) ps
openRId ps = accPIO openRId ps
openRIds n ps = accPIO (openRIds n) ps
openR2Id ps = accPIO openR2Id ps
openR2Ids n ps = accPIO (openR2Ids n) ps
*/
toMark :: !Bool -> MarkState
toMark True = Mark
toMark False = NoMark
toSelect :: !Bool -> SelectState
toSelect True = Able
toSelect False = Unable
noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
noPS f (ls,ps) = (f ls,ps)
drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
drawLeft point info picture
# text = toString info
= drawAt point text picture
drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
drawCenter {x,y} info picture
# text = toString info
(width,picture) = getPenFontStringWidth text picture
= drawAt {x=x-width/2,y=y} text picture
drawRight :: !.Point2 a !*Picture -> *Picture | toString a
drawRight {x,y} info picture
# text = toString info
(width,picture) = getPenFontStringWidth text picture
= drawAt {x=x-width,y=y} text picture
setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a
setCheckControlItem id idx True io = markCheckControlItems id [idx] io
setCheckControlItem id idx False io = unmarkCheckControlItems id [idx] io
zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
zip3 [a:as] [b:bs] [c:cs] = [(a,b,c):zip3 as bs cs]
zip3 as bs cs = []
getPenAttributeFont :: ![.PenAttribute] -> FontDef;
getPenAttributeFont [] = SansSerifFontDef
getPenAttributeFont [PenFont f:_] = getFontDef f
getPenAttributeFont [_:t] = getPenAttributeFont t
getPenAttributeColour :: ![.PenAttribute] -> Colour;
getPenAttributeColour [] = Black
getPenAttributeColour [PenColour c:_] = c
getPenAttributeColour [_:r] = getPenAttributeColour r
getPenAttributeBack :: ![.PenAttribute] -> Colour;
getPenAttributeBack [] = White
getPenAttributeBack [PenBack c:_] = c
getPenAttributeBack [_:r] = getPenAttributeBack r
instance FileEnv Files