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

cleanup for Clean2 release

parent af9b4495
implementation module syncol implementation module syncol
/* // provides preparsing for Clean syntax colouring.
syncol: provides preparsing for Clean syntax colouring.
*/
import StdArray, StdClass, StdBool, StdList, StdFunc, StdString import StdArray, StdClass, StdBool, StdList, StdFunc, StdString
import StrictList import StrictList
...@@ -133,7 +131,7 @@ SC c h = \t -> c (SCons h t) ...@@ -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 Need to replace Int by alg datatype
int now indicates comment nesting level... int now indicates comment nesting level...
need to differentiate is/isn't dtd need to differentiate is/isn't dtd
......
definition module EdClient definition module EdClient
//********************************************************************************* // only this module should be imported by users of the editor
// 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 StdMaybe, StdId, StdPSt, StdPicture, StdPrint
* EdClient.dcl: only this module should be imported by users of the editor from EdState import class Editor, :: EditorState
*/ from EdMessage import :: EditId, :: EditAction
from EdLineText import :: Text
import StdMaybe, StdId, StdPSt, StdPicture, StdPrint import EdPosition
from EdState import class Editor, :: EditorState from EdSelection import :: Selection, emptySelection, lineSelection
from EdMessage import :: EditId, :: EditAction from EdMonad import :: UndoState, :: EditMonad, :: EditState, :: StateM, getPathName
from EdLineText import :: Text import IdeState
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 isEditWin :: Id *(PSt *l) -> *(Bool,*PSt *l) | Editor l
......
implementation module EdClient implementation module EdClient
//********************************************************************************* // only this module should be imported by users of the editor
// 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
*/
import StdTuple, StdList, StdArray, StdMisc, StdEnum import StdTuple, StdList, StdArray, StdMisc, StdEnum
import StdWindow, StdClipboard, StdPSt, StdPrintText, StdId, StdPStClass import StdWindow, StdClipboard, StdPSt, StdPrintText, StdId, StdPStClass
...@@ -694,12 +675,12 @@ where ...@@ -694,12 +675,12 @@ where
msgReplaceAll :: !FRInfo -> EditAction General Int msgReplaceAll :: !FRInfo -> EditAction General Int
msgReplaceAll fr = msgReplaceAll fr =
// vlaggetjes afhandelen... // handle flags...
// ignore_case // ignore_case
// match_words // match_words
// backwards <- zinloze vlag... // backwards <- pointless flag...
// wraparound <- ook zinloos... // wraparound <- pointless flag...
// regexp // regexp
getText >>>= \text -> getText >>>= \text ->
...@@ -798,7 +779,7 @@ msgPrint printSetup ...@@ -798,7 +779,7 @@ msgPrint printSetup
myPrintText :: !PrintSetup !String !Text !FontInfo !Bool !*env -> (PrintSetup,*env) | PrintEnvironments env myPrintText :: !PrintSetup !String !Text !FontInfo !Bool !*env -> (PrintSetup,*env) | PrintEnvironments env
myPrintText printsetup path text info linenos env myPrintText printsetup path text info linenos env
# fdef = getFontDef info.thefont # fdef = getFontDef info.thefont
((_,printsetup),env) = printText2 path "page " True LeftJustify//RightJustify ((_,printsetup),env) = printText2 path "page " True LeftJustify
fdef fdef
info.tabSize info.tabSize
textstream textstream
......
definition module IDE definition module IDE
//********************************************************************************* import StdPSt
// Original Clean Library Software Module from PmTypes import :: Modulename
// Written for Clean version : 1.3 from EdClient import :: Selection, :: Position, :: ColumnNr, :: LineNr
// Written for I/O version : 1.2 from IdeState import :: General
// 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
OpenModule :: !.Modulename !.Selection !*(PSt General) -> *PSt General OpenModule :: !.Modulename !.Selection !*(PSt General) -> *PSt General
implementation module IDE 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 StdArray, StdEnum, StdFunc, StdMisc, StdTuple, StdOrdList
import StdFileSelect,StdMenu,StdMenuReceiver,StdProcess, StdPStClass import StdFileSelect,StdMenu,StdMenuReceiver,StdProcess, StdPStClass
import ExtNotice import ExtNotice
...@@ -59,7 +32,7 @@ import Platform, IdePlatform ...@@ -59,7 +32,7 @@ import Platform, IdePlatform
import PmDriver import PmDriver
import ArgEnv import ArgEnv
import logfile, set_return_code import logfile, set_return_code, first_run
import StdSystem import StdSystem
trace_n _ f :== f trace_n _ f :== f
...@@ -77,10 +50,10 @@ Start world ...@@ -77,10 +50,10 @@ Start world
// check for EnvsDir existence here... // check for EnvsDir existence here...
// check for TooltempDir existence here... // check for TooltempDir existence here...
# prefspath = MakeFullPathname PrefsDir PrefsFileName//applicationpath PrefsFileName # prefspath = MakeFullPathname PrefsDir PrefsFileName
#! (prefs,world) = openPrefs prefspath world #! (prefs,world) = openPrefs prefspath world
# envspath = MakeFullPathname EnvsDir EnvsFileName //applicationpath EnvsFileName # envspath = MakeFullPathname EnvsDir EnvsFileName
#! (iniTargets,world) #! (iniTargets,world)
= openEnvironments stup envspath world = openEnvironments stup envspath world
...@@ -132,7 +105,7 @@ Start world ...@@ -132,7 +105,7 @@ Start world
pini = ini envspath prefspath pini = ini envspath prefspath
mEditId mEdUndoId iniClip iniTargets mTargetId mEditId mEdUndoId iniClip iniTargets mTargetId
eTargetId mProjectId mPrListId mPrRecId mFhMenId eTargetId mProjectId mPrListId mPrRecId mFhMenId
mPhMenId ids prefs mPhMenId ids
| interact | interact
= startIO MDI pub pini patt world = startIO MDI pub pini patt world
// not interact // not interact
...@@ -147,50 +120,50 @@ where ...@@ -147,50 +120,50 @@ where
= ([],world) = ([],world)
# items = [] # items = []
# (items,world) = toolIconFun # (items,world) = toolIconFun
srchBM//"bitmaps\\srchBM.bmp" srchBM
(Just "Search...") (Just "Search...")
(sr_find_idi True) (sr_find_idi True)
items world items world
# (items,world) = toolIconFun # (items,world) = toolIconFun
findBM//"bitmaps\\findBM.bmp" findBM
(Just "Find...") (Just "Find...")
sr_find sr_find
items world items world
# items = if (isEmpty items) [] [ToolbarSeparator:items] # items = if (isEmpty items) [] [ToolbarSeparator:items]
/* # (items,world) = toolIconFun /* # (items,world) = toolIconFun
execBM//"bitmaps\\execBM.bmp" execBM
(Just "Run") (Just "Run")
pm_run pm_run
items world items world
*/ # (items,world) = toolIconFun */ # (items,world) = toolIconFun
updtBM//"bitmaps\\updtBM.bmp" updtBM
(Just "Update") (Just "Update")
(pm_upto False) (pm_upto False)
items world items world
# (items,world) = toolIconFun # (items,world) = toolIconFun
urunBM//"bitmaps\\urunBM.bmp" urunBM
(Just "Update and Run") (Just "Update and Run")
pm_exec pm_exec
items world items world
# items = if (isEmpty items) [] [ToolbarSeparator:items] # items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun # (items,world) = toolIconFun
prntBM//"bitmaps\\prntBM.bmp" prntBM
(Just "Print...") (Just "Print...")
ed_print ed_print
items world items world
# items = if (isEmpty items) [] [ToolbarSeparator:items] # items = if (isEmpty items) [] [ToolbarSeparator:items]
# (items,world) = toolIconFun # (items,world) = toolIconFun
saveBM//"bitmaps\\saveBM.bmp" saveBM
(Just "Save") (Just "Save")
(ide_save NoModifiers) (ide_save NoModifiers)
items world items world
# (items,world) = toolIconFun # (items,world) = toolIconFun
openBM//"bitmaps\\openBM.bmp" openBM
(Just "Open...") (Just "Open...")
(ed_open NoModifiers) (ed_open NoModifiers)
items world items world
# (items,world) = toolIconFun # (items,world) = toolIconFun
newfBM//"bitmaps\\newfBM.bmp" newfBM
(Just "New...") (Just "New...")
(ed_new "*.icl") (ed_new "*.icl")
items world items world
...@@ -202,7 +175,7 @@ where ...@@ -202,7 +175,7 @@ where
// # (bmp,world) = openBitmap (applicationpath toolname) world // # (bmp,world) = openBitmap (applicationpath toolname) world
# (bmp,world) = GetBitmapResource toolname world # (bmp,world) = GetBitmapResource toolname world
# itemlist = case bmp of # itemlist = case bmp of
Nothing -> abort ("Loading failed: "+++toString toolname)//itemlist Nothing -> abort ("Loading failed: "+++toString toolname)
Just bmp -> [ToolbarItem bmp tooltip toolfun:itemlist] Just bmp -> [ToolbarItem bmp tooltip toolfun:itemlist]
= (itemlist,world) = (itemlist,world)
ini envspath prefspath mEditId mEdUndoId iniClip iniTargets mTargetId eTargetId ini envspath prefspath mEditId mEdUndoId iniClip iniTargets mTargetId eTargetId
...@@ -214,7 +187,22 @@ where ...@@ -214,7 +187,22 @@ where
, mPrNewId, mPrOpenId , mPrNewId, mPrOpenId
, quitId , 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 # (fhRecId,ps) = getFHI ps
# (phRecId,ps) = getPHI ps # (phRecId,ps) = getPHI ps
...@@ -223,10 +211,10 @@ where ...@@ -223,10 +211,10 @@ where
| err <> NoError | err <> NoError
= abort "unable to open File menu" = abort "unable to open File menu"
# (editRecId,ps)= getEditRecId ps # (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 | err <> NoError
= abort "unable to open Edit menu" = 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 | err <> NoError
= abort "unable to open Search menu" = abort "unable to open Search menu"
# (err,ps) = openMenu Void (projectMenu mProjectId mPrOpenId mPrListId mPrRecId menuIds prefs) ps # (err,ps) = openMenu Void (projectMenu mProjectId mPrOpenId mPrListId mPrRecId menuIds prefs) ps
...@@ -250,9 +238,9 @@ where ...@@ -250,9 +238,9 @@ where
# ps = appPLoc (setTypeWinInfo twi) ps # ps = appPLoc (setTypeWinInfo twi) ps
# (files,ps) = initPlatformCommandLine ps # (files,ps) = initPlatformCommandLine ps
# ps = openfiles files ps # ps = openfiles files ps
# ps = SetProcessIcon CleanIcon ps # ps = SetProcessIcon CleanIcon ps
= installPlatformEventHandlers 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 batchOptions world
= case [arg \\ arg <-: getCommandLine] of = case [arg \\ arg <-: getCommandLine] of
[_, "--batch-build", prj] [_, "--batch-build", prj]
...@@ -511,7 +499,7 @@ moduleMenu {md_cmp,md_chk,md_gen,md_cst,md_est} = ...@@ -511,7 +499,7 @@ moduleMenu {md_cmp,md_chk,md_gen,md_cst,md_est} =
[ MenuFunction (noLS pm_copt) [ MenuFunction (noLS pm_copt)
, MenuId md_cst , MenuId md_cst
, MenuSelectState Unable , MenuSelectState Unable
, MenuShortKey 'J' // 'Fix' ctrl-J -> newline bug. , MenuShortKey 'J' // 'Fix' ctrl-J -> newline bug.
] ]
/* /*
:+: MenuItem "Editor Settings..." :+: MenuItem "Editor Settings..."
...@@ -778,7 +766,6 @@ where ...@@ -778,7 +766,6 @@ where
( EditControl (if openImp ".icl" ".dcl") (PixelWidth 200) 1 ( EditControl (if openImp ".icl" ".dcl") (PixelWidth 200) 1
[ ControlId textId [ ControlId textId
, ControlKeyboard filterReturnKeys Able (\_ -> noLS (dfun True)) , ControlKeyboard filterReturnKeys Able (\_ -> noLS (dfun True))
// , ControlActivate (noLS (setControlSelection))
] ]
:+: ButtonControl "Cancel" :+: ButtonControl "Cancel"
[ ControlPos (Left,zero) [ ControlPos (Left,zero)
...@@ -897,9 +884,9 @@ editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, m ...@@ -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 "&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 "Select &All" [ MenuId (mg_edt!!3), MenuShortKey 'A', MenuFunction (noLS ed_SelectAll)]
:+: MenuItem "&Detab" [ MenuId (mg_edt!!4), MenuFunction (noLS detabfun)] :+: MenuItem "&Detab" [ MenuId (mg_edt!!4), MenuFunction (noLS detabfun)]
:+: MenuItem "Add Prefix" [ MenuId (mg_edt!!5), MenuFunction (noLS add_prefix_selection)] :+: MenuItem "Add Pre&fix" [ MenuId (mg_edt!!5), MenuFunction (noLS add_prefix_selection)]
:+: MenuItem "Remove Prefix" [ MenuId (mg_edt!!6), MenuFunction (noLS rem_prefix_selection)] :+: MenuItem "Remove Pref&ix" [ MenuId (mg_edt!!6), MenuFunction (noLS rem_prefix_selection)]
:+: MenuItem "Change Prefix..." [ MenuId (mg_edt!!7), MenuFunction (noLS change_prefix_dlog)] :+: MenuItem "Change Prefi&x..." [ MenuId (mg_edt!!7), MenuFunction (noLS change_prefix_dlog)]
:+: MenuSeparator [] :+: MenuSeparator []
:+: MenuItem "Next &Window" :+: MenuItem "Next &Window"
[ MenuModsFunction stackfun [ MenuModsFunction stackfun
...@@ -909,7 +896,10 @@ editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, m ...@@ -909,7 +896,10 @@ editMenu altgr_workaround mEditId editRecId mFileSaveId mFileRevertId {mn_und, m
// Wrap... // Wrap...
// :+: MenuItem "Wrap1320" [MenuShortKey '`', MenuFunction (noLS wrap_preprocessor)] // :+: MenuItem "Wrap1320" [MenuShortKey '`', MenuFunction (noLS wrap_preprocessor)]
// ...Wrap // ...Wrap
:+: MenuItem "Defs..." [MenuShortKey '`', MenuFunction (noLS popup_funs)] :+: MenuItem "List Defi&nitions..."
[ MenuFunction (noLS popup_funs)
: if altgr_workaround [] [MenuShortKey '`']
]
) )
[ MenuId (mEditId) [ MenuId (mEditId)
] ]
......
definition module IdeState definition module IdeState
//********************************************************************************* import StdPSt, StdPrint
// Original Clean Library Software Module import ExtListBox, FilteredListBox
// Written for Clean version : 1.3 import fbi, clipboard, typewin
// Written for I/O version : 1.2 import EdState
// Author : Diederik van Arkel import PmProject
// Date : import PmPrefs
// Last Modified by : import flextextcontrol
// Date : from PmAbcMagic import :: ABCCache
// Copyright : 1999 Hilt - High Level Software Tools B.V. from PmFileInfo import :: FileInfoCache
// : University of Nijmegen import PmEnvironment
// e-mail : clean@cs.kun.nl or rinus@hilt.nl import conswin
//*********************************************************************************
// 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
:: *General :: *General
...@@ -244,6 +227,3 @@ setInteract :: !Bool !*(PSt *General) -> !*PSt *General ...@@ -244,6 +227,3 @@ setInteract :: !Bool !*(PSt *General) -> !*PSt *General
writeLog :: !String !*(PSt *General) -> !*PSt *General writeLog :: !String !*(PSt *General) -> !*PSt *General
abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General abortLog :: !Bool !String !*(PSt *General) -> !*PSt *General
//-- Console support...
implementation module IdeState 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 ExtListBox, FilteredListBox
import EdState import EdState
import PmPath, PmProject, PmPrefs, PmFileInfo import PmPath, PmProject, PmPrefs, PmFileInfo
...@@ -371,10 +354,10 @@ setFI :: !FindInfo !*(PSt *General) -> !*PSt *General ...@@ -371,10 +354,10 @@ setFI :: !FindInfo !*(PSt *General) -> !*PSt *General
setFI ei ps = appPLoc (\p->{p & ed_find = ei}) ps setFI ei ps = appPLoc (\p->{p & ed_find = ei}) ps
getPath :: !*(PSt *General) -> (!Pathname,!*PSt *General) 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 :: !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 :: !*(PSt *General) -> (!Pathname,!*PSt *General)
getStup ps = accPLoc (\p=:{pr_stup}->(pr_stup,p)) ps getStup ps = accPLoc (\p=:{pr_stup}->(pr_stup,p)) ps
...@@ -512,7 +495,9 @@ abortLog flag message ps ...@@ -512,7 +495,9 @@ abortLog flag message ps
= closeProcess ps = closeProcess ps
//-- Console support... //-- Console support...
import conswin import conswin
instance Consoler General instance Consoler General
where where
getConsWinInfo gen=:{cons_info} = (cons_info,