From 2d206575b98d59200b1fa1c0a9b2a9a742e83283 Mon Sep 17 00:00:00 2001 From: Diederik van Arkel Date: Tue, 25 Feb 2003 14:45:26 +0000 Subject: [PATCH] platform abstraction --- Ed/EdMonad.icl | 25 +++++++-- Ed/syncol.dcl | 2 +- Ed/syncol.icl | 93 ++++++++++++++++++++++++++++++++- HeapProfile/ShowHeapProfile.icl | 2 +- Ide/IdeState.icl | 4 +- Mac/Platform.dcl | 4 ++ Mac/Platform.icl | 60 +++++++++++++++++++++ Mac/UtilIO.dcl | 2 + Mac/UtilIO.icl | 8 +++ Util/ExtListBox.icl | 2 +- 10 files changed, 193 insertions(+), 9 deletions(-) diff --git a/Ed/EdMonad.icl b/Ed/EdMonad.icl index 6683a2e..14cba29 100644 --- a/Ed/EdMonad.icl +++ b/Ed/EdMonad.icl @@ -8,6 +8,9 @@ import UtilNewlinesFile, StateMonad import StdId import EdVisualText, EdSelection, EdLook import EdAction +import Platform +//import dodebug +trace_n` _ s :== s :: ActionInfo = NoInfo @@ -476,13 +479,28 @@ setNeedSave need = getEditState >>>= \{windowId,pathName} -> accEnv (accPIO (getWindowTitle windowId)) >>>= \oldTitle -> let - windowName = (if readOnly pathNameToWindowTitle` pathNameToWindowTitle) pathName - windowTitle = if need ("*"+++windowName) windowName + windowName = (if readOnly pathNameToWindowTitle` pathNameToWindowTitle) pathName + windowTitle = PlatformDependant + /*Win*/ (if need ("*"+++windowName) windowName) + /*Mac*/ windowName in + IF (needsetwin oldTitle windowTitle) THEN ( - appEnv (appPIO (setWindowTitle windowId windowTitle) ) >>> + appEnv (appPIO (setWindowTitle windowId windowTitle)) + ) + ELSE + ( + skip + ) >>> + + accEnv (accPIO (getWindowModified windowId)) >>>= \wasModified -> + IF (isJust wasModified && fromJust wasModified <> need) + + THEN + ( + appEnv (appPIO (setWindowModified windowId windowName need)) >>> updateEditState update ) ELSE @@ -575,3 +593,4 @@ where selectMode = state.mod virtualX = state.vix visible = state.vis + diff --git a/Ed/syncol.dcl b/Ed/syncol.dcl index 6cc3fdc..c427a6b 100644 --- a/Ed/syncol.dcl +++ b/Ed/syncol.dcl @@ -10,8 +10,8 @@ import StrictList // ,!Bool // in typedef at start of line ,!Bool // is typedef line // ,!Bool // in typedecl at start of line -// ,!Int // typedecl offside level ,!Bool // is typedecl line + ,!Int // context offside level ) // pack bools into bitfield? diff --git a/Ed/syncol.icl b/Ed/syncol.icl index 391ef28..2222db7 100644 --- a/Ed/syncol.icl +++ b/Ed/syncol.icl @@ -25,6 +25,10 @@ where line4 = " -> fraps" line5 = "global :== something" */ + + + + /* parseLine: initial comment nesting level & textline -> new comment nesting level */ @@ -204,6 +208,10 @@ where WhiteSpace c :== c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f'; +//slFromList` :: ![a] -> StrictList a +slFromList` [] r = r +slFromList` [x:xs] r = SCons x (slFromList` xs r) + /* firstParse: textlines -> zip initial comment nesting level & textlines */ @@ -240,5 +248,88 @@ where quickParse :: !Int !Int !(StrictList (!Info,!String)) -> (Int,Int,StrictList (!Info,!String)) quickParse fln lln text - = (0,slLength text - 1,firstParse (slMap (\(_,s)->s) text)) + # (beg,end,res) = parseBefore 0 (-1,0,False,False,0) id [] text + # res = trace_n` ("quickParse",beg,end,fln,lln) res + # beg = if (beg < 0) (trace_n` "FIX BEGIN" 0) beg + # end = if (end >= slLength res) (trace_n` "FIX END" slLength res - 1) end + = (beg,end,res) +where + join [] l = l + join [h:t] l = SCons h (join t l) + + parseBefore :: !Int !(!Int,!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String)) + parseBefore cln (begin,lev,def,tdec,off) res acc rest=:SNil + = (dec cln,dec cln,res (slFromList acc)) + parseBefore cln s=:(begin,lev,def,tdec,off) res acc rest=:(SCons h=:((lev`,def`,dec`,off`),l) t) + | cln >= fln + = parseDuring begin begin (lev,def,tdec,off) res [] (join acc rest) + # line_size = size l + # (index,off``,_) = scanFirst lev` 0 0 l + # non_empty = off`` >= 0 && index < line_size + # not_double_colon = l%(index,dec (scanfunny index line_size l)) <> "::" + # has_content = non_empty && if (index > 0) not_double_colon True + | trace_n` ("parseBefore",cln,has_content,s,h) False = undef + | not dec` && has_content + // flush acc & continue... + = parseBefore (inc cln) (cln,lev`,def`,dec`,off``) (\r -> res (slFromList` acc r)) [h] t + = parseBefore (inc cln) (begin,lev,def,tdec,off) res (acc ++ [h]) t + + parseDuring :: !Int !Int !(!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String)) + parseDuring cln begin (lev,def,tdec,off) res acc SNil + = (begin,dec cln,res (slFromList acc)) + parseDuring cln begin i=:(lev,def,dec,off) res acc rest=:(SCons h=:(_,l) t) + | cln > lln + = parseAfter cln begin i res acc rest + | trace_n` ("parseDuring",cln,i,h) False = undef + #! (has_contents,j=:(level`,def`,dec`,off`)) = parseLine i l + new = (lev,def`,dec`,off`) + | dec == False && dec` && off < off` + | has_contents + = parseDuring (inc cln) begin j (\r -> res (slFromList` acc r)) [(new,l)] t //@@@@ + // should be identifier in acc... + #! j` = (lev,def,dec`,off) + acc = [fix s \\ s<- acc] + res = (\r -> res (slFromList` acc r)) + = parseDuring cln begin j` res [] rest //@@@@ + | has_contents + #! res = (\r -> res (slFromList` acc r)) + = parseDuring (inc cln) begin j res [(new,l)] t //@@@@ + #! acc = acc ++ [(new,l)] + = parseDuring (inc cln) begin j res acc t + where + fix :: !(!Info,!String) -> (!Info,!String) + fix ((c,t,d,o),l) = ((c,False,True,o),l) + + parseAfter :: !Int !Int !(!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String)) + parseAfter cln begin i res acc SNil + = (begin,dec cln,res (slFromList acc)) + parseAfter cln begin state=:(lev,def,dec,off) res acc rest=:(SCons h=:(old,l) t) + | trace_n` ("parseAfter",cln,state,h) False = undef + #! (has_contents,state`=:(level`,def`,dec`,off`)) = parseLine state l + new = (lev,def`,dec`,off`) + | dec == False && dec` && off < off` + | has_contents + #! res = (\r -> res (slFromList` acc r)) + | equal_state new old + #! res = res (slFromList` [(new,l)] SNil) + = (begin,cln,slAppend res t) + = parseDuring (inc cln) begin state` res [(new,l)] t + # j` = (lev,def,dec`,off) + = parseDuring cln begin j` (\r -> res (slFromList` [fix s \\ s<- acc] r)) [] rest + | has_contents + #! res = (\r -> res (slFromList` acc r)) + | equal_state new old + #! res = res (slFromList` [(new,l)] SNil) + = (begin,cln,slAppend res t) + = parseDuring (inc cln) begin state` res [(new,l)] t + = parseDuring (inc cln) begin state` res (acc ++[(new,l)]) t + where + fix :: (!Info,!String) -> (!Info,!String) + fix ((c,t,d,o),l) = ((c,False,True,o),l) + equal_state :: !Info !Info -> Bool + equal_state (lev,def,dec,off) (lev`,def`,dec`,off`) + = lev == lev` + && def == def` + && dec == dec` + && off == off` diff --git a/HeapProfile/ShowHeapProfile.icl b/HeapProfile/ShowHeapProfile.icl index 57cc988..69f0076 100644 --- a/HeapProfile/ShowHeapProfile.icl +++ b/HeapProfile/ShowHeapProfile.icl @@ -1398,7 +1398,7 @@ open_file_function file_name s=:{application_name,current_page,file_open} io = (s, io); */ -set_page_number :: !String !Int -> !String; +set_page_number :: !String !Int -> String; set_page_number file_name new_page_number = file_name := (size file_name-PageNumberOffsetFromEndInFileName,toChar (new_page_number + toInt '0')); diff --git a/Ide/IdeState.icl b/Ide/IdeState.icl index 57584d8..0e56e4b 100644 --- a/Ide/IdeState.icl +++ b/Ide/IdeState.icl @@ -484,7 +484,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps //-- batch build support from StdProcess import closeProcess from StdPStClass import class FileSystem, instance FileSystem PSt -import logfile, set_return_code +import logfile, Platform getInteract :: !*(PSt *General) -> (!Bool,!*PSt *General) getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps @@ -506,7 +506,7 @@ abortLog flag message ps # (ok,ps) = closeLogfile lf ps // | not ok ... # ps = case flag of - True -> set_return_code_pst (-1) ps + True -> pAbort ps _ -> ps = closeProcess ps diff --git a/Mac/Platform.dcl b/Mac/Platform.dcl index 44300ee..bb8d054 100644 --- a/Mac/Platform.dcl +++ b/Mac/Platform.dcl @@ -9,6 +9,9 @@ initPlatformCommandLine :: !*(PSt .l) -> (![String],!*PSt .l) installPlatformEventHandlers :: !*(PSt .l) -> *(PSt .l) openPlatformWindowMenu :: !*(PSt .l) -> *(PSt .l) +getWindowModified :: !Id !(IOSt .l) -> (!Maybe Bool,!IOSt .l) +setWindowModified :: !Id !String !Bool !(IOSt .l) -> IOSt .l + TempDir :: String EnvsDir :: String PrefsDir :: String @@ -16,3 +19,4 @@ BitmapDir :: String batchOptions :: !*World -> (!Bool,Bool,String,*File,!*World) wAbort :: !String !*World -> *World +pAbort :: !(PSt .a) -> PSt .a diff --git a/Mac/Platform.icl b/Mac/Platform.icl index 8d4910b..cd244d7 100644 --- a/Mac/Platform.icl +++ b/Mac/Platform.icl @@ -39,6 +39,9 @@ wAbort message world # (_,world) = fclose stderr world = world +pAbort :: !(PSt .a) -> PSt .a +pAbort ps = ps + install_apple_event_handlers :: Int install_apple_event_handlers = code ()(r=D0) { @@ -56,3 +59,60 @@ PrefsDir = applicationpath "Config" BitmapDir :: String BitmapDir = applicationpath "Bitmaps" + +////////////// + +//import dodebug +trace_n` _ f :== f + +import windowaccess, iostate, StdBool,menuwindowmenu +import code from library "winmod_library" + +getWindowModified :: !Id !(IOSt .l) -> (!Maybe Bool,!IOSt .l) +getWindowModified id ioState + # (found,wDevice,ioState) = ioStGetDevice WindowDevice ioState + | not found + = (Nothing,ioState) + # windows = windowSystemStateGetWindowHandles wDevice + (found,wsH,windows) = getWindowHandlesWindow (toWID id) windows + | not found + = (Nothing,ioStSetDevice (WindowSystemState windows) ioState) + | otherwise + # (mod,wsH,ioState) = getWindowModified wsH ioState + = (Just mod,ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState) +where + getWindowModified wsH=:{wshIds={wPtr}} ioState + # (mod,ioState) = accIOToolbox (IsWindowModified wPtr) ioState + = trace_n` ("getWindowModified",wPtr,mod) (mod,wsH,ioState) + + IsWindowModified :: !OSWindowPtr !*OSToolbox -> (!Bool,!*OSToolbox) + IsWindowModified wPtr ioState = code { + ccall IsWindowModified "PI:I:I" + } + +setWindowModified :: !Id !String !Bool !(IOSt .l) -> IOSt .l +setWindowModified id windowName mod ioState + # windowTitle = if mod ("¥"+++windowName) windowName + # ioState = changeWindowInWindowMenu id windowTitle ioState + + # (found,wDevice,ioState) = ioStGetDevice WindowDevice ioState + | not found + = ioState + # windows = windowSystemStateGetWindowHandles wDevice + (found,wsH,windows) = getWindowHandlesWindow (toWID id) windows + | not found + = ioStSetDevice (WindowSystemState windows) ioState + | otherwise + # (wsH,ioState) = setWindowModified wsH mod ioState + = ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState +where + setWindowModified wsH=:{wshIds={wPtr}} mod ioState + # (err,ioState) = accIOToolbox (SetWindowModified wPtr (if mod (1 << 24) 0)) ioState + = trace_n` ("setWindowModified",wPtr,mod,err) (wsH,ioState) + + SetWindowModified :: !OSWindowPtr !Int !*OSToolbox -> (!OSStatus,!*OSToolbox) + SetWindowModified wPtr mod ioState = code { + ccall SetWindowModified "PII:I:I" + } + +:: OSStatus :== Int diff --git a/Mac/UtilIO.dcl b/Mac/UtilIO.dcl index d79cde5..d45d5fb 100644 --- a/Mac/UtilIO.dcl +++ b/Mac/UtilIO.dcl @@ -28,6 +28,8 @@ GetShortPathName :: !String -> (!Bool,!String); import StdPSt, StdMaybe +selectInputFile` :: !(PSt .l) -> (!Maybe String,!(PSt .l)) +selectOutputFile` :: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l)) selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l)) ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l)) diff --git a/Mac/UtilIO.icl b/Mac/UtilIO.icl index d8dbe0f..f345959 100644 --- a/Mac/UtilIO.icl +++ b/Mac/UtilIO.icl @@ -153,6 +153,14 @@ GetFName ioNamePtr t = code (ioNamePtr=R80O0D0SD1,t=U)(ioResult=D0,ioDate_and_Ti import StdFileSelect, StdPSt, StdPStClass +selectInputFile` :: !(PSt .l) -> (!Maybe String,!(PSt .l)) +selectInputFile` ps + = selectInputFile ps + +selectOutputFile` :: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l)) +selectOutputFile` prompt filename ok ps + = selectOutputFile prompt filename ps + selectDirectory` :: !(PSt .l) -> (!Maybe String,!PSt .l) selectDirectory` ps # (ms,ps) = selectDirectory ps diff --git a/Util/ExtListBox.icl b/Util/ExtListBox.icl index 4f0cb0e..16a88d0 100644 --- a/Util/ExtListBox.icl +++ b/Util/ExtListBox.icl @@ -588,7 +588,7 @@ applySelfun ls=:{newselfun,selection} ps = (ls,ps) // The mouse either sets, adds, or removes items to the selection: -mouseFunction :: !.MouseState *((.ExtListBoxState *(PSt .a),.b),*PSt .a) -> *((ExtListBoxState *(PSt .a),.b),*PSt .a); +//mouseFunction :: !.MouseState *((.ExtListBoxState *(PSt .a),.b),*PSt .a) -> *((ExtListBoxState *(PSt .a),.b),*PSt .a); mouseFunction (MouseDown pos {shiftDown,controlDown} 1) ((listboxState=:{tMargin,items,selection,lineHeight,initHeight},ls),ps) # listboxState = {ExtListBoxState | listboxState & selection=okSelection} # (listboxState,ps) = applySelfun listboxState ps -- GitLab