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

Amendment note: Bug fixes, handle links (on Win), hide unreadable files || Publicly available? Yes

REBOL [
	Title: "Files Renamer"
	Date: 05-06-2011
	Version: 0.5.5
	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"]
	]
	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) 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]

	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 path-name/: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 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 path
	]
;
; 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

		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 [/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!]] [
		if not attempt [read dir-name] [exit]
		path-name: dir-name
		clear orig-file-list
		if object? main-win [flash/with "reading directory..." main-win]
		orig-file-list: read dir-name
		update_lists/reset
		unview
		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 " " <> 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
		]
	]
	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 font [name: reduce [font-fixed]]
	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 ". 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 260x350 [update_info update_new-file-list] with [
			append init [
				iter/feel: make iter/feel [
					redraw-super: :redraw
					redraw: func [f a i] [
						redraw-super f a i
						iter/font/style: case [
							#"/" = pick tail iter/text -1 [[bold]]
							is-link? to-file iter/text [[underline]]
							true [[]]
						]
					]
					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
							]
							if str: is-link? 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} "{^^@}"
								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
		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 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]
	] 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]]
	do [replace_file-list first paths-list]
]

; main
	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