Commit e1f4cd2d authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

cleanup for Clean2 release

parent af9b4495
implementation module Table implementation module Table
/* // Table.icl: implements lookup table that can be inverted
* Table.icl: implements lookup table that can be inverted
*/
import StdClass, StdArray, StdFunc import StdClass, StdArray, StdFunc
import StdMaybe, StdInt import StdMaybe, StdInt
......
...@@ -2,8 +2,6 @@ implementation module UtilDate ...@@ -2,8 +2,6 @@ implementation module UtilDate
import StdArray, StdBool, StdChar, StdClass, StdInt, StdString import StdArray, StdBool, StdChar, StdClass, StdInt, StdString
//--- StdDate
NoDate :== {exists=False,yy=0,mm=0,dd=0,h=0,m=0,s=0}; NoDate :== {exists=False,yy=0,mm=0,dd=0,h=0,m=0,s=0};
:: DATE = { exists :: !Bool, :: DATE = { exists :: !Bool,
......
implementation module colorpickcontrol implementation module colorpickcontrol
// **************************************************************************************************
//
// This program creates a windows that allows a user to create a RGB colour.
//
// The program has been written in Clean 1.3.1 and uses the Clean Standard Object I/O library 1.0.2
//
// **************************************************************************************************
import StdControl, StdControlReceiver, StdReceiver import StdControl, StdControlReceiver, StdReceiver
import ioutil import ioutil
......
definition module ioutil definition module ioutil
import StdOverloaded, StdBool, StdList import StdOverloaded, StdBool, StdList
import StdPicture, StdPSt, StdId, StdIOCommon, StdFile//, StdFileSelect import StdPicture, StdPSt, StdId, StdIOCommon, StdFile
from commondef import unzip3,unzip4 from commondef import unzip3,unzip4
...@@ -9,6 +9,7 @@ instance toString FontDef ...@@ -9,6 +9,7 @@ instance toString FontDef
instance accScreenPicture (PSt .l) instance accScreenPicture (PSt .l)
instance FileEnv Files instance FileEnv Files
safeOpenFont :: !FontDef !(PSt .l) -> (Font,PSt .l)
safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture); safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture);
altScrollFunction :: !Direction !Int -> ScrollFunction altScrollFunction :: !Direction !Int -> ScrollFunction
alignScrollFunction :: !Direction !Int -> ScrollFunction alignScrollFunction :: !Direction !Int -> ScrollFunction
......
implementation module ioutil implementation module ioutil
import StdBool,StdList,StdFile import StdBool,StdList,StdFile
import StdControl,StdPSt//,StdFileSelect import StdControl,StdPSt
import iostate import iostate
altScrollFunction :: !Direction !Int -> ScrollFunction altScrollFunction :: !Direction !Int -> ScrollFunction
...@@ -39,6 +39,13 @@ where ...@@ -39,6 +39,13 @@ where
SliderThumb x -> if (x == m) x (align x) SliderThumb x -> if (x == m) x (align x)
align x = (x / d) * d align x = (x / d) * d
safeOpenFont :: !FontDef !(PSt .l) -> (Font,PSt .l)
safeOpenFont fdef ps
# ((ok,font),ps) = accScreenPicture (openFont fdef) ps
| not ok
= accScreenPicture openDefaultFont ps
= (font,ps)
safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture); safeOpenFixedFont :: !FontDef !*Picture -> (Font,*Picture);
safeOpenFixedFont fdef pict safeOpenFixedFont fdef pict
# ((ok,fnt),pict) = openFont fdef pict # ((ok,fnt),pict) = openFont fdef pict
......
implementation module logfile implementation module logfile
import StdFile, StdPathname, StdBool import StdFile, StdPathname, StdBool, StdString
openLogfile :: !String !*f -> (!Bool,!*File,!*f) | FileSystem f openLogfile :: !String !*f -> (!Bool,!*File,!*f) | FileSystem f
openLogfile prj_name env openLogfile prj_name env
......
definition module IdePlatform definition module IdePlatform
import StdPSt, StdString import StdPSt, StdString
import StdIOCommon import StdIOCommon
from IdeState import :: General from IdeState import :: General
PlatformProcessAttributes :: [ProcessAttribute *(PSt General)] PlatformProcessAttributes :: [ProcessAttribute *(PSt General)]
RunProgram :: !.String !*(PSt General) -> *PSt General RunProgram :: !.String !*(PSt General) -> *PSt General
SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l
SetProcessIcon :: !Int !(PSt .l) -> PSt .l SetProcessIcon :: !Int !(PSt .l) -> PSt .l
GetDialogBackgroundColour :: !(PSt .l) -> (!Colour, !PSt .l) GetDialogBackgroundColour :: !(PSt .l) -> (!Colour, !PSt .l)
//GetBitmapResource :: !Int !(PSt .l) -> (!Maybe Bitmap,!PSt .l) GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
CleanIcon :== 32512 CleanIcon :== 32512
ProjectIcon :== 32513 ProjectIcon :== 32513
......
implementation module IdePlatform implementation module IdePlatform
import StdPSt import StdEnv
import StdArray, StdEnum, StdList, StdTuple import StdPSt, StdPStClass
import StdFunc import PmCleanSystem
import errwin, conswin
import UtilIO
import EdKeyboard, EdMouse
from iostate import appIOToolbox,accIOToolbox
from clCCall_12 import winLaunchApp,winMakeCString,:: CSTR,:: OSToolbox
import clCrossCall_12, windowaccess, iostate
import pictCCall_12, cast
import code from "Redirect.obj"
import code from "cCrossCallMaarten.obj"
//import dodebug import code from library "conkernel_library"
trace_n` m f :== f import code from library "bmpgdi_library"
PlatformProcessAttributes :: [ProcessAttribute *(PSt General)] PlatformProcessAttributes :: [ProcessAttribute *(PSt General)]
PlatformProcessAttributes = PlatformProcessAttributes =
// []/*
[ ProcessConsoleOpen id [ ProcessConsoleOpen id
, ProcessConsoleQuit consoleKill , ProcessConsoleQuit consoleKill
, ProcessConsoleOut consoleMessageO , ProcessConsoleOut consoleMessageO
, ProcessConsoleErr consoleMessageE , ProcessConsoleErr consoleMessageE
] ]
//*/
//-- Experimental Console Handling/Redirection... //-- Experimental Console Handling/Redirection...
from clCCall_12 import winLaunchApp,:: OSToolbox
import StdBool
import PmCleanSystem
import errwin
import UtilIO, StdPStClass
RunProgram :: !.String !*(PSt General) -> *PSt General RunProgram :: !.String !*(PSt General) -> *PSt General
RunProgram path ps RunProgram path ps
# (ret,ps) = accPIO (accIOToolbox (AddMainWindowHook True)) ps # (ret,ps) = accPIO (accIOToolbox (AddMainWindowHook True)) ps
# ps = trace_n` ("Hook",ret) ps
# (project,ps) = getProject ps # (project,ps) = getProject ps
(redc,ps) = getCurrentRedc ps (redc,ps) = getCurrentRedc ps
ao = PR_GetApplicationOptions project ao = PR_GetApplicationOptions project
...@@ -52,23 +55,12 @@ where ...@@ -52,23 +55,12 @@ where
| didit | didit
= (ps,True) = (ps,True)
= (winfun ["Error: Could not launch the application."] ps,False) = (winfun ["Error: Could not launch the application."] ps,False)
// need to investigate here... # (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 | didit
// # ps = consoleMessageE ("<"+++.path+++." launched>\n") ps
= (ps,True) = (ps,True)
= (winfun ["Error: Could not launch the console application."] ps,False) = (winfun ["Error: Could not launch the console application."] ps,False)
/*
SetWindowIcon :: !Id !Int !(PSt .l) -> PSt .l
SetWindowIcon wId icon pState = pState
*/
//*
import conswin
import EdKeyboard, EdMouse
//-- //--
from iostate import appIOToolbox,accIOToolbox
consWinKeyboard :: .WindowAttribute *(EditState,*PSt *General); consWinKeyboard :: .WindowAttribute *(EditState,*PSt *General);
consWinKeyboard = WindowKeyboard (\ks -> getKeyboardStateKeyState ks == KeyDown False) Able consKeyboard consWinKeyboard = WindowKeyboard (\ks -> getKeyboardStateKeyState ks == KeyDown False) Able consKeyboard
...@@ -80,7 +72,7 @@ consoleMessageI :: !{#Char} !(PSt General) -> PSt General ...@@ -80,7 +72,7 @@ consoleMessageI :: !{#Char} !(PSt General) -> PSt General
consoleMessageI msg ps = updateConsoleWindowI msg [consWinKeyboard,consWinMouse] ps consoleMessageI msg ps = updateConsoleWindowI msg [consWinKeyboard,consWinMouse] ps
consoleMessageO :: !{#Char} !(PSt General) -> PSt General consoleMessageO :: !{#Char} !(PSt General) -> PSt General
consoleMessageO msg ps = trace_n` msg updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps consoleMessageO msg ps = updateConsoleWindowO msg [consWinKeyboard,consWinMouse] ps
consoleMessageE :: !{#Char} !(PSt General) -> PSt General consoleMessageE :: !{#Char} !(PSt General) -> PSt General
consoleMessageE msg ps = updateConsoleWindowE msg [consWinKeyboard,consWinMouse] ps consoleMessageE msg ps = updateConsoleWindowE msg [consWinKeyboard,consWinMouse] ps
...@@ -114,10 +106,6 @@ consKeyboard ks (es,ps) ...@@ -114,10 +106,6 @@ consKeyboard ks (es,ps)
//-- Console bindings... //-- Console bindings...
import code from library "conkernel_library"
import code from "Redirect.obj"
from clCCall_12 import winMakeCString,:: CSTR,:: OSToolbox
AddMainWindowHook :: !Bool !*OSToolbox -> (!Bool,!*OSToolbox) AddMainWindowHook :: !Bool !*OSToolbox -> (!Bool,!*OSToolbox)
AddMainWindowHook _ tb = code { AddMainWindowHook _ tb = code {
ccall AddMainWindowHook "I:I:I" ccall AddMainWindowHook "I:I:I"
...@@ -162,9 +150,6 @@ writeChildProcess` cstr ...@@ -162,9 +150,6 @@ writeChildProcess` cstr
//== //==
import clCrossCall_12, windowaccess, iostate
import code from "cCrossCallMaarten.obj"
winInitialiseTooltips :: !*OSToolbox -> *OSToolbox winInitialiseTooltips :: !*OSToolbox -> *OSToolbox
winInitialiseTooltips _ winInitialiseTooltips _
= code = code
...@@ -180,9 +165,6 @@ osIgnoreCallback _ tb ...@@ -180,9 +165,6 @@ osIgnoreCallback _ tb
//-- //--
import pictCCall_12, StdMisc, cast
import code from library "bmpgdi_library"
CcRqGETBITMAPRESOURCE :== 1477 CcRqGETBITMAPRESOURCE :== 1477
osGetBitmapResource :: !Int !*OSToolbox -> (!(!Int,!String,!Int,!Int),!*OSToolbox) osGetBitmapResource :: !Int !*OSToolbox -> (!(!Int,!String,!Int,!Int),!*OSToolbox)
...@@ -195,16 +177,7 @@ winGetBitmapResource :: !Int !*OSToolbox -> (!Int,!Int,!Int,!*OSToolbox) ...@@ -195,16 +177,7 @@ winGetBitmapResource :: !Int !*OSToolbox -> (!Int,!Int,!Int,!*OSToolbox)
winGetBitmapResource _ _ = code { winGetBitmapResource _ _ = code {
ccall WinGetBitmapResource "II-IIII" ccall WinGetBitmapResource "II-IIII"
} }
/*
# tb = winInitialiseTooltips tb
# (ret,tb) = (issueCleanRequest2 osIgnoreCallback (Rq1Cci CcRqGETBITMAPRESOURCE bitmap_id) tb)
| ret.p1 == 0 = ((0,"",0,0),tb)
# hbitmap = ret.p1
# data = "" //cast ret.p2
# w = ret.p3
# h = ret.p4
= ((hbitmap,data,w,h),tb)
*/
GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env) GetBitmapResource :: !Int !.env -> (!Maybe Bitmap,!.env)
GetBitmapResource bitmap_id ps GetBitmapResource bitmap_id ps
# ((hbmp,data,w,h),_) = osGetBitmapResource bitmap_id OSNewToolbox # ((hbmp,data,w,h),_) = osGetBitmapResource bitmap_id OSNewToolbox
...@@ -255,7 +228,6 @@ SetProcessIcon icon pState=:{io=ioState} ...@@ -255,7 +228,6 @@ SetProcessIcon icon pState=:{io=ioState}
# ioState = ioStSetOSDInfo osdi ioState # ioState = ioStSetOSDInfo osdi ioState
= {pState & io = ioState} = {pState & io = ioState}
//*/
CleanIcon :== 32512 CleanIcon :== 32512
ProjectIcon :== 32513 ProjectIcon :== 32513
AbcmodIcon :== 32514 AbcmodIcon :== 32514
......
...@@ -148,10 +148,6 @@ CompilePollCompleted :: !*env -> (Maybe !(!Int,!Int), !*env) | FileEnv env ...@@ -148,10 +148,6 @@ CompilePollCompleted :: !*env -> (Maybe !(!Int,!Int), !*env) | FileEnv env
CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
// ... RWS
// JVG ...
:: CompilingInfo :: CompilingInfo
InitCompilingInfo :: !*CompilingInfo InitCompilingInfo :: !*CompilingInfo
...@@ -175,7 +171,6 @@ CompilePersistent :: ...@@ -175,7 +171,6 @@ CompilePersistent ::
!*env // env !*env // env
-> (!*CompilingInfo,!(!*env, !Pathname, !CompilerMsg)) -> (!*CompilingInfo,!(!*env, !Pathname, !CompilerMsg))
| FileEnv env | FileEnv env
// ... JVG
ClearCompilerCaches :: !Int !.a -> (!Int,!.a) ClearCompilerCaches :: !Int !.a -> (!Int,!.a)
StartCodeGenerator :: !String !(WindowFun *(PSt .l)) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !ApplicationOptions !Pathname !*(PSt .l) -> (!Bool,!Pathname,!*(PSt .l)) StartCodeGenerator :: !String !(WindowFun *(PSt .l)) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !ApplicationOptions !Pathname !*(PSt .l) -> (!Bool,!Pathname,!*(PSt .l))
......
definition module UtilIO definition module UtilIO
import StdString, StdFile import StdString, StdFile
import StdPSt, StdMaybe
import UtilDate import UtilDate
LaunchApplication :: !{#Char} !{#Char} !Bool !Files -> ( !Bool, !Files) LaunchApplication :: !{#Char} !{#Char} !Bool !Files -> ( !Bool, !Files)
...@@ -25,8 +26,6 @@ GetShortPathName :: !String -> (!Bool,!String); ...@@ -25,8 +26,6 @@ GetShortPathName :: !String -> (!Bool,!String);
GetCurrentDirectory :: (!Bool,!String) GetCurrentDirectory :: (!Bool,!String)
import StdPSt, StdMaybe
selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l)) selectDirectory` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l)) ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l))
...@@ -10,9 +10,8 @@ import StdSystem ...@@ -10,9 +10,8 @@ import StdSystem
import code from library "util_io_kernel_lib" import code from library "util_io_kernel_lib"
import code from library "util_io_shell_lib" import code from library "util_io_shell_lib"
//dirseparator :== '\\' // OS separator between folder- and filenames in a pathname
//-- //--
CcRqSHELLDEFAULT :== 1476 CcRqSHELLDEFAULT :== 1476
osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox) osIgnoreCallback :: !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
......
definition module UtilNewlinesFile definition module UtilNewlinesFile
//1.3
from StdString import String
//3.1
from StdClass import class ==, class toString from StdClass import class ==, class toString
:: NewlineConvention :: NewlineConvention
......
...@@ -45,10 +45,10 @@ Global ...@@ -45,10 +45,10 @@ Global
Path: {Project}\Util Path: {Project}\Util
Path: {Project}\Interfaces\LinkerInterface Path: {Project}\Interfaces\LinkerInterface
Path: {Project}\Interfaces\ProverOptions Path: {Project}\Interfaces\ProverOptions
Path: {Application}\ArgEnvWindows
Path: {Application}\Directory
Path: {Application}\WrapDebug
Path: {Project}\Win\PatchConsoleEvents Path: {Project}\Win\PatchConsoleEvents
Path: {Project}\Win\ArgEnvWindows
Path: {Project}\Win\Directory
Path: {Project}\Registry
Precompile: Precompile:
Postlink: Postlink:
MainModule MainModule
...@@ -66,16 +66,16 @@ MainModule ...@@ -66,16 +66,16 @@ MainModule
ReuseUniqueNodes: True ReuseUniqueNodes: True
Dcl Dcl
WindowPosition WindowPosition
X: 211 X: 45
Y: 0 Y: 69
SizeX: 789 SizeX: 955
SizeY: 496 SizeY: 549
DclOpen: False DclOpen: False
Icl Icl
WindowPosition WindowPosition
X: 57 X: 43
Y: 228 Y: 2
SizeX: 784 SizeX: 955
SizeY: 414 SizeY: 549
IclOpen: False IclOpen: False
LastModified: No 0 0 0 0 0 0 LastModified: No 0 0 0 0 0 0
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
#define VERSION_RES_STRING "2.0.1.42\0" #define VERSION_RES_STRING "2.0.1.42\0"
#define VERSION_RES_PRODUCT_NAME "CleanIde\0" #define VERSION_RES_PRODUCT_NAME "CleanIde\0"
#define VERSION_RES_COMPANY_NAME "University of Nijmegen\0" #define VERSION_RES_COMPANY_NAME "University of Nijmegen\0"
#define VERSION_RES_COPYRIGHT "Copyright (C) 2001 University of Nijmegen.\0" #define VERSION_RES_COPYRIGHT "Copyright (C) 1987--2001 University of Nijmegen.\0"
32512 ICON icons\clean_exe.ico 32512 ICON icons\clean_exe.ico
32513 ICON icons\clean_prj.ico 32513 ICON icons\clean_prj.ico
......
No preview for this file type
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