EdActionType.icl 3.64 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
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
68
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
100
101
102
103
104
105
106
107
108
109
110
111
implementation module EdActionType

//*********************************************************************************
// 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 StdOverloaded, StdArray, StdInt, StdString, StdChar, StdList
import StrictList
import EdMovement
from EdText import TextFragment

:: Action
        = Move          Movement
        | Insert        TextFragment
//		| InsertChar	Char			// DvA: try this for typing speed?
        | Scroll        Movement
        | Select        Movement
        | Remove        Movement

instance toString Action where
  toString (Move   movement) = "Move to "   +++ toString movement
  toString (Scroll movement) = "Scroll to " +++ toString movement 
  toString (Select movement) = "Select to " +++ toString movement
  toString (Remove movement) = "Remove to " +++ toString movement
  toString (Insert fragment) = "Insert " +++ toStr fragment
  toString _                 = "toString (EdAction.icl): unknown action"

instance fromString Action
where
	fromString s
		# (move,s) = hasprefix "Move to " s
		| move = Move (fromString s)
		# (scroll,s) = hasprefix "Scroll to " s
		| scroll  = Scroll (fromString s)
		# (select,s) = hasprefix "Select to " s
		| select = Select (fromString s)
		# (remove,s) = hasprefix "Remove to " s
		| remove = Remove (fromString s)
		# (insert,s) = hasprefix "Insert " s
		| insert = Insert (fromStr s)
		= Scroll StartOfText	// silly default
	where
		hasprefix p s
			# x = size p - 1
			| p == s%(0,x)
				= (True,s%(x+1,size s - 1))
			= (False,s)

//toStr TextFragment
toStr SNil = ""
toStr (SCons t ts)
	= tosafe t +++ toStr ts

//fromStr TextFragment
fromStr "" = SNil
fromStr s
	# (l,r) = fromsafe s
	= SCons l (fromStr r)

tosafe "" = "$@"
tosafe s
	| s.[0] == '$'
		= "$!" +++ tosafe s%(1,size s - 1)
	= s%(0,0) +++ tosafe s%(1,size s - 1)

fromsafe s
	# (dollar,s) = hasprefix "$!" s
	| dollar
		# (l,r) = fromsafe s
		= ("$"+++l,r)
	# (eoflin,s) = hasprefix "$@" s
	| eoflin
		= ("",s)
	# (l,r) = fromsafe (s%(1,size s - 1))
	= (s%(0,0)+++l,r)
where
	hasprefix p s
		# x = size p - 1
		| p == s%(0,x)
			= (True,s%(x+1,size s - 1))
		= (False,s)

instance == Action
where
  (==) (Move   movement)        (Move   movement`)      = movement == movement`
  (==) (Scroll movement)        (Scroll movement`)      = movement == movement`
  (==) (Select movement)        (Select movement`)      = movement == movement`
  (==) (Remove movement)        (Remove movement`)      = movement == movement`
  (==) (Insert text)            (Insert text`)          = text == text`
  (==) _                                        _       = False

allActions :: [Action]
allActions
  =      [ Move   movement \\ movement <- allMovements ]
  ++ [ Select movement \\ movement <- allMovements ]
  ++ [ Scroll movement \\ movement <- [ PageUp, PageDown, StartOfText, EndOfText ] ]
  ++ [ Remove movement \\ movement <- [ CharLeft, CharRight, WordLeft, WordRight, StartOfLine, EndOfLine ] ]