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 Perform (historical) expansions of the input line.
00023 c
00024 c expandr - replace !! by !nhist
00025 c expandh - insert a range of history items
00026 c expandl - expand historical references
00027 c expands - expand historical references of the form "!string"
00028 c applysubs - apply substitutions, after expansion
00029 c
00030 c----------------------------------------------------------------------
00031
00032 subroutine expandr(line,nl)
00033 save
00034 c
00035 c Expand repeat references within a line (!! --> !nhist).
00036 c
00037 character*(*) line
00038 c
00039 parameter (NHMAX = 500)
00040 c
00041 character*200 history(NHMAX)
00042 common /histchars/ history
00043 common /histnums/ lhist(NHMAX),nhist
00044 c
00045 if (nl.le.1) return
00046 c
00047 c *** Special case -- line may start with ^..."...", meaning
00048 c that the previous line is to be modified. If the first
00049 c nonblank character is "^", insert "!!" at the start of
00050 c the line.
00051 c
00052 i = 1
00053 do while (line(i:i).le.' ')
00054 i = i + 1
00055 end do
00056 if (line(i:i).eq.'^') call repsubstr(line,nl,0,0,'!!',2)
00057 c
00058 is = 1
00059 ie = 0
00060 c
00061 i = 0
00062 do while (i.lt.nl)
00063 i = i+1
00064 if (is.eq.0) then
00065 if (line(i:i).ne.';') go to 100
00066 if (line(i+1:i+1).eq.';') then
00067 i = i+1
00068 go to 100
00069 end if
00070 is = 1
00071 ie = 0
00072 else
00073 if (line(i:i).le.' ') go to 100
00074 if (line(i:i).ne.'!') then
00075 is = 0
00076 else if (ie.eq.0) then
00077 ie = 1
00078 else
00079 c
00080 c Perform the substitution.
00081 c
00082 do j = nl,i+1,-1
00083 line(j+4:j+4) = line(j:j)
00084 end do
00085 nl = nl + 4
00086 write(line(i:i+4),'(i5)')nhist
00087 i = i + 4
00088 is = 0
00089 end if
00090 end if
00091 100 end do
00092 c
00093 end
00094
00095
00096 subroutine expandh(line,nl,ic0,ihmin,ihmax,lextra,iret)
00097 save
00098 c
00099 c Expand the specified history range (ihmin to ihmax) into the line.
00100 c The insertion is to occur immediately after character #ic0 in
00101 c the line. The total number of characters added is returned as
00102 c lextra. No trailing semicolon is added at the end.
00103 c
00104 c Neither ic0 nor nl are altered. (Bookkeeping is to be performed
00105 c by the calling routine.)
00106 c
00107 c The status flag iret returns 1 iff an error occurs.
00108 c
00109 character*(*) line
00110 c
00111 parameter (NHMAX = 500)
00112 c
00113 character*200 history(NHMAX)
00114 common /histchars/ history
00115 common /histnums/ lhist(NHMAX),nhist
00116 c
00117 iret = 0
00118 lextra = 0
00119 c
00120 do ih = ihmin,ihmax
00121 c
00122 jh = ih
00123 do while (jh.gt.NHMAX)
00124 jh = jh - NHMAX
00125 end do
00126 c
00127 if (nl+lhist(jh).ge.len(line)) then
00128 write(6,*)'Expanded line too long.'
00129 & ' Check for possible recursion.'
00130 iret = 1
00131 return
00132 end if
00133 c
00134 l0 = lextra
00135 lextra = lextra + lhist(jh)
00136 c
00137 line(ic0+l0+1:ic0+lextra) = history(jh)(1:lhist(jh))
00138 c
00139 c Add a delimiting ";", except at the end.
00140 c
00141 if (ih.lt.ihmax) then
00142 lextra = lextra + 1
00143 line(ic0+lextra:ic0+lextra) = ';'
00144 end if
00145 c
00146 end do
00147 c
00148 end
00149
00150
00151 subroutine expandl(line,nl,isuppr,*)
00152 save
00153 c
00154 c Repeatedly expand historical references in line. This routine
00155 c serves a dual function, so the substring to be expanded can be
00156 c of the form "! n;" or "! n^". This allows use during normal
00157 c line expansion, and during substitutions.
00158 c
00159 c The expansion is recursive unless isuppr is nonzero.
00160 c
00161 character*(*) line
00162 c
00163 parameter (NHMAX = 500)
00164 c
00165 character*200 history(NHMAX),lsto
00166 common/histchars/history
00167 common/histnums/lhist(NHMAX),nhist
00168 c
00169 character*80 temp
00170 character*1 which
00171 c
00172 if (nl.le.0) return 1
00173 c
00174 c The logic here is similar to that used in mcdraw when
00175 c interpreting individual commands.
00176 c
00177 iscolon = 0
00178 10 if (iscolon.ge.nl) return
00179 c
00180 c Find the next substring. If may be terminated by ";" or "^".
00181 c Note that if "^" is the terminator, we will have to search
00182 c for the next ";" before continuing.
00183 c
00184 c Note that the two expected expansion patterns are "!....;"
00185 c and "!...^xxx"yyy";".
00186 c
00187 ic0 = iscolon
00188 which = ';'
00189 c
00190 15 do ic1 = iscolon+1,nl
00191 which = line(ic1:ic1)
00192 if (which.eq.';'.or.which.eq.'^') go to 20
00193 end do
00194 ic1 = nl + 1
00195 20 if (ic1.lt.nl.and.line(ic1+1:ic1+1).eq.which) then
00196 iscolon = ic1 + 1
00197 go to 15
00198 end if
00199 c
00200 c The piece to be expanded runs from ic0+1 to ic1-1.
00201 c The terminating character is "which", at location ic1.
00202 c
00203 nin = ic1 - ic0 - 1
00204 temp(1:nin) = line(ic0+1:ic1-1)
00205 iscolon = ic1
00206 c
00207 c Expand any historical references.
00208 c
00209 do i = 1,nin
00210 if (temp(i:i).gt.' ') then
00211 if (temp(i:i).ne.'!') go to 100
00212 if (i.ge.nin) then
00213 write(6,*)'warning: possible input error...'
00214 go to 100
00215 end if
00216 call rdecode(temp(i+1:nin),nhist,ihmin,ihmax,*1001)
00217 go to 32
00218 end if
00219 end do
00220 c
00221 c Continue expanding the line.
00222 c
00223 go to 100
00224 c
00225 c Save the remainder of the string before expansion.
00226 c
00227 32 nlsto = 0
00228 if (ic1.lt.nl) then
00229 c
00230 c Note that the trailing ";" or "^" is saved.
00231 c
00232 nlsto = nl - ic1 + 1
00233 lsto(1:nlsto) = line(ic1:nl)
00234 end if
00235 c
00236 c Expand the history list (no trailing delimiter added).
00237 c
00238 call expandh(line,nl,ic0,ihmin,ihmax,lextra,iret)
00239 if (iret.ne.0) return 1
00240 c
00241 c Restore the rest of the line. (Note: this would be a good
00242 c place for a consistency check, as the string lengths are not
00243 c forced to agree...)
00244 c
00245 nl = nl - nin + lextra
00246 if (nlsto.gt.0) then
00247 line(ic0+lextra+1:nl) = lsto(1:nlsto)
00248 end if
00249 c
00250 c Continue recursively at ic0, or non-recursively, depending on
00251 c input option isuppr.
00252 c
00253 100 if (isuppr.eq.0.and.which.eq.';') then
00254 iscolon = ic0
00255 else
00256 c
00257 c Start at the next ';'.
00258 c
00259 iscolon = ic0 + lextra + 1
00260 if (which.eq.'^') then
00261 do while (iscolon.le.nl
00262 & .and.line(iscolon:iscolon).ne.';')
00263 iscolon = iscolon + 1
00264 end do
00265 end if
00266 end if
00267 c
00268 go to 10
00269 c
00270 1001 return 1
00271 end
00272
00273
00274 subroutine expands(line,nl)
00275 save
00276 c
00277 c Perform symbolic history expansion on line, replacing !string
00278 c by !ihist.
00279 c
00280 character*(*)line
00281 character*6 temp
00282 c
00283 parameter (NHMAX = 500)
00284 c
00285 character*200 history(NHMAX)
00286 common/histchars/history
00287 common/histnums/lhist(NHMAX),nhist
00288 c
00289 i2 = 0
00290 10 if (i2+1.ge.nl) return
00291 c
00292 call locsubstr(line,nl,'!',';',i1,i2,1)
00293 if (i1.le.0) return
00294 c
00295 c Strip leading and trailing blanks.
00296 c
00297 i1save = i1
00298 i1 = i1 + 1
00299 do while (line(i1:i1).le.' ')
00300 i1 = i1 + 1
00301 end do
00302 c
00303 c Note that i2 is either the location of a ";" or nl + 1.
00304 c
00305 i2save = i2
00306 i2 = i2 - 1
00307 do while (line(i2:i2).le.' ')
00308 i2 = i2 - 1
00309 end do
00310 c
00311 if (i1.le.i2) then
00312 c
00313 c Now the string to be searched for lies in line(i1:i2).
00314 c Only try to substitute if the entire string is non-numeric.
00315 c
00316 do i=i1,i2
00317 if (line(i:i).lt.'0'.or.line(i:i).gt.'9') go to 50
00318 end do
00319 go to 100
00320 c
00321 50 do ihist = nhist,max(1,nhist-NHMAX),-1
00322 c
00323 jh = ihist
00324 do while (jh.gt.NHMAX)
00325 jh = jh - NHMAX
00326 end do
00327 c
00328 if (index(history(jh)(1:lhist(jh)),line(i1:i2)).eq.1)
00329 & then
00330 write(temp,'(''!'',i5)')ihist
00331 call repsubstr(line,nl,i1save,i2save-1,temp,6)
00332 c
00333 c Note that we keep the trailing ";", if one exists.
00334 c
00335 go to 100
00336 end if
00337 c
00338 end do
00339 end if
00340 c
00341 c Continue the search.
00342 c
00343 100 i2 = i2save
00344 go to 10
00345 c
00346 end
00347
00348
00349 subroutine applysubs(line,nl,*)
00350 save
00351 c
00352 c Apply substitutions to the input line. Expand each subcommand
00353 c as necessary before making the changes.
00354 c
00355 character*(*) line
00356 character temp*200,subsn*80,subso*80
00357 c
00358 parameter (NHMAX = 500)
00359 c
00360 character*200 history(NHMAX)
00361 common /histchars/ history
00362 common /histnums/ lhist(NHMAX),nhist
00363 c
00364 c Locate and process each reference.
00365 c
00366 i2 = 0
00367 c
00368 100 call locsubstr(line,nl,'!',';',i1,i2,1)
00369 if (i1.eq.0) return
00370 c
00371 nt = i2 - i1
00372 temp(1:nt) = line(i1:i2-1)
00373 c
00374 c Note that temp includes the leading "!" but not the trailing ";".
00375 c
00376 kount = 0
00377 no = 1
00378 do while (no.gt.0.and.kount.lt.100)
00379 c
00380 call chksubs(temp,nt,nhist,iexpand,subso,no,subsn,nn)
00381 c
00382 c Perform expansion, non-recursively, prior to substitution.
00383 c
00384 if (iexpand.gt.0) call expandl(temp,nt,1,*99999)
00385 if (no.gt.0) call substitute(temp,nt,subso,no,subsn,nn)
00386 kount = kount + 1
00387 c
00388 end do
00389 c
00390 call repsubstr(line,nl,i1,i2-1,temp,nt)
00391 c
00392 c Continue the search.
00393 c
00394 i2 = i1 + nt
00395 go to 100
00396 c
00397 99999 return 1
00398 c
00399 end
