REBOL [
	Title: "Cross-Platform Rebol Code Editor"
	File: "code.r"
	Author: "Francois Jouen"
	Email: "fjouen@free.fr"
	Copyright: "(c) 2006, François Jouen"
	Rights: {BSD License

Copyright (c) 2006, François Jouen
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above copyright
      notice, this list of conditions and the following disclaimer in
      the documentation and/or other materials provided with the
      distribution.

    * Neither the name of the <ORGANIZATION> nor the names of its
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.}
]


sv*: system/view
ssize: sv*/screen-face/size
xmax: ssize/1 - 200
ymax: ssize/2 - 200
set 'app-dir what-dir 
count: tn-lines: n-char: tn-pages: tn-words: tn-paras: tn-files: tn-chars: n-page: 0
n-line: pindex: n-line-page: tn-pages: n-char: 1
font-size: 14
line-height: 16
tmp-list: []
tmp-files: []
xy: 0x35
tr: 128
cl: to-tuple  reduce [255 0 0 tr]
cx: xmax - 251
cy: line-height + 4
bxs: to-pair reduce [cx cy]


line-list: make sv*/line-info []

lcursor: copy [ fill-pen cl
				pen none
				box 0x0 bxs ]
 	
quit-requested: does [
	if (confirm/with "Really quit this program ?" ["Yes" "No"]) [quit]
	
]

Read-Config: does [
	if error? try [
	initfile: read/Lines join app-dir "editor.ini"
	rebol-location: initfile/1]; evaluateur rebol
	[rebol-location: system/options/boot]	
]

Write-Config: does [
	write join app-dir "editor.ini" rebol-location
]

Select-Rebol: does [
	dest: request-text/title/default " Where is Rebol  ? " to-string rebol-location
	if not none? dest [
		if not empty? dest [
			rebol-location: to-string dest
			Write-Config 
		Read-Config]
	]
]

Run: does [
	if error? try [
		str: join "Loading " fname
		fl: flash str wait 0.5
		call reduce [rebol-location " " Fname] 
		unview/only fl]
		[unview/only fl]
]

About_Box: layout [
	
	space 0x15
	across
	H2 200x48 "Cross-Platform Rebol Code Editor" center wrap
	
	return
	credits: text white navy bold center 200x60
	"Brought to the Rebol Community by François Jouen/Rebol France <C> 2006"

	return
	
 pad 80 btn "OK" [hide-popup]


]

Calculate-pages: does [
	clear lcount/text
	;calculate line height
	line-height: font-size + second (current/para/margin) 
	
	;calculate total number of lines
	tmp: (second (size-text current) / line-height) - 2
	for count 0 tmp 1 [append lcount/text join count + 1 newline]
	append lcount/text tmp + 2
	tn-lines: tmp + 1
	;get number of line per page
	n-line-page: round (current/size/y / line-height) 
	
	;get total number of pages 
	tn-pages: round tn-lines / n-line-page
	tmp: remainder tn-lines n-line-page
	if tmp  <> 0 [tn-pages: tn-pages + 1]
	tn-chars: to-integer length? current/text
	tn-pages: tn-pages + 1
	show [Lcount]
]


