[metaconfig.git] / U / modified / Getfile.U

?RCS: $Id: Getfile.U,v 3.0.1.7 1997/02/28 15:01:06 ram Exp $
?RCS:
?RCS: Copyright (c) 1991-1993, Raphael Manfredi
?RCS: 
?RCS: You may redistribute only under the terms of the Artistic Licence,
?RCS: as specified in the README file that comes with the distribution.
?RCS: You may reuse parts of this distribution only within the terms of
?RCS: that same Artistic Licence; a copy of which may be found at the root
?RCS: of the source tree for dist 3.0.
?RCS:
?RCS: $Log: Getfile.U,v $
?RCS: Revision 3.0.1.7  1997/02/28  15:01:06  ram
?RCS: patch61: getfile script now begins with "startsh"
?RCS:
?RCS: Revision 3.0.1.6  1995/02/15  14:11:00  ram
?RCS: patch51: was not working if ~'s allowed with d_portable on (WED)
?RCS:
?RCS: Revision 3.0.1.5  1995/01/11  15:11:25  ram
?RCS: patch45: added support for escaping answers to skip various checks
?RCS: patch45: modified message issued after file expansion
?RCS:
?RCS: Revision 3.0.1.4  1994/10/29  15:53:19  ram
?RCS: patch36: added ?F: line for metalint file checking
?RCS:
?RCS: Revision 3.0.1.3  1994/05/06  14:23:36  ram
?RCS: patch23: getfile could be confused by file name in "locate" requests
?RCS: patch23: new 'p' directive to assume file is in people's path (WED)
?RCS:
?RCS: Revision 3.0.1.2  1994/01/24  14:01:31  ram
?RCS: patch16: added metalint hint on changed 'ans' variable
?RCS:
?RCS: Revision 3.0.1.1  1993/09/13  15:46:27  ram
?RCS: patch10: minor format problems and misspellings fixed
?RCS: patch10: now performs from package dir and not from UU subdir
?RCS:
?RCS: Revision 3.0  1993/08/18  12:04:56  ram
?RCS: Baseline for dist 3.0 netwide release.
?RCS:
?X: 
?X: This unit produces a bit of shell code that must be dotted in in order
?X: to get a file name and make some sanity checks. Optionally, a ~name
?X: expansion is performed.
?X:	
?X: To use this unit, $rp and $dflt must hold the question and the
?X: default answer, which will be passed as-is to the myread script.
?X: The $fn variable must hold the file type (f or d, for file/directory).
?X: If $gfpth is set to a list of space-separated list of directories,
?X: those are prefixes for the filename.  Unless $gfpthkeep is set to 'y',
?X: gfpth is cleared on return from Getfile.
?X:
?X: If is is followed by a ~, then ~name substitution will occur. Upon return,
?X: $ans is set with the filename value. If a / is specified, then only a full
?X: path name is accepted (but ~ substitution occurs before, if needed). The
?X: expanded path name is returned in that case.
?X:
?X: If a + is specified, the existence checks are skipped. This usually means
?X: the file/directory is under the full control of the program.
?X:
?X: If the 'n' (none) type is used, then the user may answer none.
?X: The 'e' (expand) switch may be used to bypass d_portable, expanding ~name.
?X:
?X: If the 'l' (locate) type is used, then it must end with a ':' and then a
?X:	file name. If the answer is a directory, the file name will be appended
?X: before testing for file existence. This is useful in locate-style
?X: questions like "where is the active file?". In that case, one should
?X: use:
?X:
?X:   dflt='~news/lib'
?X:   fn='l~:active'
?X:   rp='Where is the active file?'
?X:   . ./getfile
?X:   active="$ans"
?X: 
?X: If the 'p' (path) letter is specified along with 'l', then an answer
?X: without a leading / will be expected to be found in everyone's path.
?X:
?X: It is also possible to include a comma-separated list of items within
?X: parentheses to specify which items should be accepted as-is with no
?X: further checks. This is useful when for instance a full path is expected
?X: but the user may escape out via "magical" answers.
?X:
?X: If the answer to the question is 'none', then the existence checks are
?X:	skipped and the empty string is returned.
?X:
?MAKE:Getfile: d_portable contains startsh Myread Filexp tr trnl
?MAKE:	-pick add $@ %<
?V:ansexp:fn gfpth gfpthkeep
?F:./getfile
?T:tilde type what orig_rp orig_dflt fullpath already redo skip none_ok \
	value exp_file nopath_ok loc_file fp pf dir direxp
