EdText.icl 3.69 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
implementation module EdText

3
4
// operations on text areas (extends EdLineText)

Diederik van Arkel's avatar
Diederik van Arkel committed
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
import StdClass, StdArray, StdMisc, StdInt, StdString, StdMaybe
import EdLineText, EdSelection
import StrictList

getTextFragment :: !Selection !Text -> (!TextFragment, !Text)
getTextFragment {start={col=col1,row=row1},end={col=col2,row=row2}} text
  // selection is within one line ?
  | row1 == row2 
	# (line, text) = getLine row1 text
	= ( SCons (line % (col1, col2 - 1)) SNil
	  , text
	  )
  // selection contains more than one line
  # (SCons firstLine restLines, text) 
				= getLines row1 row2 text
  = ( SCons (firstLine % (col1, size firstLine - 1)) 
		   (chopLastLine restLines)
	, text
	)
where
	chopLastLine SNil 
	  = SNil
	chopLastLine (SCons lastLine SNil)
	  = SCons (lastLine % (0, col2 - 1)) SNil
	chopLastLine (SCons aLine lines)
	  = SCons aLine (chopLastLine lines)

removeText :: !Selection !Text -> (Maybe Int,Text)
removeText {start={col=col1,row=row1},end={col=col2,row=row2}} text
  # (firstLine, text)	= getLine row1 text
  // selection within one line?
  | row1 == row2 
	# (fin,text)		= updateLine row1 
							(	firstLine % (0, col1 - 1) 
							+++ firstLine % (col2, size firstLine - 1)
							) text
	= (Just fin,text)
  // selection contains more than one line
  # (lastLine, text)	= getLine row2 text
  # newLine				= firstLine % (0, col1 - 1) +++ 
						  lastLine	% (col2, size lastLine - 1)
  # (_,text)			= updateLine row1 newLine text
  # text				= removeLines (row1 + 1) row2 text
  = (Nothing,text)

insertText :: !Position !TextFragment !Text -> (Maybe Int,Text)
insertText { col, row } strings text
  # (line, text) = getLine row text
	left  = line % (0, col - 1)
	right = line % (col, size line - 1)
  // no strings at all
  | nrOfStrings == 0
	= (Nothing,text)
  // insertion in a single line
  | nrOfStrings == 1
	# newLine = left +++ slHead strings +++ right
	# (fin,text) = updateLine row newLine text
	= (Just fin,text)
  // insertion of more than one line
  # fragment
	  = SCons
	  		(left +++ slHead strings)
			(appendToLastLine (slTail strings) right)
68
  // use this order to avoid trouble with removeLine applied to newText...
Diederik van Arkel's avatar
Diederik van Arkel committed
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
  # text = insertLines (inc row) fragment text
  # text = removeLine row text
  = (Nothing,text )
where
	nrOfStrings = slLength strings

replaceText :: !Selection !TextFragment !Text -> !Text
replaceText sel=:{start={col=col1,row=row1},end={col=col2,row=row2}} strings text
	# (firstLine, text)	= getLine row1 text
	# (lastLine, text)	= if (row1==row2)
							(firstLine,text)
							(getLine row2 text)
	# left = firstLine%(0, col1 - 1)
	# right = lastLine%(col2, size lastLine - 1)
	# text				= if (row1 == row2)
							text
							(removeLines (row1 + 1) row2 text)
	// no strings at all
	| nrOfStrings == 0
		# newLine			= left +++ right
		# (_,text)			= updateLine row1 newLine text
		= text
	// insertion in a single line
	| nrOfStrings == 1
		# newLine			= left +++ slHead strings +++ right
		# (_,text)			= updateLine row1 newLine text
		= text
	// insertion of more than one line
	# fragment = SCons
	  		(left +++ slHead strings)
			(appendToLastLine (slTail strings) right)
100
	// use this order to avoid trouble with removeLine applied to newText...
Diederik van Arkel's avatar
Diederik van Arkel committed
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
	# text = insertLines (inc row1) fragment text
	# text = removeLine row1 text
	= text
where
	nrOfStrings = slLength strings

appendText :: !TextFragment !Text -> Text
appendText SNil text
	= text
appendText strings text
	# text = appendLines` strings text
	= text

appendToLastLine :: .(StrictList String) String -> .StrictList String
appendToLastLine (SCons string SNil) right
  = SCons (string +++ right) SNil
appendToLastLine (SCons string strings) right
  = SCons string (appendToLastLine strings right)
appendToLastLine SNil right
  = SCons right SNil