Archive version of: files-renamer.r ... version: 9 ... luce80 15-Jun-2011

Amendment note: Undo, Num. of modified || Publicly available? Yes

REBOL [
	Title: "Files Renamer"
	Date: 14-06-2011
	Version: 0.8.1
	File: %files-renamer.r
	Author: "Marco Antoniazzi"
	Copyright: "2011 Marco Antoniazzi"
	Purpose: "Rename files"
	eMail: [luce80 AT libero DOT it]
	History: [
		0.5.0 [28-05-2011 "First version"]
		0.5.1 [02-06-2011 "Minor bug fixes"]
		0.5.2 [03-06-2011 "Bug fixes"]
		0.5.3 [04-06-2011 "Bug fixes"]
		0.5.4 [04-06-2011 "Bug fixes, use selection list also as file browser"]
		0.5.5 [05-06-2011 "Bug fixes, handle links (on Win), hide unreadable files"]
		0.6.1 [08-06-2011 "Horizontal scrollers, change case, minor bug fixes"]
		0.6.2 [10-06-2011 "Scrollers instead of sliders, minor bug fixes"]
		0.7.1 [12-06-2011 "Invert filter, select to tail, check empties and duplicates"]
		0.8.1 [14-06-2011 "Undo, Num. of modified"]
	]
	comment: {.GUI Automatically generated by VID_build. Author: Marco Antoniazzi}
	Help: {
	INSTRUCTIONS:
		1.1) unselect "Show folders" to hide folders
		1.2) select "Show all" to show unreadable files
		1.3) press "<<", "<" or "^^" to select the folder containing the files to be renamed
		1.4) insert a text with wildcards in "Filter" field to show only some files
			eg. "*.jpg" to show jpegs, "a*" to show files starting with "a", "*" to show all
			choose "Invert" to show the files not filtered
		1.5) press "Select all" to select all currently shown files
		1.6) double click on a folder (or link) name to browse it
		1.7) click on a file name to select it, press also <Ctrl> to multi-select

		2) to change the name of selected files use the panel on the right.
			Renaming is done with the use of an "imaginary" cursor that is controlled
			by the various gadgets.
		2.1) use "Trim" to remove some characters
		2.2) use "goto", "find" and "skip" to move the cursor (possibly from the tail of the name)
		2.3) use "select to" and "select" to select some characters
			beware the selection always goes from left to right.
		2.4) choose to "cut" or "copy" the selection.
			If you see some characters disappear you know you are "cutting"
		2.5) use "goto", "find" and "skip" to move the cursor (possibly from the tail of the name)
		2.6) select "Paste" to insert selected text into current position
		2.7) use "Insert" to insert additional text into current position
		2.8) select "Insert number" to insert auto-numbering into current position
			You can decide the starting number, the increment and a padding text
		2.9) select "Change case to" and choose type to change characters case. 
		2.10) press "Reset to defaults" to put all values to their initial state.
		2.11) select "Include extension" to rename also the files suffices
			
		3) press "Execute renaming of selected files" to rename files.
		
		4) press "Undo last renaming operation" to restore previous file names
	}
	Todo: {
		- various types of initial sorting
		- "multi-pass" renaming
		- insert dates
	}
	Category: [util vid files]
	library: [
		level: 'intermediate
		platform: 'all
		type: 'tool
		domain: [gui files]
		tested-under: [View 2.7.8.3.1]
		support: none
		license: 'BSD
		see-also: none
	]
]