?LINT:change ans
?LINT:change gfpth
: now set up to get a file name
cat <<EOS >getfile
$startsh
EOS
cat <<'EOSC' >>getfile
tilde=''
fullpath=''
already=''
skip=''
none_ok=''
exp_file=''
nopath_ok=''
orig_rp="$rp"
orig_dflt="$dflt"
case "$gfpth" in
'') gfpth='.' ;;
esac

?X: Begin by stripping out any (...) grouping.
case "$fn" in
*\(*)
	expr $fn : '.*(\(.*\)).*' | $tr ',' $trnl >getfile.ok
	fn=`echo $fn | sed 's/(.*)//'`
	;;
esac

?X: Catch up 'locate' requests early, so that we may strip the file name
?X: before looking at the one-letter commands, in case the file name contains
?X: one of them. Reported by Wayne Davison <davison@borland.com>.
case "$fn" in
*:*)
	loc_file=`expr $fn : '.*:\(.*\)'`
	fn=`expr $fn : '\(.*\):.*'`
	;;
esac

case "$fn" in
*~*) tilde=true;;
esac
case "$fn" in
*/*) fullpath=true;;
esac
case "$fn" in
*+*) skip=true;;
esac
case "$fn" in
*n*) none_ok=true;;
esac
case "$fn" in
*e*) exp_file=true;;
esac
case "$fn" in
*p*) nopath_ok=true;;
esac

case "$fn" in
*f*) type='File';;
*d*) type='Directory';;
*l*) type='Locate';;
esac

what="$type"
case "$what" in
Locate) what='File';;
esac

case "$exp_file" in
'')
	case "$d_portable" in
	"$define") ;;
	*) exp_file=true;;
	esac
	;;
esac

cd ..
while test "$type"; do
	redo=''
	rp="$orig_rp"
	dflt="$orig_dflt"
	case "$tilde" in
	true) rp="$rp (~name ok)";;
	esac
	. UU/myread
?X: check for allowed escape sequence which may be accepted verbatim.
	if test -f UU/getfile.ok && \
		$contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1
	then
		value="$ans"
		ansexp="$ans"
		break
	fi
	case "$ans" in
	none)
		value=''
		ansexp=''
		case "$none_ok" in
		true) type='';;
		esac
		;;
	*)
		case "$tilde" in
		'') value="$ans"
			ansexp="$ans";;
		*)
			value=`UU/filexp $ans`
			case $? in
			0)
				if test "$ans" != "$value"; then
					echo "(That expands to $value on this system.)"
				fi
				;;
			*) value="$ans";;
			esac
			ansexp="$value"
			case "$exp_file" in
			'') value="$ans";;
			esac
			;;
		esac
		case "$fullpath" in
		true)
?X: Perform all the checks on ansexp and not value since when d_portable
?X: is defined, the original un-expanded answer which is stored in value
?X: would lead to "non-existent" error messages whilst ansexp has been
?X: properly expanded. -- Fixed by Jan.Djarv@sa.erisoft.se (Jan Djarv)
?X: Always expand ~user if '/' was requested 
			case "$ansexp" in
			/*) value="$ansexp" ;;
			[a-zA-Z]:/*) value="$ansexp" ;;
			*)
				redo=true
				case "$already" in
				true)
				echo "I shall only accept a full path name, as in /bin/ls." >&4
				echo "Use a ! shell escape if you wish to check pathnames." >&4
					;;
				*)
				echo "Please give a full path name, starting with slash." >&4
					case "$tilde" in
					true)
				echo "Note that using ~name is ok provided it expands well." >&4
						already=true
						;;
					esac
				esac
				;;
			esac
			;;
		esac
		case "$redo" in
		'')
			case "$type" in
			File)
				for fp in $gfpth; do
					if test "X$fp" = X.; then
					    pf="$ansexp"
					else    
					    pf="$fp/$ansexp"
					fi
					if test -f "$pf"; then
						type=''
					elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1
					then
						echo "($value is not a plain file, but that's ok.)"
						type=''
					fi
					if test X"$type" = X; then
					    value="$pf"
					    break
					fi
				done
				;;
			Directory)
				for fp in $gfpth; do
					if test "X$fp" = X.; then
					    dir="$ans"
					    direxp="$ansexp"
					else    
					    dir="$fp/$ansexp"
					    direxp="$fp/$ansexp"
					fi
					if test -d "$direxp"; then
						type=''
						value="$dir"
						break
					fi
				done
				;;
			Locate)
				if test -d "$ansexp"; then
					echo "(Looking for $loc_file in directory $value.)"
					value="$value/$loc_file"
					ansexp="$ansexp/$loc_file"
				fi
				if test -f "$ansexp"; then
					type=''
				fi
				case "$nopath_ok" in
				true)	case "$value" in
					*/*) ;;
					*)	echo "Assuming $value will be in people's path."
						type=''
						;;
					esac
					;;
				esac
				;;
			esac

			case "$skip" in
			true) type='';
			esac

			case "$type" in
			'') ;;
			*)
				if test "$fastread" = yes; then
					dflt=y
				else
					dflt=n
				fi
				rp="$what $value doesn't exist.  Use that name anyway?"
				. UU/myread
				dflt=''
				case "$ans" in
				y*) type='';;
				*) echo " ";;
				esac
				;;
			esac
			;;
		esac
		;;
	esac