Get-File-Info: does [
	 Calculate-pages
	 n-page: 0
	 current/text: head current/text
	 lcount/text: head lcount/text
	 current/line-list: lcount/line-list: none
	 ; get some information about file
	 tn-chars: length? current/text
	 tn-words: parse current/text none
	 tn-paras: parse/all current/text "^/"
	 SBar2/text: join "Length: " tn-chars
	 n-line: n-char: 0
	 if error? try [result: textinfo current line-list n-line] [result: none]
	 sbar3/text: join "Ln " [n-line + 1 ", " line-list/num-chars " chars"]
	 sbar4/text: n-page + 1
	 sbar5/text: tn-pages
	 show [Lcount SBar2 Sbar3 SBar4 Sbar5 bx]	
	

]
update-scroller: func [lines] [
	
	
	if lines [either sl/data = 0 [n-page 0 nline: 0] 
		[n-line: to-integer sl/data * (tn-lines) 
		n-page: to-integer sl/data * (tn-pages - 1)]
	]
	
	if error? try [line-list/num-chars: 0 result: textinfo current line-list n-line] [result: none]
	sbar3/text: join "Ln " [n-line + 1 ", " line-list/num-chars " chars"]
	sbar4/text: n-page + 1
	sbar5/text: tn-pages
	
	y: round (second (current/size) - line-height * sl/data) 
	limite: current/size/y - (line-height + 4)
	if y >= limite  [y: limite]  
	bx/offset: current/offset + as-pair 0 y
	
	scroll-para lcount sl
	current/para/scroll/y: lcount/para/scroll/y
	show [ bx lcount sl sbar3 sbar4 sbar5 current]
	focus sl
	 
]





get-key: func [akey]
[
	
	if tn-chars > 0 [
	 	 
	 
	 
	tmp: to-integer length? sv*/caret
	n-char: (tn-chars - tmp) + 1
	cc: pick current/text n-char

	Calculate-pages
	
			if equal? akey 'end  [sl/data: 1 
					n-line: tn-lines n-char: tmp n-page: tn-pages - 1 
					update-scroller false] 
			        
				
			if equal? akey 'home  [sl/data: 0  
					n-line: 0 n-char: 1 n-page: 0
					update-scroller false]
					
			if equal? akey 'page-down [
					either n-page >= tn-pages [npage: tn-pages - 1] [n-page: n-page + 1]
					n-line: n-line + n-line-page 
					if (n-line > tn-lines)  [n-line: tn-lines]
					sl/data: n-line / tn-lines
					update-scroller false
					]
					
			if equal? akey 'page-up [
					either n-page <= 0 [n-page: 0] [n-page: n-page - 1]
					n-line: n-line - n-line-page 
					if (n-line <= 0)  [n-line: 0]
					sl/data: n-line / tn-lines
					update-scroller false
					]
					
					
			if equal? akey 'down [ 
					n-line: n-line + 1
					if (n-line > tn-lines) [n-line: tn-lines]
					sl/data: n-line / tn-lines
					update-scroller false
					n-line2: mod n-line n-line-page
				    if equal? n-line2 0 [n-page: n-page + 1]
			]
				
			
			
			if equal? akey 'up [
					n-line: n-line - 1
					if n-line <= 0 [n-line: 0 n-page: 1]
					sl/data: n-line / tn-lines
					update-scroller false
					n-line2: mod n-line n-line-page
					if equal? n-line2 0 [n-page: n-page - 1]
			]
			
			if equal? akey 'right [
			 	cc: pick current/text n-char
			]
			if equal? akey 'left [
			 	cc: pick current/text n-char
			]
			
			]
]
Read-File: does [
		clear current/text
		clear lcount/text
		current/text: read to-file fname
		set [path file] split-path fname
		SBar1/text: to-local-file fname
		current/line-list: lcount/line-list: none
		sl/data: 0
		update-scroller false
		n-line: n-char: 1
		show [SBar1 sl current]
	
]
Save-File: does [
	if tn-files > 0[
	if (confirm/with join "Save File " [FName " ?"] ["Yes" "No"]) [write to-file fname current/text]
	]
	
]

Write-File: does [
if tn-files > 0[
	afile: request-file/file/filter/save Fname "*.r"
	if not none? afile [sfname: first afile write to-file sfname current/text]
]
]