; files
	suffix?: func [
	    {Return the suffix (ext) of a filename or url, else tail of it.} 
	    path [any-string!]
		/local
		suff
		][
	    either all [
	        suff: find/last path #"." 
	        not find suff #"/"
	    ] [suff] [tail path]
	]

	dir?: func [file [file!]] [#"/" = last file]

	is-link?: func [file [file!] /local str] [ ; WARNING: THIS IS A DIRTY HACK!
		if all [
			equal? suffix? file %.lnk
			System/version/4 = 3 ;Win
			attempt [str: read file]
			equal? head str find str #{4C000000} 
		] [str]
	]
	
	parent-dir: func [file [file!]] [
		if equal? length? file 1 [return %/]
		file: head remove back tail dirize file
		head remove/part find/tail/last file %/ tail file
	]

	push-path: func [file [file!]] [paths-list: back insert tail paths-list file]
	
	filter_and_sort: func [list [block!] /local temp-list temp-dir-list temp-files-list] [
		temp-list: copy list
		if not get-face check-show-all [remove-each item temp-list [error? try [read path-name/:item]]]
		remove-each item temp-list [equal? found? find/any/match item get-face field-filter get-face check-filter]

		temp-dir-list: copy temp-list
		remove-each item temp-dir-list [not dir? item]
		sort temp-dir-list

		temp-files-list: copy temp-list
		remove-each item temp-files-list [dir? item]
		sort temp-files-list

		clear temp-list
		if get-face check-show-folders [insert temp-files-list temp-dir-list]
		temp-files-list
	]

	rename_selected: func [/local done item old-file new-file] [
		if empty? old-list/picked [exit]
		if not confirm "Are you sure?" [exit]
		done: true
		new-file-list: head new-file-list
		forall new-file-list [
			if spc <> item: first new-file-list [
				old-file: pick old-file-list index? new-file-list
				if not-equal? undo-file old-file [ ; avoid renaming undo.file !
					old-file: join path-name old-file
					new-file: item
					if error? try [rename old-file new-file] [done: false]
				]
			]
		]
		reset_all

		undo-list: copy modified-list
		unghost btn-undo

		replace_file-list path-name
		alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
	]

	undo: func [/local done undo-path old-file new-file] [
		if empty? undo-list [if error? try [undo-list: load undo-file] [alert "Unable to load undo file. UNDO IS NOT POSSIBLE!" exit]]
		
		undo-path: take undo-list
		done: true
		forskip undo-list 2 [
			old-file: join undo-path second undo-list
			new-file: first undo-list
			if error? try [rename old-file new-file] [done: false]
		]
		reset_all

		clear undo-list
		attempt [save undo-file []]
		ghost btn-undo

		replace_file-list undo-path
		alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
	]
;
; update lists
	update_info: func [/local info empties duplicates modified temp-list] [
		info: get-face info-nums
		change/part info length? old-list/data find info " "
		info: find/tail info ", "
		change/part info length? old-list/picked find info " "
		set-face info-nums head info

		empties: 0 foreach item new-file-list [if item = suffix? item [empties: empties + 1]]
		clear modified-list
		temp-list: copy old-file-list
		new-file-list: head new-file-list
		forall new-file-list [
			item: first new-file-list 
			if all [not-equal? item spc not-equal? item %""] [
				if all [not find modified-list item not find temp-list item] [insert modified-list reduce [first temp-list item]]
				change temp-list item
			]
			temp-list: next temp-list
		]
		temp-list: head temp-list
		duplicates: (length? old-list/data) - length? unique temp-list
		modified: duplicates + ((length? modified-list) / 2)
		insert modified-list path-name

		info: get-face info-errs
		change/part info modified find info " "
		info: find/tail info ", "
		change/part info empties find info " "
		info: find/tail info ", "
		change/part info duplicates find info " "
		info-errs/color: either (empties + duplicates) > 0 [red + 80] [green + 80]
		set-face info-errs head info
	]

	update_text-list: func [list [object!] file-list [block!]] [
		clear list/data
		clear list/picked
		; update and redraw file names text-list
		append list/data file-list
		show list/update
	]

	update_old-file-list: does [
		old-file-list: filter_and_sort orig-file-list
		max-line-length: 1
		forall old-file-list [max-line-length: max max-line-length length? first old-file-list]

		update_text-list old-list old-file-list
		scroller-old-list/redrag 34 / max-line-length show scroller-old-list ; 34 is number of chars that fits in listview
		scroller-new-list/redrag 34 / max-line-length show scroller-new-list ; 34 is number of chars that fits in listview
	]

	update_new-file-list: func [] [
		clear new-file-list
		recycle
		new-file-list: array/initial length? old-file-list spc
		foreach item old-list/picked [
			change at new-file-list index? find old-file-list item copy item
		]

		do_rename

		update_text-list new-list new-file-list
		update_info
	]

	update_lists: func [/reset] [
		if /reset [old-list/sn: new-list/sn: old-list/sld/data: new-list/sld/data: 0] ; reset starting lines and scroller of lists
		update_old-file-list
		update_new-file-list
	]

	replace_file-list: func [dir-name [file! none!] /local fl] [
		if error? try [read dir-name] [return false]
		path-name: dir-name
		clear orig-file-list
		if all [object? main-win not get-face check-show-all] [fl: flash/with "reading directory..." main-win]
		orig-file-list: read dir-name
		update_lists/reset
		if fl [unview/only fl]
		set-face info-path to-local-file dir-name
		true
	]
;
select_all: func [] [
	if empty? old-list/data [exit]
	clear old-list/picked
	old-list/picked: copy old-list/data
	show old-list
	update_info
	update_new-file-list
]

do_rename: func [/local item extensions padded autonum step padding cond1 cond2 pos str select-end copied] [
	if empty? new-file-list [exit]
	extensions: copy []
	if not get-face check-ext [
		foreach item new-file-list [append extensions take/part suffix? item tail item]
	]
	
	autonum: to-integer get-face field-start
	step: to-integer get-face field-step
	padded: func [numb paddin] [reverse head change copy reverse paddin reverse form numb]
	padding: copy get-face field-pad
	forall new-file-list [
		cond1: true
		cond2: true
		pos: 1
		if spc <> item: copy first new-file-list [
			if "" <> str: get-face field-trim [item: trim/with item str]

			cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-goto1)
			either get-face check-last1 [item: skip tail item negate pos] [item: at head item pos]

			pos: 0
			if "" <> str: get-face field-find1 [
				cond1: cond1 and found? found: either get-face check-rev1 [find/reverse item str] [find item str]
				item: any [found head item]
				pos: either found [index? found] [0]
			]

			select-end: item
			if pos > 0 [
				cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-skip1)
				item: skip item pos

				select-end: item
				if "" <> str: get-face field-select [
					cond2: cond2 and found? found: either get-face check-select [find/tail item str] [find item str]
					select-end: any [found item]
				]

			]
			if cond2 [select-end: skip select-end to-integer get-face text-select]
			
			copied: copy/part item select-end
			if get-face radio-cut [remove/part item select-end]

			cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-goto2)
			either get-face check-last2 [item: skip tail item 1 + negate pos] [item: at head item pos]

			if "" <> str: get-face field-find2 [
				cond1: cond1 and found? found: either get-face check-rev2 [find/reverse item str] [find item str]
				item: any [found head item]
			]

			cond1: cond1 and ((1 + length? item) >= pos: to-integer get-face text-skip2)
			item: skip item pos

			if get-face check-paste [item: insert item copied]

			if cond1 [item: insert item get-face field-insert]

			if get-face check-autonum [
				insert item padded autonum padding
				autonum: autonum + step
			]
			
			if get-face check-case [
				item: head item
				lowercase item
				if get-face radio-case-first [uppercase/part item 1]
				if get-face radio-case-up [uppercase item]
			]

			change new-file-list head item

		]
	]

	if not get-face check-ext [
		foreach item new-file-list [append item first extensions extensions: next extensions]
	]
]

