Archive version of: files-renamer.r ... version: 6 ... luce80 8-Jun-2011

Amendment note: Horizontal scrollers, change case, minor bug fixes || Publicly available? Yes

REBOL [
	Title: "Files Renamer"
	Date: 08-06-2011
	Version: 0.6.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"]
	]
	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
		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.
	}
	Todo: {
		- various types of initial sorting
		- "multi-pass" renaming
		- insert dates
		- undo or back-up files
		- check duplicates
	}
	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 [not find/any/match item get-face field-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 old-file new-file done] [
		if empty? old-list/picked [exit]
		if not confirm "WARNING: this operation can not be undone. Continue?" [exit]
		done: true
		forall new-file-list [
			if spc <> item: first new-file-list [
				old-file: join path-name pick old-file-list index? new-file-list
				new-file: item
				if error? try [rename old-file new-file] [done: false]
			]
		]
		reset_all
		replace_file-list path-name
		alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
	]
;
; update lists
	update_info: func [/local info] [
		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
	]

	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_info
	]

	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_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] [exit]
		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
	]
;
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 num 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]
	]
	
	padded: func [numb paddin] [reverse head change copy reverse paddin reverse form numb]
	autonum: to-integer get-face field-start
	step: to-integer get-face field-step
	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: 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
		]
	]
	new-file-list: head new-file-list

	if not get-face check-ext [
		foreach item new-file-list [append item first extensions extensions: next extensions]
	]
	head new-file-list
	;FIXME: if length? orig-file-list > length? unique new-file-list [alert "There are duplcates"]
]

reset_all: func [/local vals] [
	vals: reduce [
		check-ext no
		field-trim ""
		text-goto1 "1"
		slider-goto1 0
		check-last1 no
		field-find1 ""
		check-rev1 no
		text-skip1 "0"
		slider-skip1 0
		field-select ""
		text-select "0"
		slider-select 0
		radio-cut on
		radio-copy no
		text-goto2 "1"
		slider-goto2 0
		check-last2 no
		field-find2 ""
		check-rev2 no
		text-skip2 "0"
		slider-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]
]

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 324
	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
			h2 500 bold red center "WARNING: The renaming is NOT undoable"
			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 "*" [update_lists]
	btn "Select All" [select_all]
	return
	; LISTS
	panel [
		across origin sp 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 260x334 [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 [
								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 attempt [read path: dirize to-rebol-file str] [
									replace_file-list path
									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 -4x0
		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 + new-list/size * 1x0 + -16x20 edge [size: 1x1]
	]
	; COMMANDS
	panel [
		style txt text
		style text text 154 right
		style field field 100 [update_new-file-list]
		style check-line check-line [update_new-file-list]
		style radio-line radio-line [update_new-file-list]
		style slider slider 100x23 0.0 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 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
		text "Trim:"
		field-trim: field
		return
		text "Go to" 40
		text-goto1: text "1" 30 bold
		text "th character:" 77
		slider-goto1: slider 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
		slider-skip1: slider target text-skip1 min 0
		return
		text "Select to:"
		field-select: field
		return
		text "Select " 50
		text-select: text "0" 30 bold
		text "characters:" 66
		slider-select: slider 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
		slider-goto2: slider 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
		slider-skip2: slider 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" 260 - 16 yellow [rename_selected]
	key (escape) [if confirm "Exit now?" [quit]]
	do [replace_file-list first paths-list]
]

; main
	spc: " "
	max-line-length: 1
	path-name: none
	paths-list: copy []
	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?" [quit] return none] event]
			'scroll-line [either event/offset/y < 0 [scroll-drag/back new-list/sld] [scroll-drag new-list/sld]]
		]
		event
	]

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