done
cd UU
ans="$value"
rp="$orig_rp"
dflt="$orig_dflt"
rm -f getfile.ok
test "X$gfpthkeep" != Xy && gfpth=""
EOSC
Commit	Line	Data
959f3c4c JH	1	?RCS: $Id: Getfile.U,v 3.0.1.7 1997/02/28 15:01:06 ram Exp $
	2	?RCS:
	3	?RCS: Copyright (c) 1991-1993, Raphael Manfredi
	4	?RCS:
	5	?RCS: You may redistribute only under the terms of the Artistic Licence,
	6	?RCS: as specified in the README file that comes with the distribution.
	7	?RCS: You may reuse parts of this distribution only within the terms of
	8	?RCS: that same Artistic Licence; a copy of which may be found at the root
	9	?RCS: of the source tree for dist 3.0.
	10	?RCS:
	11	?RCS: $Log: Getfile.U,v $
	12	?RCS: Revision 3.0.1.7 1997/02/28 15:01:06 ram
	13	?RCS: patch61: getfile script now begins with "startsh"
	14	?RCS:
	15	?RCS: Revision 3.0.1.6 1995/02/15 14:11:00 ram
	16	?RCS: patch51: was not working if ~'s allowed with d_portable on (WED)
	17	?RCS:
	18	?RCS: Revision 3.0.1.5 1995/01/11 15:11:25 ram
	19	?RCS: patch45: added support for escaping answers to skip various checks
	20	?RCS: patch45: modified message issued after file expansion
	21	?RCS:
	22	?RCS: Revision 3.0.1.4 1994/10/29 15:53:19 ram
	23	?RCS: patch36: added ?F: line for metalint file checking
	24	?RCS:
	25	?RCS: Revision 3.0.1.3 1994/05/06 14:23:36 ram
	26	?RCS: patch23: getfile could be confused by file name in "locate" requests
	27	?RCS: patch23: new 'p' directive to assume file is in people's path (WED)
	28	?RCS:
	29	?RCS: Revision 3.0.1.2 1994/01/24 14:01:31 ram
	30	?RCS: patch16: added metalint hint on changed 'ans' variable
	31	?RCS:
	32	?RCS: Revision 3.0.1.1 1993/09/13 15:46:27 ram
	33	?RCS: patch10: minor format problems and misspellings fixed
	34	?RCS: patch10: now performs from package dir and not from UU subdir
	35	?RCS:
	36	?RCS: Revision 3.0 1993/08/18 12:04:56 ram
	37	?RCS: Baseline for dist 3.0 netwide release.
	38	?RCS:
	39	?X:
	40	?X: This unit produces a bit of shell code that must be dotted in in order
	41	?X: to get a file name and make some sanity checks. Optionally, a ~name
	42	?X: expansion is performed.
	43	?X:
	44	?X: To use this unit, $rp and $dflt must hold the question and the
	45	?X: default answer, which will be passed as-is to the myread script.
	46	?X: The $fn variable must hold the file type (f or d, for file/directory).
	47	?X: If $gfpth is set to a list of space-separated list of directories,
	48	?X: those are prefixes for the filename. Unless $gfpthkeep is set to 'y',
	49	?X: gfpth is cleared on return from Getfile.
	50	?X:
	51	?X: If is is followed by a ~, then ~name substitution will occur. Upon return,
	52	?X: $ans is set with the filename value. If a / is specified, then only a full
	53	?X: path name is accepted (but ~ substitution occurs before, if needed). The
	54	?X: expanded path name is returned in that case.
	55	?X:
	56	?X: If a + is specified, the existence checks are skipped. This usually means
	57	?X: the file/directory is under the full control of the program.
	58	?X:
	59	?X: If the 'n' (none) type is used, then the user may answer none.
	60	?X: The 'e' (expand) switch may be used to bypass d_portable, expanding ~name.
	61	?X:
	62	?X: If the 'l' (locate) type is used, then it must end with a ':' and then a
	63	?X: file name. If the answer is a directory, the file name will be appended
	64	?X: before testing for file existence. This is useful in locate-style
