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
where
accFiles f e = f e
appFiles f e = f e
seqmap :: (.a -> .(.b -> .b)) ![.a] !.b -> .b;
seqmap f [] e = e
seqmap f [h:t] e
#! e = f h e
= seqmap f t e
notEmpty s :== not (isEmpty s)
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)