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

cleanup for Clean2 release

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