New-File: does [
	afile: request-file/filter/save "*.r"
	if not none? afile [
		fname: first afile
		set [path file] split-path first afile
		clear current/text
		clear lcount/text
		buf: reform join "REBOL [" [ newline "Title: Demo" newline
								"File: " to-local-file fname newline
								"Author: " system/user/name newline
								"Email: " system/user/email newline
								"Date: " now newline
								"]" newline]
		
		append current/text buf
		write to-file fname current/text
		append tmp-list first afile
		buffer: copy current/text
		append/only tmp-files buffer
		set [path file] split-path first afile
		append Fliste/data file
		append clear FListe/picked file
		tn-files: tn-files + 1
		show FLIste
		Get-File-Info
		n-line: 8 n-char: length? buf
		sbar3/text: join "Ln " [n-line ", Ch " n-char] 
		SBar1/text: to-local-file fname
		show [SBar1 SBar3]
		focus current
	]
]

Open-File: does [
	afile: request-file/filter "*.r"
	if not none? afile [	
		if error? try [
		forall afile [
		fname: first afile
		Read-File
		buffer: copy current/text
		append/only tmp-files buffer
		set [path file] split-path first afile
		append tmp-list afile
		append Fliste/data file
		append clear FListe/picked file
		Get-File-Info
		focus current
		sv*/caret: head current/text
		show [current Fliste]
		tn-files: tn-files + 1]
		] 
		[Alert "Error"]
		]
		
]

Select-File: does [
		
		clear current/text
		clear lcount/text
		buffer: pick tmp-files pindex 
		current/text: copy buffer
		set [path file] split-path fname
		SBar1/text: to-local-file fname
		current/line-list: lcount/line-list: none
		sl/data: 0
		update-scroller false
		n-line: n-char: 1
		show [SBar1 sl current]
		Get-File-Info
		focus current
		sv*/caret: head current/text
]

Close-File: does  [
	if tn-files > 0 [ 
	if (confirm/with join "Close file " [fname " ?"]  ["Yes" "No"]) [
	clear current/text
	clear LCount/text
	current/line-list: lcount/line-list: none
	remove at tmp-list pindex
	remove at tmp-files pindex
	remove at FListe/data pindex
	tn-files: tn-files - 1
	either tn-files > 0 [
	either tn-files > 1 [pindex: tn-files] [ pindex: 1]
	FName: pick tmp-list pindex Select-File
	append clear FListe/picked pick FListe/data pindex 
	] [hide bx]
	show [current lcount FListe]]
]
]


find-text: func [s /local atext] [
	
	either all [
		not atext: find next sv*/caret s
		not atext: find current/text s] 
		[Alert join s " not found" unfocus return none  ]
		[
		tmp: length? atext   
		
		n-char: (tn-chars - tmp) + 1
		
		sv*/caret: atext
		sv*/highlight-start: sv*/caret
		sv*/highlight-end: skip sv*/highlight-start length? s
		
		xy: (caret-to-offset current atext) - current/para/scroll
		lcount/para/scroll/y: current/para/scroll/y: second min 0x0 current/size / 2 - xy
		
		n-line: to-integer (xy/y / (font-size + 2)) + 1
		
		ratio: n-line / tn-lines
		sl/data: ratio
		show [current lcount sl]
		sbar3/text: join "Ln " [n-line ", Ch " n-char]
		show SBar3
		]
	
]




Resize-Window: does [
	ssize: sv*/screen-face/size
	xmax: ssize/1 - 200
	ymax: ssize/2 - 200
	abox/size: MainWin/size
	ToolBar/size/x: MainWin/size/x 
	FListe/size/x: 190
	FListe/resize/y MainWin/size/y - 75
	FListe/offset: 5x35
	LCount/size/x: 40
	Lcount/size/y: Lcount/parent-face/size/y - 75
	LCount/Offset: 195x35
	Current/size/x: MainWin/size/x - 235 - 16
	Current/size/y: MainWin/size/y - 75
	Current/Offset: 235x35
	sl/size/y: MainWin/size/y - 75
	sl/offset: as-pair (235 + Current/size/x) 35
	SBar1/Size/x: 235
	SBar1/offset: as-pair 0 MainWin/size/y - 35
	SBar2/offset: as-pair 240 MainWin/size/y - 35
	SBar3/offset: as-pair 345 MainWin/size/y - 35
	SBar4/offset: as-pair 450 MainWin/size/y - 35
	SBar5/offset: as-pair 485 MainWin/size/y - 35
	SBar6/offset: as-pair 520 MainWin/size/y - 35
	SBar7/offset: as-pair 625 MainWin/size/y - 35
	cx: MainWin/size/x - 251
	cy: line-height
	bxs: to-pair reduce [cx cy]

	bx/size/x: cx bx/size/y: cy
	show [abox Fliste ToolBar Lcount Current sl SBar1 SBar2 SBar3 SBar4 SBar5 SBar6 SBar7]
	if tn-files > 0 [show bx]
]


