@prog edit-prop-names.muf
1 999 d
1 i
(
Usage: %t thing=XfromXtoXflags

thing is the thing whose properties are to have their names edited.
X is any delimiter character not appearing in the from or to strings.
from is the string to be replaced; to is the string to replace it with.
flags is zero or more flag characters.

If the flags are omitted, the trailing delimiter can also be omitted.

Currently defined flag characters:
	g - replace all occurrences of the from string; by default,
		only the first occurrence is changed.
	p - print each property, with name and value, as its name is changed.
	i - if a property by the new name already exists, prompt and query
		whether to do the change or not.
	I - query for every property, regardless of whether it would
		overwrite an existing property.

Example: %t jar=/my/private/p
This would replace "my" with "private" for any property on "jar" that
currently has "my" in the property name, and print the results.
)
: say me @ swap dup not if pop " " then notify ;
: subst1 ( s to from )
	3 pick over instr dup if
		4 rotate swap 1 - strcut
		rot strlen strcut swap pop
		rot swap strcat strcat
	else
		pop pop pop
	then
;
: strip-lead
	begin
		dup not if exit then
		1 strcut over " 	" swap instr
	while
		swap pop
	loop
	strcat
;
: trig-name
	me @ ".last" getpropstr
	dup " " instr dup if 1 - strcut then pop
;
: printhelp
	1 begin
		dup intostr "_help" swap strcat prog swap
		over over prop-exists?
	while
		getpropstr
		dup "%t" instr if trig-name "%t" subst then
		say
		1 +
	loop
	pop pop pop
;
: query-do-it
	dup " -> " strcat 4 pick strcat ": " strcat
	3 pick 3 pick getpropstr strcat say
	over 4 pick prop-exists?
	if "(already exists)" else "(does not exist)" then
	"  Do it? [y/N]" strcat say
	read 1 strcut pop tolower "y" strcmp not
;
: print-do-it
	"Changing " over strcat " -> " strcat 4 pick strcat ": " strcat
	3 pick 3 pick getpropstr strcat say
;
: main
	dup "=" instr dup not if pop pop printhelp exit then
	1 - strcut 1 strcut swap pop
	swap match
	dup #-1 dbcmp if
		pop pop "I don't see that here." say exit
	then
	dup #-2 dbcmp if
		pop pop "I don't know which one you mean." say exit
	then
	dup #-3 dbcmp if
		pop pop "HOME has no properties" say exit
	then
	swap
	strip-lead
	( object XfromXtoXflags )
	dup strlen 2 < if pop pop printhelp exit then
	1 strcut
	( object X fromXtoXflags )
	dup 3 pick instr
	dup not if pop pop pop pop printhelp exit then
	1 - strcut 1 strcut swap pop
	( object X from toXflags )
	dup 4 pick instr dup if 1 - strcut 1 strcut swap pop else pop "" then
	4 rotate pop
	( object from to flags )
	0 5 pick propfirst
	begin while
		( object from to flags p1 ... pn n t p )
		dup 4 pick 7 + pick instr if
			-3 rotate swap 1 + swap
		else
			pop
		then
		propnext
	loop
	begin dup 0 > while
		1 - swap over 6 + pick swap
		over over over over
		dup 8 pick dup 11 + pick swap 12 + pick
		10 pick 11 + pick "g" instr if subst else subst1 then
		3 put
		7 pick 8 + pick
		dup "I" instr if
			pop 1
		else
			"i" instr if
				over 4 pick prop-exists?
			else
				0
			then
		then
		if
			query-do-it
		else
			1
		then
		if
			7 pick 8 + pick "p" instr if print-do-it then
			getpropstr 0 addprop remove_prop
		else
			pop pop pop pop pop pop
		then
	loop
	pop pop pop pop pop
;
.
c
q