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

cleanup for Clean2 release

parent af9b4495
implementation module EdMouse
//*********************************************************************************
// 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.
//*********************************************************************************
/*
* EdMouse.icl: handling mouse events
*/
// handling mouse events
import StdClass, StdInt, StdBool, StdArray, StdChar, StdList, StdTuple
import StdIOCommon, StdPSt, StdWindow
......@@ -34,11 +15,6 @@ platformCommand mods
/* editWindowMouse wraps the monadic mouse function, so that the type
* conforms to that of a call-back function in the Object I/O library
*/
/*
editWindowMouse :: Tree MouseState (!EditState, !PSt PLocState) -> (EditState, PSt PLocState)
editWindowMouse tree mouseState state
# state = p4mouse tree mouseState state // P4
*/
editWindowMouse :: MouseState (!EditState, !PSt PLocState) -> (EditState, PSt PLocState)
editWindowMouse mouseState state
= noResult
......@@ -46,6 +22,11 @@ editWindowMouse mouseState state
setVirtualX 0 >>>
mouse mouseState
) state
/* P4 version
editWindowMouse :: Tree MouseState (!EditState, !PSt PLocState) -> (EditState, PSt PLocState)
editWindowMouse tree mouseState state
# state = p4mouse tree mouseState state
*/
mouse :: MouseState -> EditMonad (PSt PLocState) nothing
mouse (MouseDown point mods=:{shiftDown} nrDown)
......@@ -162,7 +143,7 @@ noMouseMoved :: !MouseState -> Bool
noMouseMoved (MouseMove _ _) = doP4
noMouseMoved _ = True
//-- P4 --- !!! ZITTEN OOK NOG WIJZIGINGEN IN EdMonad !!!
//-- P4 --- !!! Also involves modifications to EdMonad !!!
doP4 :== False
noP4 :== True
......@@ -171,15 +152,15 @@ import StdTimer,tooltip,PmParse,UtilStrictLists,EdFile,treeparse
p4mouse boom mouseState state
| noP4 = state
# (winId,state) = getWindowId state // P4
# (timId,state) = getTimerId state // P4
# pos = getMouseStatePos mouseState // P4
# (oldpos,state) = getToolPt state // P4
# state = case (pos == oldpos) of // P4
True -> state // P4
_ -> p4fun boom timId winId pos state // P4
# (_,state) = setToolPt pos state // P4
= state // P4
# (winId,state) = getWindowId state
# (timId,state) = getTimerId state
# pos = getMouseStatePos mouseState
# (oldpos,state) = getToolPt state
# state = case (pos == oldpos) of
True -> state
_ -> p4fun boom timId winId pos state
# (_,state) = setToolPt pos state
= state
p4fun boom timerId windowId pos state
# (text,state) = getText state
......
/*
* EdMovement.dcl: the Movement type and operations on it
*/
definition module EdMovement
from StdClass import class ==, class toString, class fromString
from EdSelection import :: Position, :: ColumnNr, :: LineNr
import EdMonad
from StdClass import class ==, class toString, class fromString
from EdSelection import :: Position, :: ColumnNr, :: LineNr
import EdMonad
:: Movement
= LineUp
......
/*
* EdMovement.icl: the Movement type and operations on it
*/
implementation module EdMovement
import StdMisc, StdInt, StdTuple, StdArray, StdChar, StdBool, StdList, StdFunc
......@@ -234,10 +230,10 @@ findWord isCorrectChar column line
= findRight (column+1)
= column
isWordChar c = isAlpha c || isDigit c || isMember c ['`_']
isFunnyChar c = isMember c ['~@#$%^?!+-*<>\\/|&=:.']
isWhiteSpace c = isMember c [' \t\r\n\f\b']
otherChar c = (==) c
isWordChar c = isAlpha c || isDigit c || isMember c ['`_']
isFunnyChar c = isMember c ['~@#$%^?!+-*<>\\/|&=:.']
isWhiteSpace c = isMember c [' \t\r\n\f\b']
otherChar c = (==) c
pageUp :: Position -> EditMonad (PSt .l) Position
pageUp position=:{col,row} =
......
/*
* EdPosition.dcl: the Position type represents positions within a text (sigh)
*/
definition module EdPosition
from StdClass import class <, class ==
......@@ -16,4 +12,3 @@ from StdClass import class <, class ==
instance < Position
instance == Position
/*
* EdPosition.icl: the Position type represents positions within a text (sigh)
*/
implementation module EdPosition
import StdClass, StdBool, StdInt
......
/*
* EdSelection.dcl: non-visual operations on selections
*/
definition module EdSelection
import EdPosition
from EdLineText import :: Text
// non-visual operations on selections
import EdPosition
from EdLineText import :: Text
:: Selection
= { start :: Position
......
/*
* EdSelection.icl: non-visual operations on selections
*/
implementation module EdSelection
// non-visual operations on selections
import StdList, StdFunc, StdBool, StdArray, StdTuple
import EdPosition, EdText
......
/*
* EdState.dcl: the global state of the editor process
*/
definition module EdState
// the global state of the editor process
from StdId import :: Id
from StdPSt import :: PSt
from StdMaybe import :: Maybe
from EdKeyMapping import :: KeyMapping
//from EdMonad import EditState
from EdMessage import :: EditId
class Editor env
......
/*
* EdState.icl: the global state of the editor process
*/
implementation module EdState
// the global state of the editor process
import StdList, StdFunc, StdTuple, StdBool, StdMisc
import StdId, StdMaybe, StdReceiver, StdPSt
import EdKeyMapping, EdMessage, Table
......
/*
* EdTab.dcl: functions that deal with those annoying tab characters
*/
definition module EdTab
// functions that deal with those annoying tab characters
from StdIOCommon import :: Point2
from StdPicture import :: Picture
from EdMonad import :: FontInfo
......
implementation module EdTab
/*
* EdTab.icl: functions that deal with those annoying tab characters
* functions that deal with those annoying tab characters
o Unfortunately doesn't work with proportional fonts...
Probably inevitable with an 'editor' view of tabs.
......
/*
* EdText.dcl: operations on text areas (extends EdLineText)
*/
definition module EdText
// operations on text areas (extends EdLineText)
import StdMaybe
from EdSelection import :: Selection, :: Position, :: ColumnNr, :: LineNr
......
/*
* EdText.icl: operations on text areas (extends EdLineText)
*/
implementation module EdText
// operations on text areas (extends EdLineText)
import StdClass, StdArray, StdMisc, StdInt, StdString, StdMaybe
import EdLineText, EdSelection
import StrictList
......@@ -67,7 +65,7 @@ insertText { col, row } strings text
= SCons
(left +++ slHead strings)
(appendToLastLine (slTail strings) right)
// deze volgorde om ruzie met removeLine in combinatie met newText te vermijden...
// use this order to avoid trouble with removeLine applied to newText...
# text = insertLines (inc row) fragment text
# text = removeLine row text
= (Nothing,text )
......@@ -99,7 +97,7 @@ replaceText sel=:{start={col=col1,row=row1},end={col=col2,row=row2}} strings tex
# fragment = SCons
(left +++ slHead strings)
(appendToLastLine (slTail strings) right)
// deze volgorde om ruzie met removeLine in combinatie met newText te vermijden...
// use this order to avoid trouble with removeLine applied to newText...
# text = insertLines (inc row1) fragment text
# text = removeLine row1 text
= text
......
definition module EdVisualCursor
//*********************************************************************************
// 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.
//*********************************************************************************
/*
* EdVisualCursor.dcl: visual operations on the cursor and selections
*/
from StdIOCommon import :: ViewFrame, :: Rectangle, :: Point2
import EdMonad, EdMovement
// visual operations on the cursor and selections
from StdIOCommon import :: ViewFrame, :: Rectangle, :: Point2
import EdMonad, EdMovement
vUpdateCursor :: !Bool !Position !Int !FontInfo !Text !ViewFrame ![Rectangle]
......@@ -51,7 +32,6 @@ vChangeSelectionTo :: Selection -> EditMonad (PSt .l) nothing
// to the given selection and redraws, so that the display
// reflects this change
//vUpdateSelection :: ViewFrame [Rectangle] -> EditMonad *Picture nothing
vUpdateSelection :: !Selection FontInfo Text ViewFrame [Rectangle]
-> (*Picture -> *Picture)
// vUpdateSelection: updates the selection in the frame
......
implementation module EdVisualCursor
//*********************************************************************************
// 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.
//*********************************************************************************
/*
* EdVisualCursor.icl: visual operations on the cursor
*/
// visual operations on the cursor
import StdInt, StdClass, StdBool, StdFunc
import StdPicture, StdWindow, StdPSt, StdList
......@@ -161,11 +142,15 @@ vUpdateCursor visible end height fontInfo text viewFrame rectangles =
THEN
(
let
point = positionToPoint end text fontInfo
point = positionToPoint end text fontInfo
{x,y} = point
in
IF (any (isCursorInRectangle point height) rectangles)
THEN
(vDrawCursor end height text fontInfo)
THEN (seq
[ setPenColour Black
, drawLine { x=x, y=y }
{ x=x, y=y+height - 1 }
])
ELSE
id
)
......@@ -178,7 +163,7 @@ vDrawCursor end cursorHeight text fontInfo =
p = positionToPoint end text fontInfo
{x,y} = p
in
( appXorPicture (seq // ok: je wil xoren als je direct update, maar niet in de onderliggende look...
( appXorPicture (seq
[ setPenColour Black
, drawLine { x=x, y=y }
{ x=x, y=y+cursorHeight - 1 }
......
definition module EdVisualText
// EdVisualText.dcl: visual operations on texts
// visual operations on texts
from StdIOCommon import :: ViewFrame, :: Rectangle, :: Point2, :: ViewDomain
from EdText import :: TextFragment, :: StrictList, stringsToString,
......
/*
* EdVisualText.icl: visual operations on texts
*/
implementation module EdVisualText
// visual operations on texts
import StdClass, StdFunc, StdArray, StdInt, StdMisc, StdList
import StdIOCommon, StdPicture, StdPSt, StdWindow
import EdText, EdTab, StrictList, EdMonad, EdSelection
......
/*
* EdWindow.dcl: opening and closing editor windows
*/
definition module EdWindow
// opening and closing editor windows
from StdWindow import :: Title, :: WindowAttribute
from StdPSt import :: PSt
from StdId import :: Id
......
/*
* EdWindow.icl: opening and closing editor windows
*/
implementation module EdWindow
// opening and closing editor windows
import StdInt, StdClass, StdList
import StdWindow, StdControlReceiver, StdIOBasic
import EdMessage, EdMonad, EdLook, EdVisualText, EdState
......@@ -24,7 +22,6 @@ 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
editLook = editWindowLook editState
windowAttrs = atts ++ // in this order so that new attributes override default atts
[ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 }
......@@ -33,8 +30,8 @@ openEditWindow uId title pathName text font tabs syncols windowId 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 {vx=10, vy=10})
, WindowCursor IBeamCursor
]
......@@ -57,12 +54,3 @@ closeEditWindow windowId pState
# editorState = removeReceiver windowId editorState
pState = closeWindow windowId pState
= setEditorState editorState pState
/**********************
* SCROLLBAR HANDLING *
**********************/
hScrollFun fontInfo
:== altScrollFunction Horizontal fontInfo.metrics.fMaxWidth
vScrollFun fontInfo
:== alignScrollFunction Vertical fontInfo.FontInfo.lineHeight
definition module syncol
// syncol: provides preparsing for Clean syntax colouring.
// provides preparsing for Clean syntax colouring.
import StdString
import StrictList
......
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