StdClipboard.icl 3.06 KB
Newer Older
Peter Achten's avatar
Peter Achten 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
implementation module StdClipboard


//	Clean Object I/O library, version 1.2


import	StdFunc, StdList, StdMisc, StdString
import	osclipboard
import	StdMaybe
from	commondef	import FatalError, StrictSeq, StrictSeqList, Remove, Cond
from	iostate		import PSt, IOSt, getIOToolbox, setIOToolbox, accIOToolbox, IOStGetClipboardState, IOStSetClipboardState, ClipboardState


StdClipboardFatalError :: String String -> .x
StdClipboardFatalError function error
	= FatalError function "StdClipboard" error


//	The clipboard item type:

::	ClipboardItem
	=	ClipboardString !String			// Support for strings
//	|	ClipboardPict	Handle			// Support for pictures (PA: not supported yet)

class Clipboard item where
	toClipboard		:: !item			-> ClipboardItem
	fromClipboard	:: !ClipboardItem	-> Maybe item

instance Clipboard {#Char} where
	toClipboard :: !{#Char} -> ClipboardItem
	toClipboard string = ClipboardString string
	
	fromClipboard :: !ClipboardItem -> Maybe {#Char}
	fromClipboard (ClipboardString string) = Just string


//	Reading and writing the value of the selection to the clipboard:

39
setClipboard :: ![ClipboardItem] !(PSt .l) -> PSt .l
Peter Achten's avatar
Peter Achten committed
40
41
42
43
44
45
46
47
48
49
50
51
setClipboard clipItems pState=:{io}
	# (tb,ioState)	= getIOToolbox io
	# tb			= StrictSeq (map clipboardItemToScrap singleItems) tb
	# ioState		= setIOToolbox tb ioState
	= {pState & io=ioState}
where
	singleItems		= removeDuplicateClipItems clipItems
	
	removeDuplicateClipItems :: ![ClipboardItem] -> [ClipboardItem]
	removeDuplicateClipItems [item:items]
		# (_,_,items)	= Remove (eqClipboardType item) undef items
		= [item:removeDuplicateClipItems items]
52
53
54
55
56
	where
		eqClipboardType :: !ClipboardItem !ClipboardItem -> Bool
		eqClipboardType (ClipboardString _) item	= case item of
														(ClipboardString _)	-> True
														_					-> False
Peter Achten's avatar
Peter Achten committed
57
58
59
60
61
62
63
	removeDuplicateClipItems items
		= items
	
	clipboardItemToScrap :: !ClipboardItem !*OSToolbox -> *OSToolbox
	clipboardItemToScrap (ClipboardString text) tb
		= OSsetClipboardText text tb

64
getClipboard :: !(PSt .l) -> (![ClipboardItem],!PSt .l)
Peter Achten's avatar
Peter Achten committed
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
getClipboard pState
	# (tb,ioState)		= getIOToolbox pState.io
	# (contents,tb)		= OSgetClipboardContent tb
	  contents			= filter ((==) OSClipboardText) contents
	# (clipItems,tb)	= StrictSeqList (map scrapToClipboardItem contents) tb
	# (cbs,ioState)		= IOStGetClipboardState ioState
	# (version,tb)		= OSgetClipboardVersion cbs.cbsCount tb
	# ioState			= IOStSetClipboardState {cbs & cbsCount=version} ioState
	# ioState			= setIOToolbox tb ioState
	= (clipItems,{pState & io=ioState})
where
	scrapToClipboardItem :: !Int !*OSToolbox -> (!ClipboardItem,!*OSToolbox)
	scrapToClipboardItem OSClipboardText tb
		# (text,tb)	= OSgetClipboardText tb
		= (ClipboardString text,tb)
	scrapToClipboardItem type tb
		= StdClipboardFatalError "getClipboard" ("unimplemented clipboard content of type: "+++toString type)

83
clipboardHasChanged :: !(PSt .l) -> (!Bool,!PSt .l)
Peter Achten's avatar
Peter Achten committed
84
85
86
87
88
clipboardHasChanged pState
	# (cbs,ioState)		= IOStGetClipboardState pState.io
	  oldCount			= cbs.cbsCount
	# (newCount,ioState)= accIOToolbox (OSgetClipboardVersion oldCount) ioState
	= (oldCount<>newCount,{pState & io=ioState})