U/modified/Getfile.U

   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:
  85 ?MAKE:Getfile: d_portable contains startsh Myread Filexp trnl
  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 \
  90         value exp_file nopath_ok loc_file fp pf direxp
  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 *\(*)
 114         expr $fn : '.*(\(.*\)).*' | tr ',' $trnl >getfile.ok
 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" ;;
 222                         *)
 223                                 redo=true
 224                                 case "$already" in
 225                                 true)
 226                                 echo "I shall only accept a full path name, as in /bin/ls." >&4
 227                                 echo "Use a ! shell escape if you wish to check pathnames." >&4
 228                                         ;;
 229                                 *)
 230                                 echo "Please give a full path name, starting with slash." >&4
 231                                         case "$tilde" in
 232                                         true)
 233                                 echo "Note that using ~name is ok provided it expands well." >&4
 234                                                 already=true
 235                                                 ;;
 236                                         esac
 237                                 esac
 238                                 ;;
 239                         esac
 240                         ;;
 241                 esac
 242                 case "$redo" in
 243                 '')
 244                         case "$type" in
 245                         File)
 246                                 for fp in $gfpth; do
 247                                         if test "X$fp" = X.; then
 248                                             pf="$ansexp"
 249                                         else
 250                                             pf="$fp/$ansexp"
 251                                         fi
 252                                         if test -f "$pf"; then
 253                                                 type=''
 254                                         elif test -r "$pf" || (test -h "$pf") >/dev/null 2>&1
 255                                         then
 256                                                 echo "($value is not a plain file, but that's ok.)"
 257                                                 type=''
 258                                         fi
 259                                         if test X"$type" = X; then
 260                                             value="$pf"
 261                                             break
 262                                         fi
 263                                 done
 264                                 ;;
 265                         Directory)
 266                                 for fp in $gfpth; do
 267                                         if test "X$fp" = X.; then
 268                                             dir="$ans"
 269                                             direxp="$ansexp"
 270                                         else
 271                                             dir="$fp/$ansexp"
 272                                             direxp="$fp/$ansexp"
 273                                         fi
 274                                         if test -d "$direxp"; then
 275                                                 type=''
 276                                                 value="$dir"
 277                                                 break
 278                                         fi
 279                                 done
 280                                 ;;
 281                         Locate)
 282                                 if test -d "$ansexp"; then
 283                                         echo "(Looking for $loc_file in directory $value.)"
 284                                         value="$value/$loc_file"
 285                                         ansexp="$ansexp/$loc_file"
 286                                 fi
 287                                 if test -f "$ansexp"; then
 288                                         type=''
 289                                 fi
 290                                 case "$nopath_ok" in
 291                                 true)   case "$value" in
 292                                         */*) ;;
 293                                         *)      echo "Assuming $value will be in people's path."
 294                                                 type=''
 295                                                 ;;
 296                                         esac
 297                                         ;;
 298                                 esac
 299                                 ;;
 300                         esac
 301
 302                         case "$skip" in
 303                         true) type='';
 304                         esac
 305
 306                         case "$type" in
 307                         '') ;;
 308                         *)
 309                                 if test "$fastread" = yes; then
 310                                         dflt=y
 311                                 else
 312                                         dflt=n
 313                                 fi
 314                                 rp="$what $value doesn't exist.  Use that name anyway?"
 315                                 . UU/myread
 316                                 dflt=''
 317                                 case "$ans" in
 318                                 y*) type='';;
 319                                 *) echo " ";;
 320                                 esac
 321                                 ;;
 322                         esac
 323                         ;;
 324                 esac
 325                 ;;
 326         esac
 327 done
 328 cd UU
 329 ans="$value"
 330 rp="$orig_rp"
 331 dflt="$orig_dflt"
 332 rm -f getfile.ok
 333 test "X$gfpthkeep" != Xy && gfpth=""
 334 EOSC
 335