65	?X: questions like "where is the active file?". In that case, one should
66	?X: use:
67	?X:
68	?X: dflt='~news/lib'
69	?X: fn='l~:active'
70	?X: rp='Where is the active file?'
71	?X: . ./getfile
72	?X: active="$ans"
73	?X:
74	?X: If the 'p' (path) letter is specified along with 'l', then an answer
75	?X: without a leading / will be expected to be found in everyone's path.
76	?X:
77	?X: It is also possible to include a comma-separated list of items within
78	?X: parentheses to specify which items should be accepted as-is with no
79	?X: further checks. This is useful when for instance a full path is expected
80	?X: but the user may escape out via "magical" answers.
81	?X:
82	?X: If the answer to the question is 'none', then the existence checks are
83	?X: skipped and the empty string is returned.
84	?X:
a3e4b67c	85	?MAKE:Getfile: d_portable contains startsh Myread Filexp tr trnl
959f3c4c JH	86	?MAKE: -pick add $@ %<
	87	?V:ansexp:fn gfpth gfpthkeep
	88	?F:./getfile
	89	?T:tilde type what orig_rp orig_dflt fullpath already redo skip none_ok \
17b6495f	90	value exp_file nopath_ok loc_file fp pf dir direxp
959f3c4c JH	91	?LINT:change ans
	92	?LINT:change gfpth
	93	: now set up to get a file name
	94	cat <<EOS >getfile
	95	$startsh
	96	EOS
	97	cat <<'EOSC' >>getfile
	98	tilde=''
	99	fullpath=''
	100	already=''
	101	skip=''
	102	none_ok=''
	103	exp_file=''
	104	nopath_ok=''
	105	orig_rp="$rp"
	106	orig_dflt="$dflt"
	107	case "$gfpth" in
	108	'') gfpth='.' ;;
	109	esac
	110
	111	?X: Begin by stripping out any (...) grouping.
	112	case "$fn" in
	113	\()
a3e4b67c	114	expr $fn : '.(\(.\)).*' \| $tr ',' $trnl >getfile.ok
959f3c4c JH	115	fn=`echo $fn \| sed 's/(.*)//'`
	116	;;
	117	esac
	118
	119	?X: Catch up 'locate' requests early, so that we may strip the file name
	120	?X: before looking at the one-letter commands, in case the file name contains
	121	?X: one of them. Reported by Wayne Davison <davison@borland.com>.
	122	case "$fn" in
	123	:)
	124	loc_file=`expr $fn : '.:\(.\)'`
	125	fn=`expr $fn : '\(.\):.'`
	126	;;
	127	esac
	128
	129	case "$fn" in
	130	~) tilde=true;;
	131	esac
	132	case "$fn" in
	133	/) fullpath=true;;
	134	esac
	135	case "$fn" in
	136	+) skip=true;;
	137	esac
	138	case "$fn" in
	139	n) none_ok=true;;
	140	esac
	141	case "$fn" in
	142	e) exp_file=true;;
	143	esac
	144	case "$fn" in
	145	p) nopath_ok=true;;
	146	esac
	147
	148	case "$fn" in
	149	f) type='File';;
	150	d) type='Directory';;
	151	l) type='Locate';;
	152	esac
	153
	154	what="$type"
	155	case "$what" in
	156	Locate) what='File';;
	157	esac
	158
	159	case "$exp_file" in
	160	'')
	161	case "$d_portable" in
	162	"$define") ;;
	163	*) exp_file=true;;
	164	esac
	165	;;
	166	esac
	167
	168	cd ..
	169	while test "$type"; do
	170	redo=''
	171	rp="$orig_rp"
	172	dflt="$orig_dflt"
	173	case "$tilde" in
	174	true) rp="$rp (~name ok)";;
	175	esac
	176	. UU/myread
	177	?X: check for allowed escape sequence which may be accepted verbatim.
	178	if test -f UU/getfile.ok && \
179	$contains "^$ans\$" UU/getfile.ok >/dev/null 2>&1
180	then
181	value="$ans"
182	ansexp="$ans"
183	break
184	fi
185	case "$ans" in
186	none)
187	value=''
188	ansexp=''
189	case "$none_ok" in
190	true) type='';;
191	esac
192	;;
193	*)
194	case "$tilde" in
195	'') value="$ans"
196	ansexp="$ans";;
197	*)
198	value=`UU/filexp $ans`
199	case $? in
200	0)
201	if test "$ans" != "$value"; then
202	echo "(That expands to $value on this system.)"
203	fi
204	;;
205	*) value="$ans";;
206	esac
207	ansexp="$value"
208	case "$exp_file" in
209	'') value="$ans";;
210	esac
211	;;
212	esac
213	case "$fullpath" in
214	true)
215	?X: Perform all the checks on ansexp and not value since when d_portable
216	?X: is defined, the original un-expanded answer which is stored in value
217	?X: would lead to "non-existent" error messages whilst ansexp has been
218	?X: properly expanded. -- Fixed by Jan.Djarv@sa.erisoft.se (Jan Djarv)
219	?X: Always expand ~user if '/' was requested
220	case "$ansexp" in
221	/*) value="$ansexp" ;;
ae35c09d	222	[a-zA-Z]:/*) value="$ansexp" ;;
959f3c4c JH	223	*)
	224	redo=true
	225	case "$already" in
	226	true)
	227	echo "I shall only accept a full path name, as in /bin/ls." >&4
	228	echo "Use a ! shell escape if you wish to check pathnames." >&4
	229	;;
	230	*)
	231	echo "Please give a full path name, starting with slash." >&4
	232	case "$tilde" in
	233	true)
	234	echo "Note that using ~name is ok provided it expands well." >&4
	235	already=true
	236	;;
	237	esac
	238	esac
	239	;;
	240	esac
	241	;;
	242	esac
	243	case "$redo" in
	244	'')
	245	case "$type" in
	246	File)
	247	for fp in $gfpth; do
	248	if test "X$fp" = X.; then
	249	pf="$ansexp"
	250	else
	251	pf="$fp/$ansexp"
	252	fi
	253	if test -f "$pf"; then
	254	type=''
	255	elif test -r "$pf" \|\| (test -h "$pf") >/dev/null 2>&1
	256	then
	257	echo "($value is not a plain file, but that's ok.)"
	258	type=''
	259	fi
	260	if test X"$type" = X; then
	261	value="$pf"
	262	break
	263	fi
	264	done
	265	;;
	266	Directory)
	267	for fp in $gfpth; do
	268	if test "X$fp" = X.; then
7303ecc3 JH	269	dir="$ans"
7303ecc3 JH	270	direxp="$ansexp"
959f3c4c	271	else
dcb06850	272	dir="$fp/$ansexp"
7303ecc3	273	direxp="$fp/$ansexp"
959f3c4c	274	fi
7303ecc3	275	if test -d "$direxp"; then
959f3c4c	276	type=''
7303ecc3	277	value="$dir"
959f3c4c JH	278	break
	279	fi
	280	done
	281	;;
	282	Locate)
	283	if test -d "$ansexp"; then
	284	echo "(Looking for $loc_file in directory $value.)"
	285	value="$value/$loc_file"
	286	ansexp="$ansexp/$loc_file"
	287	fi
	288	if test -f "$ansexp"; then
	289	type=''
	290	fi
	291	case "$nopath_ok" in
	292	true) case "$value" in
	293	/) ;;
	294	*) echo "Assuming $value will be in people's path."
	295	type=''
	296	;;
	297	esac
	298	;;
	299	esac
	300	;;
	301	esac
	302
	303	case "$skip" in
	304	true) type='';
	305	esac
	306
	307	case "$type" in
	308	'') ;;
	309	*)
	310	if test "$fastread" = yes; then
	311	dflt=y
	312	else
	313	dflt=n
	314	fi
	315	rp="$what $value doesn't exist. Use that name anyway?"
	316	. UU/myread
	317	dflt=''
	318	case "$ans" in
	319	y*) type='';;
	320	*) echo " ";;
	321	esac
	322	;;
	323	esac
	324	;;
	325	esac
	326	;;
	327	esac
	328	done
	329	cd UU
	330	ans="$value"
	331	rp="$orig_rp"
	332	dflt="$orig_dflt"
	333	rm -f getfile.ok
	334	test "X$gfpthkeep" != Xy && gfpth=""
	335	EOSC
	336