rebol [
	Title: "edit-text-undo"
	File: %edit-text-undo.r
	Author: "Romano Paolo Tenca"
	Date: 05/12/03
	Version: 1.0.2
	History: [
		1.0.2 05/12/03 {
			- corrected another RT code bug, to see the bug:
					view layout [f1: field "bar" hide do [focus f1]]
				then press one of ctrl-f, ctrl-b, esc ..., the a printable letter, the result is:
					** Script Error: Out of range or past end
					** Where: offset?
					** Near: subtract index? series2 index? series1
			 to fix the bug, at the end of edit-text I set to none the highlight pointers if hide is set 
		}
		1.0.1 13/10/03 {
			- corrected others two bugs in original RT code reported by
			  Bohdan 'Bo' Lechnowsky (thanks!):
				1) "typing a capital letter as the first letter of the field"
				2) delete-selected-text
			  these two bug was due to an incorrect handling of shifted moves keys,
			  which let the highlight pointers in an inconsistent mode, and
			  to the highliting of empty string.
			  They are only two known bugs of a class of possible errors which can manifest
			  with empty strings (usually in fields when the focus function (tab key) is used).
			  Changed the code which handle key movements and hilight-all to fix them.
			- corrected another strange behaviour of RT code:
			 	ctrl-x deleted all the text if nothing was selected
			 	now, if text is not selected, it does not delete anything
			- no more insert esc char in field (to be more consistent with original RT code)
			- many small changes to clean the code
		}
		1.0.0 04/10/03 "first public release"
	]
	Purpose: {
		Patch the edit-text function to fix some bugs and add Esc key and Undo/Redo
	}
	Note: {
		Corrected unprintable keys error with hide field
		Corrected cursor movements.
		Corrected the first capital letter field bug.
		Corrected the delete-selected-text bug.
		Corrected errors due to the hihlighting of empty strings after a focus
		or inconsistent hightlight pointers left by shifted move keys.
		Corrected ctrl-x with no code selected.

		New features:
		- undo/redo (keys: control-u/control-y) (does not work with hide field)
			Undo default max levels: 100 (see undo-max, if = none illimited)
			Undo is not efficient: use only with field or small area
			Usage:
				layout [
					field with [
						undo: make block! 100
					]
				]

		- esc key to retrieve the initial text content (works only with field)
			to use it do:
				layout [
					field with [esc: none]
				]
	}
]
context bind bind [
	undo-max: 100 ;max number of undo levels none = illimited 
	undo-add: func [face] [
		if all [in face 'undo not flag-face? face hide][
			insert clear face/undo at copy face/text index? caret
			if all [undo-max undo-max < length? head face/undo] [remove head face/undo]
			face/undo: tail face/undo
		]
	]
	undo-get: func [face] [
		face/text: head caret: first face/undo
		face/line-list: none
		remove face/undo
		face/dirty?: true
	]
	insert tail keymap [
		#"^u" undo
		#"^y" redo
		#"^(esc)" undo-all
	]
	;for esc
	set 'hilight-all func [
		face /only
	] [
		either empty? face/text [unlight-text][
			highlight-start: head face/text
			highlight-end: tail face/text
		]
		if all [not only in face 'esc][face/esc: copy face/text]
	]

	move: func [event ctrl plain] [
		either event/shift [any [highlight-start highlight-start: caret]][unlight-text]
		caret: either event/control ctrl plain
		if event/shift [either caret = highlight-start [unlight-text][highlight-end: caret]]
	]

	move-y: func [face delta /local pos tmp tmp2][
		tmp: offset-to-caret face delta + pos: caret-to-offset face caret
		tmp2: caret-to-offset face tmp
		either tmp2/y <> pos/y [tmp][caret]
	]

	set 'edit-text func [
		face event action
		/local key liney swap-text tmp tmp2 page-up page-down face-size
	] [
		face-size: face/size - either face/edge [2 * face/edge/size][0]
		key: event/key
		if flag-face? face hide swap-text: [
			tmp: face/text face/text: face/data face/data: tmp
			caret: either error? try [index? caret][tail face/text][at face/text index? caret]
		]
		textinfo face line-info 0
		liney: line-info/size/y
		if char? key [
			either find keys-to-insert key [
				undo-add face
				insert-char face key
			][key: select keymap key]
		]
		if word? key [
			page-up: [move-y face face-size - liney - liney * 0x-1]
			page-down: [move-y face face-size - liney * 0x1]
			do select [
				left [move event [back-word caret][back caret]]
				right [move event [next-word caret][next caret]]
				up [move event page-up [move-y face liney * 0x-1]]
				down [move event page-down [move-y face liney * 0x1]]
				page-up [move event [head caret] page-up]
				page-down [move event [tail caret] page-down]
				home [move event [head caret][beg-of-line caret]]
				end [move event [tail caret][end-of-line caret]]
				back-char [
					undo-add face
					any [
						delete-selected-text
						head? caret
						either event/control [
							tmp: caret
							remove/part caret: back-word tmp tmp
						][remove caret: back caret]
					]
					face/dirty?: true
				]
				del-char [
					undo-add face
					any [
						delete-selected-text
						tail? caret
						either event/control [remove/part caret next-word caret][remove caret]
					]
					face/dirty?: true
				]
				enter [
					if flag-face? face return [
						if flag-face? face hide swap-text
						action face face/data
						if flag-face? face tabbed [focus next-field face]
						exit
					]
					undo-add face
					insert-char face newline
				]
				all-text [hilight-all/only face]
				copy-text [copy-text face unlight-text]
				cut-text [
					undo-add face
					copy-selected-text face
					delete-selected-text
					face/dirty?: true
				]
				paste-text [
					undo-add face
					delete-selected-text
					face/line-list: none
					face/dirty?: true
					caret: insert caret read clipboard://
				]
				clear-tail [
					undo-add face
					remove/part caret end-of-line caret
					face/dirty?: true
				]
				tab-char [
					if flag-face? face tabbed [
						either in face 'refocus [
							face/refocus event/shift
						][
							tmp2: either event/shift [back-field face][next-field face]
							if flag-face? face hide swap-text
							action face face/data
							focus tmp2
						]
						exit
					]
					undo-add face
					insert-char face tab
				]
				;new
				undo [
					if all [in face 'undo not head? face/undo][
						insert face/undo at copy face/text index? caret
						face/undo: back face/undo
						undo-get face
					]
				]
				redo [
					if all [in face 'undo not tail? face/undo][
						face/undo: insert face/undo at copy face/text index? caret
						undo-get face
					]
				]
				undo-all [
					if all [in face 'esc flag-face? face field][
						clear face/text
						if all [in face 'undo not flag-face? face hide][clear face/undo]
						if string? face/esc [insert face/text face/esc]
						if flag-face? face hide swap-text
						if flag-face? face tabbed [focus next-field face]
						exit
					]
				]
			] key
		]
		if face: focal-face [
			if flag-face? face hide [
				view*/highlight-start: view*/highlight-end: none
				insert/dup clear face/data "*" length? face/text
				do swap-text
			]
	        tmp: caret-to-offset face caret
	        tmp2: face/para/scroll
	        if all [tmp/x < 0 tmp2/x < 0] [face/para/scroll/x: tmp2/x - tmp/x]
	        if all [tmp/y < 0 tmp2/y < 0] [face/para/scroll/y: tmp2/y - tmp/y]
	        action: face-size - tmp
	        if action/x < 5 [face/para/scroll/x: tmp2/x + action/x - 5]
	        if action/y < liney [face/para/scroll/y: tmp2/y + action/y - liney]
			show face
		]
	]
]  in system/view 'self in ctx-text 'self