summaryrefslogtreecommitdiff
path: root/mcon/U/Getfile.U
diff options
context:
space:
mode:
Diffstat (limited to 'mcon/U/Getfile.U')
-rw-r--r--mcon/U/Getfile.U339
1 files changed, 339 insertions, 0 deletions
diff --git a/mcon/U/Getfile.U b/mcon/U/Getfile.U
new file mode 100644
index 0000000..fe917ad
--- /dev/null
+++ b/mcon/U/Getfile.U
@@ -0,0 +1,339 @@
+?RCS: $Id$
+?RCS:
+?RCS: Copyright (c) 1991-1997, 2004-2006, 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 4.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
+*\(*)
+ : getfile will accept an answer from the comma-separated list
+ : enclosed in parentheses even if it does not meet other criteria.
+ 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" ;;
+?X: Allow for c:/some/path
+ [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
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-18 16:01:49 +0000