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

Assorted fixes

parent 4f23f9cb
......@@ -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
......
......@@ -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)
......
......@@ -92,7 +92,7 @@ where
2 // silly DOS
1 // mac
newline
=: PlatformDependant
= PlatformDependant
"\xd\xa" // windows
"\xd" // mac
......
......@@ -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.
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -156,7 +156,7 @@ where
| s.[i] == x = True
= isStringMember x (dec i) s
funnyChars =: "~@#$%^?!+-*<>\\/|&=:."
funnyChars = "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20
dL :: !.Int !.Int !*Picture -> !(!.CommentLevel,!*Picture)
......
......@@ -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
......
......@@ -25,7 +25,7 @@ where
| c == x = True
= isStringMember x (dec i) s
funnyChars =: "~@#$%^?!+-*<>\\/|&=:."
funnyChars = "~@#$%^?!+-*<>\\/|&=:."
funnySize = 20 // =: size funnyChars?
line_size = size line
......
......@@ -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
......
......@@ -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
......
......@@ -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)));
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 };
......
......@@ -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
......
......@@ -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);
//--
......
......@@ -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
......
......@@ -16,8 +16,8 @@ HelpFileName :== ApplicationName +++ "Help"
:: ProfileViewerState =
{ mode :: ViewMode
, mods :: .[FormattedProfile]
, funs :: .[FormattedProfile]
, mods :: [FormattedProfile]
, funs :: [FormattedProfile]
, pset :: PrintSetup
, name :: String
}
......
......@@ -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"
......
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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))
......@@ -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
}
......@@ -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
......
......@@ -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
......
......@@ -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*/
......@@ -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
......
......@@ -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*/
......@@ -17,6 +17,7 @@ import deviceevents, iostate
from commondef import fatalError
from processstack import topShowProcessShowState
trace_n` m f :== f
processeventFatalError :: String String -> .x