MainWin: layout [
	
	across
	origin 0x0
	at 0x0 abox: box as-pair xmax ymax + 70 ivory
	space 5x5
	at 0x0 ToolBar: box as-pair xmax 30
	at 5x35 FListe: text-list as-pair 190 Ymax black white [pindex: face/cnt 
									FName: pick tmp-list pindex Select-File]
	at 195x35 lcount: area as-pair 40 YMax right white white font [size: font-size]
	
	at 235x35 current: area as-pair (xmax - 235 - 16) ymax  white white wrap font [size: font-size]	
	at as-pair 235 + (xmax - 235 - 16) 35 sl: slider as-pair 16 ymax [if tn-files > 0 [update-scroller true]]
	at as-pair 0 (ymax + 40) SBar1: info as-pair 235  30  left  "No File" font [size: 10] wrap
	at as-pair 240 (ymax + 40) SBar2: info as-pair 100 30 center "" font [size: 10] 
	at as-pair 345 (ymax + 40) SBar3: info as-pair 100 30 center "" font [size: 10]
	at as-pair 450 (ymax + 40) SBar4: info as-pair 30 30 center "" font [size: 10]
	at as-pair 485 (ymax + 40) SBar5: info as-pair 30 30 center "" font [size: 10]
	at as-pair 520 (ymax + 40) SBar6: info as-pair 100 30 center mold now/date font [size: 10] 
	at as-pair 625 (ymax + 40) SBar7: info as-pair 50 30 
				center mold now/time font [size: 10] with [rate: 1]
				
	at 5x5 
	b1: btn "New" [New-File]
	b2: btn 50 "Open" [Open-File]
	b3: btn 50 "Close" [Close-File]
	b4: btn 50 "Save" [Save-File]
	b5: btn 50 "Save as" [Write-File]
	
	b6: btn 50 "Find" [if tn-files > 0 [show current Find-text qr/text]]
	qr: field 150 "Rebol" white white [unfocus focus current sv*/caret: head current/text]
	b7: btn 50 "Run" [if tn-files > 0 [Run]]
	b8: btn "Preferences" [Select-Rebol]
	b9: btn "About" [ if error? try [inform/title About_Box "Hello"] [inform About_Box]]
	bt10: btn "Help" [if error? try [do-thru http://www.rebol.com/view/tools/word-browser.r] ["No connected to the Internet"]]
	b11: btn "Quit" [quit-requested]
	at 235x35 bx: box  as-pair (xmax - 251) (line-height + 4) effect [draw lcursor] 
	
] 
Read-Config
center-face MainWin
view/new/options MainWin [resize] 
deflag-face current tabbed; permet les tabulations dans la visualisation
hide bx 




insert-event-func [
		
		switch event/type [
			key          [get-key event/key]       	
			time         [Sbar7/text: mold now/time show SBar7 Calculate-pages]                 	
			resize       [Resize-Window]
        	maximize 	 [Resize-Window]
        	;restore	 []
        	scroll-line []
        	;scroll-n-page []
        	
		]
		if all [event/type = 'alt-down] []
		if all [event/type = 'close event/face = MainWin][quit-requested] 
		event
]

do-events