Commit 2d206575 authored by Diederik van Arkel's avatar Diederik van Arkel

platform abstraction

parent 27759658
......@@ -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
......@@ -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?
......
......@@ -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`
......@@ -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'));
......
......@@ -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
......
......@@ -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
......@@ -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
......@@ -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))
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment