Commit 7e5709f0 authored by Diederik van Arkel's avatar Diederik van Arkel

Assorted fixes

parent 4f23f9cb
...@@ -41,7 +41,6 @@ Global ...@@ -41,7 +41,6 @@ Global
Path: {Project}\BatchBuild Path: {Project}\BatchBuild
Path: {Application}\Directory Path: {Application}\Directory
Path: {Application}\ArgEnvWindows Path: {Application}\ArgEnvWindows
Path: {Application}\SetReturnCode
Path: {Project}\Pm Path: {Project}\Pm
Path: {Project}\Util Path: {Project}\Util
Path: {Project}\Win Path: {Project}\Win
......
...@@ -12,10 +12,6 @@ import StrictList, ioutil ...@@ -12,10 +12,6 @@ import StrictList, ioutil
import EdActionType import EdActionType
import Platform import Platform
/*2.0
returnKey :== enterKey // temp hack for OIO20+uniqueness
0.2*/
//-- //--
/* /*
helpKey :== HelpKey helpKey :== HelpKey
...@@ -354,7 +350,7 @@ where ...@@ -354,7 +350,7 @@ where
buttonsControl buttonsControl
= ButtonControl "Open..." [ControlPos (Left, zero), ControlFunction openkm] = ButtonControl "Open..." [ControlPos (Left, zero), ControlFunction openkm]
:+: ButtonControl "Save..." [ControlFunction savekm] :+: ButtonControl "Save..." [ControlFunction savekm]
:+: ButtonControl "Bind" [ControlFunction bindKey] :+: ButtonControl "Bind" [ControlFunction bindKey]
:+: ButtonControl "Remove binding" [ ControlFunction removeBinding ] :+: ButtonControl "Remove binding" [ ControlFunction removeBinding ]
:+: ButtonControl "Cancel" [ ControlFunction (noLS (closeWindow dialogId)) ] :+: ButtonControl "Cancel" [ ControlFunction (noLS (closeWindow dialogId)) ]
:+: ButtonControl "Ok" [ ControlId okId :+: ButtonControl "Ok" [ ControlId okId
...@@ -470,7 +466,7 @@ where ...@@ -470,7 +466,7 @@ where
// removeBinding removes the selected key bindings // removeBinding removes the selected key bindings
removeBinding :: (KeyMappingDialogState, PSt *l) -> (KeyMappingDialogState, PSt *l) removeBinding :: (u:KeyMappingDialogState, PSt *l) -> (u:KeyMappingDialogState, PSt *l)
removeBinding (dialogState=:{ keyMapping}, pstate) removeBinding (dialogState=:{ keyMapping}, pstate)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate # (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate) | isNothing wstate = (dialogState,pstate)
...@@ -500,7 +496,7 @@ where ...@@ -500,7 +496,7 @@ where
// bindKey adds a binding to the key mapping table. It binds the // bindKey adds a binding to the key mapping table. It binds the
// currently selected action to the selected key (including modifiers). // currently selected action to the selected key (including modifiers).
bindKey :: (KeyMappingDialogState, PSt *l) -> (KeyMappingDialogState, PSt *l) bindKey :: (u:KeyMappingDialogState, PSt *l) -> (u:KeyMappingDialogState, PSt *l)
bindKey (dialogState=:{ keyMapping}, pstate) bindKey (dialogState=:{ keyMapping}, pstate)
# (wstate, pstate) = accPIO (getWindow dialogId) pstate # (wstate, pstate) = accPIO (getWindow dialogId) pstate
| isNothing wstate = (dialogState,pstate) | isNothing wstate = (dialogState,pstate)
......
...@@ -92,7 +92,7 @@ where ...@@ -92,7 +92,7 @@ where
2 // silly DOS 2 // silly DOS
1 // mac 1 // mac
newline newline
=: PlatformDependant = PlatformDependant
"\xd\xa" // windows "\xd\xa" // windows
"\xd" // mac "\xd" // mac
......
...@@ -15,7 +15,8 @@ from StdString import String ...@@ -15,7 +15,8 @@ from StdString import String
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
import EdMonad import EdMonad
editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture)) //editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
// editWindowLook: defines the look of the editor window. This function // editWindowLook: defines the look of the editor window. This function
// is used to handle update events. // is used to handle update events.
......
...@@ -15,12 +15,16 @@ trace_n _ f :== f ...@@ -15,12 +15,16 @@ trace_n _ f :== f
// editWindowLook: updating the affected areas is done by updating // editWindowLook: updating the affected areas is done by updating
// each of the rectangles. // each of the rectangles.
editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture)) //editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
editWindowLook editState editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture)
= (editState`,editWindowLook`) editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame }
= editWindowLook`
//editWindowLook editState
// = (editState`,editWindowLook`)
where where
// editWindowLook` :: !*Picture -> *Picture // editWindowLook` :: !*Picture -> *Picture
editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture editWindowLook` picture
// editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture
// # picture = traceUpdate updArea picture // # picture = traceUpdate updArea picture
# updArea = cleanUpdate updArea // hack around object i/o bug... # updArea = cleanUpdate updArea // hack around object i/o bug...
// # picture = traceUpdate updArea picture // # picture = traceUpdate updArea picture
......
...@@ -7,7 +7,7 @@ definition module EdMessage ...@@ -7,7 +7,7 @@ definition module EdMessage
from StdId import Id,RId,Ids from StdId import Id,RId,Ids
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
from StdReceiver import Receiver2, R2Id, Receiver2Function, ReceiverAttribute from StdReceiver import Receiver2, R2Id, Receiver2Function, ReceiverAttribute
from EdMonad import EditState, EditMonad from EdMonad import EditState, EditMonad, StateM
:: EditId :: EditId
:: Message :: Message
......
...@@ -49,7 +49,7 @@ appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l) ...@@ -49,7 +49,7 @@ appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)
appEditState editId monad pState appEditState editId monad pState
# (editState, pState) = getEditState editId pState # (editState, pState) = getEditState editId pState
# (x, (editState, pState)) = monad (editState, pState) # (x, (editState, pState)) = monad (editState, pState)
# pState = setEditState editId editState pState #! pState = setEditState editId editState pState
= (x, pState) = (x, pState)
// getEditState // getEditState
......
...@@ -382,10 +382,11 @@ updateLook :: EditMonad (PSt *l) nothing ...@@ -382,10 +382,11 @@ updateLook :: EditMonad (PSt *l) nothing
updateLook updateLook
= getWindowId >>>= \windowId -> = getWindowId >>>= \windowId ->
getEditState >>>= \editState -> getEditState >>>= \editState ->
let // let
(editState,editLook) = editWindowLook editState // (editState,editLook) = editWindowLook editState
in // in
appEnv (appPIO (setWindowLook windowId False (True,editLook))) // appEnv (appPIO (setWindowLook windowId False (True,editLook)))
appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState)))
// compute some properties of a font // compute some properties of a font
......
...@@ -156,7 +156,7 @@ where ...@@ -156,7 +156,7 @@ where
| s.[i] == x = True | s.[i] == x = True
= isStringMember x (dec i) s = isStringMember x (dec i) s
funnyChars =: "~@#$%^?!+-*<>\\/|&=:." funnyChars = "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20 funnySize = 20
dL :: !.Int !.Int !*Picture -> !(!.CommentLevel,!*Picture) dL :: !.Int !.Int !*Picture -> !(!.CommentLevel,!*Picture)
......
...@@ -24,7 +24,8 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps ...@@ -24,7 +24,8 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
// compute the view domain of the visual text // compute the view domain of the visual text
(viewDomain, (editState, ps)) = computeViewDomain (editState, ps) (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
// setup the window attributes // setup the window attributes
(editState,editLook) = editWindowLook editState // (editState,editLook) = editWindowLook editState
editLook = editWindowLook editState
windowAttrs = atts ++ // in this order so that new attributes override default atts windowAttrs = atts ++ // in this order so that new attributes override default atts
[ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 } [ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 }
, WindowHMargin 0 0 , WindowHMargin 0 0
......
...@@ -25,7 +25,7 @@ where ...@@ -25,7 +25,7 @@ where
| c == x = True | c == x = True
= isStringMember x (dec i) s = isStringMember x (dec i) s
funnyChars =: "~@#$%^?!+-*<>\\/|&=:." funnyChars = "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20 // =: size funnyChars? funnySize = 20 // =: size funnyChars?
line_size = size line line_size = size line
......
...@@ -3,9 +3,9 @@ definition module EdClient ...@@ -3,9 +3,9 @@ definition module EdClient
import EdMonad, EdState, EdCommon 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 sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b; message :: !Id !.(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
// Messages // Messages
......
...@@ -10,7 +10,7 @@ import EdCommon ...@@ -10,7 +10,7 @@ import EdCommon
import ExtNotice, StrictList import ExtNotice, StrictList
//sendToActiveWindow :: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l))) //sendToActiveWindow :: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l)))
sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
sendToActiveWindow editAction pState sendToActiveWindow editAction pState
# (maybeId, pState) = accPIO getActiveWindow pState # (maybeId, pState) = accPIO getActiveWindow pState
| isNothing maybeId | isNothing maybeId
...@@ -23,7 +23,7 @@ sendToActiveWindow editAction pState ...@@ -23,7 +23,7 @@ sendToActiveWindow editAction pState
= message windowId editAction pState = message windowId editAction pState
//message :: Id (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l))) //message :: Id (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l)))
message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b; message :: !Id !.(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
message windowId monad pState message windowId monad pState
# (editorState, pState) = getEditorState pState # (editorState, pState) = getEditorState pState
# (maybeEditId, editorState) = findReceiver windowId editorState # (maybeEditId, editorState) = findReceiver windowId editorState
......
...@@ -2,14 +2,14 @@ definition module EdCommon ...@@ -2,14 +2,14 @@ definition module EdCommon
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
from EdState import Editor, EditorState from EdState import Editor, EditorState
from EdMonad import EditMonad, EditState from EdMonad import EditMonad, StateM, EditState
from EdSelection import Selection, Position, ColumnNr, LineNr from EdSelection import Selection, Position, ColumnNr, LineNr
:: *PLocState :== MyEditorState :: *PLocState :== MyEditorState
:: *MyEditorState = MES EditorState :: MyEditorState = MES EditorState
instance Editor MyEditorState instance Editor MyEditorState
mRemoveSelection :: EditMonad (PSt *MyEditorState) nothing mRemoveSelection :: EditMonad (PSt *MyEditorState) nothing
mChangeSelectionTo :: Selection -> EditMonad (PSt *MyEditorState) nothing mChangeSelectionTo :: Selection -> EditMonad (PSt *MyEditorState) nothing
controlDoubleClick :: !.Bool !.Position -> .(!*(.EditState,*PSt PLocState) -> *(a,*(EditState,*PSt PLocState))); controlDoubleClick :: !.Bool !.Position -> .(!*(EditState,*PSt PLocState) -> *(a,*(EditState,*PSt PLocState)));
...@@ -73,6 +73,6 @@ where ...@@ -73,6 +73,6 @@ where
])) ]))
*/ */
controlDoubleClick :: !.Bool !.Position -> .(!*(.EditState,*PSt PLocState) -> *(a,*(EditState,*PSt PLocState))); controlDoubleClick :: !.Bool !.Position -> .(!*(EditState,*PSt PLocState) -> *(a,*(EditState,*PSt PLocState)));
controlDoubleClick shiftDown position = controlDoubleClick shiftDown position =
skip skip
\ No newline at end of file
...@@ -8,7 +8,7 @@ definition module Help ...@@ -8,7 +8,7 @@ definition module Help
// //
// ************************************************************************************************** // **************************************************************************************************
from StdString import String import StdString
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
showAbout :: String String (PSt .l) -> PSt .l showAbout :: String String (PSt .l) -> PSt .l
......
...@@ -798,7 +798,7 @@ msgPrint printSetup ...@@ -798,7 +798,7 @@ msgPrint printSetup
myPrintText :: !PrintSetup !String !Text !FontInfo !Bool !*env -> (PrintSetup,*env) | PrintEnvironments env myPrintText :: !PrintSetup !String !Text !FontInfo !Bool !*env -> (PrintSetup,*env) | PrintEnvironments env
myPrintText printsetup path text info linenos env myPrintText printsetup path text info linenos env
# fdef = getFontDef info.thefont # fdef = getFontDef info.thefont
((_,printsetup),env) = printText2 path "page " True RightJustify ((_,printsetup),env) = printText2 path "page " True LeftJustify//RightJustify
fdef fdef
info.tabSize info.tabSize
textstream textstream
......
...@@ -1033,6 +1033,6 @@ where ...@@ -1033,6 +1033,6 @@ where
wAbort message world wAbort message world
# stderr = fwrites message stderr # stderr = fwrites message stderr
// # (_,world) = fclose stderr world // # (_,world) = fclose stderr world
# world = set_return_code /* _world */ (-1) world # world = set_return_code_world (-1) world
= world = world
...@@ -485,7 +485,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps ...@@ -485,7 +485,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps
//-- batch build support //-- batch build support
from StdProcess import closeProcess from StdProcess import closeProcess
from StdPStClass import FileSystem from StdPStClass import FileSystem
import logfile import logfile, set_return_code
getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General) getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General)
getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps
...@@ -507,7 +507,7 @@ abortLog flag message ps ...@@ -507,7 +507,7 @@ abortLog flag message ps
# (ok,ps) = closeLogfile lf ps # (ok,ps) = closeLogfile lf ps
// | not ok ... // | not ok ...
# ps = case flag of # ps = case flag of
True -> ps // FIXME set_return_code_pst (-1) ps True -> set_return_code_pst (-1) ps
_ -> ps _ -> ps
= closeProcess ps = closeProcess ps
......
...@@ -4,7 +4,7 @@ import StdArray, StdFunc, StdMisc, StdTuple ...@@ -4,7 +4,7 @@ import StdArray, StdFunc, StdMisc, StdTuple
import StdFileSelect,StdPStClass,StdWindow import StdFileSelect,StdPStClass,StdWindow
import PmTypes, PmProject, PmPath, UtilStrictLists import PmTypes, PmProject, PmPath, UtilStrictLists
import tabcontrol, ExtListBox, ioutil, IdeState import tabcontrol, ExtListBox, ioutil, IdeState
import ExtNotice import ExtNotice, UtilIO
import Platform import Platform
//import dodebug //import dodebug
......
...@@ -133,7 +133,8 @@ openConsoleWindow cwi text atts ps ...@@ -133,7 +133,8 @@ openConsoleWindow cwi text atts ps
# (_, (editState, ps)) = setText text (editState, ps) # (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
# (editState,editLook) = editWindowLook editState // # (editState,editLook) = editWindowLook editState
# editLook = editWindowLook editState
# windowAttrs # windowAttrs
= [ WindowOuterSize cwi.tsiz = [ WindowOuterSize cwi.tsiz
, WindowHMargin 0 0 , WindowHMargin 0 0
......
...@@ -4,7 +4,10 @@ implementation module idehelp ...@@ -4,7 +4,10 @@ implementation module idehelp
import StdFunc, StdMisc import StdFunc, StdMisc
import StdMenu, StdPStClass, StdSystem import StdMenu, StdPStClass, StdSystem
import ExtNotice import ExtNotice
import ioutil import ioutil, UtilIO
//import dodebug
trace_n` m f :== f
//-- export //-- export
...@@ -36,7 +39,8 @@ CLEAN_VERSION ...@@ -36,7 +39,8 @@ CLEAN_VERSION
initHelpMenu :: Id !*(PSt .b) -> *PSt .b initHelpMenu :: Id !*(PSt .b) -> *PSt .b
initHelpMenu wId ps initHelpMenu wId ps
# (_,ps) = openMenu undef (helpMenu wId) ps # (items,ps) = accFiles helpItems ps
# (_,ps) = openMenu undef (helpMenu items wId) ps
= ps = ps
//-- local //-- local
...@@ -49,18 +53,36 @@ bitmapname = case toInt '\n' of ...@@ -49,18 +53,36 @@ bitmapname = case toInt '\n' of
idehelpname = applicationpath "idehelp" idehelpname = applicationpath "idehelp"
idehelptopic = "general.htm" idehelptopic = "general.htm"
helpMenu :: Id -> Menu (:+: .MenuItem .MenuItem) .a *(PSt .b ) //helpMenu :: Id -> Menu (:+: .MenuItem .MenuItem) .a *(PSt .b )
helpMenu wId helpMenu items wId
= Menu "&Help" = Menu "&Help"
( MenuItem "&About..." [MenuFunction (noLS (about wId))] ( MenuItem "&About..." [MenuFunction (noLS (about wId))]
:+: MenuItem "&Help..." [MenuFunction (noLS (help wId)),MenuSelectState Unable] // :+: MenuItem "&Help..." [MenuFunction (noLS (help "help//man.pdf" wId))]
:+: SubMenu "&Help" (ListLS [MenuItem file [MenuFunction (noLS (help file wId))] \\ file <- items]) []
) )
[ [
] ]
help wId ps import Directory, StdTuple
// # ps = htmlHelpTopic (idehelpname+++".chm::/"+++idehelptopic) wId ps
= ps helpItems files
# path = applicationpath "help"
# ((ok,path`),files) = pd_StringToPath path files
| not ok = ([],files)
# ((err,dir),files) = getDirectoryContents path` files
| err <> NoDirError = ([],files)
# items = map getinfo dir // only need common fileinfo...
# items = filter (\(b,n) -> not b) items
# items = map snd items
= (items,files)
where
getinfo {fileName,fileInfo=fi=:{pi_fileInfo=dummyname=:{isDirectory}}}
= (isDirectory,fileName)
help file wId ps
# path = applicationpath ("help//"+++.file)
# (ret,ps) = ShellDefault path ps
= trace_n` ("ShellExecute",ret,file) ps
about wId ps about wId ps
# (wId,ps) = openId ps # (wId,ps) = openId ps
......
...@@ -5,7 +5,7 @@ import StdFileSelect, StdMenu, StdMenuElement, StdPStClass, StdSystem ...@@ -5,7 +5,7 @@ import StdFileSelect, StdMenu, StdMenuElement, StdPStClass, StdSystem
import ExtNotice import ExtNotice
import IdeState import IdeState
import ioutil, tabcontrol import ioutil, tabcontrol
import UtilStrictLists, PmPath import UtilStrictLists, UtilIO, PmPath
/* /*
? add 'New' to edit list dlog ? add 'New' to edit list dlog
......
...@@ -145,7 +145,7 @@ openTypeWindow twi text atts ps ...@@ -145,7 +145,7 @@ openTypeWindow twi text atts ps
# (_, (editState, ps)) = setText text (editState, ps) # (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
# (editState,editLook) = editWindowLook editState # editLook = editWindowLook editState
# windowAttrs # windowAttrs
= [ WindowOuterSize twi.tsiz = [ WindowOuterSize twi.tsiz
, WindowHMargin 0 0 , WindowHMargin 0 0
......
...@@ -352,11 +352,13 @@ PR_GetLinkOptions project ...@@ -352,11 +352,13 @@ PR_GetLinkOptions project
PR_SetPaths :: !Bool !(List String) !(List String) !Project -> Project; PR_SetPaths :: !Bool !(List String) !(List String) !Project -> Project;
PR_SetPaths def defs new project=:{Project | inflist=Nil} = project; PR_SetPaths def defs new project=:{Project | inflist=Nil} = project;
PR_SetPaths def defs new project=:{Project | built,inflist=infl=:(root=:{InfListItem | info={dir}}):!rest,prjpaths,saved} PR_SetPaths def defs new project=:{Project | built,inflist=infl=:((root=:{InfListItem | info={dir}}):!rest),prjpaths,saved}
| def = {Project | project & built = built && olddirs, | def = {Project | project &
built = built && olddirs,
saved = saved && olddirs, saved = saved && olddirs,
inflist = inflist1 }; inflist = inflist1 };
= {Project | project & built = built && olddirs, = {Project | project &
built = built && olddirs,
saved = saved && unchanged && olddirs, saved = saved && unchanged && olddirs,
inflist = inflist1, inflist = inflist1,
prjpaths = prjpaths1 }; prjpaths = prjpaths1 };
......
...@@ -8,7 +8,7 @@ definition module Help ...@@ -8,7 +8,7 @@ definition module Help
// //
// ************************************************************************************************** // **************************************************************************************************
from StdString import String import StdString
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
showAbout :: String String (PSt .l) -> PSt .l showAbout :: String String (PSt .l) -> PSt .l
......
...@@ -30,7 +30,7 @@ g_profile_curried :: !.FormattedProfile !.FormattedProfile -> Bool; ...@@ -30,7 +30,7 @@ g_profile_curried :: !.FormattedProfile !.FormattedProfile -> Bool;
//draw_profile_lines :: [.Int] ![.FormattedProfile] .Int .Int UpdateArea *Picture -> .Picture; //draw_profile_lines :: [.Int] ![.FormattedProfile] .Int .Int UpdateArea *Picture -> .Picture;
draw_profile_lines` :: .Int [.Int] ![.FormattedProfile] .Int .Int !UpdateArea *Picture -> *Picture; draw_profile_lines` :: .Int [.Int] ![.FormattedProfile] .Int .Int !UpdateArea *Picture -> *Picture;
clock_speed_and_profile_overhead :: (Int,Real,Real); clock_speed_and_profile_overhead :: (Int,Real,Real);
printTable :: .Font !.PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a); printTable :: Font !PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a);
//-- //--
......
...@@ -282,7 +282,7 @@ where ...@@ -282,7 +282,7 @@ where
= clock_speed_and_profile_overhead = clock_speed_and_profile_overhead
= read_function_profiles (PCorMac = read_function_profiles (PCorMac
(compute_time_x86 (clock_speed*1.0E6) overhead) (compute_time_x86 (clock_speed*1.0E6) overhead)
(compute_time processor processor_clock bus_clock) undef//(compute_time processor processor_clock bus_clock)
) file ) file
read_processor_information :: *File -> (Int,Int,Int,.File); read_processor_information :: *File -> (Int,Int,Int,.File);
...@@ -480,7 +480,7 @@ sort_and_redraw_window compare_function pst ...@@ -480,7 +480,7 @@ sort_and_redraw_window compare_function pst
*/ */
//-- Printing look //-- Printing look
printTable :: .Font !.PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a); printTable :: Font !PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a);
printTable printFont printSetup functionData sumData ps printTable printFont printSetup functionData sumData ps
// # (s=:(ProfileInfo functionData sumData),ps) = accPLoc (\l=:{info}->(info,l)) ps // # (s=:(ProfileInfo functionData sumData),ps) = accPLoc (\l=:{info}->(info,l)) ps
// # (printFont,ps) = accPLoc (\l=:{monaco_font}->(monaco_font,l)) ps // # (printFont,ps) = accPLoc (\l=:{monaco_font}->(monaco_font,l)) ps
...@@ -537,7 +537,7 @@ groupBy :: !Int [x] -> [[x]] ...@@ -537,7 +537,7 @@ groupBy :: !Int [x] -> [[x]]
groupBy n [] = [] groupBy n [] = []
groupBy n l = [(take n l ) : (groupBy n (drop n l))] groupBy n l = [(take n l ) : (groupBy n (drop n l))]
print2 :: .Bool .Bool .(PrintInfo -> .(*Picture -> *(.DrawFuns,*Picture,Bool))) .PrintSetup *a -> (Bool,PrintSetup,*a) | PrintEnvironments a print2 :: .Bool .Bool (PrintInfo -> .(*Picture -> *(.DrawFuns,*Picture,Bool))) PrintSetup *a -> (Bool,PrintSetup,*a) | PrintEnvironments a
print2 doDialog emulateScreen prFun printSetup printEnv print2 doDialog emulateScreen prFun printSetup printEnv
# (alt,printEnv) = printPagePerPage doDialog emulateScreen 0 initFun stateTransition printSetup printEnv # (alt,printEnv) = printPagePerPage doDialog emulateScreen 0 initFun stateTransition printSetup printEnv
= case alt of = case alt of
...@@ -609,7 +609,7 @@ formatInfo window_font pict ...@@ -609,7 +609,7 @@ formatInfo window_font pict
*/ */
//-- //--
format_string_r :: .Int u:(a v:Char) -> a Char | Array .a, [u <= v]; //format_string_r :: .Int u:(a v:Char) -> a Char | Array .a, [u <= v];
format_string_r length string format_string_r length string
# string_size=size string # string_size=size string
| string_size >= length | string_size >= length
......
...@@ -16,8 +16,8 @@ HelpFileName :== ApplicationName +++ "Help" ...@@ -16,8 +16,8 @@ HelpFileName :== ApplicationName +++ "Help"
:: ProfileViewerState = :: ProfileViewerState =
{ mode :: ViewMode { mode :: ViewMode
, mods :: .[FormattedProfile] , mods :: [FormattedProfile]
, funs :: .[FormattedProfile] , funs :: [FormattedProfile]
, pset :: PrintSetup , pset :: PrintSetup
, name :: String , name :: String
} }
......
...@@ -11,25 +11,27 @@ import StdId, StdPSt, StdWindow, StdTimer ...@@ -11,25 +11,27 @@ import StdId, StdPSt, StdWindow, StdTimer
instance Dialogs Notice instance Dialogs Notice
where where
openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l) // openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
openDialog ls notice ps openDialog ls notice ps
# (wId, ps) = accPIO openId ps # (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps (okId,ps) = accPIO openId ps
= openDialog ls (noticeToDialog wId okId notice) ps = openDialog ls (noticeToDialog wId okId notice) ps
openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l) // openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
openModalDialog ls notice ps openModalDialog ls notice ps
# (wId, ps) = accPIO openId ps # (wId, ps) = accPIO openId ps
(okId,ps) = accPIO openId ps (okId,ps) = accPIO openId ps
= openModalDialog ls (noticeToDialog wId okId notice) ps = openModalDialog ls (noticeToDialog wId okId notice) ps
getDialogType :: (Notice .ls .ps) -> WindowType