Archive version of: files-renamer.r ... version: 1 ... luce80 2-Jun-2011

Amendment note: new script || Publicly available? Yes

REBOL [
	Title: "Files Renamer"
	Date: 02-06-2011
	Version: 0.5.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"]
	]
	comment: {.GUI Automatically generated by VID_build. Author: Marco Antoniazzi}
	Help: {
	INSTRUCTIONS:
		1) press "Open folder..." to select the folder containing the files to be renamed
		1.1) select "Show folders" to be able to rename also folders
		1.2) insert a text with wildcards to show only some files
			eg. "*.jpg" to show jpegs, "a*" to show files starting with "a", "*" to show all
		1.3) press "Select all" to select all currently shown files
		1.4) 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) press "Reset to defaults" to put all values to their initial state.
		2.10) select "Include extension" to rename also the files suffices
			
		3) select "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] ; System func does not work !

	choose_dir: func [/local dir-name] [
		until [
			dir-name: request-dir/title/keep "Select a folder"
			if none? dir-name [return none]
			exists? dir-name
		]
		dirize dir-name
	]

	filter_and_sort: func [list [block!] /local temp-list temp-dir-list temp-files-list] [
		temp-list: copy list
		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 path 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
		path: copy join to-rebol-file get-face info-path "/"
		forall new-file-list [
			if " " <> item: first new-file-list [
				old-file: join path pick old-file-list index? new-file-list
				new-file: item
				if error? try [rename old-file new-file] [done: false]
			]
		]
		alert either done ["DONE"] ["An error occured. NOT ALL FILES RENAMED"]
		replace_file-list/dir path
	]
;
; update lists
	update_info_shown: func [/local info] [
		info: get-face info-nums
		remove/part info find info " "
		insert info length? old-list/data
		set-face info-nums info
	]

	update_info_sel: func [/local info] [
		info: get-face info-nums
		info: find/tail info ", "
		remove/part info find info " "
		insert info length? old-list/picked
		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_shown
		update_info_sel
	]

	update_old-file-list: func [] [
		old-file-list: filter_and_sort orig-file-list

		update_text-list old-list old-file-list
	]

	update_new-file-list: func [] [
		clear new-file-list
		new-file-list: array/initial length? old-file-list " "
		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 [] [
		update_old-file-list
		update_new-file-list
	]

	replace_file-list: func [/dir dir-name [file!]] [
		if none? dir-name [if none? dir-name: choose_dir [exit]]
		clear orig-file-list
		orig-file-list: read dir-name
		update_lists
		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
	update_info_sel
	update_new-file-list
]

do_rename: func [/local item extensions padded autonum step padding cond1 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
	cond1: true
	cond2: true
	pos: 1
	forall new-file-list [
		if " " <> 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
			]
			
			change new-file-list head item
		]
		cond1: true
		cond2: true
		pos: 1
	]
	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"
	]
	forskip vals 2 [set-face first vals second vals]
]

main-win: [
	do [sp: 4x4] origin sp space sp
	style text-list text-list with [
		update: func [/local item tot-rows visible-rows] [
			tot-rows: length? data visible-lines: visible-rows: lc
			sld/redrag visible-rows / max 1 tot-rows
			if item: find data picked/1 [
				either visible-rows >= tot-rows [
					sld/step: 0.0
					sld/data: 0.0
					sn: 0
				][
					sld/step: 1 / (tot-rows - visible-rows)
					sld/data: (index? item) / tot-rows ; simple but it works
					if sld/data < sld/step [sld/data: 0]
					sn: to-integer sld/data / sld/step
				]
			]
			self
		]
		append init [
			iter/font/name: reduce [font-fixed]
			iter/feel/redraw: func [f a i] [
				iter/color: color 
				if flag-face? slf striped [iter/color: pick next colors odd? cnt] 
				if find picked iter/text [iter/color: svvc/field-select]
				iter/font/style: either #"/" = last iter/text [[bold]] [[]] ; <<- ADDED
			]
		]
	]
	Across
	btn "Open folder..." [replace_file-list]
	txt "Path:"
	info-path: info bold "" 380 edge [size: 1x1]
	pad 330
	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 ". Copyright: " ssh/Copyright] 
			text as-is trim/auto ssh/Help
			h2 500 bold red center "WARNING: The renaming is NOT undoable"
		]
	]
	return
	check-show-folders: check-line "Show folders" [update_lists]
	txt "Filter:"
	field-filter: field "*" [update_lists]
	btn "Select All" [select_all]
	return
	; LISTS
	panel [
		across origin sp space sp
		text bold "Current file name" 250 center
		text bold "New file name" 250 center
		return
		old-list: text-list 260x353 [update_info_sel update_new-file-list]
		indent -16 - 4 ; hide scroller
		new-list: text-list old-list/size with [
			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
		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 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
		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 [update_new-file-list]
		radio-copy: radio-line "Copy" [update_new-file-list]
		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]
		return
		check-autonum: check-line "Insert"
		txt "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]
	] edge [size: 1x1]
	return
	;FIXME: partial renaming btn "Rename"
	btn "Execute renaming of selected files" 260 yellow [rename_selected]
	key (escape) [if confirm "Exit now?" [quit]]
]

; main
	orig-file-list:
	old-file-list:
	new-file-list: []

	insert-event-func func [face event] [if all [event/type = 'close event/face = main-win] [if confirm "Exit now?" [quit] return none] event]

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