reset_all: func [/local vals] [
	vals: reduce [
		check-ext no
		field-trim ""
		text-goto1 "1"
		scroller-goto1 0
		check-last1 no
		field-find1 ""
		check-rev1 no
		text-skip1 "0"
		scroller-skip1 0
		field-select ""
		check-select no
		text-select "0"
		scroller-select 0
		radio-cut on
		radio-copy no
		text-goto2 "1"
		scroller-goto2 0
		check-last2 no
		field-find2 ""
		check-rev2 no
		text-skip2 "0"
		scroller-skip2 0
		check-paste no
		field-insert ""
		check-autonum no
		field-start "1"
		field-step "1"
		field-pad "0000"
		check-case no
		radio-case-low on
		radio-case-up no
		radio-case-first no
	]
	forskip vals 2 [set-face first vals second vals]
]

ghost: func [face] [box-ghost/offset: face/offset box-ghost/size: face/size show box-ghost]
unghost: func [face] [box-ghost/offset: -10000x-10000 show box-ghost]

main-win: [
	do [sp: 4x4] origin sp space sp
	style text-list text-list font [name: reduce [font-fixed]] para [wrap?: false]
	Across
	txt "Path:"
	info-path: info bold "" 470 edge [size: 1x1]
	pad 316
	btn "?" sky keycode [f1] [
		ssh: System/script/header
		view/new layout [ below space sp
			text 500 bold center ssh/Title
			text 500 center rejoin ["Version: " ssh/Version " , " ssh/Date ". Copyright: " ssh/Copyright] 
			text as-is trim/auto ssh/Help
			key (escape) [unview]
		]
	]
	return
	check-show-folders: check-line "Show folders" on [update_lists]
	check-show-all: check-line "Show all" [
		if get-face face [
			if not confirm "Showing hidden files makes reading folders faster but anyway you will not be able to rename them. Really show them?" [set-face face off]
		]
		update_lists
	]
	txt "Filter:"
	field-filter: field "*" 150 [update_lists]
	check-filter: check-line "Invert" no [update_lists]
	btn "Select All" [select_all]
	return
	; LISTS
	panel [
		across origin 0 space sp
		btn "<<" [replace_file-list %/ push-path %/]
		btn " < " [if (length? head paths-list) > 1 [replace_file-list pick paths-list: back remove paths-list 1]]
		btn " ^^ " [
			if not none? path-name [
				replace_file-list parent-dir path-name
				push-path path-name
			]
		]
		text bold "Current file name" 150 center
		text bold "New file name" 250 center
		return
		old-list: text-list 260x320 [update_info update_new-file-list] with [
			append init [
				iter/feel: make iter/feel [
					redraw-super: :redraw
					redraw: func [f a i /local fil] [
						redraw-super f a i
						fil: to-file iter/text
						iter/font/color: case [
							#"/" = pick tail fil -1 [blue]
							is-link? path-name/:fil [navy]
							true [black]
						]
					]
					engage-super: :engage
					engage: func [face action event /local path str] [
						engage-super face action event
						if event/double-click [
							path: last get-face old-list
							if dir? path [
								if replace_file-list path-name/:path [push-path path-name]
							]
							if str: is-link? path-name/:path [ ; WARNING: THIS IS A DIRTY HACK!
								str: back find/any/last str "?:" ; find a: b: c: etc. drive letters
								str: trim/with/all mold copy/part str find str #{00000000} "{^^@}" ; trim 0s
								if replace_file-list dirize to-rebol-file str [push-path path-name]
							]
						]
					]
				]
			]
		]
		indent -16 - 4 ; hide scroller
		new-list: text-list old-list/size with [
			update: func [/local tot-rows visible-rows] [
				tot-rows: length? data visible-rows: lc
				sld/redrag visible-rows / max 1 tot-rows
				either visible-rows >= tot-rows [
					sld/step: 0.0
				][
					sld/step: 1 / (tot-rows - visible-rows)
				]
				self
			]
			append init [
				iter/feel/engage: none ; disable selection
				sld/action: func [face value] [ ;patched
					if sn = value: max 0 to-integer value * ((length? slf/data) - lc) [exit] ; I always hated that "1 +" !
					old-list/sn: sn: value ; keep lists syncronized
					show [old-list sub-area]
				]
			]
		]
		return
		pad 0x-4
		scroller-old-list: scroller old-list/size * 1x0 + -16x16 [old-list/iter/para/scroll: -1x0 * round max-line-length - 34 - 0 * value + 0 * 8 show old-list]
		pad -4
		scroller-new-list: scroller new-list/size * 1x0 + -16x16 [new-list/iter/para/scroll: -1x0 * round max-line-length - 34 - 0 * value + 0 * 8 show new-list]
		return
		info-nums: info "0 files shown , 0 files selected" old-list/size * 1x0 + -16x20 edge [size: 1x1]
		pad -4
		info-errs: info "0 modified , 0 empties , 0 duplicates" new-list/size * 1x0 + 0x20 edge [size: 1x1]
	]
	; COMMANDS
	panel [
		style txt text
		style text text 154 right
		style field field 100x22 [update_new-file-list]
		style check-line check-line [update_new-file-list]
		style radio-line radio-line [update_new-file-list]
		style scroller scroller 100x20 0.0 edge [size: 2x2] with [
			min: 1
			max: 50
			target: none
			words: reduce [
				'min func [new args] [new/min: second args next args]
				'max func [new args] [new/max: second args new/step: 1 / (new/max - new/min) next args]
				'target func [new args] [new/target: second args next args]
			]
		] [set-face face/target round face/max - face/min * value + face/min update_new-file-list]
		Across origin sp space sp
		btn "Reset to defaults" [reset_all update_new-file-list]
		;return
		pad 54
		check-ext: check-line "Include extension"
		return
		pad 0x9
		text "Trim:"
		field-trim: field
		return
		text "Go to" 40
		text-goto1: text "1" 30 bold
		text "th character:" 77
		scroller-goto1: scroller target text-goto1
		check-last1: check-line "from last"
		return
		text "Find:"
		field-find1: field
		check-rev1: check-line "reverse"
		return
		text "Skip " 50
		text-skip1: text "0" 30 bold
		text "characters:" 66
		scroller-skip1: scroller target text-skip1 min 0
		return
		text "Select to:"
		field-select: field
		check-select: check-line "included" no
		return
		text "Select " 50
		text-select: text "0" 30 bold
		text "characters:" 66
		scroller-select: scroller 175 target text-select min 0 max 120
		return
		radio-cut: radio-line "Cut" on
		radio-copy: radio-line "Copy"
		return
		text "Go to" 40
		text-goto2: text "1" 30 bold
		text "th character:" 77
		scroller-goto2: scroller target text-goto2
		check-last2: check-line "from last"
		return
		text "Find:"
		field-find2: field
		check-rev2: check-line "reverse"
		return
		text "Skip " 50
		text-skip2: text "0" 30 bold
		text "characters:" 66
		scroller-skip2: scroller target text-skip2 min 0
		return
		check-paste: check-line "Paste"
		return
		text "Insert:"
		field-insert: field [remove-each char face/text [find {\/:*?"<>|} char] show face update_new-file-list]
		return
		check-autonum: check-line "Insert number from"
		field-start: field "1" 30 [if error? try [to-integer face/text] [face/text: "1" show face] update_new-file-list]
		txt	"step"
		field-step: field "1" 30 [if error? try [to-integer face/text] [face/text: "1" show face] update_new-file-list]
		txt "pad"
		field-pad: field "0000" 50 [remove-each char face/text [find {\/:*?"<>|} char] show face update_new-file-list]
		return
		check-case: check-line "Change case to"
		radio-case-low: radio-line "lower" of 'case on
		radio-case-up: radio-line "UPPER" of 'case
		radio-case-first: radio-line "First upper" of 'case
		return
	] edge [size: 1x1]
	return
	;FIXME: partial renaming btn "Rename"
	btn "Execute renaming of selected files" old-list/size/x - 16 - 2 yellow [rename_selected]
	btn-undo: btn "Undo last renaming operation" new-list/size/x [undo]
	key (escape) [if confirm "Exit now?" [quit]]
	at -100x-100 ; put out of sight
	box-ghost: box 1x1 effect [merge blur blur] ; used to ghost (aka disable) face
]

; main
	spc: " "
	max-line-length: 1
	path-name: none
	paths-list: copy []
	modified-list: copy []
	undo-file: %files-renamer-undo.rbl
	undo-list:
	orig-file-list:
	old-file-list:
	new-file-list: []
	
	append paths-list what-dir

	insert-event-func func [face event] [
		switch event/type reduce [
			'close [
				if event/face = main-win [
					if confirm "Exit now?" [
						if error? try [save undo-file undo-list] [alert "Unable to save undo file. UNDO IS DISABLED!"]
						quit
					]
					return none
				]
				event
			]
			'scroll-line [either event/offset/y < 0 [scroll-drag/back new-list/sld] [scroll-drag new-list/sld]]
		]
		event
	]

	main-win: layout main-win

	replace_file-list first paths-list
	if any [
			error? try [undo-list: load undo-file]
			empty? undo-list
		] [
		ghost btn-undo
	]

	view/new/title/options main-win "Files Renamer" []
	
	do-events