00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 c--------------------------------------------------------------------------
00021 c
00022 c Contents: chkhead - Check for leading character in string
00023 c chktail - Check for trailing character in string
00024 c chksubs - Check for substitutions in string
00025 c stripbl - Remove non-significant blanks
00026 c cleanup - Beautify a string
00027 c shiftstr - Left shift a string.
00028 c locsubstr - Locate a substring with specific delimiters.
00029 c locchar - Locate a character in a string
00030 c repsubstr - Replace a substring by location
00031 c substitute - Repeatedly replace a substring by name.
00032 c
00033 c--------------------------------------------------------------------------
00034
00035 subroutine chkhead(line,nl,char,iflag,istrip)
00036 c
00037 c Check for presence of a specified leading character
00038 c
00039 c Set iflag = 1 if the character is found, and optionally
00040 c strip the character.
00041 c
00042 character*(*) line
00043 character*1 char
00044 c
00045 iflag = 0
00046 c
00047 c Search for the character.
00048 c
00049 do i=1,nl
00050 if (line(i:i).eq.char) iflag = 1
00051 if (line(i:i).gt.' ') go to 100
00052 end do
00053 i = nl + 1
00054 c
00055 c Strip the character, if desired.
00056 c
00057 100 if (iflag.eq.1.and.istrip.ne.0) then
00058 do ii = i+1,nl
00059 line(ii-i:ii-i) = line(ii:ii)
00060 end do
00061 nl = nl - i
00062 end if
00063 c
00064 end
00065
00066
00067 subroutine chktail(line,nl,char,iflag,istrip)
00068 c
00069 c Check for presence of a specified trailing character
00070 c
00071 c Set iflag = 1 if the character is found, and optionally
00072 c strip the character.
00073 c
00074 character*(*) line
00075 character*1 char
00076 c
00077 iflag = 0
00078 c
00079 c Search for the character.
00080 c
00081 do i = nl,1,-1
00082 if (line(i:i).eq.char) iflag = 1
00083 if (line(i:i).gt.' ') go to 100
00084 end do
00085 c
00086 c Strip the trailing character, if requested.
00087 c
00088 100 if (iflag.eq.1.and.istrip.ne.0) nl = i-1
00089 c
00090 end
00091
00092
00093 subroutine chksubs(line,nl,nhist,iexpand,subso,no,subsn,nn)
00094 c
00095 c Check for substitutions (.....^xxx"yyy" substitutes yyy for xxx).
00096 c Return the old and new strings in the arrays subso and subsn, and
00097 c truncate the line. Retain the trailing '"' in the convention to
00098 c allow blanks in the substitute string. Each invocation of this
00099 c routine will lead to the final ^xxx"yyy" substitution being flagged.
00100 c
00101 c On return, no > 0 if a substitution is due.
00102 c
00103 c The substitutions are not made here (history expansion must occur
00104 c first), but the ^xxx"yyy" piece is removed from the string.
00105 c If only the "substitute" piece is found, insert "!!" as the string.
00106 c
00107 character*(*) line,subso,subsn
00108 c
00109 isubs = 0
00110 iexpand = 0
00111 no = 0
00112 nn = 0
00113 c
00114 i = nl
00115 do while (i.gt.0)
00116 if (line(i:i).eq.'"') then
00117 if (line(i-1:i-1).ne.'"') then
00118 isubs = isubs+1
00119 if (isubs.eq.1) then
00120 icar = i
00121 else if (isubs.gt.2) then
00122 i = 0
00123 else
00124 nn = icar - 1 - i
00125 subsn(1:nn) = line(i+1:icar-1)
00126 icar = i
00127 end if
00128 else
00129 i = i - 1
00130 end if
00131 else if (line(i:i).eq.'^') then
00132 if (isubs.ge.2) then
00133 if (i.gt.1.and.line(i-1:i-1).eq.'^') then
00134 i = i - 1
00135 else
00136 no = icar - 1 - i
00137 subso(1:no) = line(i+1:icar-1)
00138 nl = i - 1
00139 iexpand = 1
00140 i = 0
00141 if (nl.le.0) then
00142 write(line(1:6),'(''!'',i5)')nhist
00143 nl = 6
00144 end if
00145 end if
00146 end if
00147 else if (isubs.eq.0.and.line(i:i).ne.' ') then
00148 i = 0
00149 end if
00150 i = i - 1
00151 end do
00152 c
00153 end
00154
00155
00156 subroutine stripbl(line,nl,*,*)
00157 c
00158 c Strip off trailing blanks and non-significant semicolons
00159 c from the input line.
00160 c
00161 character*(*) line
00162 c
00163 ns = 0
00164 do i = nl,1,-1
00165 if (line(i:i).ne.' ') then
00166 if (line(i:i).eq.';') then
00167 ns = 1
00168 do j = i-1,1,-1
00169 if (line(j:j).ne.';') go to 100
00170 ns = ns+1
00171 end do
00172 return 1
00173 end if
00174 go to 100
00175 end if
00176 end do
00177 return 2
00178 c
00179 100 if (2*(ns/2).eq.ns) then
00180 nl = i
00181 else
00182 nl = i - 1
00183 end if
00184 c
00185 end
00186
00187
00188 subroutine cleanup(input,nin,istart,*)
00189 c
00190 c Beautify the command string.
00191 c
00192 character*(*) input
00193 c
00194 c Strip leading blanks.
00195 c
00196 do i1 = 1,nin
00197 if (input(i1:i1).gt.' ') go to 50
00198 end do
00199 return 1
00200 c
00201 50 input(1:nin-i1+1) = input(i1:nin)
00202 nin = nin-i1+1
00203 c
00204 c Locate the first blank.
00205 c
00206 ib = 0
00207 nn = 0
00208 nino = nin
00209 do i = 1,nin
00210 if (input(i:i).eq.' ') then
00211 if (nn.gt.0.and.ib.eq.0) then
00212 ib = i
00213 go to 100
00214 end if
00215 else
00216 nn = 1
00217 end if
00218 end do
00219 c
00220 c Add a trailing blank if there are no others.
00221 c
00222 100 if (ib.eq.0) then
00223 ib = nin+1
00224 input(ib:ib) = ' '
00225 nin = ib
00226 end if
00227 c
00228 c Convert to lowercase.
00229 c
00230 do i = 1,ib-1
00231 if (input(i:i).ge.'A'.and.input(i:i).le.'Z')
00232 & input(i:i) = char(ichar(input(i:i))+32)
00233 end do
00234 c
00235 c Locate the start of the argument list.
00236 c
00237 do i = ib+1,nin
00238 if (input(i:i).ne.' ') then
00239 istart = i
00240 return
00241 end if
00242 end do
00243 istart = ib+1
00244 c
00245 end
00246
00247
00248 subroutine shiftstr(string,n,ishift)
00249 c
00250 c Shift the string left by the specified amount.
00251 c
00252 character*(*) string
00253 c
00254 if (ishift.le.0) return
00255 c
00256 do i=1,n-ishift
00257 string(i:i) = string(i+ishift:i+ishift)
00258 end do
00259 n = n - ishift
00260 c
00261 end
00262
00263
00264 subroutine locsubstr(string,n,c1,c2,i1,i2,iend)
00265 c
00266 c Locate the substring of string delimited by the characters
00267 c c1 and c2 (skip double characters), beginning the search at
00268 c location i2 + 1. The end of the string is regarded as a
00269 c delimiter of type c2 if iend is nonzero.
00270 c
00271 character*(*) string
00272 character*1 c1,c2
00273 c
00274 i1 = 0
00275 if (i2.lt.0) return
00276 c
00277 i = i2 + 1
00278 call locchar(string,n,i,c1)
00279 if (i.ge.n) return
00280 c
00281 i1save = i
00282 c
00283 i = i + 1
00284 call locchar(string,n,i,c2)
00285 if (i.gt.n.and.iend.eq.0) return
00286 c
00287 i1 = i1save
00288 i2 = i
00289 c
00290 end
00291
00292
00293 subroutine locchar(string,n,i,c)
00294 c
00295 c Find the next location of the single character c in string,
00296 c beginning the search at location i
00297 c
00298 character*(*) string
00299 character*1 c
00300 c
00301 10 do while(i.le.n.and.string(i:i).ne.c)
00302 i = i + 1
00303 end do
00304 c
00305 if (i.ge.n) return
00306 c
00307 if (string(i+1:i+1).eq.c) then
00308 i = i + 2
00309 go to 10
00310 end if
00311 c
00312 end
00313
00314
00315 subroutine repsubstr(string,n,i1in,i2in,substr,nsub)
00316 c
00317 c Replace the portion of string between i1in and i2in (inclusive)
00318 c by substr, and adjust the string length n accordingly.
00319 c
00320 c Handle the special case of insertion at the start of the
00321 c string by i2in = 0.
00322 c
00323 character*(*) string,substr
00324 c
00325 i1 = i1in
00326 i2 = i2in
00327 c
00328 c Make room for the new string.
00329 c
00330 if (i2.le.0) then
00331 i1 = 1
00332 i2 = 0
00333 joff = nsub
00334 else
00335 joff = nsub - (i2 - i1 + 1)
00336 end if
00337 c
00338 if (joff.ne.0) then
00339 if (joff.gt.0) then
00340 j1 = n
00341 j2 = i2 + 1
00342 jinc = -1
00343 else
00344 j1 = i2 + 1
00345 j2 = n
00346 jinc = 1
00347 end if
00348 c
00349 do j=j1,j2,jinc
00350 string(j+joff:j+joff) = string(j:j)
00351 end do
00352 c
00353 end if
00354 c
00355 string(i1:i1+nsub-1) = substr(1:nsub)
00356 n = n + joff
00357 c
00358 end
00359
00360
00361 subroutine substitute(line,nl,old,no,new,nn)
00362 c
00363 c Repeatedly substitute new for old in the input line.
00364 c
00365 character*(*)line,old,new
00366 c
00367 idel = no - nn
00368 if (idel.ne.0) inc = sign(1,idel)
00369 c
00370 i1 = 1
00371 100 if (i1.gt.nl) return
00372 c
00373 i2 = i1 - 1 + index(line(i1:nl),old(1:no))
00374 if (i2.lt.i1) return
00375 c
00376 if (inc.gt.0) then
00377 if = i2 + no
00378 il = nl
00379 else
00380 if = nl
00381 il = i2 + no
00382 end if
00383 if (idel.ne.0) then
00384 do i = if,il,inc
00385 line(i-idel:i-idel) = line(i:i)
00386 end do
00387 end if
00388 line(i2:i2+nn-1) = new(1:nn)
00389 nl = nl - idel
00390 i1 = i2 + nn
00391 c
00392 c Continue the search.
00393 c
00394 go to 100
00395 c
00396 end
