diff --git a/BatchBuild.prj b/BatchBuild.prj index d9b1fc245e7bb59feeb887f36ec27953dd94cbcd..8edb8e5757ad7157b40b5cd869ec3b4caaa24a1e 100644 --- a/BatchBuild.prj +++ b/BatchBuild.prj @@ -41,7 +41,6 @@ Global Path: {Project}\BatchBuild Path: {Application}\Directory Path: {Application}\ArgEnvWindows - Path: {Application}\SetReturnCode Path: {Project}\Pm Path: {Project}\Util Path: {Project}\Win diff --git a/Ed/EdKeyMapping.icl b/Ed/EdKeyMapping.icl index 366c0af13c547055716518d06d18976bc8a0f318..09c217e180f1017fbc00a0a1f52ce8e60e8deb69 100644 --- a/Ed/EdKeyMapping.icl +++ b/Ed/EdKeyMapping.icl @@ -12,10 +12,6 @@ import StrictList, ioutil import EdActionType import Platform -/*2.0 -returnKey :== enterKey // temp hack for OIO20+uniqueness -0.2*/ - //-- /* helpKey :== HelpKey @@ -354,7 +350,7 @@ where buttonsControl = ButtonControl "Open..." [ControlPos (Left, zero), ControlFunction openkm] :+: ButtonControl "Save..." [ControlFunction savekm] - :+: ButtonControl "Bind" [ControlFunction bindKey] + :+: ButtonControl "Bind" [ControlFunction bindKey] :+: ButtonControl "Remove binding" [ ControlFunction removeBinding ] :+: ButtonControl "Cancel" [ ControlFunction (noLS (closeWindow dialogId)) ] :+: ButtonControl "Ok" [ ControlId okId @@ -470,7 +466,7 @@ where // 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) # (wstate, pstate) = accPIO (getWindow dialogId) pstate | isNothing wstate = (dialogState,pstate) @@ -500,7 +496,7 @@ where // bindKey adds a binding to the key mapping table. It binds the // 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) # (wstate, pstate) = accPIO (getWindow dialogId) pstate | isNothing wstate = (dialogState,pstate) diff --git a/Ed/EdLineText.icl b/Ed/EdLineText.icl index 8cdab8df02f12ebe8a5696ab5bbd5340f72c5a4f..1c2a9686da21ed606c9b20668bd0bd497d8796ef 100644 --- a/Ed/EdLineText.icl +++ b/Ed/EdLineText.icl @@ -92,7 +92,7 @@ where 2 // silly DOS 1 // mac newline - =: PlatformDependant + = PlatformDependant "\xd\xa" // windows "\xd" // mac diff --git a/Ed/EdLook.dcl b/Ed/EdLook.dcl index 28ccb177a5cb935de9a23754455ca7b69754054f..3d5e6c9f9563aaad9da46640ed065100dbc31129 100644 --- a/Ed/EdLook.dcl +++ b/Ed/EdLook.dcl @@ -15,7 +15,8 @@ from StdString import String from StdPSt import PSt, IOSt 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 // is used to handle update events. diff --git a/Ed/EdLook.icl b/Ed/EdLook.icl index 144dd21fc048845c5d7309a220bedd9939f836fd..79b7aece8012698bbe611fc29d3f28a98b981115 100644 --- a/Ed/EdLook.icl +++ b/Ed/EdLook.icl @@ -15,12 +15,16 @@ trace_n _ f :== f // editWindowLook: updating the affected areas is done by updating // each of the rectangles. -editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture)) -editWindowLook editState - = (editState`,editWindowLook`) +//editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture)) +editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture) +editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame } + = editWindowLook` +//editWindowLook editState +// = (editState`,editWindowLook`) where // editWindowLook` :: !*Picture -> *Picture - editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture + editWindowLook` picture +// editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture // # picture = traceUpdate updArea picture # updArea = cleanUpdate updArea // hack around object i/o bug... // # picture = traceUpdate updArea picture diff --git a/Ed/EdMessage.dcl b/Ed/EdMessage.dcl index cb24b8b046370882ecb3b2d90db6852d65f867d6..d80dea6e9c87a7fd86ec2b4de9138ffb4acdde28 100644 --- a/Ed/EdMessage.dcl +++ b/Ed/EdMessage.dcl @@ -7,7 +7,7 @@ definition module EdMessage from StdId import Id,RId,Ids from StdPSt import PSt, IOSt from StdReceiver import Receiver2, R2Id, Receiver2Function, ReceiverAttribute -from EdMonad import EditState, EditMonad +from EdMonad import EditState, EditMonad, StateM :: EditId :: Message diff --git a/Ed/EdMessage.icl b/Ed/EdMessage.icl index fadc34b245c749aac031862fae5d43af05120fdb..afa93aa494f933a457b970c245bbe4056a2690f7 100644 --- a/Ed/EdMessage.icl +++ b/Ed/EdMessage.icl @@ -49,7 +49,7 @@ appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l) appEditState editId monad pState # (editState, pState) = getEditState editId pState # (x, (editState, pState)) = monad (editState, pState) - # pState = setEditState editId editState pState + #! pState = setEditState editId editState pState = (x, pState) // getEditState diff --git a/Ed/EdMonad.icl b/Ed/EdMonad.icl index 6d5cbab8e2cb9b4697320c665580e93469ef242a..bd82d9cfd30da2532033ef08053a7d33da6f323e 100644 --- a/Ed/EdMonad.icl +++ b/Ed/EdMonad.icl @@ -382,10 +382,11 @@ updateLook :: EditMonad (PSt *l) nothing updateLook = getWindowId >>>= \windowId -> getEditState >>>= \editState -> - let - (editState,editLook) = editWindowLook editState - in - appEnv (appPIO (setWindowLook windowId False (True,editLook))) +// let +// (editState,editLook) = editWindowLook editState +// in +// appEnv (appPIO (setWindowLook windowId False (True,editLook))) + appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState))) // compute some properties of a font diff --git a/Ed/EdTab.icl b/Ed/EdTab.icl index 8228d36e5cfdf6a96c466a31631937a6ecedfdc5..d0533d2c12af43079b2fe331485f138b4105d3a2 100644 --- a/Ed/EdTab.icl +++ b/Ed/EdTab.icl @@ -156,7 +156,7 @@ where | s.[i] == x = True = isStringMember x (dec i) s - funnyChars =: "~@#$%^?!+-*<>\\/|&=:." + funnyChars = "~@#$%^?!+-*<>\\/|&=:." funnySize = 20 dL :: !.Int !.Int !*Picture -> !(!.CommentLevel,!*Picture) diff --git a/Ed/EdWindow.icl b/Ed/EdWindow.icl index aaa7f957855c208833e10f29113c03141d660341..2fb173139f66ca20f8700c74b8f554141d0aa158 100644 --- a/Ed/EdWindow.icl +++ b/Ed/EdWindow.icl @@ -24,7 +24,8 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps // compute the view domain of the visual text (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) // 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 [ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 } , WindowHMargin 0 0 diff --git a/Ed/syncol.icl b/Ed/syncol.icl index 48d82d7212e68d45176268c076103d75fdc2542a..b9ec386e9aa19b70534350cd43d3da17fe7287f3 100644 --- a/Ed/syncol.icl +++ b/Ed/syncol.icl @@ -25,7 +25,7 @@ where | c == x = True = isStringMember x (dec i) s - funnyChars =: "~@#$%^?!+-*<>\\/|&=:." + funnyChars = "~@#$%^?!+-*<>\\/|&=:." funnySize = 20 // =: size funnyChars? line_size = size line diff --git a/Editor/EdClient.dcl b/Editor/EdClient.dcl index ace8b1c7a3c266f03b9faf195d8d68bd0a7cc7c7..6511b4655dd56ed86e3ad45b19748514d696eb8e 100644 --- a/Editor/EdClient.dcl +++ b/Editor/EdClient.dcl @@ -3,9 +3,9 @@ definition module EdClient import EdMonad, EdState, EdCommon 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 diff --git a/Editor/EdClient.icl b/Editor/EdClient.icl index 10a5f6be5ae39a4b87b6ae0553f49c362ac68f2d..6908b2706b46e0dd558fb68d1c957b87bc46a872 100644 --- a/Editor/EdClient.icl +++ b/Editor/EdClient.icl @@ -10,7 +10,7 @@ import EdCommon import ExtNotice, StrictList //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 # (maybeId, pState) = accPIO getActiveWindow pState | isNothing maybeId @@ -23,7 +23,7 @@ sendToActiveWindow editAction pState = message windowId editAction pState //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 # (editorState, pState) = getEditorState pState # (maybeEditId, editorState) = findReceiver windowId editorState diff --git a/Editor/EdCommon.dcl b/Editor/EdCommon.dcl index d3d257b012b4885d50d4eaae3bc3e828a63bac24..5b39aee7bdab44381bcdbc0d0e27f045b12d8100 100644 --- a/Editor/EdCommon.dcl +++ b/Editor/EdCommon.dcl @@ -2,14 +2,14 @@ definition module EdCommon from StdPSt import PSt, IOSt from EdState import Editor, EditorState -from EdMonad import EditMonad, EditState +from EdMonad import EditMonad, StateM, EditState from EdSelection import Selection, Position, ColumnNr, LineNr :: *PLocState :== MyEditorState -:: *MyEditorState = MES EditorState +:: MyEditorState = MES EditorState instance Editor MyEditorState mRemoveSelection :: 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))); diff --git a/Editor/EdCommon.icl b/Editor/EdCommon.icl index 06f0dce2161c162d9b0606927462b50f6e714e4b..74bfdde532e3a9eb85194dea4dd2548177e40185 100644 --- a/Editor/EdCommon.icl +++ b/Editor/EdCommon.icl @@ -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 = skip \ No newline at end of file diff --git a/HeapProfile/Help.dcl b/HeapProfile/Help.dcl index 31d21aa52c93399ae09b75bb69d06daafa93e44e..a82698e27dee2ca1b42a8f9c32705afff16c742f 100644 --- a/HeapProfile/Help.dcl +++ b/HeapProfile/Help.dcl @@ -8,7 +8,7 @@ definition module Help // // ************************************************************************************************** -from StdString import String +import StdString from StdPSt import PSt, IOSt showAbout :: String String (PSt .l) -> PSt .l diff --git a/Ide/EdClient.icl b/Ide/EdClient.icl index 05c068fafaea8e608b27e8de553831f90b53f9d5..251560912e4ed10df06d3679c6a74c2785084fda 100644 --- a/Ide/EdClient.icl +++ b/Ide/EdClient.icl @@ -798,7 +798,7 @@ msgPrint printSetup myPrintText :: !PrintSetup !String !Text !FontInfo !Bool !*env -> (PrintSetup,*env) | PrintEnvironments env myPrintText printsetup path text info linenos env # fdef = getFontDef info.thefont - ((_,printsetup),env) = printText2 path "page " True RightJustify + ((_,printsetup),env) = printText2 path "page " True LeftJustify//RightJustify fdef info.tabSize textstream diff --git a/Ide/IDE.icl b/Ide/IDE.icl index 3cbafa32a95199902fda5637d16638b44011450b..9d3f343e44d881ec83a318429f755b570dbe0c8c 100644 --- a/Ide/IDE.icl +++ b/Ide/IDE.icl @@ -1033,6 +1033,6 @@ where wAbort message world # stderr = fwrites message stderr // # (_,world) = fclose stderr world - # world = set_return_code /* _world */ (-1) world + # world = set_return_code_world (-1) world = world diff --git a/Ide/IdeState.icl b/Ide/IdeState.icl index 124db98a0b24a1dbd44bb5f7790e0ee91b9f6205..4c32ec6ce84863c7bcecc5ebf83ebee86d4059d9 100644 --- a/Ide/IdeState.icl +++ b/Ide/IdeState.icl @@ -485,7 +485,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps //-- batch build support from StdProcess import closeProcess from StdPStClass import FileSystem -import logfile +import logfile, set_return_code getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General) getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps @@ -507,7 +507,7 @@ abortLog flag message ps # (ok,ps) = closeLogfile lf ps // | not ok ... # ps = case flag of - True -> ps // FIXME set_return_code_pst (-1) ps + True -> set_return_code_pst (-1) ps _ -> ps = closeProcess ps diff --git a/Ide/PmDialogues.icl b/Ide/PmDialogues.icl index fa3e3bf82de5a19884af5803a16a57a07740414c..223a31c7628c72a71faf36330a1b355fefee41c8 100644 --- a/Ide/PmDialogues.icl +++ b/Ide/PmDialogues.icl @@ -4,7 +4,7 @@ import StdArray, StdFunc, StdMisc, StdTuple import StdFileSelect,StdPStClass,StdWindow import PmTypes, PmProject, PmPath, UtilStrictLists import tabcontrol, ExtListBox, ioutil, IdeState -import ExtNotice +import ExtNotice, UtilIO import Platform //import dodebug diff --git a/Ide/conswin.icl b/Ide/conswin.icl index 3199c88de72e072732435375d3ab304fd439c400..b31d4db8e9ad94bf7ba9437f76b914e04e2136df 100644 --- a/Ide/conswin.icl +++ b/Ide/conswin.icl @@ -133,7 +133,8 @@ openConsoleWindow cwi text atts ps # (_, (editState, ps)) = setText text (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) - # (editState,editLook) = editWindowLook editState +// # (editState,editLook) = editWindowLook editState + # editLook = editWindowLook editState # windowAttrs = [ WindowOuterSize cwi.tsiz , WindowHMargin 0 0 diff --git a/Ide/idehelp.icl b/Ide/idehelp.icl index 23fbc8aa642f6412476b21ef0af3f6ac52e2c919..140c4216be4218282149cf765eeea96dbc5c610b 100644 --- a/Ide/idehelp.icl +++ b/Ide/idehelp.icl @@ -4,7 +4,10 @@ implementation module idehelp import StdFunc, StdMisc import StdMenu, StdPStClass, StdSystem import ExtNotice -import ioutil +import ioutil, UtilIO + +//import dodebug +trace_n` m f :== f //-- export @@ -36,7 +39,8 @@ CLEAN_VERSION initHelpMenu :: Id !*(PSt .b) -> *PSt .b initHelpMenu wId ps - # (_,ps) = openMenu undef (helpMenu wId) ps + # (items,ps) = accFiles helpItems ps + # (_,ps) = openMenu undef (helpMenu items wId) ps = ps //-- local @@ -49,18 +53,36 @@ bitmapname = case toInt '\n' of idehelpname = applicationpath "idehelp" idehelptopic = "general.htm" -helpMenu :: Id -> Menu (:+: .MenuItem .MenuItem) .a *(PSt .b ) -helpMenu wId +//helpMenu :: Id -> Menu (:+: .MenuItem .MenuItem) .a *(PSt .b ) +helpMenu items wId = Menu "&Help" ( 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 -// # ps = htmlHelpTopic (idehelpname+++".chm::/"+++idehelptopic) wId ps - = ps +import Directory, StdTuple + +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 # (wId,ps) = openId ps diff --git a/Ide/targetui.icl b/Ide/targetui.icl index 163ea70bf86ed38ae8749b25adb73a9e942db4ba..4b381250c87a973df1eb7320003aee089d597d92 100644 --- a/Ide/targetui.icl +++ b/Ide/targetui.icl @@ -5,7 +5,7 @@ import StdFileSelect, StdMenu, StdMenuElement, StdPStClass, StdSystem import ExtNotice import IdeState import ioutil, tabcontrol -import UtilStrictLists, PmPath +import UtilStrictLists, UtilIO, PmPath /* ? add 'New' to edit list dlog diff --git a/Ide/typewin.icl b/Ide/typewin.icl index 0f2272ba9a87666d92b1bc15356e403fa7cf7d38..322eebc166e1ef6e621e8431a60417d0bb624cfd 100644 --- a/Ide/typewin.icl +++ b/Ide/typewin.icl @@ -145,7 +145,7 @@ openTypeWindow twi text atts ps # (_, (editState, ps)) = setText text (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) - # (editState,editLook) = editWindowLook editState + # editLook = editWindowLook editState # windowAttrs = [ WindowOuterSize twi.tsiz , WindowHMargin 0 0 diff --git a/Pm/PmProject.icl b/Pm/PmProject.icl index 0b138c440380db061d9ff0ad761e2e05db0d0655..b9993a07306c69eb8a98a3a56fbebfd0e75f4b34 100644 --- a/Pm/PmProject.icl +++ b/Pm/PmProject.icl @@ -352,11 +352,13 @@ PR_GetLinkOptions 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 | built,inflist=infl=:(root=:{InfListItem | info={dir}}):!rest,prjpaths,saved} - | def = {Project | project & built = built && olddirs, +PR_SetPaths def defs new project=:{Project | built,inflist=infl=:((root=:{InfListItem | info={dir}}):!rest),prjpaths,saved} + | def = {Project | project & + built = built && olddirs, saved = saved && olddirs, inflist = inflist1 }; - = {Project | project & built = built && olddirs, + = {Project | project & + built = built && olddirs, saved = saved && unchanged && olddirs, inflist = inflist1, prjpaths = prjpaths1 }; diff --git a/TimeProfile/Help.dcl b/TimeProfile/Help.dcl index 31d21aa52c93399ae09b75bb69d06daafa93e44e..a82698e27dee2ca1b42a8f9c32705afff16c742f 100644 --- a/TimeProfile/Help.dcl +++ b/TimeProfile/Help.dcl @@ -8,7 +8,7 @@ definition module Help // // ************************************************************************************************** -from StdString import String +import StdString from StdPSt import PSt, IOSt showAbout :: String String (PSt .l) -> PSt .l diff --git a/TimeProfile/ShowProfile.dcl b/TimeProfile/ShowProfile.dcl index 9960e0fa1cb7d8428c5bba583080b6c5c2205c23..66c9f397d6509b67bcec0ea3784fbf07d11ee315 100644 --- a/TimeProfile/ShowProfile.dcl +++ b/TimeProfile/ShowProfile.dcl @@ -30,7 +30,7 @@ g_profile_curried :: !.FormattedProfile !.FormattedProfile -> Bool; //draw_profile_lines :: [.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); -printTable :: .Font !.PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a); +printTable :: Font !PrintSetup [.FormattedProfile] .FormattedProfile !*(PSt .a) -> *(PrintSetup,*PSt .a); //-- diff --git a/TimeProfile/ShowProfile.icl b/TimeProfile/ShowProfile.icl index 2f3a017dc3e6b312e7626ca4d4d71f7e38a70536..411c9aca69c63e12c5d9c0edd0434262efcd7f27 100644 --- a/TimeProfile/ShowProfile.icl +++ b/TimeProfile/ShowProfile.icl @@ -282,7 +282,7 @@ where = clock_speed_and_profile_overhead = read_function_profiles (PCorMac (compute_time_x86 (clock_speed*1.0E6) overhead) - (compute_time processor processor_clock bus_clock) + undef//(compute_time processor processor_clock bus_clock) ) file read_processor_information :: *File -> (Int,Int,Int,.File); @@ -480,7 +480,7 @@ sort_and_redraw_window compare_function pst */ //-- 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 // # (s=:(ProfileInfo functionData sumData),ps) = accPLoc (\l=:{info}->(info,l)) ps // # (printFont,ps) = accPLoc (\l=:{monaco_font}->(monaco_font,l)) ps @@ -537,7 +537,7 @@ groupBy :: !Int [x] -> [[x]] groupBy n [] = [] 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 # (alt,printEnv) = printPagePerPage doDialog emulateScreen 0 initFun stateTransition printSetup printEnv = case alt of @@ -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 # string_size=size string | string_size >= length diff --git a/TimeProfile/timeprofiler.icl b/TimeProfile/timeprofiler.icl index 4d9a849dc0b9a38d1cdd926f5ea8ffd6df3c5791..f285bf043952168835ecc218a129fef9f3b459c3 100644 --- a/TimeProfile/timeprofiler.icl +++ b/TimeProfile/timeprofiler.icl @@ -16,8 +16,8 @@ HelpFileName :== ApplicationName +++ "Help" :: ProfileViewerState = { mode :: ViewMode - , mods :: .[FormattedProfile] - , funs :: .[FormattedProfile] + , mods :: [FormattedProfile] + , funs :: [FormattedProfile] , pset :: PrintSetup , name :: String } diff --git a/Util/ExtNotice.icl b/Util/ExtNotice.icl index e15a29eac5232b91d5a18862b966e3cb7b1bdd89..60cfe103e1cbb0b67fadef6e1ffa2977939cd66d 100644 --- a/Util/ExtNotice.icl +++ b/Util/ExtNotice.icl @@ -11,25 +11,27 @@ import StdId, StdPSt, StdWindow, StdTimer instance Dialogs Notice 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 # (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 .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 .ls .ps) -> WindowType getDialogType _ = "Notice" openNotice :: !(Notice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l openNotice notice ps - = snd (openModalDialog undef notice ps) +// = snd (openModalDialog undef notice ps) + # (_,ps) = openModalDialog undef notice ps + = ps //noticeToDialog :: Id Id !(Notice .ls (PSt .l)) -> Dialog noticeToDialog wid okid (Notice texts ok buttons) @@ -66,19 +68,19 @@ okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps instance Dialogs TimedNotice where - openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l) +// 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 (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 :: (TimedNotice .ls .ps) -> WindowType getDialogType _ = "TimerNotice" diff --git a/Util/FontEnv.dcl b/Util/FontEnv.dcl index 392bc11e4077ed6856de8601657f4508e8c19c3d..ae525ec2a2c0b8798c1f069dfc7c000a607f3403 100644 --- a/Util/FontEnv.dcl +++ b/Util/FontEnv.dcl @@ -11,6 +11,6 @@ where getFontMetricsFE :: !Font !*env -> (!FontMetrics, !*env) // accFontEnv :: (*Picture -> (a,*Picture)) -> EditMonad !*env a -instance FontEnv (*Picture) +instance FontEnv Picture instance FontEnv (PSt .l) instance FontEnv World diff --git a/Util/FontEnv.icl b/Util/FontEnv.icl index d48a67295cded6a999c13e4fb78c5dd018715040..6a4e3e3ab2fab27b21730e145d73f579e890e3fc 100644 --- a/Util/FontEnv.icl +++ b/Util/FontEnv.icl @@ -11,7 +11,7 @@ where getFontMetricsFE :: !Font !*env -> (!FontMetrics, !*env) // accFontEnv :: (*Picture -> (a,*Picture)) -> EditMonad !*env a -instance FontEnv (*Picture) +instance FontEnv Picture where openDialogFontFE e = openDialogFont e openFontFE f e = openFont f e diff --git a/Util/StdListBox.dcl b/Util/StdListBox.dcl index 0fa368b9ca8722fd533eac68a809b619da311422..4efea81e29684ab5ecd6538457a62d928fed20af 100644 --- a/Util/StdListBox.dcl +++ b/Util/StdListBox.dcl @@ -2,12 +2,7 @@ definition module StdListBox import StdControl, StdControlClass, StdId, StdPSt -//1.3 :: ListBoxControl ls ps -//3.1 -/*2.0 -:: *ListBoxControl ls ps -0.2*/ = ListBoxControl [String] [Int] ListBoxId [ControlAttribute *(ls,ps)] instance Controls ListBoxControl diff --git a/Util/StdListBox.icl b/Util/StdListBox.icl index d55323596bc33645557973025ba2384b01d001dd..d5a163728d61934576e51a8cd39e3ffded3bcc6b 100644 --- a/Util/StdListBox.icl +++ b/Util/StdListBox.icl @@ -37,12 +37,7 @@ import ioutil | OutCloseAllItems // Reply to remove all items | OutTwiddleItems -//1.3 :: ListBoxControl ls ps -//3.1 -/*2.0 -:: *ListBoxControl ls ps -0.2*/ = ListBoxControl [String] [Int] ListBoxId [ControlAttribute *(ls,ps)] instance Controls ListBoxControl @@ -163,12 +158,7 @@ calcControlDomain allItems ps // The receiver function: -//1.3 receiver :: MessageIn ((*ListBoxState,.ls),PSt .l) -> (MessageOut,((*ListBoxState,.ls),PSt .l)) -//3.1 -/*2.0 -receiver :: MessageIn ((*ListBoxState,.ls),PSt *l) -> (MessageOut,((*ListBoxState,.ls),PSt *l)) -0.2*/ // Return the current selection: receiver InGetSelection ((listboxState=:{items,selection},ls),ps) diff --git a/Util/ioutil.dcl b/Util/ioutil.dcl index 4aec7f0eb7a8e1596287138c4cf5404fb611071d..ead7eb8b312187565b234eb976002994362cb3ba 100644 --- a/Util/ioutil.dcl +++ b/Util/ioutil.dcl @@ -6,12 +6,7 @@ from commondef import unzip3,unzip4 instance toString FontDef -//1.3 instance accScreenPicture (PSt .l) -//3.1 -/*2.0 -instance accScreenPicture (PSt *l) -0.2*/ instance FileEnv Files safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture); @@ -32,4 +27,3 @@ getPenAttributeColour :: ![.PenAttribute] -> Colour; getPenAttributeBack :: ![.PenAttribute] -> Colour; seqmap :: (.a -> .(.b -> .b)) ![.a] !.b -> .b; notEmpty s :== not (isEmpty s) -selectDirectory` :: !(PSt *l) -> (!Maybe String,!(PSt *l)) diff --git a/Util/ioutil.icl b/Util/ioutil.icl index 574b1e2d6ed725d25085944a701864cab4bf66ed..d2197b2915179fcbc6f3ffffa34e68f2837c4708 100644 --- a/Util/ioutil.icl +++ b/Util/ioutil.icl @@ -140,86 +140,3 @@ seqmap f [h:t] e notEmpty s :== not (isEmpty s) -import StdTuple, clCCall_12, clCrossCall_12 -from osfileselect import osInitialiseFileSelectors -from scheduler import handleOneEventForDevices -from commondef import fatalError - -selectDirectory` :: !(PSt *l) -> (!Maybe String,!(PSt *l)) -selectDirectory` env -// = selectDirectory Nothing env - # initial = global.[0] - # (result,env) = selectDirectory initial env - # (result,_) = case result of - Nothing -> (result,global) - (Just _) -> update_maybe_string result global - = (result,env) -where - selectDirectory :: !(Maybe String) !(PSt *l) -> (!Maybe String,!PSt *l) - selectDirectory initial pState - # (tb,pState) = accPIO getIOToolbox pState - # tb = osInitialiseFileSelectors tb - # (ok,name,pState,tb) = osSelectdirectory handleOSEvent pState initial tb - # pState = appPIO (setIOToolbox tb) pState - = (if ok (Just name) Nothing,pState) - - // handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile. - handleOSEvent :: !OSEvent !*(PSt *l) -> *PSt *l - handleOSEvent osEvent pState - = thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState) - - osSelectdirectory :: !(OSEvent->.s->.s) !.s !(Maybe String) !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox) - osSelectdirectory handleOSEvent state initial tb - # (initialptr, tb) = case initial of - Just initial -> winMakeCString initial tb - Nothing -> (0,tb) - # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq1Cci CcRqDIRECTORYDIALOG initialptr) state tb - # tb = case initialptr of - 0 -> tb - _ -> winReleaseCString initialptr tb - # (ok,name,tb) = getinputfilename rcci tb - = (ok,name,state,tb) - where - getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox) - getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb - | ok==0 - = (False,"",tb) - | otherwise - # (pathname,tb) = winGetCStringAndFree ptr tb - = (True,pathname,tb) - getinputfilename {ccMsg=CcWASQUIT} tb - = (False,"",tb) - getinputfilename {ccMsg} _ - = osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")") - - // callback lifts a function::(OSEvent -> .s -> .s) to - // a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox)) - callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox) - callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb) - - osfileselectFatalError :: String String -> .x - osfileselectFatalError function error - = fatalError function "osfileselect" error - -//== UNSAFE HACK... - -import StdArray - -global =: {Just ""} - -//update_maybe_string :: !(Maybe String) !*{(Maybe String)} -> (!(Maybe String),!*{(Maybe String)}) -update_maybe_string :: !(Maybe String) !{(Maybe String)} -> (!(Maybe String),!{(Maybe String)}) -update_maybe_string ms ar -// = (ms,{ar & [0] = ms}) - = code { - push_a 0 - pushI 0 - push_a 2 - update_a 2 3 - update_a 1 2 - updatepop_a 0 1 - update _ 1 0 - push_a 1 - update_a 1 2 - updatepop_a 0 1 - } diff --git a/Win/IdePlatform.icl b/Win/IdePlatform.icl index 30f99da93f9dea951142e317e902eb4e4824942b..fae7c7a399c309f15c24f8d978ebf772a2ac910f 100644 --- a/Win/IdePlatform.icl +++ b/Win/IdePlatform.icl @@ -4,6 +4,9 @@ import StdPSt import StdArray, StdEnum, StdList, StdTuple import StdFunc +//import dodebug +trace_n` m f :== f + PlatformProcessAttributes :: [ProcessAttribute *(PSt General)] PlatformProcessAttributes = // []/* @@ -23,6 +26,8 @@ import UtilIO, StdPStClass RunProgram :: !.String !*(PSt General) -> *PSt General RunProgram path ps + # (ret,ps) = accPIO (accIOToolbox (AddMainWindowHook True)) ps + # ps = trace_n` ("Hook",ret) ps # (project,ps) = getProject ps (redc,ps) = getCurrentRedc ps ao = PR_GetApplicationOptions project @@ -48,8 +53,8 @@ where = (ps,True) = (winfun ["Error: Could not launch the application."] ps,False) // need to investigate here... - # (didit,_) = winLaunchApp (quoted_string path) (o<>NoConsole) 99 -// # (didit,_) = startChildProcess (quoted_string path +++. " -con") False/*True*/ 99 +// # (didit,_) = winLaunchApp (quoted_string path) (o<>NoConsole) 99 + # (didit,_) = trace_n` "Launch" startChildProcess (quoted_string path +++. " -con") False/*True*/ 99 | didit // # ps = consoleMessageE ("<"+++.path+++." launched>\n") ps = (ps,True) @@ -75,7 +80,7 @@ consoleMessageI :: !{#Char} !(PSt General) -> PSt General consoleMessageI msg ps = updateConsoleWindowI msg [consWinKeyboard,consWinMouse] ps consoleMessageO :: !{#Char} !(PSt General) -> PSt General -consoleMessageO msg ps = updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps +consoleMessageO msg ps = trace_n` msg updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps consoleMessageE :: !{#Char} !(PSt General) -> PSt General consoleMessageE msg ps = updateConsoleWindowE msg [consWinKeyboard,consWinMouse] ps @@ -113,6 +118,11 @@ import code from library "conkernel_library" import code from "Redirect.obj" from clCCall_12 import winMakeCString,CSTR,OSToolbox +AddMainWindowHook :: !Bool !*OSToolbox -> (!Bool,!*OSToolbox) +AddMainWindowHook _ tb = code { + ccall AddMainWindowHook "I:I:I" + } + startChildProcess :: !{#Char} !Bool !*OSToolbox -> (!Bool,!*OSToolbox) startChildProcess cmdl swin tb # (cstr,tb) = winMakeCString cmdl tb diff --git a/Win/PatchConsoleEvents/Clean System Files/Redirect.obj b/Win/PatchConsoleEvents/Clean System Files/Redirect.obj index 349b5aedfd4a51698d9c3c7984c6c4aee3ac0a96..d8525b0ddf501743129ead3722b918d9b83324d0 100644 Binary files a/Win/PatchConsoleEvents/Clean System Files/Redirect.obj and b/Win/PatchConsoleEvents/Clean System Files/Redirect.obj differ diff --git a/Win/PatchConsoleEvents/Clean System Files/cCrossCallMaarten.obj b/Win/PatchConsoleEvents/Clean System Files/cCrossCallMaarten.obj index 92b6f143c68808d03164eba0c9fe77426dcebe15..c8fd226e3936b2aef3c4f24f410445e2f7268775 100644 Binary files a/Win/PatchConsoleEvents/Clean System Files/cCrossCallMaarten.obj and b/Win/PatchConsoleEvents/Clean System Files/cCrossCallMaarten.obj differ diff --git a/Win/PatchConsoleEvents/deviceevents.dcl b/Win/PatchConsoleEvents/deviceevents.dcl index 46b7dbe7f4d75feb638d2e000a983fd173873c14..2a6312921c4385b8f1b14c14b7d1921ecee451c0 100644 --- a/Win/PatchConsoleEvents/deviceevents.dcl +++ b/Win/PatchConsoleEvents/deviceevents.dcl @@ -7,10 +7,6 @@ import osevent, ostypes import receivermessage, timertable from windowhandle import WIDS from receiverhandle import InetEvent`, EndpointRef`, InetReceiverCategory` // MW11++ -/*2.0 -import ospicture // For OIO1.2+uniqueness -:: OSRect :== Rect -0.2*/ :: MsgEvent = QASyncMessage !QASyncMessage diff --git a/Win/PatchConsoleEvents/processdevice.dcl b/Win/PatchConsoleEvents/processdevice.dcl index 332dd1feaa413b1b00703b0869986a0748919eb5..5a69c13998feb44ada88510849dce3e60fb0b91b 100644 --- a/Win/PatchConsoleEvents/processdevice.dcl +++ b/Win/PatchConsoleEvents/processdevice.dcl @@ -8,9 +8,4 @@ import devicefunctions from iostate import PSt, IOSt -//1.3 processFunctions :: DeviceFunctions (PSt .l) -//3.1 -/*2.0 -processFunctions :: DeviceFunctions (PSt *l) -0.2*/ diff --git a/Win/PatchConsoleEvents/processdevice.icl b/Win/PatchConsoleEvents/processdevice.icl index 7c6f0870b7463b29d37c1b62e6221d54de1b6744..abcc5d3ca7e39da4b1a61c70b4a8612d759f5116 100644 --- a/Win/PatchConsoleEvents/processdevice.icl +++ b/Win/PatchConsoleEvents/processdevice.icl @@ -13,12 +13,7 @@ processdeviceFatalError rule error = fatalError rule "processdevice" error -//1.3 processFunctions :: DeviceFunctions (PSt .l) -//3.1 -/*2.0 -processFunctions :: DeviceFunctions (PSt *l) -0.2*/ processFunctions = { dDevice = ProcessDevice , dShow = id//processShow diff --git a/Win/PatchConsoleEvents/processevent.dcl b/Win/PatchConsoleEvents/processevent.dcl index 8665bbd654f4d512dd24348a4936f44e7c3b73da..a630d991cb26e84d0f3bdc76be1e31cfa5907703 100644 --- a/Win/PatchConsoleEvents/processevent.dcl +++ b/Win/PatchConsoleEvents/processevent.dcl @@ -11,9 +11,4 @@ import deviceevents from iostate import PSt, IOSt -//1.3 processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l) -//3.1 -/*2.0 -processEvent :: !SchedulerEvent !(PSt *l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt *l) -0.2*/ diff --git a/Win/PatchConsoleEvents/processevent.icl b/Win/PatchConsoleEvents/processevent.icl index 2fd1634b647ec3e54e56b0ff992d6f6f4a172519..87774bda6ce087b30659c3ca29acb0bb1da2dce8 100644 --- a/Win/PatchConsoleEvents/processevent.icl +++ b/Win/PatchConsoleEvents/processevent.icl @@ -17,6 +17,7 @@ import deviceevents, iostate from commondef import fatalError from processstack import topShowProcessShowState +trace_n` m f :== f processeventFatalError :: String String -> .x processeventFatalError function error @@ -26,13 +27,7 @@ processeventFatalError function error /* processEvent filters the scheduler events that can be handled by this process device. processEvent assumes that it is not applied to an empty IOSt. */ -//1.3 processEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l) -//3.1 -/*2.0 -processEvent :: !SchedulerEvent !(PSt *l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt *l) -0.2*/ - processEvent schedulerEvent=:(ScheduleOSEvent osEvent=:{ccMsg} _) pState=:{io=ioState} | isProcessOSEvent ccMsg # (processStack,ioState) = ioStGetProcessStack ioState @@ -62,7 +57,6 @@ where processEvent schedulerEvent pState = (False,Nothing,schedulerEvent,pState) - /* filterOSEvent filters the OSEvents that can be handled by this process device. The Bool argument is True iff the parent process is visible and active. */ @@ -72,17 +66,17 @@ filterOSEvent :: !OSEvent !Bool !OSDInfo !*OSToolbox -> (!Bool,!Maybe [Int],!May filterOSEvent {ccMsg=141} isActive _ tb | not isActive = (False,Nothing,Nothing,tb) - = (True, Nothing, Just (ConsoleQuitEvent), tb) + = trace_n` "ConsoleQuitEvent" (True, Nothing, Just (ConsoleQuitEvent), tb) filterOSEvent {ccMsg=142,p1} isActive _ tb | not isActive = (False,Nothing,Nothing,tb) # (string,tb) = winGetCStringAndFree p1 tb - = (True, Nothing, Just (ConsoleOutEvent string), tb) + = trace_n` "ConsoleOutEvent" (True, Nothing, Just (ConsoleOutEvent string), tb) filterOSEvent {ccMsg=143,p1} isActive _ tb | not isActive = (False,Nothing,Nothing,tb) # (string,tb) = winGetCStringAndFree p1 tb - = (True, Nothing, Just (ConsoleErrEvent string), tb) + = trace_n` "ConsoleErrEvent" (True, Nothing, Just (ConsoleErrEvent string), tb) // ...DvA filterOSEvent {ccMsg=CcWmDDEEXECUTE,p1=cString} isActive _ tb | not isActive diff --git a/Win/Platform.icl b/Win/Platform.icl index 893d20fcf95456ec1fce1fcea7dc517839fb59e4..ca7394bc64ef74f245c11d9875ad6f22f6038922 100644 --- a/Win/Platform.icl +++ b/Win/Platform.icl @@ -74,24 +74,27 @@ envskey =: "envsdir\0" prefskey =: "prefsdir\0" TooltempDir :: String -TooltempDir =: let - (has_arg,arg) = get_arg "-tooltemp" - (has_env,env) = get_env "TOOLTEMP" - ini = get_ini inifilename section toolkey (StartUpDir+++."\0") +TooltempDir =: + let + (has_arg,arg) = get_arg "-tooltemp" + (has_env,env) = get_env "TOOLTEMP" + ini = get_ini inifilename section toolkey (StartUpDir+++."\0") in if has_arg arg (if has_env env ini) EnvsDir :: String -EnvsDir =: let - (has_arg,arg) = get_arg "-envsdir" - (has_env,env) = get_env "ENVSDIR" - ini = get_ini inifilename section envskey (StartUpDir+++."\0") +EnvsDir =: + let + (has_arg,arg) = get_arg "-envsdir" + (has_env,env) = get_env "ENVSDIR" + ini = get_ini inifilename section envskey (StartUpDir+++."\0") in if has_arg arg (if has_env env ini) PrefsDir :: String -PrefsDir =: let - (has_arg,arg) = get_arg "-prefsdir" - (has_env,env) = get_env "PREFSDIR" - ini = get_ini inifilename section prefskey (StartUpDir+++."\0") +PrefsDir =: + let + (has_arg,arg) = get_arg "-prefsdir" + (has_env,env) = get_env "PREFSDIR" + ini = get_ini inifilename section prefskey (StartUpDir+++."\0") in if has_arg arg (if has_env env ini) StartUpDir :: !String diff --git a/Win/UtilIO.dcl b/Win/UtilIO.dcl index 301fd9591bad1ed9675056892676c6fd7d12138b..201d317a4c1270e4d25b5ef4a5248b98c982d59e 100644 --- a/Win/UtilIO.dcl +++ b/Win/UtilIO.dcl @@ -24,3 +24,9 @@ GetLongPathName :: !String -> String; GetShortPathName :: !String -> (!Bool,!String); GetCurrentDirectory :: (!Bool,!String) + +import StdPSt, StdMaybe + +selectDirectory` :: !(PSt *l) -> (!Maybe String,!(PSt *l)) +ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l)) + diff --git a/Win/UtilIO.icl b/Win/UtilIO.icl index a39698ccfd3114bf84dedc2c7b216c52b8264153..6fccd63544de862b5a07806d02b70552764f708b 100644 --- a/Win/UtilIO.icl +++ b/Win/UtilIO.icl @@ -8,9 +8,39 @@ import UtilDate import StdSystem import code from library "util_io_kernel_lib" +import code from library "util_io_shell_lib" //dirseparator :== '\\' // OS separator between folder- and filenames in a pathname +//-- +CcRqSHELLDEFAULT :== 1476 + +osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox) +osIgnoreCallback _ tb + = (return0Cci,tb) + +osShellDefault :: !{#Char} !*OSToolbox -> (!Int,!*OSToolbox) +osShellDefault file tb +// # tb = winInitialiseTooltips tb + # (cstr,tb) = winMakeCString file tb + # (ret,tb) = (issueCleanRequest2 osIgnoreCallback (Rq2Cci CcRqSHELLDEFAULT 0 cstr) tb) + # tb = winReleaseCString cstr tb + = (ret.p1,tb) + + +//--- +SW_SHOWNORMAL :== 1 + +ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l)) +ShellDefault file ps + = accPIO (accIOToolbox (osShellDefault file)) ps +// = accPIO (accIOToolbox (ShellExecute 0 0 file 0 0 SW_SHOWNORMAL)) ps + +ShellExecute :: !Int !Int !{#Char} !Int !Int !Int !*OSToolbox -> (!Int,!*OSToolbox) +ShellExecute _ _ _ _ _ _ _ = code { + ccall ShellExecuteA@24 "IIsIII:I:I" + } + //--- import StdPathname, Directory @@ -55,8 +85,8 @@ FFileSize path files //-- -:: OSToolbox - :== Int +//:: OSToolbox +// :== Int WinLaunchApp :: !{#Char} !Bool !*OSToolbox -> ( !Bool, !*OSToolbox) WinLaunchApp _ _ _ @@ -278,3 +308,93 @@ where } */ +//==== + +import StdTuple, clCCall_12, clCrossCall_12 +import StdPSt, StdMaybe, iostate +from deviceevents import SchedulerEvent +from osfileselect import osInitialiseFileSelectors +from scheduler import handleOneEventForDevices +from commondef import fatalError + +CcRqALTDIRECTORYDIALOG :== 1475 + +selectDirectory` :: !(PSt *l) -> (!Maybe String,!(PSt *l)) +selectDirectory` env +// = selectDirectory Nothing env + # initial = global.[0] + # (result,env) = selectDirectory initial env + # (result,_) = case result of + Nothing -> (result,global) + (Just _) -> update_maybe_string result global + = (result,env) +where + selectDirectory :: !(Maybe String) !(PSt *l) -> (!Maybe String,!PSt *l) + selectDirectory initial pState + # (tb,pState) = accPIO getIOToolbox pState + # tb = osInitialiseFileSelectors tb + # (ok,name,pState,tb) = osSelectdirectory handleOSEvent pState initial tb + # pState = appPIO (setIOToolbox tb) pState + = (if ok (Just name) Nothing,pState) + + // handleOSEvent turns handleOneEventForDevices into the form required by osSelect(in/out)putfile. + handleOSEvent :: !OSEvent !*(PSt *l) -> *PSt *l + handleOSEvent osEvent pState + = thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState) + + osSelectdirectory :: !(OSEvent->.s->.s) !.s !(Maybe String) !*OSToolbox -> (!Bool,!String,!.s,!*OSToolbox) + osSelectdirectory handleOSEvent state initial tb + # (initialptr, tb) = case initial of + Just initial -> winMakeCString initial tb + Nothing -> (0,tb) + # (rcci,state,tb) = issueCleanRequest (callback handleOSEvent) (Rq1Cci CcRqALTDIRECTORYDIALOG initialptr) state tb + # tb = case initialptr of + 0 -> tb + _ -> winReleaseCString initialptr tb + # (ok,name,tb) = getinputfilename rcci tb + = (ok,name,state,tb) + where + getinputfilename :: !CrossCallInfo !*OSToolbox -> (!Bool,!String,!*OSToolbox) + getinputfilename {ccMsg=CcRETURN2,p1=ok,p2=ptr} tb + | ok==0 + = (False,"",tb) + | otherwise + # (pathname,tb) = winGetCStringAndFree ptr tb + = (True,pathname,tb) + getinputfilename {ccMsg=CcWASQUIT} tb + = (False,"",tb) + getinputfilename {ccMsg} _ + = osfileselectFatalError "osSelectdirectory" ("unexpected ccMsg field of return CrossCallInfo ("+++toString ccMsg+++")") + + // callback lifts a function::(OSEvent -> .s -> .s) to + // a crosscallfunction::(CrossCallInfo -> .s -> *OSToolbox -> (CrossCallInfo,.s,*OSToolbox)) + callback :: !(OSEvent->.s->.s) !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox) + callback handleOSEvent cci state tb = (return0Cci,handleOSEvent cci state,tb) + + osfileselectFatalError :: String String -> .x + osfileselectFatalError function error + = fatalError function "osfileselect" error + +//== UNSAFE HACK... + +import StdArray + +global :: {Maybe String} +global =: {Just ""} + +//update_maybe_string :: !(Maybe String) !*{(Maybe String)} -> (!(Maybe String),!*{(Maybe String)}) +update_maybe_string :: !(Maybe String) !{(Maybe String)} -> (!(Maybe String),!{(Maybe String)}) +update_maybe_string ms ar +// = (ms,{ar & [0] = ms}) + = code { + push_a 0 + pushI 0 + push_a 2 + update_a 2 3 + update_a 1 2 + updatepop_a 0 1 + update _ 1 0 + push_a 1 + update_a 1 2 + updatepop_a 0 1 + } diff --git a/Win/lib.dcl b/Win/lib.dcl index 378fff9c17e05af69e506703889aa33360ae51bd..889e341f67b7c977e909f0e0d1d57f8bbe4c3fda 100644 --- a/Win/lib.dcl +++ b/Win/lib.dcl @@ -5,7 +5,7 @@ from StdFile import Files; import StdString //3.1 -CreateArchive :: !String ![!String] !*Files -> (![!String], !Files) +CreateArchive :: !String ![String] !*Files -> (![String], !Files) /* Creates an archive named after the first argument. The archive consists of the object modules in the second argument. The diff --git a/Win/lib.icl b/Win/lib.icl index 333c74ff27dc08aab17b7a9a2570d910b477f928..980fd3c0e8e435a05eeec6b81e0de498504a6904 100644 --- a/Win/lib.icl +++ b/Win/lib.icl @@ -29,7 +29,7 @@ import xcoff (ILONG) string i = (string BYTE (i+3)<<24) bitor (string BYTE (i+2)<<16) bitor (string BYTE (i+1)<<8) bitor (string BYTE i); -read_external_symbol_names_from_xcoff_file :: !String !*Files -> (![!String], !Int, !Int, ![!String],![!String],!*Files); +read_external_symbol_names_from_xcoff_file :: !String !*Files -> (![String], !Int, !Int, ![String],![String],!*Files); read_external_symbol_names_from_xcoff_file file_name files #! (ok, xcoff_file, files) = fopen file_name FReadData files; @@ -307,7 +307,7 @@ ReadObjectFile file_name file_n files } = ([],object_file_member,files) -ReadObjectFiles :: ![!.String] !Int !*{# ObjectFileMember} !Int !ObjectFileMembers !Int !String !*Files -> *(![String],ObjectFileMembers,{#ObjectFileMember},Int,String,!*Files) +ReadObjectFiles :: ![String] !Int !*{# ObjectFileMember} !Int !ObjectFileMembers !Int !String !*Files -> *(![String],ObjectFileMembers,{#ObjectFileMember},Int,String,!*Files) ReadObjectFiles [] i object_file_member_a object_file_offset object_file_members longnames_index longnames_member files = ([],object_file_members,object_file_member_a,longnames_index,longnames_member,files) @@ -362,7 +362,7 @@ where -> (object_name_within_library, longnames_index + (size object_file_name) + 1, longnames_member +++ object_file_name +++ "\0") -CreateArchive :: !String ![!String] !*Files -> (![!String], !Files) +CreateArchive :: !String ![String] !*Files -> (![String], !Files) CreateArchive archive_name objects files #! (ok, lib_file, files) = fopen archive_name FWriteData files @@ -843,7 +843,7 @@ where = read_member_names (inc i) limit member_offset_a (member_names ++ [member_name]) longnames lib_file - Error :: ![!String] !*File !*Files -> (![String],![String],!*Files) + Error :: ![String] !*File !*Files -> (![String],![String],!*Files) Error errors lib_file files # (_,files) = fclose lib_file files diff --git a/Win/set_return_code.dcl b/Win/set_return_code.dcl index e8ed7f819ed18318836a4b6651ef5b63c2f96151..40b92f9bf03a978c4207a8e7c60533e750bcbb4d 100644 --- a/Win/set_return_code.dcl +++ b/Win/set_return_code.dcl @@ -3,7 +3,9 @@ definition module set_return_code; //1.3 from StdString import String; //3.1 +from StdPSt import PSt,IOSt; :: *UniqueWorld :== World; -set_return_code :: !Int !UniqueWorld -> UniqueWorld; -// void set_return_code (int return_code); + +set_return_code_world :: !Int !UniqueWorld -> UniqueWorld; +set_return_code_pst :: !Int !(PSt .l) -> PSt .l; diff --git a/Win/set_return_code.icl b/Win/set_return_code.icl index f15a39ddeea92157863f37bab3b9a639fe7b6566..456bf48d5eeab1587a0272a8e0376f0efe5ce9f3 100644 --- a/Win/set_return_code.icl +++ b/Win/set_return_code.icl @@ -3,14 +3,22 @@ implementation module set_return_code; import code from "set_return_code.obj"; import StdString; +import StdPSt; :: *UniqueWorld :== World; -set_return_code :: !Int !UniqueWorld -> UniqueWorld; -set_return_code a0 a1 = code -{ - ccall set_return_code "I:V:A" - fill_a 0 1 - pop_a 1 + +set_return_code_world :: !Int !UniqueWorld -> UniqueWorld; +set_return_code_world a0 a1 = code { + ccall set_return_code "I:V:A" + fill_a 0 1 + pop_a 1 +} + +set_return_code_pst :: !Int !(PSt .l) -> PSt .l; +set_return_code_pst a0 a1 = code { + ccall set_return_code "I:V:A" + fill_a 0 1 + pop_a 1 } // void set_return_code (int return_code);