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

cleanup for Clean2 release

parent af9b4495
implementation module syncol
/*
syncol: provides preparsing for Clean syntax colouring.
*/
// provides preparsing for Clean syntax colouring.
import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StrictList
......@@ -133,7 +131,7 @@ SC c h = \t -> c (SCons h t)
//--
/*
Extension to datatype definities simple...
Extension to datatype definitions simple...
Need to replace Int by alg datatype
int now indicates comment nesting level...
need to differentiate is/isn't dtd
......
definition module EdClient
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
// only this module should be imported by users of the editor
/*
* EdClient.dcl: only this module should be imported by users of the editor
*/
import StdMaybe, StdId, StdPSt, StdPicture, StdPrint
from EdState import class Editor, :: EditorState
from EdMessage import :: EditId, :: EditAction
from EdLineText import :: Text
import EdPosition
from EdSelection import :: Selection, emptySelection, lineSelection
from EdMonad import :: UndoState, :: EditMonad, :: EditState, :: StateM, getPathName
import IdeState
import StdMaybe, StdId, StdPSt, StdPicture, StdPrint
from EdState import class Editor, :: EditorState
from EdMessage import :: EditId, :: EditAction
from EdLineText import :: Text
import EdPosition
from EdSelection import :: Selection, emptySelection, lineSelection
from EdMonad import :: UndoState, :: EditMonad, :: EditState, :: StateM, getPathName
import IdeState
isEditWin :: Id *(PSt *l) -> *(Bool,*PSt *l) | Editor l
......
implementation module EdClient
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
/*
* EdClient.icl: only this module should be imported by users of the editor
*/
// only this module should be imported by users of the editor
import StdTuple, StdList, StdArray, StdMisc, StdEnum
import StdWindow, StdClipboard, StdPSt, StdPrintText, StdId, StdPStClass
......@@ -694,12 +675,12 @@ where
msgReplaceAll :: !FRInfo -> EditAction General Int
msgReplaceAll fr =
// vlaggetjes afhandelen...
// handle flags...
// ignore_case
// match_words
// backwards <- zinloze vlag...
// wraparound <- ook zinloos...
// backwards <- pointless flag...
// wraparound <- pointless flag...
// regexp
getText >>>= \text ->
......@@ -798,7 +779,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 LeftJustify//RightJustify
((_,printsetup),env) = printText2 path "page " True LeftJustify
fdef
info.tabSize
textstream
......
definition module IDE
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
import StdPSt
from PmTypes import :: Modulename
//import PmProject
from EdClient import :: Selection, :: Position, :: ColumnNr, :: LineNr
from IdeState import :: General
import StdPSt
from PmTypes import :: Modulename
from EdClient import :: Selection, :: Position, :: ColumnNr, :: LineNr
from IdeState import :: General
OpenModule :: !.Modulename !.Selection !*(PSt General) -> *PSt General
implementation module IDE
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
//=>*********************************************************************************
//=> Clean Integrated Development Environment Module
//=> Copyright : 1999 -- 2001
//=> : Hilt - High Level Software Tools B.V.
//=> : University of Nijmegen
//=> e-mail : clean@cs.kun.nl or rinus@hilt.nl
//=> License : xxxxx
//=>*********************************************************************************
import StdArray, StdEnum, StdFunc, StdMisc, StdTuple, StdOrdList
import StdFileSelect,StdMenu,StdMenuReceiver,StdProcess, StdPStClass
import ExtNotice
......@@ -59,7 +32,7 @@ import Platform, IdePlatform
import PmDriver
import ArgEnv
import logfile, set_return_code
import logfile, set_return_code, first_run
import StdSystem
trace_n _ f :== f
......@@ -77,10 +50,10 @@ Start world
// check for EnvsDir existence here...
// check for TooltempDir existence here...
# prefspath = MakeFullPathname PrefsDir PrefsFileName//applicationpath PrefsFileName
# prefspath = MakeFullPathname PrefsDir PrefsFileName
#! (prefs,world) = openPrefs prefspath world
# envspath = MakeFullPathname EnvsDir EnvsFileName //applicationpath EnvsFileName
# envspath = MakeFullPathname EnvsDir EnvsFileName
#! (iniTargets,world)
= openEnvironments stup envspath world
......@@ -132,7 +105,7 @@ Start world
pini = ini envspath prefspath
mEditId mEdUndoId iniClip iniTargets mTargetId
eTargetId mProjectId mPrListId mPrRecId mFhMenId
mPhMenId ids prefs
mPhMenId ids
| interact
= startIO MDI pub pini patt world
// not interact
......@@ -147,50 +120,50 @@ where
= ([],world)
# items = []
# (items,world) = toolIconFun
srchBM//"bitmaps\\srchBM.bmp"
srchBM
(Just "Search...")
(sr_find_idi True)
items world
# (items,world) = toolIconFun
findBM//"bitmaps\\findBM.bmp"
findBM
(Just "Find...")
sr_find
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
/* # (items,world) = toolIconFun
execBM//"bitmaps\\execBM.bmp"
execBM
(Just "Run")
pm_run
items world
*/ # (items,world) = toolIconFun
updtBM//"bitmaps\\updtBM.bmp"
updtBM
(Just "Update")
(pm_upto False)
items world
# (items,world) = toolIconFun
urunBM//"bitmaps\\urunBM.bmp"
urunBM
(Just "Update and Run")
pm_exec
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun
prntBM//"bitmaps\\prntBM.bmp"
prntBM
(Just "Print...")
ed_print
items world
# items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun
saveBM//"bitmaps\\saveBM.bmp"
saveBM
(Just "Save")
(ide_save NoModifiers)
items world
# (items,world) = toolIconFun
openBM//"bitmaps\\openBM.bmp"
openBM
(Just "Open...")
(ed_open NoModifiers)
items world
# (items,world) = toolIconFun
newfBM//"bitmaps\\newfBM.bmp"
newfBM
(Just "New...")
(ed_new "*.icl")
items world
......@@ -202,7 +175,7 @@ where
// # (bmp,world) = openBitmap (applicationpath toolname) world
# (bmp,world) = GetBitmapResource toolname world
# itemlist = case bmp of
Nothing -> abort ("Loading failed: "+++toString toolname)//itemlist
Nothing -> abort ("Loading failed: "+++toString toolname)
Just bmp -> [ToolbarItem bmp tooltip toolfun:itemlist]
= (itemlist,world)
ini envspath prefspath mEditId mEdUndoId iniClip iniTargets mTargetId eTargetId
......@@ -214,7 +187,22 @@ where
, mPrNewId, mPrOpenId
, quitId
: _
] prefs=:{altgr_workaround} ps
] ps
# (prefs,ps) = getPrefs ps
# (ide_vers,ide_name,ide_path) = GetVNP
# pcl_name = prefs.reg_prefs.tp_name
# pcl_path = prefs.reg_prefs.tp_path
# hcl_name = prefs.reg_prefs.hp_name
# hcl_path = prefs.reg_prefs.hp_path
# flags = prefs.reg_prefs.rp_flags
# (res,ps) = first_run ide_vers ide_name ide_path pcl_name pcl_path hcl_name hcl_path flags ps
# ps = case res of
True # flags = take 10 [(ide_name,ide_path,ide_vers):flags]
# prefs = {prefs & reg_prefs.rp_flags = flags}
-> setPrefs prefs ps
_ -> ps
# (fhRecId,ps) = getFHI ps
# (phRecId,ps) = getPHI ps
......@@ -223,10 +211,10 @@ where
| err <> NoError
= abort "unable to open File menu"
# (editRecId,ps)= getEditRecId ps
# (err,ps) = openMenu iniEditLS (editMenu altgr_workaround mEditId editRecId menuIds.mn_sav menuIds.mn_rev menuIds iniClip) ps
# (err,ps) = openMenu iniEditLS (editMenu prefs.altgr_workaround mEditId editRecId menuIds.mn_sav menuIds.mn_rev menuIds iniClip) ps
| err <> NoError
= abort "unable to open Edit menu"
# (err,ps) = openMenu Void (searchMenu altgr_workaround mSearchId menuIds.searchIds) ps
# (err,ps) = openMenu Void (searchMenu prefs.altgr_workaround mSearchId menuIds.searchIds) ps
| err <> NoError
= abort "unable to open Search menu"
# (err,ps) = openMenu Void (projectMenu mProjectId mPrOpenId mPrListId mPrRecId menuIds prefs) ps
......@@ -250,9 +238,9 @@ where
# ps = appPLoc (setTypeWinInfo twi) ps
# (files,ps) = initPlatformCommandLine ps
# ps = openfiles files ps
# ps = SetProcessIcon CleanIcon ps
# ps = SetProcessIcon CleanIcon ps
= installPlatformEventHandlers ps
ini _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ps = abort "IDE.icl: ini called with insufficient id's"
ini _ _ _ _ _ _ _ _ _ _ _ _ _ _ ps = abort "IDE.icl: ini called with insufficient id's"
batchOptions world
= case [arg \\ arg <-: getCommandLine] of
[_, "--batch-build", prj]
......@@ -511,7 +499,7 @@ moduleMenu {md_cmp,md_chk,md_gen,md_cst,md_est} =
[ MenuFunction (noLS pm_copt)
, MenuId md_cst
, MenuSelectState Unable
, MenuShortKey 'J' // 'Fix' ctrl-J -> newline bug.
, MenuShortKey 'J' // 'Fix' ctrl-J -> newline bug.
]
/*
:+: MenuItem "Editor Settings..."
......@@ -778,7 +766,6 @@ where
( EditControl (if openImp ".icl" ".dcl") (PixelWidth 200) 1
[ ControlId textId
, ControlKeyboard filterReturnKeys Able (\_ -> noLS (dfun True))
// , ControlActivate (noLS (setControlSelection))
]
:+: ButtonControl "Cancel"
[ ControlPos (Left,zero)
......@@ -897,9 +884,9 @@ editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, m
:+: MenuItem "&Balance" [ MenuId (mg_edt!!2), MenuShortKey 'B', MenuFunction (noLS ed_Balance)]
:+: MenuItem "Select &All" [ MenuId (mg_edt!!3), MenuShortKey 'A', MenuFunction (noLS ed_SelectAll)]
:+: MenuItem "&Detab" [ MenuId (mg_edt!!4), MenuFunction (noLS detabfun)]
:+: MenuItem "Add Prefix" [ MenuId (mg_edt!!5), MenuFunction (noLS add_prefix_selection)]
:+: MenuItem "Remove Prefix" [ MenuId (mg_edt!!6), MenuFunction (noLS rem_prefix_selection)]
:+: MenuItem "Change Prefix..." [ MenuId (mg_edt!!7), MenuFunction (noLS change_prefix_dlog)]
:+: MenuItem "Add Pre&fix" [ MenuId (mg_edt!!5), MenuFunction (noLS add_prefix_selection)]
:+: MenuItem "Remove Pref&ix" [ MenuId (mg_edt!!6), MenuFunction (noLS rem_prefix_selection)]
:+: MenuItem "Change Prefi&x..." [ MenuId (mg_edt!!7), MenuFunction (noLS change_prefix_dlog)]
:+: MenuSeparator []
:+: MenuItem "Next &Window"
[ MenuModsFunction stackfun
......@@ -909,7 +896,10 @@ editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, m
// Wrap...
// :+: MenuItem "Wrap1320" [MenuShortKey '`', MenuFunction (noLS wrap_preprocessor)]
// ...Wrap
:+: MenuItem "Defs..." [MenuShortKey '`', MenuFunction (noLS popup_funs)]
:+: MenuItem "List Defi&nitions..."
[ MenuFunction (noLS popup_funs)
: if altgr_workaround [] [MenuShortKey '`']
]
)
[ MenuId (mEditId)
]
......
definition module IdeState
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
import StdPSt, StdPrint
import ExtListBox, FilteredListBox
import fbi, clipboard, typewin
import EdState
import PmProject
import PmPrefs
import flextextcontrol
from PmAbcMagic import :: ABCCache
from PmFileInfo import :: FileInfoCache
import PmEnvironment
import conswin
import StdPSt, StdPrint
import ExtListBox, FilteredListBox
import fbi, clipboard, typewin
import EdState
import PmProject
import PmPrefs
import flextextcontrol
from PmAbcMagic import :: ABCCache
from PmFileInfo import :: FileInfoCache
import PmEnvironment
import conswin
:: *General
......@@ -244,6 +227,3 @@ setInteract :: !Bool !*(PSt *General) -> !*PSt *General
writeLog :: !String !*(PSt *General) -> !*PSt *General
abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General
//-- Console support...
implementation module IdeState
//*********************************************************************************
// Original Clean Library Software Module
// Written for Clean version : 1.3
// Written for I/O version : 1.2
// Author : Diederik van Arkel
// Date :
// Last Modified by :
// Date :
// Copyright : 1999 Hilt - High Level Software Tools B.V.
// : University of Nijmegen
// e-mail : clean@cs.kun.nl or rinus@hilt.nl
//*********************************************************************************
// It is allowed to modify this module for your own purposes but it is NOT allowed
// to (re)distribute the code or the modified code in ANY form without written
// permission.
//*********************************************************************************
import ExtListBox, FilteredListBox
import EdState
import PmPath, PmProject, PmPrefs, PmFileInfo
......@@ -371,10 +354,10 @@ setFI :: !FindInfo !*(PSt *General) -> !*PSt *General
setFI ei ps = appPLoc (\p->{p & ed_find = ei}) ps
getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getPath ps = accPLoc (\p=:{pr_path}->(pr_path,p)) ps
getPath ps = accPLoc (\p=:{General | pr_path}->(pr_path,p)) ps
setPath :: !Pathname !*(PSt *General) -> !*PSt *General
setPath ts ps = appPLoc (\p->{p & pr_path = ts}) ps
setPath ts ps = appPLoc (\p->{General | p & pr_path = ts}) ps
getStup :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getStup ps = accPLoc (\p=:{pr_stup}->(pr_stup,p)) ps
......@@ -512,7 +495,9 @@ abortLog flag message ps
= closeProcess ps
//-- Console support...
import conswin
instance Consoler General
where
getConsWinInfo gen=:{cons_info} = (cons_info,gen)
......
......@@ -7,7 +7,6 @@ import tabcontrol, ExtListBox, ioutil, IdeState
import ExtNotice, UtilIO
import Platform
//import dodebug
:: PO_LS =
{ ao :: !ApplicationOptions
......@@ -167,22 +166,42 @@ where
applicationPane = Pane "Application"
// heap size
( TextControl "Application Options" []
:+: EditControl (IntToMemSize ao.hs) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId hsId]
:+: EditControl (IntToMemSize ao.hs) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId hsId
, ControlActivate (noLS (appPIO (setEditControlSelection hsId 1 0)))
]
:+: TextControl "Maximum Heap Size" []
// stack size
:+: EditControl (IntToMemSize ao.ss) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId ssId]
:+: EditControl (IntToMemSize ao.ss) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId ssId
, ControlActivate (noLS (appPIO (setEditControlSelection ssId 1 0)))
]
:+: TextControl "Stack Size" []
:+: PlatformDependant // extra memory (want only on mac...)
(NilLS) // win
( // mac
EditControl (IntToMemSize ao.em) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId emId]
EditControl (IntToMemSize ao.em) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId emId
, ControlActivate (noLS (appPIO (setEditControlSelection emId 1 0)))
]
:+: TextControl "Extra Memory" []
)
// next heap size factor
:+: EditControl (FixedPointToString ao.heap_size_multiple) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId hmId]
:+: EditControl (FixedPointToString ao.heap_size_multiple) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId hmId
, ControlActivate (noLS (appPIO (setEditControlSelection hmId 1 0)))
]
:+: TextControl "Next Heap Size Factor" []
// initial heap size
:+: EditControl (IntToMemSize ao.initial_heap_size) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId ihId]
:+: EditControl (IntToMemSize ao.initial_heap_size) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId ihId
, ControlActivate (noLS (appPIO (setEditControlSelection ihId 1 0)))
]
:+: TextControl "Initial Heap Size" []
// marking collector
:+: CheckControl
......@@ -240,7 +259,11 @@ where
:+: CheckControl
[("Heap Profile",Nothing,toMark ao.memoryProfiling, noPS (\l->{l & ao = {l.ao & memoryProfiling = not l.ao.memoryProfiling}}))]
(Columns 1) [ControlPos (Left,zero)]
:+: EditControl (IntToMemSize ao.memoryProfilingMinimumHeapSize) (PixelWidth 100) 1 [ControlPos (Left,zero),ControlId mhId]
:+: EditControl (IntToMemSize ao.memoryProfilingMinimumHeapSize) (PixelWidth 100) 1
[ ControlPos (Left,zero)
, ControlId mhId
, ControlActivate (noLS (appPIO (setEditControlSelection mhId 1 0)))
]
:+: TextControl "Minimum Profile Heap" []
)
diagnosticsPane = Pane "Diagnostics"
......
......@@ -83,7 +83,7 @@ deactivate ps
clipMenuItems :: !Id !Id !ClipInfo -> .MenuItem .c *(PSt *l) | Clipper , Editor l
clipMenuItems mn_sav mn_rev ci
= MenuItem "Show Clipboard" [MenuFunction (noLS showClip), MenuId ci.clip_itemId]
= MenuItem "&Show Clipboard" [MenuFunction (noLS showClip), MenuId ci.clip_itemId]
where
showClip ps
# (ci,ps) = getClipInfo ps
......
......@@ -142,8 +142,8 @@ openConsoleWindow cwi text atts ps
, WindowId windowId
, WindowViewDomain viewDomain
, WindowLook True editLook
, WindowHScroll (hScrollFun fontInfo)
, WindowVScroll (vScrollFun fontInfo)
, WindowHScroll (altScrollFunction Horizontal fontInfo.metrics.fMaxWidth)
, WindowVScroll (alignScrollFunction Vertical fontInfo.FontInfo.lineHeight)
, WindowPos (Fix, OffsetVector cwi.tpos)
, WindowClose (noLS (cw_close o cw_deactivate)) // be careful here if editable...
, WindowActivate (noLS (cw_activate))
......@@ -194,15 +194,6 @@ cw_deactivate ps
# io = enableMenuElements twi.ids io
= {ps & io = io}
/**********************
* SCROLLBAR HANDLING *
**********************/
hScrollFun fontInfo
:== altScrollFunction Horizontal fontInfo.metrics.fMaxWidth
vScrollFun fontInfo
:== alignScrollFunction Vertical fontInfo.FontInfo.lineHeight
//-- cons win options...
import morecontrols, colorpickcontrol, ioutil, colourclip
......@@ -487,7 +478,7 @@ where
# (twi,ps) = accPLoc getConsWinInfo ps
# sync = getConSync twi
# sync = sc_update sync
# (font,ps) = safeOpen {fName = fn, fSize = fs, fStyles = []} ps
# (font,ps) = safeOpenFont {fName = fn, fSize = fs, fStyles = []} ps
# twi = setConSync sync twi
# twi = setConFont font twi
# ps = appPLoc (setConsWinInfo twi) ps
......@@ -508,10 +499,3 @@ where
, stringColour = mod
, backgroundColour = bck
}
safeOpen fdef ps
# ((ok,font),ps) = accScreenPicture (openFont fdef) ps
| not ok
= accScreenPicture openDefaultFont ps
= (font,ps)
......@@ -4,7 +4,6 @@ from StdId import :: Id
from StdPSt import :: PSt
from IdeState import :: General
from EdClient import :: Selection
//from EdClient import Editor, EditorState, Selection, Position, ColumnNr, LineNr
ed_ask_save_all :: !Bool (*(PSt General) -> *PSt General) !*(PSt General) -> *PSt General
// cycle through modified edit windows asking user if they should be saved
......
......@@ -180,7 +180,6 @@ where
ed_activate :: !String !*(!EditState,!*PSt General) -> *(EditState,*PSt General)